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(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(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