/* REXX: SHOWDATE: SHOW DATES */
/* AS SET UP EITHER CALLED BY @DATE -- OR SHOWDATE YYDDD WRITE */
/*********************************************************************/
/*  @SHOWDATE  1986/07/09 D.MCRITCHIE, THIS CODE HAS BEEN REWRITTEN  */
/*    IN REXX FOR USE BY THE @DATE MACRO.                            */
/*  DATES ARE ACCEPTED IN SEVERAL FORMS INCLUDING SAS OR DMS FORM    */
/*    OF DDMMMYY.  WHEN INVOKED IN A NON NESTED FASHION WILL WRITE   */
/*    LINES TO SCREEN.                                               */
/*********************************************************************/

/*********************************************************************/
/*  DATE CONVERSION ROUTINE -- SYNTAX:                               */
/*     %SHOWDATE YYDDD    -OR-      E.G.  86348                      */
/*     %SHOWDATE YY/MM/DD           E.G.  1986/12/14                 */
/*     %SHOWDATE DDMMMYY            E.G.  14DEC86      DMS AND SAS   */
/*  SETS VARIABLES "JDATE" AND "GDATE" TO THE YYDDD AND YY/MM/DD     */
/*  FORMS, RESPECTIVELY.                                             */
/*********************************************************************/

 PDATE='';WRITE=''
 ARG PDATE WRITE
 PARSE VERSION V1 V2 V3 V4 V5  /* TO CHECK FOR TSO OR OS/2 */
 IF PDATE = "" | PDATE= "*" THEN  PDATE=DATE('O');
 RPTTIME=TIME()
 M.='';V.='';W.='';
 M.0=0; M.1=31; M.2=60; M.3=91; M.4=121; M.5=152; M.6=182; M.7=213;
          M.8=244; M.9=274; M.10=305; M.11=335; M.12=99999999;
 V.1="JAN"; V.2="FEB"; V.3="MAR"; V.4="APR"; V.5="MAY"; V.6="JUN";
          V.7="JUL"; V.8="AUG"; V.9="SEP"; V.10="OCT"; V.11="NOV";
          V.12="DEC";
 W.1="SUN"; W.2="MON"; W.3="TUE"; W.4="WED"; W.5="THU"; W.6="FRI";
          W.7="SAT";


   IF WRITE \= "NOWRITE" THEN DO
      PARSE VERSION V1 V2 V3 V4 V5
      IF V1 /= "REXX370" THEN WRITE = "WRITE"  /* OS/2 NO SYSNEST*/
      IF WRITE = "" THEN DO       /* WRITE(WRITE) WILL PRINT RESULTS*/
         IF SYSVAR('SYSNEST') = "NO" THEN WRITE = "WRITE"
         ELSE  WRITE = "NOWRITE"
      END
   END
   IF PDATE = "*" THEN PDATE = DATE('O')
   IF SUBSTR(PDATE,4,1) < "0" THEN DO
      I = 1                /*  E.G.  14DEC86 CONVERTED TO 1986/12/14 */
      DO WHILE I  <= 12
         XXX = V.I
         X3  = 100 +  I
         IF SUBSTR(PDATE,3,3) = XXX THEN DO
            PDATE = SUBSTR(PDATE,6,2)"/"SUBSTR(X3,2,2)"/"SUBSTR(PDATE,1,2)
            SIGNAL REFORMED
         END
         I = I + 1
      END
   END
 REFORMED:
   IF DATATYPE(PDATE) \= "NUM" THEN SIGNAL TRY2
   IF LENGTH(PDATE)  \= 5      THEN SIGNAL TRY2
   Y = SUBSTR(PDATE,1,2) + 0
   D = SUBSTR(PDATE,3,3) + 0
   Y1 = Y//4
   IF Y1 \= 0 THEN IF D > 59 THEN D = D + 1
   IF  D > 366 THEN SIGNAL TRY2
   I = 1
   OLDM = 0
   DO WHILE  I <= 12
      NEWM = M.I
      IF  D <=  NEWM THEN SIGNAL DCONS1
      OLDM =  NEWM
      I =  I + 1
   END
 DCONS1:
   X = V.I
   DX0 = SUBSTR(PDATE,3,3)
   DX1 = TRUNC((Y+3)/4) + 365 * Y + DX0 + 6
   DX2 = TRUNC(DX1/7)
   DX3 = (DX1 -  DX2) * 7 + 1
   DX2 = (DX1)//7 + 1
   WDATE =W.DX2
   JDATE = PDATE
   D = D -  OLDM
   GDATE = RIGHT(Y,2,'0')'/'RIGHT(I,2,'0')'/'RIGHT(D,2,'0')
   SDATE = RIGHT(D,2,'0')X||RIGHT(Y,2,'0')
   SIGNAL GOODEXIT
 TRY2:
   IF LENGTH(PDATE) \= 8 THEN SIGNAL ERRORS
   IF SUBSTR(PDATE,3,1) \= "/" THEN SIGNAL ERRORS
   IF SUBSTR(PDATE,6,1) \= "/" THEN SIGNAL ERRORS
   Y = LEFT(PDATE,2,'0')
   I = SUBSTR(PDATE,4,2)
   D = RIGHT(PDATE,2,'0')
   IF DATATYPE(Y) \= "NUM" THEN SIGNAL ERRORS
   IF DATATYPE(I) \= "NUM" THEN SIGNAL ERRORS
   IF DATATYPE(D) \= "NUM" THEN SIGNAL ERRORS
   IF  D > 31 THEN SIGNAL ERRORS /* USED MM/DD/YY INSTEAD OF YY/MM/DD*/
   IF  I > 12 THEN SIGNAL ERRORS
   I = I - 1
   I = M.I
   D =  D +  I
   IF  D > 366 THEN SIGNAL ERRORS
   I =  TRUNC(Y / 4) * 4
   IF  Y \=  I  &   D > 59 THEN D =  D - 1
   DX1 = TRUNC((Y+3)/4) + 365*Y  +  D + 6
   DX2 = TRUNC(DX1 / 7)
   DX3 =  DX1 -  DX2 * 7 + 1
   WDATE = W.DX3
   GDATE = PDATE
   JDATE = RIGHT(Y,2,'0')RIGHT(D,3,'0')
   I = SUBSTR(PDATE,4,2) + 0
   SDATE = SUBSTR(PDATE,7,2)||V.I||RIGHT(Y,2,'0')
 GOODEXIT:
   IF WRITE = "WRITE" THEN SAY JDATE GDATE SDATE   WDATE RPTTIME
   IF V1 = "REXX370"        /* USING TSO,  OTHERWISE USING SPF/PC*/
      THEN ADDRESS "ISPEXEC" "VPUT (JDATE,GDATE,SDATE,WDATE)"
      ELSE DO;QUEUE JDATE; QUEUE GDATE; QUEUE SDATE; QUEUE WDATE;END;
   EXIT 0

 ERRORS:
   IF WRITE = "WRITE" THEN DO
      SAY "REQUESTED        SHOWDATE" PDATE " IS IN ERROR  RC=8"
      SAY "IF REENTERED FOR CURRENT DATE AS ===> SHOWDATE *    ",
          "THE RESULTS WOULD BE..."
      ADDRESS "TSO" "SHOWDATE * WRITE"
      SAY "YOUR ORIGINAL REQUEST OF ""SHOWDATE" PDATE" WAS IN ERROR RC=8"
   END
   EXIT 8