00001  IDENTIFICATION DIVISION.                                         08/05/98
00002  PROGRAM-ID.             DTSBU002.                                DTSBU002
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV003
00004  DATE-WRITTEN.           NOVEMBER 1991.                           DTSBU002
00005  DATE-COMPILED.                                                   DTSBU002
00006      SKIP3                                                        DTSBU002
00007 *****                                                             DTSBU002
00008 *                                                                 DTSBU002
00009 *    FUNCTION:  DISPLAY DATE IN TEXT FORMAT.                      DTSBU002
00010 *                                                                 DTSBU002
00011 *                                                                 DTSBU002
00012 *    MODIFICATION LOG:                                            DTSBU002
00013 *                                                                 DTSBU002
00014 *    08/04/98    CLONED FROM MACCU002.                               CL**2
00015 *                WORK ORDER:                 PROGRAMMER: ZL1         CL**2
00016 *                                                                 DTSBU002
00017 *    XX/XX/XX    XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX     DTSBU002
00018 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX     DTSBU002
00019 *                WORK ORDER:                 PROGRAMMER:          DTSBU002
00020 *                                                                 DTSBU002
00021 *                                                                 DTSBU002
00022 *    DESCRIPTION:                                                 DTSBU002
00023 *                                                                 DTSBU002
00024 *    DTSBU002 IS PASSED L002-OPTION, AND L002-DATE. DTSBU002         CL**2
00025 *    RETURNS L002-LONG-TEXT-CNT, L002-LONG-TEXT-AREA,             DTSBU002
00026 *    L002-SHORT-TEXT-CNT, AND L002-SHORT-TEXT-AREA.               DTSBU002
00027 *                                                                 DTSBU002
00028 *    IF L002-OPTION IS NOT A VALID OPTION OR L002-DATE IS NOT A   DTSBU002
00029 *    VALID DATE, THEN ABEND DTSBU002 WITH ABEND CODE +002.           CL**2
00030 *                                                                 DTSBU002
00031 *    EXAMPLE OF USE:                                              DTSBU002
00032 *                                                                 DTSBU002
00033 *      IF L002-UPPER-CASE AND L002-DATE = 19911203, THEN          DTSBU002
00034 *        RETURN L002-LONG-TEXT-CNT = 16 AND L002-LONG-TEXT-AREA = DTSBU002
00035 *        'DECEMBER 3, 1991' AND L002-SHORT-TEXT-CNT = 11 AND      DTSBU002
00036 *        L002-SHORT-TEXT-AREA = 'DEC 3, 1991'                     DTSBU002
00037 *                                                                 DTSBU002
00038 *    SET THE SPF EDITOR TO "CAPS OFF" AND THE SCREEN DISPLAY TO   DTSBU002
00039 *    MIXED MODE ("Aa") WHEN EDITING THIS MODULE.                  DTSBU002
00040 *****                                                             DTSBU002
00041      SKIP3                                                        DTSBU002
00042  ENVIRONMENT DIVISION.                                            DTSBU002
00043      SKIP3                                                        DTSBU002
00044  DATA DIVISION.                                                   DTSBU002
00045      SKIP3                                                        DTSBU002
00046  WORKING-STORAGE SECTION.                                         DTSBU002
000465 77  PAN-VALET PICTURE X(24) VALUE '003DTSBU002  08/05/98'.       DTSBU002
00047      SKIP3                                                        DTSBU002
00048  01  WRK-AREA.                                                    DTSBU002
00049      05  WRK-ABEND-CD               PIC S9(04)  COMP VALUE +002.  DTSBU002
00050      05  LONG-SUB                   PIC S9(04)  COMP.             DTSBU002
00051      05  SHORT-SUB                  PIC S9(04)  COMP.             DTSBU002
00052      05  WRK-DAY.                                                 DTSBU002
00053          10  WRK-DAY-1              PIC  X(01).                   DTSBU002
00054          10  WRK-DAY-2              PIC  X(01).                   DTSBU002
00055  01  LONG-DATE                      PIC  X(18).                   DTSBU002
00056  01  SHORT-DATE                     PIC  X(12).                   DTSBU002
00057      SKIP1                                                        DTSBU002
00058  01  MONTH-TABLE-1.                                               DTSBU002
00059      05  FILLER                PIC X(09)  VALUE 'JANUARY  '.      DTSBU002
00060      05  FILLER                PIC X(09)  VALUE 'FEBRUARY '.      DTSBU002
00061      05  FILLER                PIC X(09)  VALUE 'MARCH    '.      DTSBU002
00062      05  FILLER                PIC X(09)  VALUE 'APRIL    '.      DTSBU002
00063      05  FILLER                PIC X(09)  VALUE 'MAY      '.      DTSBU002
00064      05  FILLER                PIC X(09)  VALUE 'JUNE     '.      DTSBU002
00065      05  FILLER                PIC X(09)  VALUE 'JULY     '.      DTSBU002
00066      05  FILLER                PIC X(09)  VALUE 'AUGUST   '.      DTSBU002
00067      05  FILLER                PIC X(09)  VALUE 'SEPTEMBER'.      DTSBU002
00068      05  FILLER                PIC X(09)  VALUE 'OCTOBER  '.      DTSBU002
00069      05  FILLER                PIC X(09)  VALUE 'NOVEMBER '.      DTSBU002
00070      05  FILLER                PIC X(09)  VALUE 'DECEMBER '.      DTSBU002
00071  01  FILLER REDEFINES MONTH-TABLE-1.                              DTSBU002
00072      05  FILLER   OCCURS 12.                                      DTSBU002
00073          10  MONTH-NAME-1.                                        DTSBU002
00074              15  MONTH-NAME-1-SHORT PIC X(03).                    DTSBU002
00075              15  FILLER             PIC X(06).                    DTSBU002
00076  SKIP1                                                            DTSBU002
00077  01  MONTH-TABLE-2.                                               DTSBU002
00078      05  FILLER                PIC X(09)  VALUE 'January  '.      DTSBU002
00079      05  FILLER                PIC X(09)  VALUE 'February '.      DTSBU002
00080      05  FILLER                PIC X(09)  VALUE 'March    '.      DTSBU002
00081      05  FILLER                PIC X(09)  VALUE 'April    '.      DTSBU002
00082      05  FILLER                PIC X(09)  VALUE 'May      '.      DTSBU002
00083      05  FILLER                PIC X(09)  VALUE 'June     '.      DTSBU002
00084      05  FILLER                PIC X(09)  VALUE 'July     '.      DTSBU002
00085      05  FILLER                PIC X(09)  VALUE 'August   '.      DTSBU002
00086      05  FILLER                PIC X(09)  VALUE 'September'.      DTSBU002
00087      05  FILLER                PIC X(09)  VALUE 'October  '.      DTSBU002
00088      05  FILLER                PIC X(09)  VALUE 'November '.      DTSBU002
00089      05  FILLER                PIC X(09)  VALUE 'December '.      DTSBU002
00090  01  FILLER REDEFINES MONTH-TABLE-2.                              DTSBU002
00091      05  FILLER   OCCURS 12.                                      DTSBU002
00092          10  MONTH-NAME-2.                                        DTSBU002
00093              15  MONTH-NAME-2-SHORT PIC X(03).                    DTSBU002
00094              15  FILLER             PIC X(06).                    DTSBU002
00095  SKIP1                                                            DTSBU002
00096  01  MONTH-TABLE-LENGTH.                                          DTSBU002
00097      05  LENGTH-JANUARY        PIC S9(04) COMP VALUE +7.          DTSBU002
00098      05  LENGTH-FEBRUARY       PIC S9(04) COMP VALUE +8.          DTSBU002
00099      05  LENGTH-MARCH          PIC S9(04) COMP VALUE +5.          DTSBU002
00100      05  LENGTH-APRIL          PIC S9(04) COMP VALUE +5.          DTSBU002
00101      05  LENGTH-MAY            PIC S9(04) COMP VALUE +3.          DTSBU002
00102      05  LENGTH-JUNE           PIC S9(04) COMP VALUE +4.          DTSBU002
00103      05  LENGTH-JULY           PIC S9(04) COMP VALUE +4.          DTSBU002
00104      05  LENGTH-AUGUST         PIC S9(04) COMP VALUE +6.          DTSBU002
00105      05  LENGTH-SEPTEMBER      PIC S9(04) COMP VALUE +9.          DTSBU002
00106      05  LENGTH-OCTOBER        PIC S9(04) COMP VALUE +7.          DTSBU002
00107      05  LENGTH-NOVEMBER       PIC S9(04) COMP VALUE +8.          DTSBU002
00108      05  LENGTH-DECEMBER       PIC S9(04) COMP VALUE +8.          DTSBU002
00109  01  FILLER REDEFINES MONTH-TABLE-LENGTH.                         DTSBU002
00110      05  MONTH-NAME-LENGTH OCCURS 12 TIMES PIC S9(04) COMP.       DTSBU002
00111      EJECT                                                        DTSBU002
00112  01  L001-LINK-AREA.                                              DTSBU002
00113  ++INCLUDE DTSIL001                                                  CL**3
00114      EJECT                                                        DTSBU002
00115  LINKAGE SECTION.                                                 DTSBU002
00116      SKIP3                                                        DTSBU002
00117  01  L002-LINK-AREA.                                              DTSBU002
00118  ++INCLUDE DTSIL002                                                  CL**3
00119      EJECT                                                        DTSBU002
00120  PROCEDURE DIVISION                                               DTSBU002
00121      USING L002-LINK-AREA.                                        DTSBU002
00122      SKIP2                                                        DTSBU002
00123      PERFORM P1000-PROCESS THRU                                      CL**2
00124              P1000-PROCESS-EXIT.                                     CL**2
00125      SKIP2                                                        DTSBU002
00126      GOBACK.                                                      DTSBU002
00127      EJECT                                                        DTSBU002
00128  P1000-PROCESS.                                                   DTSBU002
00129      SKIP1                                                        DTSBU002
00130      MOVE '1'        TO L001-OPTION.                              DTSBU002
00131      MOVE L002-DATE  TO L001-FED-8-DATE-9.                        DTSBU002
00132      PERFORM S001-LINK-DATE THRU                                     CL**2
00133              S001-LINK-DATE-EXIT.                                    CL**2
00134      IF L001-INVALID-DATE                                         DTSBU002
00135         PERFORM S999-ABEND THRU S999-ABEND-EXIT.                     CL**2
00136      SKIP1                                                        DTSBU002
00137      IF L002-UPPER-CASE                                           DTSBU002
00138         MOVE MONTH-NAME-1       (L001-FED-8-MO) TO LONG-DATE      DTSBU002
00139         MOVE MONTH-NAME-1-SHORT (L001-FED-8-MO) TO SHORT-DATE     DTSBU002
00140      ELSE                                                         DTSBU002
00141      IF L002-MIXED-CASE                                           DTSBU002
00142         MOVE MONTH-NAME-2       (L001-FED-8-MO) TO LONG-DATE      DTSBU002
00143         MOVE MONTH-NAME-2-SHORT (L001-FED-8-MO) TO SHORT-DATE     DTSBU002
00144      ELSE                                                         DTSBU002
00145         PERFORM S999-ABEND THRU S999-ABEND-EXIT.                     CL**2
00146      SKIP1                                                        DTSBU002
00147      PERFORM P1100-DAY-AND-YEAR THRU                                 CL**2
00148              P1100-DAY-AND-YEAR-EXIT.                                CL**2
00149      SKIP1                                                        DTSBU002
00150      MOVE LONG-DATE     TO     L002-LONG-TEXT-AREA.               DTSBU002
00151      ADD LONG-SUB, 5    GIVING L002-LONG-TEXT-CNT.                DTSBU002
00152      MOVE SHORT-DATE    TO     L002-SHORT-TEXT-AREA.              DTSBU002
00153      ADD SHORT-SUB, 5   GIVING L002-SHORT-TEXT-CNT.               DTSBU002
00154      SKIP1                                                        DTSBU002
00155  P1000-PROCESS-EXIT.                                                 CL**2
00156      EXIT.                                                        DTSBU002
00157      EJECT                                                        DTSBU002
00158  P1100-DAY-AND-YEAR.                                              DTSBU002
00159      ADD MONTH-NAME-LENGTH (L001-FED-8-MO), 2  GIVING LONG-SUB.   DTSBU002
00160      MOVE +5                                   TO     SHORT-SUB.  DTSBU002
00161      SKIP1                                                        DTSBU002
00162      MOVE L001-FED-8-DA                        TO WRK-DAY.        DTSBU002
00163      IF WRK-DAY-1  NOT =  '0'                                     DTSBU002
00164          MOVE WRK-DAY-1 TO LONG-DATE  (LONG-SUB  : 1)             DTSBU002
00165                            SHORT-DATE (SHORT-SUB : 1)             DTSBU002
00166          ADD +1 TO LONG-SUB                                       DTSBU002
00167                    SHORT-SUB.                                     DTSBU002
00168      MOVE WRK-DAY-2 TO LONG-DATE  (LONG-SUB  : 1)                 DTSBU002
00169                        SHORT-DATE (SHORT-SUB : 1)                 DTSBU002
00170      SKIP1                                                        DTSBU002
00171      ADD +1 TO LONG-SUB                                           DTSBU002
00172                SHORT-SUB.                                         DTSBU002
00173      MOVE ','                  TO LONG-DATE  (LONG-SUB  : 1)      DTSBU002
00174                                   SHORT-DATE (SHORT-SUB : 1).     DTSBU002
00175      MOVE L001-FED-8-YR        TO LONG-DATE  (LONG-SUB  + 2 : 4)  DTSBU002
00176                                   SHORT-DATE (SHORT-SUB + 2 : 4). DTSBU002
00177      SKIP1                                                        DTSBU002
00178  P1100-DAY-AND-YEAR-EXIT.  EXIT.                                     CL**2
00179      EJECT                                                        DTSBU002
00180  S001-LINK-DATE.                                                  DTSBU002
00181      SKIP1                                                        DTSBU002
00182      CALL 'DTSBU001'                                                 CL**2
00183          USING L001-LINK-AREA.                                    DTSBU002
00184      SKIP1                                                        DTSBU002
00185  S001-LINK-DATE-EXIT.  EXIT.                                         CL**2
00186      EJECT                                                        DTSBU002
00187  S999-ABEND.                                                      DTSBU002
00188      SKIP1                                                        DTSBU002
00189      CALL 'DTSBU999'                                                 CL**2
00190          USING WRK-ABEND-CD.                                      DTSBU002
00191      SKIP1                                                        DTSBU002
00192  S999-ABEND-EXIT.  EXIT.                                             CL**2
