       IDENTIFICATION DIVISION.
       PROGRAM-ID. Y2KTDOW.
       AUTHOR. JAY MOSELEY.
       DATE-WRITTEN. DECEMBER, 1997.
       DATE-COMPILED.
      *                                                               *
      *****************************************************************
      *                                                               *
      *   YY   YY   222   KK   KK TTTTTTTT DDDDDD   OOOOO  WW   WW    *
      *   YY   YY  2   2  KK  KK     TT    DD   DD OO   OO WW   WW    *
      *   YY   YY      2  KK KK      TT    DD   DD OO   OO WW   WW    *
      *    YY YY       2  KKKK       TT    DD   DD OO   OO WW   WW    *
      *     YYY     222   KKKK       TT    DD   DD OO   OO WW W WW    *
      *     YY     2      KK KK      TT    DD   DD OO   OO WWWWWWW    *
      *     YY     2      KK  KK     TT    DD   DD OO   OO WWW WWW    *
      *     YY     22222  KK   KK    TT    DDDDDD   OOOOO   W   W     *
      *                                                               *
      *************************************************************** *
      * THIS SUBROUTINE DETERMINES THE DATE FOR A GIVEN DAY OF WEEK   *
      * USING A GIVEN GREGORIAN DATE (MMDDYYYY) AS A REFERENCE DATE   *
      *                                                               *
      *  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.                                          *
      *                                                               *
      *  FIVE FIELDS ARE PASSED AS PARAMETERS TO THE ROUTINE:         *
      *  1)  AN 8 BYTE FIELD CONTAINING THE REFERENCE DATE (IN        *
      *      ZONED-DECIMAL FORMAT),                                   *
      *  2)  A 1 BYTE FIELD CONTAINING 'P' TO SPECIFY THE PREVIOUS    *
      *      DATE OR 'N' TO SPECIFY THE NEXT DATE TO BE RETURNED,     *
      *  3)  A 1 BYTE FIELD CONTAINING THE NUMERIC DESIGNATION OF     *
      *      THE DAY OF WEEK TO BE RETURNED (0=MONDAY, 1=TUESDAY, ... *
      *      6=SUNDAY),                                               *
      *  4)  A 1 BYTE ZONED-DECIMAL RETURN CODE, AND                  *
      *  5)  AN 8 BYTE FIELD IN WHICH THE DERIVED DATE (IN            *
      *      ZONED-DECIMAL FORMAT) WILL BE PLACED.                    *
      *  THE ROUTINE WILL NOT ALTER THE FIELDS PASSED TO IT.          *
      *                                                               *
      *  SUGGESTED CALLING SYNTAX FOR COBOL CALLERS:                  *
      *                                                               *
      *       01  TDOW-PARAMETERS.                                    *
      *           02  DATE    PIC 9(8) VALUE 04151997.                *
      *           02  NORP    PIC X(1) VALUE 'N'.                     *
      *           02  DAYN    PIC 9(1) VALUE 3.                       *
      *           02  RC      PIC 9(1) VALUE 0.                       *
      *           02  NEWDATE PIC 9(8) VALUE 0.                       *
      *       CALL 'Y2KTDOW' USING TDOW-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'A', X'E', 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 THE VALUE OF THE PREVIOUS/NEXT INDICATOR WAS     *
      *  NOT VALID ('N' OR 'P').                                      *
      *                                                               *
      *  5 INDICATES THAN AN INVALID DATE WILL BE DEVELOPED WHEN      *
      *  THE TARGET DATE IS CREATED (OUTSIDE OF YEAR RANGE LISTED     *
      *  IN 1 ABOVE).                                                 *
      *                                                               *
      *  7 INDICATES THE VALUE OF THE DAY OF THE WEEK WAS NOT IN      *
      *  THE ALLOWABLE RANGE (0-6).                                   *
      *                                                               *
      *  UPON SUCCESSFUL EXECUTION, THE DERIVED DATE WILL BE          *
      *  PLACED IN THE 5TH PARAMETER FIELD.  IF THE RETURN CODE IS    *
      *  A NON-ZERO VALUE (UNSUCCESSFUL EXECUTION), THE 5TH           *
      *  PARAMETER FIELD 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 'Y2KTDOW STORAGE BEGINS->'.

      * ************************************************************* *
      * THESE ARE PROGRAM CONTROL SWITCHES AND WORK FIELDS.           *
      * ************************************************************* *
       01  PROGRAM-CONTROL-FIELDS.
           02  WORK-A                  PIC S9(3) COMP-3.

           02  PROJ-PARAMETERS.
               03  PROJP-DATE          PIC 9(8).
               03  PROJP-INCR          PIC S9(6).
               03  PROJP-RC            PIC 9(1).
               03  PROJP-NEWDATE       PIC 9(8).

           02  DOWN-PARAMETERS.
               03  DOWNP-DATE          PIC 9(8).
               03  DOWNP-RC            PIC 9(1).
               03  DOWNP-DAYNUMBER     PIC 9(1).

       01  FILLER                      PIC X(24)
           VALUE '<-Y2KTDOW 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  TDOW-PARAMETERS.
           02  TDOWP-DATE              PIC 9(8).
           02  TDOWP-NORP              PIC X(1).
           02  TDOWP-DAYNUMBER         PIC 9(1).
           02  TDOWP-RC                PIC 9(1).
           02  TDOWP-NEWDATE           PIC 9(8).
      /
       PROCEDURE DIVISION USING TDOW-PARAMETERS.

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

       0050-GET-DAYNUMBER.
           MOVE TDOWP-DATE TO DOWNP-DATE.
           CALL 'Y2KDOWN' USING DOWN-PARAMETERS.

           IF DOWNP-RC NOT EQUAL ZERO
               MOVE DOWNP-RC TO TDOWP-RC
               GOBACK.

       0075-VALIDATE-DIRECTION.
           IF TDOWP-NORP EQUAL 'N'
           OR TDOWP-NORP EQUAL 'P'
               NEXT SENTENCE
           ELSE
               MOVE 3 TO TDOWP-RC
               GOBACK.

       0100-VALIDATE-TARGET-DAYNUMBER.
           EVALUATE TDOWP-DAYNUMBER
               WHEN 0 THROUGH 6
                   NEXT SENTENCE
               WHEN OTHER
                   MOVE 7 TO TDOWP-RC
                   GOBACK.

       0125-COMPUTE-TARGET-OFFSET.
           MOVE +7 TO WORK-A.
           IF TDOWP-NORP = 'P'
               ADD DOWNP-DAYNUMBER TO WORK-A
               SUBTRACT TDOWP-DAYNUMBER FROM WORK-A
               IF WORK-A GREATER THAN 7
                   SUBTRACT 7 FROM WORK-A
               END-IF
               MULTIPLY WORK-A BY -1 GIVING PROJP-INCR
           ELSE
               SUBTRACT DOWNP-DAYNUMBER FROM WORK-A
               ADD TDOWP-DAYNUMBER TO WORK-A
               IF WORK-A GREATER THAN 7
                   SUBTRACT 7 FROM WORK-A
               END-IF
               MOVE WORK-A TO PROJP-INCR
           END-IF.

       0130-PROJECT-TO-DATE.
           MOVE TDOWP-DATE TO PROJP-DATE.
           CALL 'Y2KPROJ' USING PROJ-PARAMETERS.

           IF PROJP-RC NOT EQUAL ZERO
               MOVE PROJP-RC TO TDOWP-RC
           ELSE
               MOVE PROJP-NEWDATE TO TDOWP-NEWDATE.

           GOBACK.

       END PROGRAM Y2KTDOW.

