1000 SUB DATECV (INTYPE%, OUTTYPE%, CVTPARAM$) & 1010 !NAME: DATE CONVERSION ROUTINE & !PROGRAMMER: C. A. WILKINSON & !DATE: JAN. 1979 & ! MODIFICATION: INSERT LINE # 15010 & 15020 BY JYK ON 1-15-80 & ! MODIFICATION: OPTIMISED CODE AND REMOVED UN-NEEDED LINE NUMBERS & ! RESTRUCTURED FOR EASIER READING JMH 1-5-81 & !FUNCTION: THIS IS A SUB PROGRAM WHICH WILL CONVERT DATES & ! TO USE PUT THE FOLLOWING LOGIC IN YOUR PROGRAM & ! COMMON (DATPRM) DATE.1900%, DATE.STRING$ = 18%, DATE.JUL, ERRFLAG% & ! SET THE FOLLOWING THREE FIELDS: INTYPE%, OUTTYPE%, CVTPARAM$ & ! INTYPE% INDICATES INPUT FORMAT IN CVTPARAM$ & ! & ! VALID INTYPE% AND CORRESPONDING CVTPARAM$ ARE AS FOLLOWS & ! 1% = JULIAN DATE YYDDD, 78029 & ! 2% = MM/DD/YY, 01/29/78 & ! 3% = MMDDYY, 012978 & ! 4% = DAYS FROM JAN. 1, 1901, DDDDD, 28253 & ! 5% = STANDARD SYSTEM DATE DD-Mmm-YY, 28-Jan-78 & ! NOTE THAT THE LAST TWO LETTERS OF MONTH ARE LOWER CASE & ! 6% = YYMMDD & ! & ! VALID OUTTYPE%, RETURNED FORMAT AND FIELD ARE AS FOLLOWS & ! 1%, JULIAN DATE, YYDDD, 78027, DATE.JUL & ! 2%, MM/DD/YY, 01/27/78 & ! 3%, MMDDYY, 012778, DATE.STRING$ & ! 4%, DAYS SINCE JAN. 1, 1901, DDDDD, 28253, DATE.1900% & ! 5%, CALANDER DATE JANUARY 27, 1978, DATE.STRING$ & ! 6%, DAY OF WEEK, FRIDAY & ! 7%, YYMMDD & ! & ! CALL DATECV WITH THESE PARAMETERS & ! IF INVALID INTYPE%, OUTYPE%, OR INVALID INPUT DATE THEN ERRFLAG IS & ! SET TO 1% & ! 1020 ON ERROR GOTO 32000% & \ COMMON (DATPRM) DATE.1900%, DATE.STRING$ = 18%, DATE.JUL, ERRFLAG% & \ ERRFLAG% = 0% & \ GOTO 32000% IF INTYPE% < 1% OR INTYPE% > 6% & OR OUTTYPE% < 1% OR OUTTYPE% > 7% & \ DIM MTH.NAME$(12%), DAYS.IN.MTH%(12%), MTH.ABRV$(12%), & MTH.NUM%(12%), DAY.NAME$(7%) & \ RESTORE & \ READ MTH.NAME$(I%) FOR I% = 1% TO 12% & \ READ DAYS.IN.MTH%(I%) FOR I% = 1% TO 12% & \ READ MTH.ABRV$(I%) FOR I% = 1% TO 12% & \ READ MTH.NUM%(I%) FOR I% = 1% TO 12% & \ READ DAY.NAME$(I%) FOR I% = 0% TO 6% & ! & \ GOSUB 5000% IF INTYPE% = 1% & \ GOSUB 6000% IF INTYPE% = 2% & \ GOSUB 7000% IF INTYPE% = 3% & \ GOSUB 8000% IF INTYPE% = 4% & \ GOSUB 9000% IF INTYPE% = 5% & \ GOSUB 15000% IF INTYPE% = 6% & ! & \ GOSUB 10000% IF OUTTYPE% = 1% & \ GOSUB 11000% IF OUTTYPE% = 2% OR & OUTTYPE% = 3% OR & OUTTYPE% = 7% & \ GOSUB 12000% IF OUTTYPE% = 4% & \ GOSUB 13000% IF OUTTYPE% = 5% & \ GOSUB 14000% IF OUTTYPE% = 6% & ! & \ GOTO 32767% & ! 5000 JYR% = VAL(MID(CVTPARAM$,1%,2%)) & \ JDAY% = VAL(MID(CVTPARAM$,3%,3%)) ! INPUT JULIAN DATE & \ GOTO 32000% IF JYR% < 70% OR JYR% > 90% OR JDAY% < 1% OR JDAY% > 366% & \ RETURN & ! 6000 JYR% = VAL(MID(CVTPARAM$,7%,2%)) ! INPUT MM/DD/YY & \ GOSUB 20000% & \ MTH% = VAL(MID(CVTPARAM$,1%,2%)) & \ DAYS% = VAL(MID(CVTPARAM$,4%,2%)) & \ GOSUB 22000% & \ RETURN & ! 7000 JYR% = VAL(MID(CVTPARAM$,5%,2%)) ! INPUT MMDDYY & \ GOSUB 20000% & \ MTH% = VAL(MID(CVTPARAM$,1%,2%)) & \ DAYS% = VAL(MID(CVTPARAM$,3%,2%)) & \ GOSUB 22000% & \ RETURN & ! 8000 CENT.DAYS = VAL(MID(CVTPARAM$,1%,5%)) !INPUT TOTAL DAYS IN CENTURY & \ CALC1% = (CENT.DAYS - 1.0) / 1461.0 & \ JYR% = CALC1% * 4% & \ CALC2 = CENT.DAYS - (CALC1% * 1461.0) & \ CALC3 = CALC2 & \ FOR I% = 1% TO 4% & \ CALC3 = CALC3 - 365.0 & \ GOTO 8010% IF CALC3 <= 0.0 & \ NEXT I% & 8010 J% = I% - 1% & \ JYR% = JYR% + I% & \ CALC4 = J% * 365.0 & \ CALC3 = CALC2 - CALC4 & \ JDAY% = CALC3 & \ GOTO 32000% IF CENT.DAYS < 25203.0 OR CENT.DAYS > 32767.0 & \ RETURN & ! 9000 JYR% = VAL(MID(CVTPARAM$,8%,2%)) !INPUT DATE DD-MMM-YY & \ GOSUB 20000% & \ GOTO 9010% IF MTH.ABRV$(I%) = MID(CVTPARAM$,4%,3%) FOR I% = 1% TO 12% & \ GOTO 32000% & 9010 JDAY% = VAL(MID(CVTPARAM$,1%,2%)) & \ GOTO 32000% IF JYR% < 70% OR JYR% > 89% OR JDAY% < 1% OR JDAY% > 31% & \ I% = I% - 1% & \ JDAY% = JDAY% + DAYS.IN.MTH%(J%) FOR J% = 1% TO I% & \ RETURN & ! 10000 JYR = JYR% * 1000.0 ! OUTPUT JULIAN DATE & \ DATE.JUL = JYR + JDAY% & \ RETURN & ! 11000 JYR$ = NUM1$(JYR%) ! OUTPUT MM/DD/YY & \ GOSUB 20000% & \ GOSUB 21000% & \ IF I% < 10% & THEN MONTH.OUT$ = '0' + NUM1$(I%) & ELSE MONTH.OUT$ = NUM1$(I%) & 11010 IF CALC1% < 10% & THEN DAY.OUT$ = '0' + NUM1$(CALC1%) & ELSE DAY.OUT$ = NUM1$(CALC1%) & 11020 DATE.STRING$ = MONTH.OUT$ + '/' + DAY.OUT$ + "/" + JYR$ & IF OUTTYPE% = 2% & \ DATE.STRING$ = MONTH.OUT$ + DAY.OUT$ + JYR$ & IF OUTTYPE% = 3% & \ DATE.STRING$ = JYR$ + MONTH.OUT$ + DAY.OUT$ & IF OUTTYPE% = 7% & ! & ! 2% = MM/DD/YY & ! 3% = MMDDYY & ! 7% = YYMMDD & ! & 11030 RETURN & ! 12000 JYR% = JYR% - 1% & \ CALC1% = JYR% / 4% ! OUTPUT DAYS IN CENTURY & \ CALC2 = JDAY% + (365% * JYR%) + CALC1% & \ DATE.1900% = CALC2 & \ RETURN & ! 13000 OUTYEAR$ = '19' + NUM1$(JYR%) ! OUTPUT CALENDAR DATE & \ GOSUB 20000% & \ GOSUB 21000% & \ DAY.OUT$ = NUM1$(CALC1%) & \ DATE.STRING$ = MTH.NAME$(I%) + ' ' + DAY.OUT$ + ', ' + OUTYEAR$ & \ RETURN & ! 14000 OUTTYPE% = 3% ! OUTPUT DAY OF WEEK & \ GOSUB 11000% ! CONVERTS BACK TO MMDDYY & \ YR% = VAL(MID(DATE.STRING$,5%,2%)) & \ GOSUB 20000% ! CHECK FOR LEAP YEAR & \ MTH% = VAL(MID(DATE.STRING$,1%,2%)) & \ DAY% = VAL(MID(DATE.STRING$,3%,2%)) & \ CALC1% = YR%/4% + YR% + DAY% + MTH.NUM%(MTH%) & \ CALC2% = CALC1% / 7% & \ CALC1% = CALC1% - 7% * CALC2% & \ DATE.STRING$ = DAY.NAME$(CALC1%) & 14010 IF CALC1% < 2% THEN CALC1% = CALC1% + 5% & ELSE CALC1% = CALC1% - 2% & 14020 DATE.1900% = CALC1% & \ RETURN & ! 15000 JYR% = VAL(MID(CVTPARAM$,1%,2%)) ! INPUT YYMMDD & \ GOSUB 20000% & \ MTH% = VAL(MID(CVTPARAM$,3%,2%)) & \ DAYS% = VAL(MID(CVTPARAM$,5%,2%)) & \ GOSUB 22000% & \ RETURN & ! 20000 LEAP1% = JYR% - 1% & \ LEAP2% = LEAP1% / 4% ! CHECK FOR LEAP YEAR & \ LEAP1% = LEAP1% - (LEAP2% * 4.0) & 20010 IF LEAP1% = 3% & THEN DAYS.IN.MTH%(2%) = 29% & \ MTH.NUM%(1%) = 0% & \ MTH.NUM%(2%) = 3% & 20020 RETURN & ! 21000 CALC1% = JDAY% & \ FOR I% = 1% TO 12% & \ RETURN IF CALC1% <= DAYS.IN.MTH%(I%) & \ CALC1% = CALC1% - DAYS.IN.MTH%(I%) & \ NEXT I% & \ RETURN & ! 22000 GOTO 22010% IF MTH% = 1% & \ J% = MTH% - 1% & \ JDAY% = JDAY% + DAYS.IN.MTH%(I%) FOR I% = 1% TO J% & 22010 JDAY% = JDAY% + DAYS% & \ GOTO 32000 IF JYR% < 70% OR JYR% > 89% & \ GOTO 32000 IF MTH% < 1% OR MTH% > 12% & \ GOTO 32000 IF DAYS% < 1% OR DAYS% > DAYS.IN.MTH%(MTH%) & 22020 RETURN & ! 31000 DATA JANUARY,FEBRUARY,MARCH,APRIL,MAY,JUNE,JULY, & AUGUST,SEPTEMBER,OCTOBER,NOVEMBER,DECEMBER, & 31,28,31,30,31,30,31,31,30,31,30,31, & Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec, & 1,4,4,0,2,5,0,3,6,1,4,6,SATURDAY,SUNDAY,MONDAY,TUESDAY, & WEDNESDAY,THURSDAY,FRIDAY & ! 32000 ERRFLAG% = 1% & \ RESUME 32767% & 32767 SUBEND