       IDENTIFICATION DIVISION.
       PROGRAM-ID. Y2KCONV.
       AUTHOR. JAY MOSELEY.
       DATE-WRITTEN. DECEMBER, 1997.
       DATE-COMPILED.
      *                                                               *
      *   YY   YY   222   KK   KK  CCCCC   OOOOO  NN   NN VV   VV     *
      *   YY   YY  2   2  KK  KK  CC   CC OO   OO NNN  NN VV   VV     *
      *   YY   YY      2  KK KK   CC   CC OO   OO NNN  NN VV   VV     *
      *    YY YY       2  KKKK    CC      OO   OO NNNN NN VV   VV     *
      *     YYY     222   KKKK    CC      OO   OO NN NNNN VV   VV     *
      *     YY     2      KK KK   CC   CC OO   OO NN  NNN  VV VV      *
      *     YY     2      KK  KK  CC   CC OO   OO NN  NNN   VVV       *
      *     YY     22222  KK   KK  CCCCC   OOOOO  NN   NN    V        *
      *                                                               *
      *************************************************************** *
      * THIS SUBROUTINE CONVERTS EXISTING DATE FIELDS WITH 2 DIGIT    *
      * YEARS TO A YEAR 2000 COMPLIANT FORMAT                         *
      *                                                               *
      *  VALID INPUT MONTH VALUES (FOR FORMATS 1, 2, AND 3 INPUT      *
      *  DATES) FOR THIS ROUTINE ARE 01 THROUGH 12.                   *
      *                                                               *
      *  VALID INPUT DAY VALUES (FOR FORMATS 1, 2, AND 3 INPUT DATES) *
      *  FOR THIS ROUTINE ARE 01 THROUGH 31, WITH EXCEPTIONS FOR      *
      *  THE MONTHS LISTED:                                           *
      *       MONTH          MAXIMUM DAY VALUE                        *
      *        04                    30                               *
      *        06                    30                               *
      *        09                    30                               *
      *        11                    30                               *
      *        02                    28                               *
      *        02 DURING LEAP YEAR   29                               *
      *                                                               *
      *  VALID INPUT DAY OF YEAR VALUES (FOR FORMAT 4 INPUT DATE)     *
      *  FOR THIS ROUTINE ARE 001 THROUGH 365 (FOR NON-LEAP YEARS)    *
      *  OR 001 THROUGH 366 (FOR LEAP YEARS).                         *
      *                                                               *
      *  THE DATE FORMAT MUST BE ONE OF THE FOLLOWING (BASED UPON     *
      *  THE INPUT FORMAT CODE - PARAMETER 2):                        *
      *    A)  FORMAT 1 DATES MUST BE MMDDYY (U.S. 6)                 *
      *    B)  FORMAT 2 DATES MUST BE DDMMYY (EUROPEAN 6)             *
      *    C)  FORMAT 3 DATES MUST BE YYMMDD (FIPS 6)                 *
      *    D)  FORMAT 4 DATES MUST BE YYDDD (JULIAN 5)                *
      *  WHERE MM = THE 2 DIGIT MONTH VALUE, DD = THE 2 DIGIT DAY     *
      *  VALUE, YY = THE 2 DIGIT YEAR VALUE, AND DDD = THE 3 DIGIT    *
      *  ORDINAL DAY OF THE YEAR VALUE.                               *
      *                                                               *
      *  SEVEN FIELDS ARE PASSED AS PARAMETERS TO THE ROUTINE:        *
      *  1)  THE INPUT DATE (IN ZONED-DECIMAL FORMAT) TO BE CON-      *
      *      VERTED IN A SUB-FORMAT CORRESPONDING TO THE FORMAT       *
      *      CODE CONTAINED IN FIELD #2 (SEE 4 ABOVE).  (FORMAT 4     *
      *      DATES (5 BYTE JULIAN) MUST BE FOLLOWED BY A SLACK        *
      *      BYTE WHICH IS NOT ACCESSED BY THE ROUTINE)               *
      *  2)  A 1 BYTE FIELD CONTAINING THE FORMAT OF THE DATE IN      *
      *      FIELD #1 (IN ZONED-DECIMAL) AS SPECIFIED IN 4 (ABOVE).   *
      *  3)  A 2 BYTE FIELD CONTAINING THE YEAR AT WHICH THE CENTURY  *
      *      IS TO SWITCH FROM 1900 TO 2000 (IN ZONED-DECIMAL).  IF   *
      *      THIS FIELD CONTAINS 20, INPUT DATES WITH YEAR VALUES OF  *
      *      00 THROUGH 20 WILL EXPAND TO 2000 THROUGH 2020 AND       *
      *      INPUT DATES WITH YEAR VALUES OF 21 THROUGH 99 WILL       *
      *      EXPAND TO 1921 THROUGH 1999.                             *
      *  4)  A 1 BYTE ZONED-DECIMAL RETURN CODE.                      *
      *  5)  AN 8 BYTE FIELD WHICH WILL RECEIVE THE DATE IN GREGOR-   *
      *      IAN FORMAT (IN ZONED DECIMAL FORMAT).  THE FORMAT OF     *
      *      THIS FIELD WILL BE COMMERCIAL-8 (MMDDYYYY).              *
      *  6)  A 7 BYTE FIELD WHICH WILL RECEIVE THE DATE IN JULIAN     *
      *      FORMAT (IN ZONED DECIMAL FORMAT).                        *
      *  7)  A 7 BYTE FIELD WHICH WILL RECEIVE THE ASTRONOMICAL       *
      *      NUMBER (IN ZONED DECIMAL FORMAT).                        *
      *  THE ROUTINE WILL NOT ALTER THE FIELDS PASSED TO IT (1-3).    *
      *                                                               *
      *  SUGGESTED CALLING SYNTAX FOR COBOL CALLERS:                  *
      *                                                               *
      *       01  CONV-PARAMETERS.                                    *
      *           02  DATEIN  PIC 9(6) VALUE 010197.                  *
      *           02  DATEFMT PIC 9(1) VALUE 1.                       *
      *           02  BREAK   PIC 9(2) VALUE 20.                      *
      *           02  RC      PIC 9(1) VALUE 0.                       *
      *           02  DATEG   PIC 9(8) VALUE 0.                       *
      *           02  DATEJ   PIC 9(7) VALUE 0.                       *
      *           02  ANUM    PIC 9(7) VALUE 0.                       *
      *       CALL 'Y2KCONV' USING CONV-PARAMETERS.                   *
      *                                                               *
      *  THE POSSIBLE VALUES FOR THE RETURN CODE FIELD ARE:           *
      *                                                               *
      *  0 INDICATES SUCCESSFUL EXECUTION OF THE ROUTINE.             *
      *                                                               *
      *  2 INDICATES INVALID DATA WAS FOUND IN THE INPUT DATE FIELD   *
      *  (3 FOR THE BREAK VALUE FIELD).  INVALID DATA ARE DETERMINED  *
      *  IF THE FIELD'S LOW ORDER BYTE'S ZONE CONTAINS AN INVALID     *
      *  SIGN, (NOT ONE OF X'C', X'D', OR X'F'), OR IF THE PRECEED-   *
      *  ING BYTES' ZONES ARE OTHER THAN X'F', OR IF ANY BYTE'S LOW   *
      *  LOW ORDER NIBBLE CONTAINS A VALUE GREATER THAN X'9'.         *
      *                                                               *
      *  5 INDICATES THE VALUE OF THE DATE FORMAT CODE IS INVALID     *
      *  ('1', '2', '3', AND '4' ARE VALID).                          *
      *                                                               *
      *  6 INDICATES THE VALUE OF THE MONTH SPECIFIED IN THE INPUT    *
      *  DATE FIELD WAS NOT IN THE RANGE SPECIFIED IN 1 (ABOVE).      *
      *                                                               *
      *  8 INDICATES THE VALUE OF THE DAY SPECIFIED IN THE INPUT      *
      *  DATE FIELD WAS NOT IN THE RANGE SPECIFIED IN 2 OR 3          *
      *  (ABOVE) DEPENDING UPON THE INPUT DATE FORMAT.                *
      *                                                               *
      *  UPON SUCCESSFUL EXECUTION, THE GREGORIAN DATE WITH THE 4     *
      *  DIGIT YEAR WILL BE PLACED IN FIELD 5, THE JULIAN DATE WITH   *
      *  THE 4 DIGIT YEAR WILL BE PLACED IN FIELD 6, AND THE ASTRO-   *
      *  NOMICAL NUMBER FOR THE DATE WILL BE PLACE IN FIELD 7.  IF    *
      *  THE RETURN CODE IS A NON-ZERO VALUE (UNSUCCESSFUL EXECUTION) *
      *  RETURN FIELDS 5 THROUGH 7 WILL CONTAIN ZEROS.                *
      *                                                               *
      *---------------------------------------------------------------*
      *                                                               *
      * 18 Sep 2017 - Change from INITIAL to LOCAL-STORAGE            *
      *               This change has no affect on program execution. *
      *               It was made to accomodate a bug in GnuCOBOL 2.2 *
      *               which will be fixed, but the change makes sense *
      *               from a logical viewpoint, so thus is justified. *
      *                                                               *
      *************************************************************** *
      /
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.

       LOCAL-STORAGE SECTION.

       01  FILLER                      PIC X(24)
           VALUE 'Y2KCONV STORAGE BEGINS->'.

      * ************************************************************* *
      * THESE ARE PROGRAM CONTROL SWITCHES AND WORK FIELDS.           *
      * ************************************************************* *
       01  PROGRAM-CONTROL-FIELDS.
           02  EXTENDED-YEAR           PIC 9(4).
           02  FILLER                  REDEFINES EXTENDED-YEAR.
               03  CENTURY             PIC 9(2).
               03  SHORT-YEAR          PIC 9(2).

           02  JTOG-PARAMETERS.
               03  JTOGP-DATEJ         PIC 9(7).
               03  FILLER              REDEFINES JTOGP-DATEJ.
                   05  JTOGP-DATEJ-Y   PIC 9(4).
                   05  JTOGP-DATEJ-D   PIC 9(3).
               03  JTOGP-RC            PIC 9(1).
               03  JTOGP-DATEG         PIC 9(8).

           02  GTOJ-PARAMETERS.
               03  GTOJP-DATEG         PIC 9(8).
               03  GTOJP-RC            PIC 9(1).
               03  GTOJP-DATEJ         PIC 9(7).

           02  GTOA-PARAMETERS.
               03  GTOAP-DATEG         PIC 9(8).
               03  GTOAP-RC            PIC 9(1).
               03  GTOAP-ANUM          PIC S9(7).

       01  FILLER                      PIC X(24)
           VALUE '<-Y2KCONV STORAGE ENDS'.

       LINKAGE SECTION.

      * ************************************************************* *
      * THESE ARE THE FIELDS USED TO RECEIVE INPUT DATA FROM THE      *
      * CALLER AND PASS RESULT FIELDS BACK TO THE CALLER.             *
      * ************************************************************* *
       01  CONV-PARAMETERS.
           02  CONVP-DATEIG            PIC 9(6).
           02  FILLER                  REDEFINES CONVP-DATEIG.
               03  CONVP-DATEIJ        PIC 9(5).
               03  FILLER              REDEFINES CONVP-DATEIJ.
                   05  CONVP-DATEIJ-Y  PIC 9(2).
                   05  CONVP-DATEIJ-D  PIC 9(3).
               03  FILLER              PIC X(1).
           02  CONVP-FORMAT            PIC X(1).
           02  CONVP-BREAK             PIC 9(2).
           02  CONVP-RC                PIC 9(1).
           02  CONVP-DATEG             PIC 9(8).
           02  CONVP-DATEJ             PIC 9(7).
           02  CONVP-ANUM              PIC S9(7).
      /
       PROCEDURE DIVISION USING CONV-PARAMETERS.

       0000-MAIN SECTION.
       0025-INITIALIZE.
           MOVE ZERO TO CONVP-RC, CONVP-DATEG, CONVP-DATEJ, CONVP-ANUM.

       0050-VALIDATE-FORMAT.
           IF CONVP-FORMAT EQUAL '1'
           OR CONVP-FORMAT EQUAL '2'
           OR CONVP-FORMAT EQUAL '3'
           OR CONVP-FORMAT EQUAL '4'
               NEXT SENTENCE
           ELSE
               MOVE 5 TO CONVP-RC
               GOBACK.

       0075-VALIDATE-BREAK-POINT.
           IF CONVP-BREAK IS NOT NUMERIC
               MOVE 3 TO CONVP-RC
               GOBACK.

       0100-VALIDATE-INPUT-DATE.
           IF CONVP-FORMAT IS EQUAL 4
               IF CONVP-DATEIJ IS NOT NUMERIC
                   MOVE 2 TO CONVP-RC
                   GOBACK
               END-IF
           ELSE
               IF CONVP-DATEIG IS NOT NUMERIC
                   MOVE 2 TO CONVP-RC
                   GOBACK
               END-IF
           END-IF.

       0125-FORMAT-DECISION.
           IF CONVP-FORMAT IS NOT EQUAL '4'
               GO TO 0175-PROCESS-GREG-INPUT.

       0150-CONVERT-TO-GREG.
           MOVE CONVP-DATEIJ-D TO JTOGP-DATEJ-D.
           MOVE CONVP-DATEIJ-Y TO SHORT-YEAR.
           PERFORM 0400-EXTEND-YEAR.
           MOVE EXTENDED-YEAR TO JTOGP-DATEJ-Y.
           CALL 'Y2KJTOG' USING JTOG-PARAMETERS.

           IF JTOGP-RC NOT EQUAL ZERO
               MOVE JTOGP-RC TO CONVP-RC
               GOBACK.

           MOVE JTOGP-DATEG TO CONVP-DATEG.
           MOVE JTOGP-DATEJ TO CONVP-DATEJ.
           MOVE CONVP-DATEG TO GTOAP-DATEG.
           GO TO 0300-FINISH.

       0175-PROCESS-GREG-INPUT.
           EVALUATE CONVP-FORMAT
               WHEN '2'
                   GO TO 0200-EUROPEAN
               WHEN '3'
                   GO TO 0225-FIPS.

           MOVE CONVP-DATEIG(1 : 4) TO GTOJP-DATEG(1 : 4).
           MOVE CONVP-DATEIG(5 : 2) TO SHORT-YEAR.
           GO TO 0250-CONVERT-TO-JULIAN.

       0200-EUROPEAN.
           MOVE CONVP-DATEIG(3 : 2) TO GTOJP-DATEG(1 : 2).
           MOVE CONVP-DATEIG(1 : 2) TO GTOJP-DATEG(3 : 2).
           MOVE CONVP-DATEIG(5 : 2) TO SHORT-YEAR.
           GO TO 0250-CONVERT-TO-JULIAN.

       0225-FIPS.
           MOVE CONVP-DATEIG(3 : 4) TO GTOJP-DATEG(1 : 4).
           MOVE CONVP-DATEIG(1 : 2) TO SHORT-YEAR.

       0250-CONVERT-TO-JULIAN.
           PERFORM 0400-EXTEND-YEAR.
           MOVE EXTENDED-YEAR TO GTOJP-DATEG(5 : 4).
           CALL 'Y2KGTOJ' USING GTOJ-PARAMETERS.

           IF GTOJP-RC NOT EQUAL ZERO
               MOVE GTOJP-RC TO CONVP-RC
               GOBACK.

           MOVE GTOJP-DATEJ TO CONVP-DATEJ.
           MOVE GTOJP-DATEG TO CONVP-DATEG.
           MOVE GTOJP-DATEG TO GTOAP-DATEG.

       0300-FINISH.
           CALL 'Y2KGTOA' USING GTOA-PARAMETERS.
           MOVE GTOAP-ANUM TO CONVP-ANUM.

           GOBACK.


       0400-EXTEND-YEAR.
           IF SHORT-YEAR IS GREATER THAN CONVP-BREAK
               MOVE 19 TO CENTURY
           ELSE
               MOVE 20 TO CENTURY.

       END PROGRAM Y2KCONV.
