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