*DEFINE FIND_THE_DAY *. *. Given a date in format YYYYMMDD or YYMMDD, this routine returns the *. day of the week in DAY_OF_THE_WEEK. *. *. This is an enhanced version of the same routine supplied on the SSG *. 22/23 release tape and documented in Appendix C of the SSG P.R.M. *. *. Differences between this version and the SSG release tape version: *. - This version allows either a six- or eight-digit input date. If *. a six-digit date is supplied, it's converted to an eight-digit *. date according to the Unisys Standard of 2027. The day-of-week *. algorithm used does not recognize that 2100 will not be a leap year, *. so the input year must be less than 2100. Thus, this version *. supports eight-digit input dates from 1964 to 2099 and six-digit *. input dates from 1964 to 2027. (The release tape version allows *. any six-digit input date but returns wrong answers beginning on *. January 1, 2000.) *. - This version works whether NEW_PROCESS$ is set or clear. (The *. release tape version requires that NEW_PROCESS$ be set.) *. - This version names all variables and SGSs internal to this routine *. beginning with 'DOW__' and *REMOVEs them before returning. This *. reduces the risk of using the same names as the caller uses. *. (The release tape version is undisciplined in its naming.) *. *. Written by Steve J. Martin, July 1996. *. *. Input parameter: *. Note: This routine works for both values of NEW_PROCESS$ (i.e., *. it interprets the input parameter appropriately). *. [#1] = Date in format YYYYMMDD or YYMMDD (character); optional; *. if omitted, current date will be used. *. *. Output: *. If the input date is valid *. DAY_OF_THE_WEEK will contain the day of the week (e.g., Monday). *. Else *. ERRCNT$ is incremented and an error message is printed. *. *. *IF [DATE$] . if SSG 23R1 or above *SET DOW__IN = '[DATE$,1,5,1]' . default is current YYYYMMDD *ELSE *SET DOW__IN = '[DATIME$,1,3,1]' . default is current YYMMDD *ENDIF *. *SET DAY_OF_THE_WEEK = '' . output variable *. *IF NEW_PROCESS$ IS SET *IF [#,PROCESS_LEVEL$,1,1,LEN$] <> 0 . if date supplied by caller *SET DOW__IN = '[#,PROCESS_LEVEL$,1,1]' *ENDIF *ELSE *IF [#1] . if date supplied by caller *SET DOW__IN = '[#1]' *ENDIF *ENDIF *. *CREATE SGS: DOW__DATETAB 3,127,240,364,484,608,728,852,976,1096,1220,1340 *CREATE SGS: DOW__DAYTAB Satur,Sun,Mon,Tues,Wednes,Thurs,Fri *. *IF [*DOW__IN,NLEN$] = 6 . if YYMMDD format *IF +[*DOW__IN,LSTR$,2] > 27 . Unisys Standard of 2027 *SET DOW__IN = '19[*DOW__IN]' *ELSE *SET DOW__IN = '20[*DOW__IN]' *ENDIF *ENDIF *. *IF [*DOW__IN,NLEN$] = 8 . if date is 8 digits *SET DOW__YEAR = +[*DOW__IN,LSTR$,4] - 1964 . TDATE$ year *SET DOW__MONTH = +[*DOW__IN,SUBSTR$,5,2] *SET DOW__DAY = +[*DOW__IN,RSTR$,2] *IF +DOW__YEAR >= 0 AND +DOW__YEAR < 136 . if between 1964 and 2099 *SET DOW__HOLD = DOW__YEAR * 1461 + [DOW__DATETAB,1,1,DOW__MONTH] *SET DOW__HOLD = DOW__HOLD / 4 + DOW__DAY + 3 *SET DOW__TEMP = DOW__HOLD / 7 *SET DOW__HOLD = DOW__HOLD - DOW__TEMP * 7 *SET DAY_OF_THE_WEEK = '[DOW__DAYTAB,1,1,DOW__HOLD+1]day' *ELSE *DISPLAY 'FIND_THE_DAY: Error -- input year ([*DOW__IN,LSTR$,4]) is out '; 'range (1964 to 2099)' *SET ERRCNT$ = ERRCNT$ + 1 *ENDIF *ELSE *DISPLAY 'FIND_THE_DAY: Error -- input date ([*DOW__IN]) must be exactly '; '8 digits' *SET ERRCNT$ = ERRCNT$ + 1 *ENDIF *. *REMOVE VARIABLE DOW__YEAR *REMOVE VARIABLE DOW__MONTH *REMOVE VARIABLE DOW__DAY *REMOVE VARIABLE DOW__TEMP *REMOVE VARIABLE DOW__HOLD *REMOVE SGS DOW__DAYTAB,1,[DOW__DAYTAB] *REMOVE SGS DOW__DATETAB,1,[DOW__DATETAB] *. *ENDDEFINE,E