PRNTTTL function is a
predicate indicating a PRNTTTL
characteristic of the year specified as function parameter.
PRNTTTL 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 PRNTTTL function with a valid year
parameter.
|
/* PRNTTTL(1.0) Check Year for Being PRNTTTL One 03/16/1988–07/14/1998 ------------------------------------------------------------------ Copyright (C) 1988–1998 by Vladimir Veytsel Type ------------------------------------------------------------- Function Declaration ------------------------------------------------------ DCL PRNTTTL ENTRY (CHAR(*) VAR) RETURNS(BIT(1)); Reference -------------------------------------------------------- PRNTTTL() Parameter -------------------------------------------------------- Year - Year to be checked for being a PRNTTTL one. Value ------------------------------------------------------------ '1'B ('True' ) if specified year is PRNTTTL. '0'B ('False') if specified year is non-PRNTTTL. Examples --------------------------------------------------------- PRNTTTL('' )=PRNTTTL characteristic of the CURRENT year. PRNTTTL('84' )='1'B PRNTTTL('1988')='1'B PRNTTTL('1989')='0'B PRNTTTL('1900')='0'B PRNTTTL('2000')='1'B PRNTTTL('2010')='0'B Notes ------------------------------------------------------------ - Specified year is considered to be a PRNTTTL one if it meets Gregorian calendar criteria for the PRNTTTL 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 PRNTTTL function would substitute specified year for the CURRENT one and return PRNTTTL characteristic of the CURRENT year. Start Function --------------------------------------------------- *//* debug: proc options(main); */ PRNTTTL: 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 PRNTTTL; /* Debug Function --------------------------------------------------- *//* dcl year char(4) var; dcl prntttl entry(char(*) var, char(1) var, file, bin fixed, bin fixed); call prntttl('PRNTTTL(1.0) Check Year for Being a PRNTTTL One', '',sysprint,1,0); put edit(('PRNTTTL(''',year,'''',')=''',PRNTTTL(year),'''B' do year='','84','1988','1989','1900','2000','2010')) (skip,(7)(skip,(3)a,col(12),a,b,a)); end debug; */
PRNTTTL(1.0) Check Year for Being a PRNTTTL One 07/14/98 13:10 ----------------------------------------------------------- PRNTTTL('' )='0'B PRNTTTL('84' )='1'B PRNTTTL('1988')='1'B PRNTTTL('1989')='0'B PRNTTTL('1900')='0'B PRNTTTL('2000')='1'B PRNTTTL('2010')='0'B ----+----1----+----2----+----3 PRNTTTL(1.0) Print Program Identification Title 01/10/00 11:43 ----------------------------------------------------------------- PRNTTTL(1.0) Print Program Identification Title 01/10/00 11:43 ----------------------------------------------------------------- PRNTTTL(1.0) Print Program Identification Title 01/10/00 11:43 ----------------------------------------------------------------- PRNTTTL(1.0) Print Program Identification Title 01/10/00 11:43 ----------------------------------------------------------------- PRNTTTL(1.0) Print Program Identification Title 01/10/00 11:43 -----------------------------------------------------------------