Go to:  Davar site entry | Site contents | Site index | Mainframe | PL/I | Text bottom

LEAP  PL/I  Function

        
LEAP function is a predicate indicating a leap characteristic of the year specified as function parameter.  LEAP function was developed for the environment which wasn't Y2K-compliant and it has a build-in constant for 20-th century to be used as a default when only 2 digits of year are specified or when year is not specified or is invalid and current date has to be obtained from the system.  This is used for contingency only, since it is the responsibility of the calling program to provide the LEAP function with a valid year parameter.



          LEAP  Source  Program         Debugging program       Debugging logout

     /* LEAP(1.0)  Check Year for Being Leap One  03/16/1988–07/14/1998
     ------------------------------------------------------------------
        Copyright (C) 1988–1998 by Vladimir Veytsel

     Type -------------------------------------------------------------

        Function

     Declaration ------------------------------------------------------

        DCL LEAP ENTRY  (CHAR(*) VAR)
                 RETURNS(BIT(1));

     Reference --------------------------------------------------------

        LEAP()

     Parameter --------------------------------------------------------

        Year  - Year to be checked for being a leap one.

     Value ------------------------------------------------------------

        '1'B ('True' ) if specified year is     leap.
        '0'B ('False') if specified year is non-leap.

     Examples ---------------------------------------------------------

        LEAP(''    )=Leap characteristic of the CURRENT year.
        LEAP('84'  )='1'B
        LEAP('1988')='1'B
        LEAP('1989')='0'B
        LEAP('1900')='0'B
        LEAP('2000')='1'B
        LEAP('2010')='0'B

     Notes ------------------------------------------------------------

      - Specified year is considered to be a leap one
        if it meets Gregorian calendar criteria for the leap year:

        - On century border century number is multiple of 4;
        - Otherwise         year    number is multiple of 4
          (it's sufficient to check only last 2 digits of year number).

      - If length of specified year is 2 characters,
        then current century is assumed by default (see constant below).

      - Specified year length should be either either 2 or 4 characters.
        This condition should mandatory be checked/provided by
        the CALLing program, lest LEAP function would substitute
        specified year for the CURRENT one and return
        leap characteristic of the CURRENT year.

     Start Function --------------------------------------------------- *//*

        debug:  proc options(main);                                        */

        LEAP:   PROC   (Year)
               RETURNS(BIT(1)) REORDER;                                 /*

     Parameter -------------------------------------------------------- */

        DCL Year CHAR(4) VAR;                                           /*

     Constant for Default Current Century (Change Once a Century!) ---- */

        DCL Current_Century CHAR(2) INIT('19');                         /*

     Variables -------------------------------------------------------- */

        DCL CNYE       CHAR(4),
           (CN,
            YE POS(3)) CHAR(2) DEF CNYE;                                /*

     Preform Year Parameter ------------------------------------------- */

        SELECT (LENGTH(Year));
          WHEN (2) CNYE=Current_Century||Year;
          WHEN (4) CNYE=Year;
          OTHER    CNYE=Current_Century||SUBSTR(DATE(),1,2);
        END;                                                            /*

     Form and Return Function Value to the Point of Invocation -------- */

        RETURN((YE ='00')&(MOD(CN,4)=0)|
               (YE^='00')&(MOD(YE,4)=0));                               /*

     Finish Function -------------------------------------------------- */

        END LEAP;                                                       /*

     Debug Function --------------------------------------------------- *//*

        dcl year char(4) var;

        dcl prntttl entry(char(*) var, char(1) var, file,
                          bin fixed, bin fixed);

        call prntttl('LEAP(1.0)  Check Year for Being a Leap One',
                     '',sysprint,1,0);

        put edit(('LEAP(''',year,'''',')=''',leap(year),'''B'
                  do year='','84','1988','1989','1900','2000','2010'))
                (skip,(7)(skip,(3)a,col(12),a,b,a));

        end debug;                                                        */
  


         LEAP  Debugging  Logout      Source program     Debugging program

     LEAP(1.0)  Check Year for Being a Leap One  07/14/98  13:10
     -----------------------------------------------------------

     LEAP(''    )='0'B
     LEAP('84'  )='1'B
     LEAP('1988')='1'B
     LEAP('1989')='0'B
     LEAP('1900')='0'B
     LEAP('2000')='1'B
     LEAP('2010')='0'B
  

View [and save] LEAP.PLI text
Go to:  Davar site entry | Site contents | Site index | Mainframe | PL/I | Text top