Code:
#cat xdatex.dbl
.SUBROUTINE XDATEX
DATEXREF, A
RECORD DATEREC
CLDRDATE, D8
CLDRYEAR, D4 @CLDRDATE
CLDRMTH, D2 @CLDRDATE +4
CLDRDAY , D2 @CLDRDATE +6
DAYS1901, D10
DAYOFWK, D1
NAMOFDAY, A9
NAMOFMTH, A9
RECORD
CALCYEAR , D10
CALCMTH ,D10
CALCDAY , D10
DYYR , D10
DYWK , D10
DYMO , D10
TEMPYEAR , D10
TEMPDAY , D10
LEAPYEAR , D10
HOLDDATE , D8
M, A8
DAYDATA, 7A9, 'SUNDAY ','MONDAY ','TUESDAY ','WEDNESDAY'
&,'THURSDAY ','FRIDAY ','SATURDAY '
MTHDATA, 12A9, 'JANUARY ','FEBRUARY ','MARCH ','APRIL ',
&'MAY ','JUNE ','JULY ','AUGUST ',
&'SEPTEMBER','OCTOBER ','NOVEMBER ','DECEMBER '
PROC
SOJ,
DATEREC=DATEXREF
HOLDDATE=CLDRDATE
IF (DAYS1901 .NE. 0) GO TO CENTOCLD
LEAPYEAR=2
CALCYEAR= CLDRYEAR - 1900
CALCMTH= CLDRMTH
CALCDAY= CLDRDAY
TEMPYEAR= CALCYEAR/4
TEMPYEAR= TEMPYEAR * 4
IF (TEMPYEAR .EQ. CALCYEAR) LEAPYEAR=1
DYYR= (CALCMTH * 275)/9 + CALCDAY - 30
IF (CALCMTH .GT. 2) DYYR= DYYR -LEAPYEAR
DAYS1901= CALCYEAR - 1
DAYS1901= (DAYS1901 * 1461) / 4 + DYYR
CALL CENTOCLD
IF (CLDRDATE .NE. HOLDDATE)
BEGIN
DAYS1901= 0
CLDRDATE= 0
DAYOFWK = 0
NAMOFDAY=
NAMOFMTH=
DATEXREF=DATEREC
RETURN
END
RETURN
CENTOCLD,
CALCYEAR=(DAYS1901/1461)
CALCYEAR=(DAYS1901 - CALCYEAR + 364)/365
DYYR=((CALCYEAR - 1)*1461)/4
DYYR=DAYS1901-DYYR
LEAPYEAR= 2
TEMPYEAR= CALCYEAR/4
TEMPYEAR= TEMPYEAR * 4
IF (TEMPYEAR .EQ. CALCYEAR) LEAPYEAR=1
TEMPDAY= DYYR
TEMPYEAR= 61 - LEAPYEAR
IF (TEMPDAY .GT. TEMPYEAR) TEMPDAY= TEMPDAY + LEAPYEAR
CALCMTH= (TEMPDAY * 9 + 269) / 275
DYMO= ((CALCMTH * 275) / 9) - 30
CALCDAY= TEMPDAY - DYMO
DYMO=CALCDAY
DYWK=DAYS1901 + 1
DYWK=DYWK-((DYWK/7)*7)+1
DAYOFWK=DYWK
CLDRYEAR = CALCYEAR + 1900
CLDRMTH= CALCMTH
CLDRDAY= CALCDAY
NAMOFDAY= DAYDATA(DYWK)
NAMOFMTH=MTHDATA(CALCMTH)
DATEXREF=DATEREC
RETURN
#