       IDENTIFICATION DIVISION.
       PROGRAM-ID. Y2KJTOG.
       AUTHOR. JAY MOSELEY.
       DATE-WRITTEN. DECEMBER, 1997.
       DATE-COMPILED.
      *                                                               *
      *   YY   YY   222   KK   KK      JJTTTTTTTT  OOOOO   GGGGG      *
      *   YY   YY  2   2  KK  KK       JJ   TT    OO   OO GG   GG     *
      *   YY   YY      2  KK KK        JJ   TT    OO   OO GG   GG     *
      *    YY YY       2  KKKK         JJ   TT    OO   OO GG          *
      *     YYY     222   KKKK         JJ   TT    OO   OO GG  GGG     *
      *     YY     2      KK KK   JJ   JJ   TT    OO   OO GG   GG     *
      *     YY     2      KK  KK  JJ   JJ   TT    OO   OO GG   GG     *
      *     YY     22222  KK   KK  JJJJJ    TT     OOOOO   GGGGG      *
      *                                                               *
      *************************************************************** *
      * THIS SUBROUTINE RETURNS THE GREGORIAN DATE (MMDDYYYY) FOR     *
      * GIVEN JULIAN DATE (YYYYDDD)                                   *
      *                                                               *
      *  VALID INPUT YEARS FOR THIS ROUTINE ARE THE YEARS 1601        *
      *  THROUGH 3399 A. D. (INCLUSIVE)                               *
      *                                                               *
      *  VALID INPUT DAY VALUES FOR THIS ROUTINE ARE 001 THROUGH      *
      *  365 (NON-LEAP YEARS) AND 001 THROUGH 366 (LEAP YEARS).       *
      *                                                               *
      *  THE DATE FORMAT MUST BE YYYYDDD, WHERE YYYY = THE 4 DIGIT    *
      *  YEAR VALUE AND DDD = THE 3 DIGIT JULIAN DAY NUMBER VALUE.    *
      *                                                               *
      *  THREE FIELDS ARE PASSED AS PARAMETERS TO THE ROUTINE:        *
      *  1)  A 7 BYTE FIELD CONTAINING THE JULIAN DATE (IN ZONED      *
      *      DECIMAL FORMAT),                                         *
      *  2)  A 1 BYTE ZONED-DECIMAL RETURN CODE, AND                  *
      *  3)  AN 8 BYTE FIELD WHICH WILL RECEIVE THE CORRESPONDING     *
      *      GREGORIAN DATE (IN ZONED-DECIMAL FORMAT).                *
      *  THE ROUTINE WILL NOT ALTER THE DATE PASSED TO IT.            *
      *                                                               *
      *  SUGGESTED CALLING SYNTAX FOR COBOL CALLERS:                  *
      *                                                               *
      *       01  JTOG-PARAMETERS.                                    *
      *           02  DATEJ PIC 9(7) VALUE 1997158.                   *
      *           02  RC    PIC 9(1) VALUE 0.                         *
      *           02  DATEG PIC 9(8) VALUE 0.                         *
      *       CALL 'Y2KJTOG' USING JTOG-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 DATE 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 PRECEDING BYTES' ZONES        *
      *  ARE OTHER THAN X'F', OR IF ANY BYTE'S LOW ORDER NIBBLE       *
      *  CONTAINS A VALUE GREATER THAN X'9'.                          *
      *                                                               *
      *  4 INDICATES THE VALUE OF THE YEAR SPECIFIED WAS NOT IN       *
      *  THE RANGE SPECIFIED IN 1 (ABOVE).                            *
      *                                                               *
      *  8 INDICATES THE VALUE OF THE DAY SPECIFIED WAS NOT IN        *
      *  THE RANGE SPECIFIED IN 2 (ABOVE).                            *
      *                                                               *
      *  UPON SUCCESSFUL EXECUTION, THE 8 DIGIT GREGORIAN DATE        *
      *  (MMDDYYYY) WILL BE PLACED IN THE 3RD PARAMETER FIELD (IN     *
      *  ZONED DECIMAL FORMAT).  IF THE RETURN CODE IS A NON-ZERO     *
      *  VALUE (UNSUCCESSFUL EXECUTION), THE 3RD PARAMETER 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 'Y2KJTOG STORAGE BEGINS->'.

      * ************************************************************* *
      * THESE ARE PROGRAM CONTROL SWITCHES AND WORK FIELDS.           *
      * ************************************************************* *
       01  PROGRAM-CONTROL-FIELDS.
           02  CURRENT-ASTRO-NUMBER    PIC S9(7).

           02  GTOA-PARAMETERS.
               03  GTOAP-DATEG         PIC 9(8).
               03  FILLER              REDEFINES GTOAP-DATEG.
                   04  GTOAP-DATEG-MD  PIC 9(4).
                   04  GTOAP-DATEG-Y   PIC 9(4).
               03  GTOAP-RC            PIC 9(1).
               03  GTOAP-ANUM          PIC S9(7).

           02  ATOG-PARAMETERS.
               03  ATOGP-ANUM          PIC S9(7).
               03  ATOGP-RC            PIC 9(1).
               03  ATOGP-DATEG         PIC 9(8).
               03  FILLER              REDEFINES ATOGP-DATEG.
                   04  ATOGP-DATEG-MD  PIC 9(4).
                   04  ATOGP-DATEG-Y   PIC 9(4).

       01  FILLER                      PIC X(24)
           VALUE '<-Y2KJTOG 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  JTOG-PARAMETERS.
           02  JTOGP-DATEJ.
               03  JTOGP-DATEJ-YYYY    PIC 9(4).
               03  JTOGP-DATEJ-DDD     PIC 9(3).
           02  JTOGP-RC                PIC 9(1).
           02  JTOGP-DATEG             PIC 9(8).
      /
       PROCEDURE DIVISION USING JTOG-PARAMETERS.

       0000-MAIN SECTION.
       0025-INITIALIZE.
           MOVE ZERO TO JTOGP-RC, JTOGP-DATEG.

       0050-VALIDATE-INPUT-DATE.
           IF JTOGP-DATEJ IS NOT NUMERIC
               MOVE 2 TO JTOGP-RC
               GOBACK.

       0075-VALIDATE-INPUT-YEAR.
           IF JTOGP-DATEJ-YYYY IS LESS THAN 1601
           OR JTOGP-DATEJ-YYYY IS GREATER THAN 3399
               MOVE 4 TO JTOGP-RC
               GOBACK.

       0100-GET-PRIOR-YEAREND-ASTRO.
           MOVE JTOGP-DATEJ-YYYY TO GTOAP-DATEG-Y.
           MOVE '0101' TO GTOAP-DATEG-MD.
           CALL 'Y2KGTOA' USING GTOA-PARAMETERS.

       0125-COMPUTE-TARGET-ASTRO.
           MOVE GTOAP-ANUM TO ATOGP-ANUM.
           SUBTRACT 1 FROM ATOGP-ANUM.
           ADD JTOGP-DATEJ-DDD TO ATOGP-ANUM.
           CALL 'Y2KATOG' USING ATOG-PARAMETERS.

       0130-VALIDATE-DDD-FOR-YY.
           IF ATOGP-DATEG-Y NOT EQUAL JTOGP-DATEJ-YYYY
               MOVE 8 TO JTOGP-RC
           ELSE
               MOVE ATOGP-DATEG TO JTOGP-DATEG.

           GOBACK.

       END PROGRAM Y2KJTOG.

