/* rexx:  @DATE yy/mm/dd | yyddd                                     */
/*  Converted to REXX from own @DATE clist 1993/06/07 David McRitchie*/
/*  @DATE  created 1986/07/09 David McRitchie                        */
/*   updated for year 2000 using obtained coding, 1997/05/12 D.McR   */
Address "ISREDIT";"MACRO"
jdate=""; gdate="";
arg xdate test
xdatex = xdate
if xdate="" |  xdate="*" then xdate=date('s');
L = length(xdate)
p = pos("/",xdate)
if p > 0 then do
   xdate = left(xdate,p - 1)||right(xdate,p + 1)
   p = pos("/",xdate); pm1 = p - 1; pp1 = P + 1;
   if pos <> 0 then xdate = left(xdate,pm1)||right(xdate,pp1)
   L = length(xdate)
end
if datatype(xdate,"n") = 0 then signal errx
if L = 5 | L = 6 then
   if left(xdate,2) < '70' then xdate="20"xdate; else xdate="19"xdate
L = length(xdate)
if l = 8 then do; call convert1 xdate; signal reporting; end;
if l = 7 then do; call convert2 xdate; signal reporting; end;
errx:
zedlmsg = "@DATEW:" xdatex " is invalid, expect YYYYMMDD or YYYYNNN"
/*adDRESS*/ "ISPEXEC"   "SETMSG MSG(ISRZ001)"
return 4
reporting:
   zedsmsg = gdate jdate day_of_week
   zedlmsg = day_of_week gdate jdate", the time now is" time('n')
   if test \= "" then "line_before .zfirst = noteline (zedlmsg)"
/*adDRESS*/ "ISPEXEC"   "SETMSG MSG(ISRZ001)"
return 0

/*********************************************************************/
/* Coding implementation obtained from internet with better algorithm*/
/*    indicated as verified correct 15 Oct 1582 thru  31 Dec 9999.   */
/*********************************************************************/

CONVERT1:
/* REXX exec CONVERT1
   Converts "YYYYMMDD" into (1) Julian date "YYYYNNN" (NNN is 001-366)
                        and (2) day-of-week.
   (1): Algorithm 398 in the Oct 1970 Communication of the ACM,
        by Richard A. Stone.
   (2): added by Harold Zbiegien.
*/
arg YYYY +4 MM +2 DD
if YYYY //   4 = 0 then LY = 1 ; else LY = 0
if YYYY // 100 = 0 then LY = 0
if YYYY // 400 = 0 then LY = 1        /* LY is 1 if it is a leap year
*/
NNN = TRUNC(((MM + 2) * 3055) / 100) + DD - 91
if NNN > (59 + LY) then NNN = NNN - 2 + LY
NNN = RIGHT(NNN,3,0)
T = TRUNC(YYYY / 100) - 6 - TRUNC(YYYY / 400)
DOW = (NNN + TRUNC((YYYY * 5) / 4) - LY - T) // 7
                             /* DOW is 0-6, 0=Sunday, 1=Monday, etc.)
*/
array = 'Sun Mon Tues Wed Thurs Fri Sat'
day_of_week = WORD(array,DOW+1)
mm = right(mm,2,"0")
dd = right(dd,2,"0")
nnn = right(nnn,3,"0")
gdate = YYYY"/"MM"/"DD
jdate = yyyy"/"nnn
/*day_of_week*/
signal reporting


convert2:
/*********************************************************************/
/*    REXX exec CONVERT2                                             */
/*    Converts Julian date "YYYYNNN" into (1) "YYYYMMDD"             */
/*                                    and (2) day-of-week.           */
/*    This is a reversal of routine CONVERT1, worked out by Harold   */
/* Zbiegien                                                          */
/*********************************************************************/
yyyy = substr(xdate,1,4); nnn = right(xdate,3)
arg YYYY +4 NNN
if YYYY //   4 = 0 then LY = 1 ; else LY = 0
if YYYY // 100 = 0 then LY = 0
if YYYY // 400 = 0 then LY = 1        /* LY is 1 if it is a leap year
*/
WORK = NNN
if WORK > (59 + LY) then WORK = WORK + 2 - LY
MM = TRUNC(((WORK + 91) * 100) / 3055)
DD = (WORK + 91) - TRUNC((MM * 3055) / 100)
DD = RIGHT(DD,2,0)
MM = MM - 2
MM = RIGHT(MM,2,0)
T = TRUNC(YYYY / 100) - 6 - TRUNC(YYYY / 400)
DOW = (NNN + TRUNC((YYYY * 5) / 4) - LY - T) // 7
            /* DOW is 0-6, 0=Sunday, 1=Monday, etc.)*/
array = 'Sun Mon Tues Wed Thurs Fri Sat'
day_of_week = WORD(array,DOW+1)
mm = right(mm,2,"0")
dd = right(dd,2,"0")
nnn = right(nnn,3,"0")
jdate = yyyy||nnn
gdate = yyyy||mm||dd
/* day_of_week*/
signal reporting

/* @DATE: in "The REXX Macros Toolbox" is located 1995/05/12    */
/* at http://www.geocities.com/davemcritchie/nclist.htm         */
/* should be indexed in AltaVista if it moves.  David McRitchie */