       IDENTIFICATION DIVISION.
       PROGRAM-ID. Y2KGETD.
       AUTHOR. JAY MOSELEY.
       DATE-WRITTEN. DECEMBER, 1997.
       DATE-COMPILED.
      *                                                               *
      *   YY   YY   222   KK   KK  GGGGG  EEEEEE TTTTTTTT DDDDDD      *
      *   YY   YY  2   2  KK  KK  GG   GG EE        TT    DD   DD     *
      *   YY   YY      2  KK KK   GG   GG EE        TT    DD   DD     *
      *    YY YY       2  KKKK    GG      EEEE      TT    DD   DD     *
      *     YYY     222   KKKK    GG  GGG EE        TT    DD   DD     *
      *     YY     2      KK KK   GG   GG EE        TT    DD   DD     *
      *     YY     2      KK  KK  GG   GG EE        TT    DD   DD     *
      *     YY     22222  KK   KK  GGGGG  EEEEEEE   TT    DDDDDD      *
      *                                                               *
      *************************************************************** *
      * THIS SUBROUTINE RETRIEVES THE CURRENT DATE FROM THE OPERATING *
      * SYSTEM AND RETURNS IT IN 3 FORMATS                            *
      *                                                               *
      *  THREE FIELDS ARE PASSED AS PARAMETERS TO THE ROUTINE:        *
      *  1)  AN 8 BYTE FIELD WHICH WILL RECEIVE THE CURRENT GREGORIAN *
      *      DATE (IN ZONED-DECIMAL FORMAT),                          *
      *  2)  A 7 BYTE FIELD WHICH WILL RECEIVE THE CURRENT JULIAN     *
      *      DATE (IN ZONED-DECIMAL FORMAT), AND                      *
      *  3)  A 7 BYTE FIELD WHICH WILL RECEIVE THE ASTRONOMICAL       *
      *      NUMBER (IN ZONED-DECIMAL FORMAT) FOR THE CURRENT DATE.   *
      *                                                               *
      *  SUGGESTED CALLING SYNTAX FOR COBOL CALLERS:                  *
      *                                                               *
      *       01  GETD-PARAMETERS.                                    *
      *           02  DATEG PIC 9(8) VALUE 0.                         *
      *           02  DATEJ PIC 9(7) VALUE 0.                         *
      *           02  ANUM  PIC 9(7) VALUE 0.                         *
      *       CALL 'Y2KGETD' USING GETD-PARAMETERS.                   *
      *                                                               *
      *  UPON SUCCESSFUL EXECUTION, THE CURRENT DATE IN GREGORIAN     *
      *  (MMDDYYYY) AND JULIAN (YYYYDDD) WILL BE PLACED IN FIELDS     *
      *  1 AND 2, RESPECTIVELY, AND THE ASTRONOMICAL NUMBER FOR THE   *
      *  CURRENT DATE WILL BE PLACED IN FIELD 3.                      *
      *                                                               *
      *---------------------------------------------------------------*
      *                                                               *
      * 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 'Y2KGETD STORAGE BEGINS->'.

      * ************************************************************* *
      * THESE ARE PROGRAM CONTROL SWITCHES AND WORK FIELDS.           *
      * ************************************************************* *
       01  PROGRAM-CONTROL-FIELDS.
           02  SYSTEM-CURRENT-DATE.
               03  SCD-YYYY            PIC 9(4).
               03  SCD-MM              PIC 9(2).
               03  SCD-DD              PIC 9(2).
               03  FILLER              PIC X(13).

           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 '<-Y2KGETD 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  GETD-PARAMETERS.
           02  GETDP-DATEG.
               03  GETDP-DATEG-MM      PIC 9(2).
               03  GETDP-DATEG-DD      PIC 9(2).
               03  GETDP-DATEG-YYYY    PIC 9(4).
           02  GETDP-DATEJ             PIC 9(7).
           02  GETDP-ANUM              PIC S9(7).
      /
       PROCEDURE DIVISION USING GETD-PARAMETERS.

       0000-MAIN SECTION.
       0025-RETRIEVE-SYSTEM-DATE.

           MOVE FUNCTION CURRENT-DATE TO SYSTEM-CURRENT-DATE.

           MOVE SCD-MM   TO GETDP-DATEG-MM.
           MOVE SCD-DD   TO GETDP-DATEG-DD.
           MOVE SCD-YYYY TO GETDP-DATEG-YYYY.

       0050-CONVERT-TO-JULIAN.

           MOVE GETDP-DATEG TO GTOJP-DATEG.
           CALL 'Y2KGTOJ' USING GTOJ-PARAMETERS.
           MOVE GTOJP-DATEJ TO GETDP-DATEJ.

       0075-CONVERT-TO-ASTRO-NUMBER.
           MOVE GETDP-DATEG TO GTOAP-DATEG.
           CALL 'Y2KGTOA' USING GTOA-PARAMETERS.
           MOVE GTOAP-ANUM TO GETDP-ANUM.

           GOBACK.

       END PROGRAM Y2KGETD.
