       IDENTIFICATION DIVISION.
       PROGRAM-ID. Y2KPROJ.
       AUTHOR. JAY MOSELEY.
       DATE-WRITTEN. DECEMBER, 1997.
       DATE-COMPILED.
      *                                                               *
      *   YY   YY   222   KK   KK PPPPPP  RRRRRR   OOOOO       JJ     *
      *   YY   YY  2   2  KK  KK  PP   PP RR   RR OO   OO      JJ     *
      *   YY   YY      2  KK KK   PP   PP RR   RR OO   OO      JJ     *
      *    YY YY       2  KKKK    PP   PP RR   RR OO   OO      JJ     *
      *     YYY     222   KKKK    PPPPPP  RRRRRR  OO   OO      JJ     *
      *     YY     2      KK KK   PP      RR RR   OO   OO JJ   JJ     *
      *     YY     2      KK  KK  PP      RR  RR  OO   OO JJ   JJ     *
      *     YY     22222  KK   KK PP      RR   RR  OOOOO   JJJJJ      *
      *                                                               *
      *************************************************************** *
      * THIS SUBROUTINE INCREMENTS OR DECREMENTS A GIVEN GREGORIAN    *
      * DATE (MMDDYYYY) BY A SPECIFIED NUMBER OF DAYS                 *
      *                                                               *
      *  VALID INPUT YEARS FOR THIS ROUTINE ARE THE YEARS 1601        *
      *  THROUGH 3399 A. D. (INCLUSIVE)                               *
      *                                                               *
      *  VALID INPUT MONTH VALUES FOR THIS ROUTINE ARE 01 THROUGH 12. *
      *                                                               *
      *  VALID INPUT DAY VALUES 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                               *
      *                                                               *
      *  THE DATE FORMAT MUST BE MMDDYYYY, WHERE MM = THE 2 DIGIT     *
      *  MONTH VALUE, DD = THE 2 DIGIT DAY VALUE, AND YYYY = THE      *
      *  4 DIGIT YEAR VALUE.                                          *
      *                                                               *
      *  FOUR FIELDS ARE PASSED AS PARAMETERS TO THE ROUTINE:         *
      *  1)  AN 8 BYTE FIELD CONTAINING THE DATE TO BE INCR/          *
      *      DECREMENTED (IN ZONED-DECIMAL FORMAT),                   *
      *  2)  A 6 BYTE FIELD CONTAINING THE INCREMENTAL VALUE (IN      *
      *      ZONED-DECIMAL FORMAT, NEGATIVE OR POSITIVE),             *
      *  3)  A 1 BYTE ZONED-DECIMAL RETURN CODE, AND                  *
      *  4)  AN 8 BYTE FIELD WHICH WILL RECEIVE THE RESULTING         *
      *      GREGORIAN DATE (IN ZONED-DECIMAL FORMAT).                *
      *  THE ROUTINE WILL NOT ALTER THE DATE AND INCREMENT FIELDS     *
      *  PASSED TO IT.                                                *
      *                                                               *
      *  SUGGESTED CALLING SYNTAX FOR COBOL CALLERS:                  *
      *                                                               *
      *       01  PROJ-PARAMETERS.                                    *
      *           02  DATE   PIC 9(8) VALUE 01011997.                 *
      *           02  INCR   PIC S9(6) VALUE -35.                     *
      *           02  RC     PIC 9(1) VALUE 0.                        *
      *           02  NUDATE PIC 9(8) VALUE ZERO.                     *
      *       CALL 'Y2KPROJ' USING PROJ-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).                            *
      *                                                               *
      *  6 INDICATES THE VALUE OF THE MONTH SPECIFIED WAS NOT IN      *
      *  THE RANGE SPECIFIED IN 2 (ABOVE).                            *
      *                                                               *
      *  8 INDICATES THE VALUE OF THE DAY SPECIFIED WAS NOT IN        *
      *  THE RANGE SPECIFIED IN 3 (ABOVE).                            *
      *                                                               *
      *  3 INDICATES INVALID DATA WAS FOUND IN THE INCREMENT 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'.                          *
      *                                                               *
      *  5 INDICATES THAN AN INVALID DATE WILL BE DEVELOPED WHEN      *
      *  THE INPUT DATE IS INCREMENTED BY THE SPECIFIED AMOUNT        *
      *  (OUTSIDE OF YEAR RANGE LISTED IN 1 ABOVE).                   *
      *                                                               *
      *  UPON SUCCESSFUL EXECUTION, THE RESULTING DATE IS PLACED      *
      *  IN THE 4TH PARAMETER.  IF THE RETURN CODE IS A NON-ZERO      *
      *  VALUE (UNSUCCESSFUL EXECUTION), THE 4TH 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 'Y2KPROJ 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  GTOA-PARAMETERS.
               03  GTOAP-DATEG         PIC 9(8).
               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).

       01  FILLER                      PIC X(24)
           VALUE '<-Y2KPROJ 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  PROJ-PARAMETERS.
           02  PROJP-DATEG.
               03  PROJP-DATE-MM       PIC 9(2).
               03  PROJP-DATE-DD       PIC 9(2).
               03  PROJP-DATE-YYYY     PIC 9(4).
           02  PROJP-INCR              PIC S9(6).
           02  PROJP-RC                PIC 9(1).
           02  PROJP-NEWDATE           PIC 9(8).
      /
       PROCEDURE DIVISION USING PROJ-PARAMETERS.

       0000-MAIN SECTION.
       0025-INITIALIZE.
           MOVE ZERO TO PROJP-RC, PROJP-NEWDATE.

       0050-RETRIEVE-SEED-ASTRO.
           MOVE PROJP-DATEG TO GTOAP-DATEG.
           CALL 'Y2KGTOA' USING GTOA-PARAMETERS.

           IF GTOAP-RC NOT EQUAL ZERO
               MOVE GTOAP-RC TO PROJP-RC
               GOBACK.

       0075-VALIDATE-INCREMENT.
           IF PROJP-INCR IS NOT NUMERIC
               MOVE 3 TO PROJP-RC
               GOBACK.

       0100-COMPUTE-NEW-ASTRO.
           ADD PROJP-INCR TO GTOAP-ANUM.

       0125-VALIDATE-ASTRO.
           IF GTOAP-ANUM IS LESS THAN 2305814
           OR GTOAP-ANUM IS GREATER THAN 2962884
               MOVE 5 TO PROJP-RC
               GOBACK.

       0150-CONVERT-ASTRO-TO-DATE.
           MOVE GTOAP-ANUM TO ATOGP-ANUM.
           CALL 'Y2KATOG' USING ATOG-PARAMETERS.

           MOVE ATOGP-DATEG TO PROJP-NEWDATE.

           GOBACK.

       END PROGRAM Y2KPROJ.
