JULDATE: PROC(DATE_STRING) RETURNS(FIXED BINARY(31));

/*  Function takes date character string in the form YYMMDD
    and returns number of days after December 31, 1899.
    To reverse this calculation use the function YYMMDD.
    JULDATE also accepts partial dates, separator characters,
    three letter month abbreviaations, and the missing values
    '  ' and '99' in place of month and day.  The character
    string 'TODAY' evaluates to the current date.  -1 is returned
    if the argument cannot be interpreted as a date.  For example,
    all the following dates are interpreted as June 15, 1982:

    '820615', '820699', '829999', '82', '8206', '82/6/15',
    '82/  /  ', '82/99/99', '82-6', '82//', '82JUN15', '82JUN'

     AUTHOR:     CHUCK EASTLACK
     DATE:       MARCH 2, 1982

     REVISED BY: AL JAWORSKI
     DATE:       MARCH 3, 1982

     WESTAT PL/I PROCEDURE LIBRARY . . . . . . . */

%INCLUDE SCAN;
%INCLUDE REVERSE;
%INCLUDE UPPER;

DCL DATE_STRING CHAR(*) VARYING;
DCL DUMMY CHAR(20) VARYING;

DCL (YEAR,MONTH,DAY) CHAR(3) VARYING;
DCL (YY,MM,DD) FIXED BINARY(31);

DCL DPM(12) FIXED BINARY(31)
    INIT(31, 28, 31, 30, 31, 30,
         31, 31, 30, 31, 30, 31);

DCL (LEAPYEAR,ERROR_FLAG) BIT(1);
DCL LEAPCOUNT FIXED BINARY(31);
DCL (I,J,DAYS,ANSWER) FIXED BINARY(31);
DCL BREAK_CHAR CHAR(1) VARYING;

ON ERROR ERROR_FLAG='1'B;

YEAR='';
MONTH='';
DAY='';
ERROR_FLAG='0'B;

DUMMY=UPPER(DATE_STRING);
IF INDEX(DUMMY,'TODAY')>0 THEN DUMMY=DATE();

IF LENGTH(DUMMY)=6 & VERIFY(DUMMY,' 0123456789')=0 THEN DO; 
  YEAR=SUBSTR(DUMMY,1,2);
  MONTH=SUBSTR(DUMMY,3,2);
  DAY=SUBSTR(DUMMY,5,2);
END;
ELSE IF LENGTH(DUMMY)=4 & VERIFY(DUMMY,' 0123456789')=0 THEN DO;
  YEAR=SUBSTR(DUMMY,1,2);
  MONTH=SUBSTR(DUMMY,3,2);
END;
ELSE IF LENGTH(DUMMY)=2 & VERIFY(DUMMY,'0123456789')=0 THEN DO;
  YEAR=SUBSTR(DUMMY,1,2);
END;
ELSE IF VERIFY(DUMMY,' 0123456789ABCDEFGJLMNOPRSTUVY')=0 THEN DO;
  YEAR=SCAN(DUMMY,1,'ABCDEFGJKLMNOPRSTUVY');
  IF INDEX(DUMMY,'JAN')>0 THEN MONTH='1';
  ELSE IF INDEX(DUMMY,'FEB')>0 THEN MONTH='2';
  ELSE IF INDEX(DUMMY,'MAR')>0 THEN MONTH='3';
  ELSE IF INDEX(DUMMY,'APR')>0 THEN MONTH='4';
  ELSE IF INDEX(DUMMY,'MAY')>0 THEN MONTH='5';
  ELSE IF INDEX(DUMMY,'JUN')>0 THEN MONTH='6';
  ELSE IF INDEX(DUMMY,'JUL')>0 THEN MONTH='7';
  ELSE IF INDEX(DUMMY,'AUG')>0 THEN MONTH='8';
  ELSE IF INDEX(DUMMY,'SEP')>0 THEN MONTH='9';
  ELSE IF INDEX(DUMMY,'OCT')>0 THEN MONTH='10';
  ELSE IF INDEX(DUMMY,'NOV')>0 THEN MONTH='11';
  ELSE IF INDEX(DUMMY,'DEC')>0 THEN MONTH='12';
  ELSE RETURN(-1);
  DAY=REVERSE(SCAN(REVERSE(DUMMY),1,' ABCDEFGJKLMNOPRSTUVY'));
END;
ELSE IF VERIFY(DUMMY,' 0123456789/-')=0 THEN DO;
  J=VERIFY(DUMMY,' 0123456789');
  IF J>0 THEN DO;
    BREAK_CHAR=SUBSTR(DUMMY,J,1);
    YEAR=SCAN(DUMMY,1,BREAK_CHAR||' ');
    MONTH=SCAN(DUMMY,2,BREAK_CHAR||' ');
    DAY=SCAN(DUMMY,3,BREAK_CHAR||' ');
  END;
  ELSE RETURN(-1);
END;
ELSE RETURN(-1);

IF YEAR='' THEN RETURN(-1);
IF (MONTH='99' | MONTH='') THEN MONTH='6';
IF (DAY='99' | DAY='') THEN DAY='15';

YY=BINARY(YEAR);
MM=BINARY(MONTH);
DD=BINARY(DAY);

IF YY<0 | YY>99 | MM<1 | MM>12 | DD<1 |
   ((MM^=2) & (DD>DPM(MM))) THEN RETURN(-1);
 
IF MOD(YY,4)^=0 | YY=0 THEN LEAPYEAR='0'B;
ELSE LEAPYEAR='1'B;

IF MM=2 & 
  ((LEAPYEAR & (DD>29))|(^LEAPYEAR & (DD>28))) THEN RETURN(-1);

DAYS=0;

DO I=1 TO MM-1;
   DAYS=DAYS+DPM(I);
   IF LEAPYEAR & (I=2) THEN DAYS=DAYS+1;
END;

LEAPCOUNT=DIVIDE((YY-1),4,31);

IF YY<1 THEN ANSWER=(DAYS+DD);
ELSE ANSWER=((YY * 365)+LEAPCOUNT+DAYS+DD);

IF ^ERROR_FLAG THEN RETURN (ANSWER);
ELSE RETURN(-1);

END JULDATE;