       IDENTIFICATION DIVISION.
       PROGRAM-ID. Y2KLEAP.
       AUTHOR. JAY MOSELEY.
       DATE-WRITTEN. DECEMBER, 1997.
       DATE-COMPILED.
      *                                                                     *
      *   YY   YY   222   KK   KK LL      EEEEEE     A    PPPPPP            *
      *   YY   YY  2   2  KK  KK  LL      EE        AAA   PP   PP           *
      *   YY   YY      2  KK KK   LL      EE       AA AA  PP   PP           *
      *    YY YY       2  KKKK    LL      EEEE    AA   AA PP   PP           *
      *     YYY     222   KKKK    LL      EE      AA   AA PPPPPP            *
      *     YY     2      KK KK   LL      EE      AAAAAAA PP                *
      *     YY     2      KK  KK  LL      EE      AA   AA PP                *
      *     YY     22222  KK   KK LLLLLLL EEEEEEE AA   AA PP                *
      *                                                                     *
      * ******************************************************************* *
      *    THIS SUBROUTINE DETERMINES GREGORIAN LEAP YEARS                  *
      *                                                                     *
      *    1.  VALID INPUT YEARS FOR THIS ROUTINE ARE THE YEARS 1601        *
      *        THROUGH 3399 A. D. (INCLUSIVE)                               *
      *                                                                     *
      *    2.  THREE FIELDS ARE PASSED AS PARAMETERS TO THE ROUTINE:        *
      *        1)  A 4 BYTE FIELD CONTAINING THE YEAR TO BE TESTED          *
      *            (IN ZONED-DECIMAL FORMAT),                               *
      *        2)  A 1 BYTE ZONED-DECIMAL RETURN CODE, AND                  *
      *        3)  A 1 BYTE LEAP YEAR INDICATOR (IN ZONED-DECIMAL FORMAT).  *
      *        THE ROUTINE WILL NOT ALTER THE YEAR PASSED TO IT.            *
      *                                                                     *
      *        SUGGESTED CALLING SYNTAX FOR COBOL CALLERS:                  *
      *                                                                     *
      *             01  Y2K-LEAP-PARAMETERS.                                *
      *                 02  Y2K-LEAPP-YEAR          PIC 9(4).               *
      *                 02  Y2K-LEAPP-RC            PIC 9(1).               *
      *                 02  Y2K-LEAPP-LEAP-SWITCH   PIC 9(1).               *
      *             CALL 'Y2KLEAP' USING Y2K-LEAP-PARAMETERS.               *
      *                                                                     *
      *    3.  THE POSSIBLE VALUES FOR THE RETURN CODE FIELD ARE:           *
      *                                                                     *
      *        0 INDICATES SUCCESSFUL EXECUTION OF THE ROUTINE.             *
      *                                                                     *
      *        2 INDICATES INVALID DATA WAS FOUND IN THE YEAR FIELD.        *
      *        INVALID DATA ARE DETERMINED IF FIELD CONTAINS NON-NUMERIC    *
      *        CHARACTERS.                                                  *
      *                                                                     *
      *        4 INDICATES THE VALUE OF THE YEAR SPECIFIED WAS NOT IN       *
      *        THE RANGE SPECIFIED IN 1 (ABOVE).                            *
      *                                                                     *
      *    4.  UPON SUCCESSFUL EXECUTION, THE LEAP INDICATOR FIELD WILL     *
      *        CONTAIN A VALUE OF 1 IF THE YEAR IS A LEAP YEAR.  A VALUE    *
      *        OF 0 INDICATES NO LEAP YEAR.  IF THE RETURN CODE IS A        *
      *        NON-ZERO VALUE (UNSUCCESSFUL EXECUTION), THE LEAP YEAR       *
      *        INDICATOR WILL CONTAIN THE VALUE OF 9 TO PROTECT AGAINST     *
      *        UNINTENTIONAL USE OF AN INVALID RESULT.                      *
      *                                                                     *
      * ******************************************************************* *
      /
       ENVIRONMENT DIVISION.

       CONFIGURATION SECTION.
       REPOSITORY.
           FUNCTION ALL INTRINSIC.

       INPUT-OUTPUT SECTION.

       DATA DIVISION.

       WORKING-STORAGE SECTION.

       LOCAL-STORAGE SECTION.

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


       01  FILLER                      PIC X(24)
           VALUE '<-Y2KDOWN 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  Y2K-LEAP-PARAMETERS.
           02  Y2K-LEAPP-YEAR          PIC 9(4).
           02  Y2K-LEAPP-RC            PIC 9(1).
           02  Y2K-LEAPP-LEAP-SWITCH   PIC 9(1). 
               88  Y2K-IS-LEAP         VALUE 1. 
               88  Y2K-IS-NOT-LEAP     VALUE 0.
      /
       PROCEDURE DIVISION USING Y2K-LEAP-PARAMETERS.

       0000-MAIN SECTION.

       0025-INITIALIZE.

           MOVE ZERO TO Y2K-LEAPP-RC.
           MOVE 9 TO Y2K-LEAPP-LEAP-SWITCH.

       0050-VALIDATE.

           IF Y2K-LEAPP-YEAR IS NOT NUMERIC
               MOVE 2 TO Y2K-LEAPP-RC
           ELSE
               IF (Y2K-LEAPP-YEAR < 1601)
               OR (Y2K-LEAPP-YEAR > 3399)
                   MOVE 4 TO Y2K-LEAPP-RC
               END-IF
           END-IF.

       0075-DETERMINE-LEAP-STATUS.

           IF Y2K-LEAPP-RC = 0
               IF MOD(Y2K-LEAPP-YEAR, 400) = 0
                   SET Y2K-IS-LEAP TO TRUE
               ELSE
                   IF MOD(Y2K-LEAPP-YEAR, 100) = 0
                       SET Y2K-IS-NOT-LEAP TO TRUE
                   ELSE
                       IF MOD(Y2K-LEAPP-YEAR, 4) = 0
                           SET Y2K-IS-LEAP TO TRUE
                       ELSE
                           SET Y2K-IS-NOT-LEAP TO TRUE
                       END-IF
                   END-IF
               END-IF
           END-IF.
           
       0100-RETURN. 
           GOBACK.

       END PROGRAM Y2KLEAP.
