       IDENTIFICATION DIVISION.
       PROGRAM-ID. Y2KIVP.
       AUTHOR. JAY MOSELEY.
       DATE-WRITTEN. FEBRUARY, 1997.
       DATE-COMPILED.
      * ************************************************************* *
      * THE PURPOSE OF THIS PROGRAM IS TO VERIFY THE CORRECT INSTALL- *
      * ATION AND FUNCTIONING OF THE SET OF DYNAMICALLY CALLABLE Y2K  *
      * SUBROUTINES (YEAR 2000 COMPLAIANT DATE ROUTINES).  WHEN THE   *
      * SUPPLIED DATA IS READ AND PROCESSED BY THIS PROGRAM, EACH OF  *
      * THE ROUTINES WILL BE CALLED AND ALL FUNCTIONALITY OF EACH IS  *
      * THOROUGHLY TESTED.  THE OUTPUT REPORT SHOULD BE COMPARED WITH *
      * THE BENCHMARK REPORT PRODUCED WHEN THE ROUTINES WERE ORIGIN-  *
      * ALLY WRITTEN AND TESTED.  THEY SHOULD BE IDENTICAL.           *
      * ************************************************************* *
      /
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT DATA-FILE ASSIGN TO "Y2KIVP.dat"
               ORGANIZATION IS LINE SEQUENTIAL.
           SELECT PRINT-FILE ASSIGN TO "Y2KIVP.rpt"
               ORGANIZATION IS LINE SEQUENTIAL.
       DATA DIVISION.
      
       FILE SECTION.
       FD  DATA-FILE
           DATA RECORD IS DATA-RECORD.
       01  DATA-RECORD                 PIC X(80).
       FD  PRINT-FILE
           DATA RECORD IS PRINT-RECORD.
       01  PRINT-RECORD                PIC X(132).
      /
       WORKING-STORAGE SECTION.
      
      * ************************************************************* *
      * THESE ARE PROGRAM CONTROL SWITCHES AND MISCELLANEOUS FIELDS.  *
      * ************************************************************* *
       01  PROGRAM-CONTROL-FIELDS.
           02  END-OF-DATA-SWITCH      PIC X(1) VALUE 'N'.
               88  END-OF-DATA         VALUE 'Y'.
           02  WS-CURRENT-DATE         PIC X(8).
           02  SYSTEM-TIME             PIC 9(8).
           02  FILLER                  REDEFINES SYSTEM-TIME.
               03  SYSTEM-TIME-SHORT   PIC 9(4).
               03  FILLER              PIC 9(4).
           02  PAGE-COUNT              PIC 999 VALUE ZERO.
           02  LINE-COUNT              PIC 99  VALUE 99.
           02  PAGE-SIZE               PIC 99  VALUE 42.
      
      * ************************************************************* *
      * FOLLOWING ARE SPECIFIC RECORD DESCRIPTIONS USED TO REDEFINE   *
      * THE TEST DATA INPUT RECORD FOR EACH OF THE 12 ROUTINES.       *
      * ************************************************************* *
       01  TEST-RECORD.
           02  TR-IDENTIFICATION       PIC X(4).
           02  FILLER                  PIC X(1).
           02  TR-DATA                 PIC X(75).
      
           02  FILLER                  REDEFINES TR-DATA.
               03  TR-ATOG-ANUM        PIC X(7).
               03  FILLER              PIC X(68).
      
           02  FILLER                  REDEFINES TR-DATA.
               03  TR-CONV-DATE        PIC X(6).
               03  FILLER              PIC X(1).
               03  TR-CONV-FORMAT      PIC X(1).
               03  FILLER              PIC X(1).
               03  TR-CONV-BREAK       PIC X(2).
               03  FILLER              PIC X(64).
      
           02  FILLER                  REDEFINES TR-DATA.
               03  TR-DFMT-DATE        PIC X(8).
               03  FILLER              PIC X(1).
               03  TR-DFMT-MAJOR       PIC X(1).
               03  FILLER              PIC X(1).
               03  TR-DFMT-MINOR       PIC X(1).
               03  FILLER              PIC X(63).
      
           02  FILLER                  REDEFINES TR-DATA.
               03  TR-DOWN-DATE        PIC X(8).
               03  FILLER              PIC X(67).
      
           02  FILLER                  REDEFINES TR-DATA.
               03  TR-ESTR-YEAR        PIC X(4).
               03  FILLER              PIC X(71).
      
           02  FILLER                  REDEFINES TR-DATA.
               03  TR-GTOA-DATE        PIC X(8).
               03  FILLER              PIC X(67).
      
           02  FILLER                  REDEFINES TR-DATA.
               03  TR-GTOJ-DATE        PIC X(8).
               03  FILLER              PIC X(67).
      
           02  FILLER                  REDEFINES TR-DATA.
               03  TR-JTOG-DATE        PIC X(7).
               03  FILLER              PIC X(68).
      
           02  FILLER                  REDEFINES TR-DATA.
               03  TR-LAGE-DATE1       PIC X(8).
               03  FILLER              PIC X(1).
               03  TR-LAGE-DATE2       PIC X(8).
               03  FILLER              PIC X(58).
      
           02  FILLER                  REDEFINES TR-DATA.
               03  TR-PROJ-DATE        PIC X(8).
               03  FILLER              PIC X(1).
               03  TR-PROJ-INCREMENT   PIC X(6).
               03  FILLER              PIC X(60).
      
           02  FILLER                  REDEFINES TR-DATA.
               03  TR-SAGE-DATE1       PIC X(8).
               03  FILLER              PIC X(1).
               03  TR-SAGE-DATE2       PIC X(8).
               03  FILLER              PIC X(58).
      
           02  FILLER                  REDEFINES TR-DATA.
               03  TR-TDOW-DATE        PIC X(8).
               03  FILLER              PIC X(1).
               03  TR-TDOW-DIRECTION   PIC X(1).
               03  FILLER              PIC X(1).
               03  TR-TDOW-DAY-NUMBER  PIC X(1).
               03  FILLER              PIC X(63).

       COPY 'Y2K.cpy'.      
      
      * ************************************************************* *
      * FOLLOWING ARE THE REPORT HEADING AND DETAIL DESCRIPTIONS.     *
      * ************************************************************* *
      
       01  HEADING-1.
           02  FILLER  PIC X(6) VALUE 'DATE: '.
           02  H1-DATE PIC X(10) VALUE '  /  /    '.
           02  FILLER  PIC X(30) VALUE SPACES.
           02  FILLER  PIC X(36) VALUE
               'YEAR 2000 COMPLIANT DATE SUBROUTINES'.
           02  FILLER  PIC X(35) VALUE SPACES.
           02  FILLER  PIC X(15) VALUE 'PROGRAM: Y2KIVP'.
      
       01  HEADING-2.
           02  FILLER  PIC X(6) VALUE 'TIME: '.
           02  H2-TIME PIC Z9/99.
           02  FILLER  PIC X(36) VALUE SPACES.
           02  FILLER  PIC X(33) VALUE
               'INSTALLATION VERIFICATION PROGRAM'.
           02  FILLER  PIC X(40) VALUE SPACES.
           02  FILLER  PIC X(9) VALUE 'PAGE:   '.
           02  H2-PAGE PIC ZZ9.
      
       01  HEADING-3.
           02  FILLER  PIC X(22) VALUE
               'TEST DATA INPUT RECORD'.
           02  FILLER  PIC X(39) VALUE SPACES.
           02  FILLER  PIC X(7) VALUE 'ROUTINE'.
           02  FILLER  PIC X(2) VALUE SPACES.
           02  FILLER  PIC X(3) VALUE 'R/C'.
           02  FILLER  PIC X(59) VALUE SPACES.
      
       01  DETAIL-LINE.
           02  DL-TEST-RECORD          PIC X(54).
           02  FILLER                  PIC X(7) VALUE SPACES.
           02  DL-ROUTINE-NAME         PIC X(7).
           02  FILLER                  PIC X(2) VALUE SPACES.
           02  DL-RETURN-CODE          PIC /9/.
           02  FILLER                  PIC X(2) VALUE SPACES.
           02  DL-COMMON-FORMAT        PIC X(57).
      
       01  DETAIL-ATOG.
           02  DATOG-DATE              PIC 99/99/9999.
      
       01  DETAIL-CONV.
           02  DCONV-DATEG             PIC 99/99/9999.
           02  FILLER                  PIC X(2) VALUE SPACES.
           02  DCONV-DATEJ             PIC 9999/999.
           02  FILLER                  PIC X(2) VALUE SPACES.
           02  DCONV-ANUM              PIC 9,999,999.
      
       01  DETAIL-DFMT.
           02  DDFMT-COUNT             PIC 99.
           02  FILLER                  PIC X(14) VALUE
               ' BYTES OUTPUT='.
           02  DDFMT-FORMAT            PIC X(29).
      
       01  DETAIL-DOWN.
           02  FILLER                  PIC X(23) VALUE
               'DAY OF WEEK NUMBER IS: '.
           02  DDOWN-NUMBER            PIC 9.
           02  FILLER                  PIC X(2) VALUE ' ('.
           02  DDOWN-NAME              PIC X(10).
      
       01  DETAIL-ESTR.
           02  FILLER                  PIC X(17) VALUE
               'EASTER FALLS ON: '.
           02  DESTR-DATE              PIC 99/99/9999.
      
       01  DETAIL-GETD.
           02  DGETD-DATEG             PIC 99/99/9999.
           02  FILLER                  PIC X(2) VALUE SPACES.
           02  DGETD-DATEJ             PIC 9999/999.
           02  FILLER                  PIC X(2) VALUE SPACES.
           02  DGETD-ANUM              PIC 9,999,999.
      
       01  DETAIL-GTOA.
           02  DGTOA-ANUM              PIC 9,999,999.
      
       01  DETAIL-GTOJ.
           02  DGTOJ-DATE              PIC 9999/999.
      
       01  DETAIL-JTOG.
           02  DJTOG-DATE              PIC 99/99/9999.
      
       01  DETAIL-LAGE.
           02  DLAGE-YEARS             PIC ZZ,ZZ9.
           02  FILLER                  PIC X(8) VALUE ' YEARS, '.
           02  DLAGE-MONTHS            PIC Z9.
           02  FILLER                  PIC X(9) VALUE ' MONTHS, '.
           02  DLAGE-DAYS              PIC Z9.
           02  FILLER                  PIC X(13) VALUE ' DAYS BETWEEN'.
      
       01  DETAIL-PROJ.
           02  DPROJ-DATE              PIC 99/99/9999.
      
       01  DETAIL-SAGE.
           02  DSAGE-DAYS              PIC Z,ZZZ,ZZ9.
           02  FILLER                  PIC X(13) VALUE ' DAYS BETWEEN'.
      
       01  DETAIL-TDOW.
           02  DTDOW-DATE              PIC 99/99/9999.
      /
       PROCEDURE DIVISION.
      
       0000-MAIN SECTION.
       0050-SETUP.
           ACCEPT SYSTEM-TIME FROM TIME.
           MOVE FUNCTION CURRENT-DATE(1:08) TO WS-CURRENT-DATE.
           MOVE WS-CURRENT-DATE(1:04) TO H1-DATE(7:04).
           MOVE WS-CURRENT-DATE(5:02) TO H1-DATE(1:02).
           MOVE WS-CURRENT-DATE(7:02) TO H1-DATE(4:02).
           MOVE SYSTEM-TIME-SHORT TO H2-TIME.
           INSPECT H2-TIME REPLACING ALL '/' BY ':'.
      
       0100-CONTROL.
           OPEN INPUT DATA-FILE, OUTPUT PRINT-FILE.
           PERFORM 0200-READ-DATA-FILE.
           PERFORM 0300-PROCESS-DATA THRU 0399-PROCESS-DATA-EXIT
               UNTIL END-OF-DATA.
           CLOSE DATA-FILE, PRINT-FILE.
           STOP RUN.
      
       0200-READ-DATA-FILE.
           READ DATA-FILE AT END MOVE 'Y' TO END-OF-DATA-SWITCH.
      
       0300-PROCESS-DATA.
           MOVE SPACES TO DETAIL-LINE.
           MOVE DATA-RECORD TO TEST-RECORD, DL-TEST-RECORD.
           EVALUATE TR-IDENTIFICATION
               WHEN 'ATOG' PERFORM 0400-CALL-ATOG
               WHEN 'CONV' PERFORM 0405-CALL-CONV
               WHEN 'DFMT' PERFORM 0410-CALL-DFMT
               WHEN 'DOWN' PERFORM 0415-CALL-DOWN
               WHEN 'ESTR' PERFORM 0418-CALL-ESTR
               WHEN 'GETD' PERFORM 0420-CALL-GETD
               WHEN 'GTOA' PERFORM 0425-CALL-GTOA
               WHEN 'GTOJ' PERFORM 0430-CALL-GTOJ
               WHEN 'JTOG' PERFORM 0435-CALL-JTOG
               WHEN 'LAGE' PERFORM 0440-CALL-LAGE
               WHEN 'PROJ' PERFORM 0445-CALL-PROJ
               WHEN 'SAGE' PERFORM 0450-CALL-SAGE
               WHEN 'TDOW' PERFORM 0455-CALL-TDOW
               WHEN OTHER
                   MOVE '-------' TO DL-ROUTINE-NAME
                   INSPECT DL-RETURN-CODE REPLACING ALL ' ' BY '*'
                   MOVE 'INVALID ROUTINE SPECIFIED' TO DL-COMMON-FORMAT
           END-EVALUATE.
           IF LINE-COUNT > PAGE-SIZE
               IF LINE-COUNT < 99
                   MOVE SPACES TO PRINT-RECORD
                   WRITE PRINT-RECORD BEFORE ADVANCING PAGE
               END-IF
               ADD 1 TO PAGE-COUNT
               MOVE PAGE-COUNT TO H2-PAGE
               WRITE PRINT-RECORD FROM HEADING-1 BEFORE ADVANCING 1
               WRITE PRINT-RECORD FROM HEADING-2 BEFORE ADVANCING 2
               WRITE PRINT-RECORD FROM HEADING-3 BEFORE ADVANCING 1
               MOVE 4 TO LINE-COUNT
           END-IF.
           WRITE PRINT-RECORD FROM DETAIL-LINE BEFORE ADVANCING 1.
           ADD 1 TO LINE-COUNT.
           PERFORM 0200-READ-DATA-FILE.
       0399-PROCESS-DATA-EXIT.
      
       0400-CALL-ATOG.
           MOVE 'Y2KATOG' TO DL-ROUTINE-NAME.
           MOVE TR-ATOG-ANUM TO Y2K-ATOGP-ANUM.
           CALL 'Y2KATOG' USING Y2K-ATOG-PARAMETERS.
           MOVE Y2K-ATOGP-RETURN-CODE TO DL-RETURN-CODE.
           IF Y2K-ATOGP-RETURN-CODE = 0
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY ' '
               MOVE Y2K-ATOGP-DATE TO DATOG-DATE
               MOVE DETAIL-ATOG TO DL-COMMON-FORMAT
           ELSE
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY '*'
               EVALUATE Y2K-ATOGP-RETURN-CODE
                   WHEN 2
                       MOVE 'INVALID ZONED-DECIMAL DATA'
                         TO DL-COMMON-FORMAT
                   WHEN 4
                       MOVE 'INVALID VALUE (OUT OF RANGE)'
                         TO DL-COMMON-FORMAT
               END-EVALUATE
           END-IF.
      
       0405-CALL-CONV.
           MOVE 'Y2KCONV' TO DL-ROUTINE-NAME.
           MOVE TR-CONV-DATE TO Y2K-CONVP-DATEIN.
           MOVE TR-CONV-FORMAT TO Y2K-CONVP-FORMAT.
           MOVE TR-CONV-BREAK TO Y2K-CONVP-BREAK.
           CALL 'Y2KCONV' USING Y2K-CONV-PARAMETERS.
           MOVE Y2K-CONVP-RETURN-CODE TO DL-RETURN-CODE.
           IF Y2K-CONVP-RETURN-CODE = 0
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY ' '
               MOVE Y2K-CONVP-DATE-G TO DCONV-DATEG
               MOVE Y2K-CONVP-DATE-J TO DCONV-DATEJ
               MOVE Y2K-CONVP-ANUM TO DCONV-ANUM
               MOVE DETAIL-CONV TO DL-COMMON-FORMAT
           ELSE
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY '*'
               EVALUATE Y2K-CONVP-RETURN-CODE
                   WHEN 2
                       MOVE 'INVALID ZONED-DECIMAL DATA (DATE)'
                         TO DL-COMMON-FORMAT
                   WHEN 3
                       MOVE 'INVALID ZONED-DECIMAL DATA (BREAK)'
                         TO DL-COMMON-FORMAT
                   WHEN 4
                       MOVE 'INVALID VALUE (YEAR)'
                         TO DL-COMMON-FORMAT
                   WHEN 5
                       MOVE 'INVALID DATE FORMAT CODE'
                         TO DL-COMMON-FORMAT
                   WHEN 6
                       MOVE 'INVALID VALUE (MONTH)'
                         TO DL-COMMON-FORMAT
                   WHEN 8
                       MOVE 'INVALID VALUE (DAY)'
                         TO DL-COMMON-FORMAT
               END-EVALUATE
           END-IF.
      
       0410-CALL-DFMT.
           MOVE 'Y2KDFMT' TO DL-ROUTINE-NAME.
           MOVE TR-DFMT-DATE TO Y2K-DFMTP-DATEIN.
           MOVE TR-DFMT-MAJOR TO Y2K-DFMTP-MAJOR.
           MOVE TR-DFMT-MINOR TO Y2K-DFMTP-MINOR.
           MOVE SPACES TO Y2K-DFMTP-OUTPUT.
           CALL 'Y2KDFMT' USING Y2K-DFMT-PARAMETERS.
           MOVE Y2K-DFMTP-RETURN-CODE TO DL-RETURN-CODE.
           IF Y2K-DFMTP-RETURN-CODE = 0
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY ' '
               MOVE Y2K-DFMTP-OUTPUT-SIZE TO DDFMT-COUNT
               MOVE Y2K-DFMTP-OUTPUT TO DDFMT-FORMAT
               MOVE DETAIL-DFMT TO DL-COMMON-FORMAT
           ELSE
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY '*'
               EVALUATE Y2K-DFMTP-RETURN-CODE
                   WHEN 2
                       MOVE 'INVALID ZONED-DECIMAL DATA'
                         TO DL-COMMON-FORMAT
                   WHEN 3
                       MOVE 'INVALID MAJOR FORMAT CODE'
                         TO DL-COMMON-FORMAT
                   WHEN 4
                       MOVE 'INVALID VALUE (YEAR)'
                         TO DL-COMMON-FORMAT
                   WHEN 5
                       MOVE 'INVALID MINOR FORMAT CODE'
                         TO DL-COMMON-FORMAT
                   WHEN 6
                       MOVE 'INVALID VALUE (MONTH)'
                         TO DL-COMMON-FORMAT
                   WHEN 8
                       MOVE 'INVALID VALUE (DAY)'
                         TO DL-COMMON-FORMAT
               END-EVALUATE
           END-IF.
      
       0415-CALL-DOWN.
           MOVE 'Y2KDOWN' TO DL-ROUTINE-NAME.
           MOVE TR-DOWN-DATE TO Y2K-DOWNP-DATE.
           CALL 'Y2KDOWN' USING Y2K-DOWN-PARAMETERS.
           MOVE Y2K-DOWNP-RETURN-CODE TO DL-RETURN-CODE.
           IF Y2K-DOWNP-RETURN-CODE = 0
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY ' '
               MOVE Y2K-DOWNP-DAY-NUMBER TO DDOWN-NUMBER
               EVALUATE Y2K-DOWNP-DAY-NUMBER
                   WHEN 0 MOVE 'Monday)' TO DDOWN-NAME
                   WHEN 1 MOVE 'Tuesday)' TO DDOWN-NAME
                   WHEN 2 MOVE 'Wednesday)' TO DDOWN-NAME
                   WHEN 3 MOVE 'Thursday)' TO DDOWN-NAME
                   WHEN 4 MOVE 'Friday)' TO DDOWN-NAME
                   WHEN 5 MOVE 'Saturday)' TO DDOWN-NAME
                   WHEN 6 MOVE 'Sunday)' TO DDOWN-NAME
               END-EVALUATE
               MOVE DETAIL-DOWN TO DL-COMMON-FORMAT
           ELSE
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY '*'
               EVALUATE Y2K-DOWNP-RETURN-CODE
                   WHEN 2
                       MOVE 'INVALID ZONED-DECIMAL DATA'
                         TO DL-COMMON-FORMAT
                   WHEN 4
                       MOVE 'INVALID VALUE (YEAR)'
                         TO DL-COMMON-FORMAT
                   WHEN 6
                       MOVE 'INVALID VALUE (MONTH)'
                         TO DL-COMMON-FORMAT
                   WHEN 8
                       MOVE 'INVALID VALUE (DAY)'
                         TO DL-COMMON-FORMAT
               END-EVALUATE
           END-IF.
      
       0418-CALL-ESTR.
           MOVE 'Y2KESTR' TO DL-ROUTINE-NAME.
           MOVE TR-ESTR-YEAR TO Y2K-ESTRP-YEAR.
           CALL 'Y2KESTR' USING Y2K-ESTR-PARAMETERS.
           MOVE Y2K-ESTRP-RETURN-CODE TO DL-RETURN-CODE
           IF Y2K-ESTRP-RETURN-CODE = 0
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY ' '
               MOVE Y2K-ESTRP-DATE TO DESTR-DATE
               MOVE DETAIL-ESTR TO DL-COMMON-FORMAT
           ELSE
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY '*'
               EVALUATE Y2K-ESTRP-RETURN-CODE
                   WHEN 2
                       MOVE 'INVALID ZONED-DECIMAL DATA'
                         TO DL-COMMON-FORMAT
                   WHEN 4
                       MOVE 'INVALID VALUE (YEAR)'
                         TO DL-COMMON-FORMAT
               END-EVALUATE
           END-IF.
      
       0420-CALL-GETD.
           MOVE 'Y2KGETD' TO DL-ROUTINE-NAME.
           CALL 'Y2KGETD' USING Y2K-GETD-PARAMETERS.
           MOVE Y2K-GETDP-DATE-G TO DGETD-DATEG.
           MOVE Y2K-GETDP-DATE-J TO DGETD-DATEJ.
           MOVE Y2K-GETDP-ANUM TO DGETD-ANUM.
           MOVE DETAIL-GETD TO DL-COMMON-FORMAT.
      
       0425-CALL-GTOA.
           MOVE 'Y2KGTOA' TO DL-ROUTINE-NAME.
           MOVE TR-GTOA-DATE TO Y2K-GTOAP-DATE-G.
           CALL 'Y2KGTOA' USING Y2K-GTOA-PARAMETERS.
           MOVE Y2K-GTOAP-RETURN-CODE TO DL-RETURN-CODE.
           IF Y2K-GTOAP-RETURN-CODE = 0
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY ' '
               MOVE Y2K-GTOAP-ANUM TO DGTOA-ANUM
               MOVE DETAIL-GTOA TO DL-COMMON-FORMAT
           ELSE
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY '*'
               EVALUATE Y2K-GTOAP-RETURN-CODE
                   WHEN 2
                       MOVE 'INVALID ZONED-DECIMAL DATA'
                         TO DL-COMMON-FORMAT
                   WHEN 4
                       MOVE 'INVALID VALUE (YEAR)'
                         TO DL-COMMON-FORMAT
                   WHEN 6
                       MOVE 'INVALID VALUE (MONTH)'
                         TO DL-COMMON-FORMAT
                   WHEN 8
                       MOVE 'INVALID VALUE (DAY)'
                         TO DL-COMMON-FORMAT
               END-EVALUATE
           END-IF.
      
       0430-CALL-GTOJ.
           MOVE 'Y2KGTOJ' TO DL-ROUTINE-NAME.
           MOVE TR-GTOJ-DATE TO Y2K-GTOJP-DATE-G.
           CALL 'Y2KGTOJ' USING Y2K-GTOJ-PARAMETERS.
           MOVE Y2K-GTOJP-RETURN-CODE TO DL-RETURN-CODE.
           IF Y2K-GTOJP-RETURN-CODE = 0
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY ' '
               MOVE Y2K-GTOJP-DATE-J TO DGTOJ-DATE
               MOVE DETAIL-GTOJ TO DL-COMMON-FORMAT
           ELSE
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY '*'
               EVALUATE Y2K-GTOJP-RETURN-CODE
                   WHEN 2
                       MOVE 'INVALID ZONED-DECIMAL DATA'
                         TO DL-COMMON-FORMAT
                   WHEN 4
                       MOVE 'INVALID VALUE (YEAR)'
                         TO DL-COMMON-FORMAT
                   WHEN 6
                       MOVE 'INVALID VALUE (MONTH)'
                         TO DL-COMMON-FORMAT
                   WHEN 8
                       MOVE 'INVALID VALUE (DAY)'
                         TO DL-COMMON-FORMAT
               END-EVALUATE
           END-IF.
      
       0435-CALL-JTOG.
           MOVE 'Y2KJTOG' TO DL-ROUTINE-NAME.
           MOVE TR-JTOG-DATE TO Y2K-JTOGP-DATE-J.
           CALL 'Y2KJTOG' USING Y2K-JTOG-PARAMETERS.
           MOVE Y2K-JTOGP-RETURN-CODE TO DL-RETURN-CODE.
           IF Y2K-JTOGP-RETURN-CODE = 0
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY ' '
               MOVE Y2K-JTOGP-DATE-G TO DJTOG-DATE
               MOVE DETAIL-JTOG TO DL-COMMON-FORMAT
           ELSE
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY '*'
               EVALUATE Y2K-JTOGP-RETURN-CODE
                   WHEN 2
                       MOVE 'INVALID ZONED-DECIMAL DATA'
                         TO DL-COMMON-FORMAT
                   WHEN 4
                       MOVE 'INVALID VALUE (YEAR)'
                         TO DL-COMMON-FORMAT
                   WHEN 8
                       MOVE 'INVALID VALUE (DAY)'
                         TO DL-COMMON-FORMAT
               END-EVALUATE
           END-IF.
      
       0440-CALL-LAGE.
           MOVE 'Y2KLAGE' TO DL-ROUTINE-NAME.
           MOVE TR-LAGE-DATE1 TO Y2K-LAGEP-DATE1.
           MOVE TR-LAGE-DATE2 TO Y2K-LAGEP-DATE2.
           CALL 'Y2KLAGE' USING Y2K-LAGE-PARAMETERS.
           MOVE Y2K-LAGEP-RETURN-CODE TO DL-RETURN-CODE.
           IF Y2K-LAGEP-RETURN-CODE = 0
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY ' '
               MOVE Y2K-LAGEP-DAYS-PAST TO DLAGE-DAYS
               MOVE Y2K-LAGEP-MONTHS-PAST TO DLAGE-MONTHS
               MOVE Y2K-LAGEP-YEARS-PAST TO DLAGE-YEARS
               MOVE DETAIL-LAGE TO DL-COMMON-FORMAT
           ELSE
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY '*'
               EVALUATE Y2K-LAGEP-RETURN-CODE
                   WHEN 2
                       MOVE 'INVALID ZONED-DECIMAL DATA (DATE 1)'
                         TO DL-COMMON-FORMAT
                   WHEN 3
                       MOVE 'INVALID ZONED-DECIMAL DATA (DATE 2)'
                         TO DL-COMMON-FORMAT
                   WHEN 4
                       MOVE 'INVALID VALUE (YEAR/DATE 1)'
                         TO DL-COMMON-FORMAT
                   WHEN 5
                       MOVE 'INVALID VALUE (YEAR/DATE 2)'
                         TO DL-COMMON-FORMAT
                   WHEN 6
                       MOVE 'INVALID VALUE (MONTH/DATE 1)'
                         TO DL-COMMON-FORMAT
                   WHEN 7
                       MOVE 'INVALID VALUE (MONTH/DATE 2)'
                         TO DL-COMMON-FORMAT
                   WHEN 8
                       MOVE 'INVALID VALUE (DAY/DATE 1)'
                         TO DL-COMMON-FORMAT
                   WHEN 9
                       MOVE 'INVALID VALUE (DAY/DATE 2)'
                         TO DL-COMMON-FORMAT
               END-EVALUATE
           END-IF.
      
       0445-CALL-PROJ.
           MOVE 'Y2KPROJ' TO DL-ROUTINE-NAME.
           MOVE TR-PROJ-DATE TO Y2K-PROJP-DATE.
           MOVE TR-PROJ-INCREMENT TO Y2K-PROJP-INCREMENT.
           CALL 'Y2KPROJ' USING Y2K-PROJ-PARAMETERS.
           MOVE Y2K-PROJP-RETURN-CODE TO DL-RETURN-CODE.
           IF Y2K-PROJP-RETURN-CODE = 0
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY ' '
               MOVE Y2K-PROJP-NEW-DATE TO DPROJ-DATE
               MOVE DETAIL-PROJ TO DL-COMMON-FORMAT
           ELSE
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY '*'
               EVALUATE Y2K-PROJP-RETURN-CODE
                   WHEN 2
                       MOVE 'INVALID ZONED-DECIMAL DATA (DATE)'
                         TO DL-COMMON-FORMAT
                   WHEN 3
                       MOVE 'INVALID ZONED-DECIMAL DATA (INCREMENT)'
                         TO DL-COMMON-FORMAT
                   WHEN 4
                       MOVE 'INVALID VALUE (YEAR)'
                         TO DL-COMMON-FORMAT
                   WHEN 5
                       MOVE 'INVALID VALUE (INCREMENT)'
                         TO DL-COMMON-FORMAT
                   WHEN 6
                       MOVE 'INVALID VALUE (MONTH)'
                         TO DL-COMMON-FORMAT
                   WHEN 8
                       MOVE 'INVALID VALUE (DAY)'
                         TO DL-COMMON-FORMAT
               END-EVALUATE
           END-IF.
      
       0450-CALL-SAGE.
           MOVE 'Y2KSAGE' TO DL-ROUTINE-NAME.
           MOVE TR-SAGE-DATE1 TO Y2K-SAGEP-DATE1.
           MOVE TR-SAGE-DATE2 TO Y2K-SAGEP-DATE2.
           CALL 'Y2KSAGE' USING Y2K-SAGE-PARAMETERS.
           MOVE Y2K-SAGEP-RETURN-CODE TO DL-RETURN-CODE.
           IF Y2K-SAGEP-RETURN-CODE = 0
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY ' '
               MOVE Y2K-SAGEP-DAYS-PAST TO DSAGE-DAYS
               MOVE DETAIL-SAGE TO DL-COMMON-FORMAT
           ELSE
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY '*'
               EVALUATE Y2K-SAGEP-RETURN-CODE
                   WHEN 2
                       MOVE 'INVALID ZONED-DECIMAL DATA (DATE 1)'
                         TO DL-COMMON-FORMAT
                   WHEN 3
                       MOVE 'INVALID ZONED-DECIMAL DATA (DATE 2)'
                         TO DL-COMMON-FORMAT
                   WHEN 4
                       MOVE 'INVALID VALUE (YEAR/DATE 1)'
                         TO DL-COMMON-FORMAT
                   WHEN 5
                       MOVE 'INVALID VALUE (YEAR/DATE 2)'
                         TO DL-COMMON-FORMAT
                   WHEN 6
                       MOVE 'INVALID VALUE (MONTH/DATE 1)'
                         TO DL-COMMON-FORMAT
                   WHEN 7
                       MOVE 'INVALID VALUE (MONTH/DATE 2)'
                         TO DL-COMMON-FORMAT
                   WHEN 8
                       MOVE 'INVALID VALUE (DAY/DATE 1)'
                         TO DL-COMMON-FORMAT
                   WHEN 9
                       MOVE 'INVALID VALUE (DAY/DATE 2)'
                         TO DL-COMMON-FORMAT
               END-EVALUATE
           END-IF.
      
       0455-CALL-TDOW.
           MOVE 'Y2KTDOW' TO DL-ROUTINE-NAME.
           MOVE TR-TDOW-DATE TO Y2K-TDOWP-DATEIN.
           MOVE TR-TDOW-DIRECTION TO Y2K-TDOWP-DIRECTION.
           MOVE TR-TDOW-DAY-NUMBER TO Y2K-TDOWP-DAY-NUMBER.
           CALL 'Y2KTDOW' USING Y2K-TDOW-PARAMETERS.
           MOVE Y2K-TDOWP-RETURN-CODE TO DL-RETURN-CODE.
           IF Y2K-TDOWP-RETURN-CODE = 0
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY ' '
               MOVE Y2K-TDOWP-NEW-DATE TO DTDOW-DATE
               MOVE DETAIL-TDOW TO DL-COMMON-FORMAT
           ELSE
               INSPECT DL-RETURN-CODE REPLACING ALL '/' BY '*'
               EVALUATE Y2K-TDOWP-RETURN-CODE
                   WHEN 2
                       MOVE 'INVALID ZONED-DECIMAL DATA (DATE)'
                         TO DL-COMMON-FORMAT
                   WHEN 3
                       MOVE 'INVALID DIRECTION CODE'
                         TO DL-COMMON-FORMAT
                   WHEN 4
                       MOVE 'INVALID VALUE (YEAR)'
                         TO DL-COMMON-FORMAT
                   WHEN 5
                       MOVE 'TARGET DATE WILL BE INVALID'
                         TO DL-COMMON-FORMAT
                   WHEN 7
                       MOVE 'INVALID DAY OF WEEK NUMBER'
                         TO DL-COMMON-FORMAT
                   WHEN 6
                       MOVE 'INVALID VALUE (MONTH)'
                         TO DL-COMMON-FORMAT
                   WHEN 8
                       MOVE 'INVALID VALUE (DAY)'
                         TO DL-COMMON-FORMAT
               END-EVALUATE
           END-IF.
      
       END PROGRAM Y2KIVP.
