10 ! ----- ADD_DATES.FUN ----- ! ! ----- DATE/OFFSET ADDITION FUNCTION ----- ! ! ---------- Passed: ---------- ! ! ----- MMDDYY (6-DIGIT STRING) Contains Date (as MMDDYY) to ! ----- be added to (or 000000 to use the current ! ----- date). (Note: Dates with years from 00-49 ! ----- will be treated as from 2000-2049; Dates with ! ----- years from 50-99 will be treated as from ! ----- 1950-1999) ! ! ----- OFFSET (LONGWORD) Contains the number of days to be ! ----- added (subtracted if negative) to the passed ! ----- date (MMDDYY) ! ! ---------- Returned: ---------- ! ! ----- ADD_DATES (LONGWORD) Function returns exit status from ! ----- VMS system services (SS$_NORMAL if successful) ! ----- (or SS$_ABORT if range error in passed data) ! ! ----- MMDDYY (6-DIGIT STRING) Contains calculated Date (as ! ----- MMDDYY) after the addition has been performed ! ----- (Note: The two-digit century (19 or 20) is ! ----- not returned). ! ! ----- Last Change 05/01/89 by Brian Lomasky ----- ! ! ----- Teradyne, Inc., 179 Lincoln Street, Boston, MA 02111 ----- ! ----- (617) 482-2706, x3259 ----- ! ! ----- Neither Brian Lomasky nor Teradyne, Inc. implicitly or ----- ! ----- explicitly implies this program is usable in any way. ----- ! ----- This program is released to the public domain in an ----- ! ----- "AS-IS" condition. ----- ! ! ----- Restrictions: ----- ! ----- 1) Requires VAX BASIC V2.4 or later. ----- ! FUNCTION LONG ADD_DATES(STRING MMDDYY, LONG OFFSET) OPTION TYPE = EXPLICIT ! ----- VMS SYSTEM SERVICE ERROR STATUS VALUES ----- EXTERNAL LONG CONSTANT SS$_ABORT ! ABORT EXIT STATUS EXTERNAL LONG CONSTANT SS$_NORMAL ! NORMAL EXIT STATUS ! ----- VARIABLE DECLARATIONS ----- DECLARE LONG CURRENT_OFFSET ! CURRENT OFFSET TO APPLY DECLARE LONG SYS_STATUS ! SYSTEM SERVICE EXIT STATUS DECLARE STRING TEMP_STRING ! TEMPORARY STRING DECLARE LONG THE_OFFSET ! POSITIVE OFFSET VALUE MAP (ADATES) & LONG CLUNK_DATE(1%), ! INTERNAL CLUNKS DATE & LONG OFFSET_DAYS(1%), ! OFFSET NUMBER OF DAYS & STRING DAYS_IN_MONTH = 2%, ! MAX DAYS IN MONTH & STRING TIME_STRING = 23% ! TIME TO/FROM $ASCTIM/$BINTIM ! ----- EXTERNAL FUNCTION DECLARATIONS ----- EXTERNAL LONG FUNCTION LIB$ADDX ! MULTIPLE-PRECISION ADDITION EXTERNAL LONG FUNCTION SYS$ASCTIM ! CONVERT QUAD-WORD TO ASCII EXTERNAL LONG FUNCTION SYS$BINTIM ! CONVERT ASCII TO QUAD-WORD EXTERNAL LONG FUNCTION LIB$SUBX ! MULTIPLE-PRECISION SUBTRACTION ! ----- VERIFY PASSED DATE ----- IF LEN(MMDDYY) <> 6% THEN ! BETTER BE 6 CHARS ADD_DATES = SS$_ABORT ! STORE ABORT STATUS TO RETURN EXIT FUNCTION ! EXIT WITH ERROR STATUS ELSE TEMP_STRING = EDIT$(MMDDYY, 6%) ! DISCARD SPACE, TABS, CTRL CHAR IF MMDDYY <> TEMP_STRING THEN ! BETTER MATCH PASSED DATA ADD_DATES = SS$_ABORT ! STORE ABORT STATUS TO RETURN EXIT FUNCTION ! EXIT WITH ERROR STATUS END IF END IF IF MMDDYY = "000000" THEN ! SEE IF CURRENT DATE TO USE ! ----- CONVERT CURRENT DATE TO ASCII STRING ----- TEMP_STRING = EDIT$(DATE$(0%), 32%) ! GET CURRENT UPPERCASE DATE IF RIGHT(TEMP_STRING, 8%) >= "50" THEN TIME_STRING = LEFT(TEMP_STRING, 7%) + & "19" + RIGHT(TEMP_STRING, 8%) + " 00:00:00.00" ELSE TIME_STRING = LEFT(TEMP_STRING, 7%) + & "20" + RIGHT(TEMP_STRING, 8%) + " 00:00:00.00" END IF ELSE ! ----- CONVERT PASSED DATE TO ASCII STRING ----- SELECT LEFT(MMDDYY, 2%) CASE "01" TEMP_STRING = "JAN" DAYS_IN_MONTH = "31" CASE "02" TEMP_STRING = "FEB" DAYS_IN_MONTH = "29" CASE "03" TEMP_STRING = "MAR" DAYS_IN_MONTH = "31" CASE "04" TEMP_STRING = "APR" DAYS_IN_MONTH = "30" CASE "05" TEMP_STRING = "MAY" DAYS_IN_MONTH = "31" CASE "06" TEMP_STRING = "JUN" DAYS_IN_MONTH = "30" CASE "07" TEMP_STRING = "JUL" DAYS_IN_MONTH = "31" CASE "08" TEMP_STRING = "AUG" DAYS_IN_MONTH = "31" CASE "09" TEMP_STRING = "SEP" DAYS_IN_MONTH = "30" CASE "10" TEMP_STRING = "OCT" DAYS_IN_MONTH = "31" CASE "11" TEMP_STRING = "NOV" DAYS_IN_MONTH = "30" CASE "12" TEMP_STRING = "DEC" DAYS_IN_MONTH = "31" CASE ELSE ! INVALID MONTH PASSED ADD_DATES = SS$_ABORT ! STORE ABORT STATUS TO RETURN EXIT FUNCTION ! EXIT WITH ERROR STATUS END SELECT ! ----- VERIFY DAY NUMBER ----- IF MID(MMDDYY, 3%, 2%) < "01" OR MID(MMDDYY, 3%, 2%) > & DAYS_IN_MONTH THEN ADD_DATES = SS$_ABORT ! STORE ABORT STATUS TO RETURN EXIT FUNCTION ! EXIT WITH ERROR STATUS END IF IF RIGHT(MMDDYY, 5%) >= "50" THEN TIME_STRING = MID(MMDDYY, 3%, 2%) + "-" + & TEMP_STRING + "-19" + RIGHT(MMDDYY, 5%) & + " 00:00:00.00" ELSE TIME_STRING = MID(MMDDYY, 3%, 2%) + "-" + & TEMP_STRING + "-20" + RIGHT(MMDDYY, 5%) & + " 00:00:00.00" END IF END IF ! ----- CONVERT ASCII STRING (dd-mmm-yyyy hh:mm:ss.cc) TO CLUNKS ----- SYS_STATUS = SYS$BINTIM(TIME_STRING, CLUNK_DATE() BY REF) IF (SYS_STATUS AND 1%) <> SS$_NORMAL THEN ADD_DATES = SYS_STATUS ! STORE ERROR STATUS TO RETURN EXIT FUNCTION ! EXIT WITH ERROR STATUS END IF IF OFFSET < 0% THEN ! SEE IF NEGATIVE OFFSET VALUE THE_OFFSET = -OFFSET ! MAKE OFFSET POSITIVE ELSE ! OFFSET IS POSITIVE THE_OFFSET = OFFSET ! MAKE OFFSET POSITIVE END IF WHILE THE_OFFSET <> 0% ! UNTIL NO MORE OFFSET: ! ----- CALC OFFSET TO USE WITHIN VALID DELTA DATE RANGE ----- IF THE_OFFSET > 9999% THEN CURRENT_OFFSET = 9999% ELSE CURRENT_OFFSET = THE_OFFSET END IF ! ----- CALC REMAINING OFFSET TO BE APPLIED ----- THE_OFFSET = THE_OFFSET - CURRENT_OFFSET ! ----- CONVERT OFFSET NUMBER OF DAYS TO CLUNKS ----- TIME_STRING = NUM1$(CURRENT_OFFSET) + " 00:00:00.00" SYS_STATUS = SYS$BINTIM(TIME_STRING, OFFSET_DAYS() BY REF) IF (SYS_STATUS AND 1%) <> SS$_NORMAL THEN ADD_DATES = SYS_STATUS ! STORE ERROR STATUS TO RETURN EXIT FUNCTION ! EXIT WITH ERROR STATUS END IF IF OFFSET < 0% THEN ! IF NEGATIVE OFFSET: ! ----- SUBTRACT OFFSET NUMBER OF DAYS FROM CLUNK ----- ! ----- DATE (THIS IS DONE BY ADDING THE NEGATIVE ----- ! ----- DELTA DATE TO THE INTERNAL DATE) ----- SYS_STATUS = LIB$ADDX(CLUNK_DATE() BY REF, & OFFSET_DAYS() BY REF, CLUNK_DATE() BY REF) ELSE ! IF POSITIVE OFFSET: ! ----- ADD OFFSET NUMBER OF DAYS TO CLUNK DATE ----- ! ----- (THIS IS DONE BY SUBTRACTING THE NEGATIVE ----- ! ----- DELTA DATE FROM THE INTERNAL DATE) ----- SYS_STATUS = LIB$SUBX(CLUNK_DATE() BY REF, & OFFSET_DAYS() BY REF, CLUNK_DATE() BY REF) END IF IF (SYS_STATUS AND 1%) <> SS$_NORMAL THEN ADD_DATES = SYS_STATUS ! STORE ERROR STATUS TO RETURN EXIT FUNCTION ! EXIT WITH ERROR STATUS END IF NEXT ! ----- CONVERT CLUNKS BACK TO ASCII STRING ----- ! ----- (dd-mmm-yyyy hh:mm:ss.cc) (RJLB) ----- SYS_STATUS = SYS$ASCTIM(, TIME_STRING, CLUNK_DATE() BY REF, ) IF (SYS_STATUS AND 1%) <> SS$_NORMAL THEN ADD_DATES = SYS_STATUS ! STORE ERROR STATUS TO RETURN EXIT FUNCTION ! EXIT WITH ERROR STATUS END IF ! ----- CONVERT ASCII STRING BACK TO RETURNED DATE (MMDDYY) ----- SELECT MID(TIME_STRING, 4%, 3%) CASE "JAN" TEMP_STRING = "01" CASE "FEB" TEMP_STRING = "02" CASE "MAR" TEMP_STRING = "03" CASE "APR" TEMP_STRING = "04" CASE "MAY" TEMP_STRING = "05" CASE "JUN" TEMP_STRING = "06" CASE "JUL" TEMP_STRING = "07" CASE "AUG" TEMP_STRING = "08" CASE "SEP" TEMP_STRING = "09" CASE "OCT" TEMP_STRING = "10" CASE "NOV" TEMP_STRING = "11" CASE "DEC" TEMP_STRING = "12" CASE ELSE ADD_DATES = SS$_ABORT ! STORE ABORT STATUS TO RETURN EXIT FUNCTION ! EXIT WITH ERROR STATUS END SELECT IF LEFT(TIME_STRING, 1%) = " " THEN MMDDYY = TEMP_STRING + "0" + MID(TIME_STRING, 2%, 1%) + & MID(TIME_STRING, 10%, 2%) ELSE MMDDYY = TEMP_STRING + LEFT(TIME_STRING, 2%) + & MID(TIME_STRING, 10%, 2%) END IF ADD_DATES = SS$_NORMAL ! STORE SUCCESS STATUS TO RETURN END FUNCTION