10 ! ----- DAYS_DIFF.FUN ----- ! ! ----- Function to return the Number of Days Different between ----- ! ----- the 2 Passed Dates (Subtracting Second Date from the First ----- ! ----- Date) (or a Passed Date and the Current Date, if no ----- ! ----- Second Date is specified) ----- ! ! ---------- Passed: ---------- ! ! ----- THE_MONTH (LONG) MONTH NUMBER (1 THRU 12) OF THE 1ST ----- ! ----- DATE TO BE SUBTRACTED FROM (OR 0 TO USE ----- ! ----- THE CURRENT SYSTEM DATE) ----- ! ! ----- THE_DAY (LONG) DAY NUMBER (1 THRU 31) OF THE 1ST ----- ! ----- DATE TO BE SUBTRACTED FROM (OR 0 TO USE ----- ! ----- THE CURRENT SYSTEM DATE) ----- ! ! ----- THE_YEAR (LONG) YEAR NUMBER (00 THRU 99) OF THE 1ST ----- ! ----- DATE TO BE SUBTRACTED FROM (ASSUMES ----- ! ----- YEARS LESS THAN 50 ARE IN THE 21ST ----- ! ----- CENTURY) (OR 0 TO USE THE CURRENT SYSTEM ----- ! ----- DATE) ----- ! ! ----- THE_MONTH2 (LONG) MONTH NUMBER (1 THRU 12) OF THE 2ND ----- ! ----- DATE TO SUBTRACT FROM THE 1ST DATE (OR 0 ----- ! ----- TO USE THE CURRENT SYSTEM DATE) ----- ! ! ----- THE_DAY2 (LONG) DAY NUMBER (1 THRU 31) OF THE 2ND ----- ! ----- DATE TO SUBTRACT FROM THE 1ST DATE (OR 0 ----- ! ----- TO USE THE CURRENT SYSTEM DATE) ----- ! ! ----- THE_YEAR2 (LONG) YEAR NUMBER (00 THRU 99) OF THE 2ND ----- ! ----- DATE TO SUBTRACT FROM THE 1ST DATE ----- ! ----- (ASSUMES YEARS LESS THAN 50 ARE IN THE ----- ! ----- 21ST CENTURY) (OR 0 TO USE THE CURRENT ----- ! ----- SYSTEM DATE) ----- ! ! ---------- Returned: ---------- ! ! ----- DAYS_DIFF (LONG) DIFFERENCE, IN DAYS, BETWEEN THE 2 ----- ! ----- PASSED DATES (RETURNS NEGATIVE VALUE IF ----- ! ----- SECOND (CURRENT) DATE IS AFTER THE FIRST ----- ! ----- DATE) (RETURNS -32767 IF INVALID MONTHS, ----- ! ----- DAYS, OR YEARS ARE PASSED) ----- ! ! ----- 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 DAYS_DIFF(LONG THE_MONTH, LONG THE_DAY, & LONG THE_YEAR, LONG THE_MONTH2, LONG THE_DAY2, LONG THE_YEAR2) OPTION TYPE = EXPLICIT %LET %DEBUG = 0% ! 1 IF DEBUG MODE ON, 0 IF NOT ! ----- EXTERNAL CONSTANTS ----- EXTERNAL LONG CONSTANT SS$_NORMAL ! NORMAL EXIT STATUS ! ----- VARIABLE DECLARATIONS ----- DECLARE STRING YEAR_PREFIX ! CENTURY PREFIX MAP (DDIFF) LONG BIN_TIME(1%), ! BINARY PASSED DATE & LONG FIRST_DATE, ! FIRST JULIAN DATE & LONG SYS_STATUS, ! SYSTEM SERVICE STATUS & LONG SECOND_DATE, ! SECOND JULIAN DATE & STRING ASCII_TIME = 23%,! ASCII TIME FOR $BINTIM& STRING MONTHS(12%) = 3% ! MONTHS OF THE YEAR EXTERNAL LONG FUNCTION LIB$DAY ! RETURN JULIAN DATE EXTERNAL LONG FUNCTION SYS$BINTIM ! CONVERT ASCII TO BINARY MONTHS(1%) = "JAN" MONTHS(2%) = "FEB" MONTHS(3%) = "MAR" MONTHS(4%) = "APR" MONTHS(5%) = "MAY" MONTHS(6%) = "JUN" MONTHS(7%) = "JUL" MONTHS(8%) = "AUG" MONTHS(9%) = "SEP" MONTHS(10%) = "OCT" MONTHS(11%) = "NOV" MONTHS(12%) = "DEC" ! ----- SEE IF CURRENT SYSTEM DATE TO BE COMPARED AGAINST ----- IF THE_MONTH = 0% AND THE_DAY = 0% AND THE_YEAR = 0% THEN ! ----- GET TODAY'S JULIAN DATE ----- SYS_STATUS = LIB$DAY(FIRST_DATE, , ) ELSE ! ----- VERIFY RANGE OF THE_YEAR ----- IF THE_YEAR < 0% OR THE_YEAR > 99% THEN %IF %DEBUG = 1% %THEN PRINT "INVALID YEAR" %END %IF ! ----- RETURN ERROR CODE IF INVALID YEAR ----- ! ----- PASSED ----- DAYS_DIFF = -32767% EXIT FUNCTION END IF ! ----- VERIFY RANGE OF THE_MONTH ----- IF THE_MONTH < 1% OR THE_MONTH > 12% THEN %IF %DEBUG = 1% %THEN PRINT "INVALID MONTH" %END %IF ! ----- RETURN ERROR CODE IF INVALID MONTH ----- ! ----- PASSED ----- DAYS_DIFF = -32767% EXIT FUNCTION END IF ! ----- VERIFY RANGE OF THE_DAY ----- IF THE_DAY < 1% OR THE_DAY > 31% THEN %IF %DEBUG = 1% %THEN PRINT "INVALID DAY" %END %IF ! ----- RETURN ERROR CODE IF INVALID DAY ----- ! ----- PASSED ----- DAYS_DIFF = -32767% EXIT FUNCTION END IF ! ----- CALCULATE APPROPRIATE CENTURY FOR THE YEAR ----- SELECT THE_YEAR CASE < 10% YEAR_PREFIX = "200" CASE < 50% YEAR_PREFIX = "20" CASE ELSE YEAR_PREFIX = "19" END SELECT ! ----- STORE FIRST PASSED DATE AS ----- ! ----- DD-MMM-YYYY HH:MM:SS.C STRING ----- ASCII_TIME = NUM1$(THE_DAY) + "-" + & MONTHS(THE_MONTH) + "-" + YEAR_PREFIX + & NUM1$(THE_YEAR) + " 0:0:0.0" %IF %DEBUG = 1% %THEN PRINT "ASCII_TIME=" + ASCII_TIME %END %IF ! ----- CONVERT THE FIRST ASCII TIME TO BINARY ----- ! ----- QUADWORD ----- SYS_STATUS = SYS$BINTIM(ASCII_TIME, BIN_TIME() BY REF) IF (SYS_STATUS AND 1%) <> SS$_NORMAL THEN %IF %DEBUG = 1% %THEN PRINT "$BINTIM ERROR: "; SYS_STATUS %END %IF ! ----- RETURN ERROR CODE IF INVALID DATE ----- ! ----- PASSED ----- DAYS_DIFF = -32767% EXIT FUNCTION END IF ! ----- GET JULIAN DATE OF FIRST PASSED DATE ----- SYS_STATUS = LIB$DAY(FIRST_DATE, BIN_TIME() BY REF, ) END IF IF (SYS_STATUS AND 1%) <> SS$_NORMAL THEN %IF %DEBUG = 1% %THEN PRINT "LIB$DAY ERROR: "; SYS_STATUS %END %IF ! ----- RETURN ERROR CODE IF INVALID DATE PASSED ----- DAYS_DIFF = -32767% EXIT FUNCTION END IF %IF %DEBUG = 1% %THEN PRINT "DEBUG>FIRST_DATE=" + NUM1$(FIRST_DATE) %END %IF ! ----- SEE IF CURRENT SYSTEM DATE TO BE COMPARED AGAINST ----- IF THE_MONTH2 = 0% AND THE_DAY2 = 0% AND THE_YEAR2 = 0% THEN ! ----- GET TODAY'S JULIAN DATE ----- SYS_STATUS = LIB$DAY(SECOND_DATE, , ) ELSE ! ----- VERIFY RANGE OF THE_YEAR2 ----- IF THE_YEAR2 < 0% OR THE_YEAR2 > 99% THEN %IF %DEBUG = 1% %THEN PRINT "INVALID YEAR2" %END %IF ! ----- RETURN ERROR CODE IF INVALID YEAR ----- ! ----- PASSED ----- DAYS_DIFF = -32767% EXIT FUNCTION END IF ! ----- VERIFY RANGE OF THE_MONTH2 ----- IF THE_MONTH2 < 1% OR THE_MONTH2 > 12% THEN %IF %DEBUG = 1% %THEN PRINT "INVALID MONTH2" %END %IF ! ----- RETURN ERROR CODE IF INVALID MONTH ----- ! ----- PASSED ----- DAYS_DIFF = -32767% EXIT FUNCTION END IF ! ----- VERIFY RANGE OF THE_DAY2 ----- IF THE_DAY2 < 1% OR THE_DAY2 > 31% THEN %IF %DEBUG = 1% %THEN PRINT "INVALID DAY2" %END %IF ! ----- RETURN ERROR CODE IF INVALID DAY ----- ! ----- PASSED ----- DAYS_DIFF = -32767% EXIT FUNCTION END IF ! ----- CALCULATE APPROPRIATE CENTURY FOR THE YEAR ----- SELECT THE_YEAR2 CASE < 10% YEAR_PREFIX = "200" CASE < 50% YEAR_PREFIX = "20" CASE ELSE YEAR_PREFIX = "19" END SELECT ! ----- STORE SECOND PASSED DATE AS ----- ! ----- DD-MMM-YYYY HH:MM:SS.C STRING ----- ASCII_TIME = NUM1$(THE_DAY2) + "-" + & MONTHS(THE_MONTH2) + "-" + YEAR_PREFIX & + NUM1$(THE_YEAR2) + " 0:0:0.0" %IF %DEBUG = 1% %THEN PRINT "ASCII_TIME(2)=" + ASCII_TIME %END %IF ! ----- CONVERT THE FIRST ASCII TIME TO BINARY ----- ! ----- QUADWORD ----- SYS_STATUS = SYS$BINTIM(ASCII_TIME, BIN_TIME() BY REF) IF (SYS_STATUS AND 1%) <> SS$_NORMAL THEN %IF %DEBUG = 1% %THEN PRINT "$BINTIM(2) ERROR: "; SYS_STATUS %END %IF ! ----- RETURN ERROR CODE IF INVALID DATE ----- ! ----- PASSED ----- DAYS_DIFF = -32767% EXIT FUNCTION END IF ! ----- GET JULIAN DATE OF SECOND PASSED DATE ----- SYS_STATUS = LIB$DAY(SECOND_DATE, BIN_TIME() BY REF, ) END IF IF (SYS_STATUS AND 1%) <> SS$_NORMAL THEN %IF %DEBUG = 1% %THEN PRINT "LIB$DAY(2) ERROR: "; SYS_STATUS %END %IF ! ----- RETURN ERROR CODE IF INVALID DATE PASSED ----- DAYS_DIFF = -32767% EXIT FUNCTION END IF %IF %DEBUG = 1% %THEN PRINT "DEBUG>SECOND_DATE=" + NUM1$(SECOND_DATE) %END %IF ! ----- RETURN NUMBER OF DAYS DIFFERENT (NEGATIVE IF ----- ! ----- SECOND (CURRENT) DATE IS AFTER THE FIRST DATE) ----- DAYS_DIFF = FIRST_DATE - SECOND_DATE END FUNCTION