YYMMDD: PROC(DAYS) RETURNS(CHAR(*) VARYING); /* CONVERTS A BINARY NUMBER IN THE RANGE FROM 1 TO 36524 INTO A 20TH CENTURY CALENDAR DATE OF THE FORM YYMMDD IF THE INPUT ARGUMENT IS NOT IN THE ABOVE RANGE, THE NULL STRING '' IS RETURNED AUTHOR: CHUCK EASTLACK DATE: MARCH 2, 1982 WESTAT PL/I PROCEDURE LIBARY . . . . */ DCL (DAYS,XDAYS,YRS) FIXED BINARY(31); DCL (I,M,LEAPCOUNT) FIXED BINARY(31); DCL ($YY,$MM,$DD) PIC'99'; DCL LEAPYEAR BIT(1); DCL DPM(12) FIXED BINARY(31) INIT(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); IF DAYS<1 THEN RETURN(''); IF DAYS>36524 THEN RETURN(''); XDAYS=MOD(DAYS,365); YRS=DIVIDE((DAYS-XDAYS),365,31); IF YRS=0 THEN LEAPCOUNT=0; ELSE LEAPCOUNT=DIVIDE((YRS-1),4,31); XDAYS=XDAYS-LEAPCOUNT; IF XDAYS<1 THEN DO; YRS=YRS-1; LEAPYEAR='0'B; IF MOD(YRS,4)=0 THEN LEAPYEAR='1'B; IF YRS=0 THEN LEAPYEAR='0'B; IF LEAPYEAR THEN XDAYS=XDAYS+366; ELSE XDAYS=XDAYS+365; END; ELSE DO; IF MOD(YRS,4)^=0 | YRS=0 THEN LEAPYEAR='0'B; ELSE LEAPYEAR='1'B; END; I=0; M=0; DO WHILE(I=M); I=I+1; IF (I=2) THEN DO; IF LEAPYEAR & (XDAYS>29) THEN DO; XDAYS=XDAYS-29; M=M+1; END; IF ^LEAPYEAR & (XDAYS>28) THEN DO; XDAYS=XDAYS-28; M=M+1; END; END; ELSE IF XDAYS>DPM(I) THEN DO; XDAYS=XDAYS-DPM(I); M=M+1; END; END; M=M+1; $DD=XDAYS; $MM=M; $YY=YRS; RETURN ($YY||$MM||$DD); END YYMMDD;