/* rexx */
RDATE:
/*                                       */
/* AUTHOR: Mark Zelden                   */
/*                                       */
/************************************************/
/*  Function version of RDATE                   */
/************************************************/
/* Convert MM DD YYYY , YYYY DDD, or NNNNN to   */
/* standard date output that includes the day   */
/* of the week and the number of days (NNNNN)   */
/* from January 1, 1900. This is not the same   */
/* as the Century date! Valid input dates range */
/* from 01/01/1900 through 12/31/2172.          */
/*                                              */
/* A parm of "TODAY" can also be passed to      */
/* the date conversion routine.                 */
/*                                              */
/* The result format is always as follows:      */
/*      MM/DD/YYYY.JJJ NNNNN WEEKDAY            */
/*                                              */
/* example: X = RDATEF(TODAY)                   */
/* example: X = RDATEF(1996,300)                */
/* example: X = RDATEF(10,26,1996)              */
/* example: X = RDATEF(35363)                   */
/* result:  X = 10/26/1996.300 35363 Saturday   */
/************************************************/
arg P1,P2,P3

JULTBL = '000031059090120151181212243273304334'
DAY.0 = 'Sunday'
DAY.1 = 'Monday'
DAY.2 = 'Tuesday'
DAY.3 = 'Wednesday'
DAY.4 = 'Thursday'
DAY.5 = 'Friday'
DAY.6 = 'Saturday'

Select
  When P1 = 'TODAY' then do
    P1 = Substr(date('s'),5,2)
    P2 = Substr(date('s'),7,2)
    P3 = Substr(date('s'),1,4)
    call CONVERT_MDY
    call THE_END
  end
  When P2 = '' & P3 = '' then do
    call CONVERT_NNNNN
    call THE_END
  end
  When P3 = '' then do
    call CONVERT_JDATE
    call DOUBLE_CHECK
    call THE_END
  end
  otherwise do
    call CONVERT_MDY
    call DOUBLE_CHECK
    call THE_END
  end
end /* end select */
/* say RDATE_VAL; exit 0 */
return RDATE_VAL
/**********************************************/
/*  E N D    O F   M A I N L I N E   C O D E  */
/**********************************************/

CONVERT_MDY:
if P1<1 | P1>12 then do
  say 'Invalid month passed to date routine'
  exit 12
end
if P2<1 | P2>31 then do
  say 'Invalid day passed to date routine'
  exit 12
end
if (P1=4 | P1=6 | P1=9 | P1=11) & P2>30 then do
  say 'Invalid day passed to date routine'
  exit 12
end
if P3<1900 | P3>2172 then do
  say 'Invalid year passed to date routine. Must be be 1900-2172'
  exit 12
end
BASE   = Substr(JULTBL,((P1-1)*3)+1,3)
if (P3//4=0 & P3<>1900 & P3<>2100) then LEAP= 1
  else LEAP = 0
if P1 > 2 then BASE = BASE+LEAP
JJJ = BASE + P2

MM   = P1
DD   = P2
YYYY = P3
return

CONVERT_NNNNN:
if P1<1 | P1>99712 then do
  say 'Invalid date passed to date routine. NNNNN must be 1-99712'
  exit 12
end
/* Determine YYYY and JJJ */
if P1>365 then P1=P1+1
YEARS_X4=(P1-1)%1461
JJJ=P1-YEARS_X4*1461
if P1 > 73415 then JJJ = JJJ +1
EXTRA_YEARS=(JJJ*3-3)%1096
JJJ=JJJ-(EXTRA_YEARS*1096+2)%3
YYYY=YEARS_X4*4+EXTRA_YEARS+1900
P1 = YYYY ; P2 = JJJ ;  call CONVERT_JDATE

CONVERT_JDATE:
MATCH = 'N'
if P1<1900 | P1>2172 then do
  say 'Invalid year passed to date routine. Must be be 1900-2172'
  exit 12
end
if P2<1 | P2>366 then do
  say 'Invalid Julian date passed to date routine'
  exit 12
end
if (P1//4=0 & P1<>1900 & P1<>2100) then LEAP= 1
  else LEAP = 0
ADJ1 = 0
ADJ2 = 0
Do MM = 1 to 11
   VAL1 = Substr(JULTBL,((MM-1)*3)+1,3)
   VAL2 = Substr(JULTBL,((MM-1)*3)+4,3)
   if MM >=2 then ADJ2 = LEAP
   if MM >=3 then ADJ1 = LEAP
   if P2 > VAL1+ADJ1 & P2 <= VAL2+ADJ2 then do
        DD = P2-VAL1-ADJ1
        MATCH = 'Y'
        leave
   end
end
if MATCH <> 'Y' then do
    MM = 12
    DD = P2-334-LEAP
end

YYYY = P1
JJJ  = P2
return

DOUBLE_CHECK:
if MM = 2 then do
   if DD > 28 & LEAP = 0 then do
     say 'Invalid day passed to date routine'
     exit 12
   end
   if DD > 29 & LEAP = 1 then do
     say 'Invalid day passed to date routine'
     exit 12
   end
end
if LEAP = 0 & JJJ > 365 then do
  say 'Invalid Julian date passed to date routine'
  exit 12
end
return

THE_END:
YR_1900 = YYYY-1900
NNNNN = (YR_1900*365) +(YR_1900+3)%4 + JJJ
if YYYY > 1900 then NNNNN = NNNNN-1
if YYYY > 2100 then NNNNN = NNNNN-1
INDEX   = NNNNN//7  /* index to DAY stem */
WEEKDAY =  DAY.INDEX

DD      = Right(DD,2,'0')
MM      = Right(MM,2,'0')
YYYY    = Strip(YYYY)
NNNNN   = Right(NNNNN,5,'0')
JJJ     = Right(JJJ,3,'0')

RDATE_VAL = MM||'/'||DD||'/'||YYYY||'.'||JJJ||' '||NNNNN||' '||WEEKDAY
return