00800000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00800100 %% ALGOL DATE MODULE (ALGORITHM 199) %%00800200 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00800300 %% %%00800302 %% Copyright (C) 2002: %%00800304 %% Paradigm Corporation %%00800306 %% 9625 Black Mountain Road, Suite 218 %%00800308 %% San Diego, California 92126-4598 USA %%00800310 %% voice +1-858-536-5533; fax 858-536-5545 %%00800312 %% http://www.digm.com %%00800314 %% %%00800316 %% This material may be copied and used for any purpose %%00800318 %% providing this copyright notice is preserved and that %%00800320 %% appropriate credit is given. %%00800322 %% %%00800324 %% This material is offered AS-IS WITH NO WARRANTY. %%00800326 %% Paradigm hereby disclaims all warranties respecting this %%00800328 %% material, expressed or implied, including without limita- %%00800330 %% tion warranty of design, merchantability, fitness for a %%00800332 %% particular purpose and against infringement. %%00800334 %% %%00800340 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00800341 % 2002-11-22 P.KIMPEL 00800342 % ORIGINAL VERSION, FROM UTIL/PARADIGM/LIBRARY. 00800343 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00800390 DEFINE 00800400 TICK = (2.4@-6) #, % CLOCK TICKS/SECOND 00800500 00800600 %----- TIME(6) LAYOUT ----- 00800700 TIME6DATEF = [47:16] #, % JULIAN DATE-70000 00800800 TIME6TIMEF = [31:32] #, % TIME OF DAY IN TICKS/16 00800900 TIME6DATEBIAS = 70000 #, 00801000 TIME6TICK = (16*TICK) #; 00801100 00801200 $ BEGINSEGMENT 00801250 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00801300 INTEGER PROCEDURE DATE_KDAY (GREGORIAN); 00801400 VALUE GREGORIAN; 00801500 INTEGER GREGORIAN; 00801600 BEGIN COMMENT 00801700 CONVERTS THE GREGORIAN DATE (YYYYMMDD OR YYMMDD) TO A JULIAN 00801800 DAY NUMBER, RETURNING THE RESULT AS THE FUNCTION VALUE. THE 00801900 JULIAN DAY NUMBER IS BASED ON 01-MAR-1900 (DAY 1). NOT 00802000 VALID FOR DATES BEFORE 01-MAR-1900 OR AFTER 31-DEC-2099. 00802100 ADAPTED FROM CACM ALGORITHM 199, R.G. TANTZEN, COMM. ACM, 00802200 VOL.8, AUG.1963, P.444. 00802300 ; 00802400 INTEGER 00802500 YY, 00802600 MM, 00802700 DD; 00802800 00802900 YY:= GREGORIAN DIV 10000; 00803000 IF YY >= 1900 THEN 00803100 YY:= *-1900; 00803200 00803300 DD:= GREGORIAN MOD 10000; 00803400 MM:= DD DIV 100; 00803500 IF MM > 2 THEN 00803600 MM:= *-3 00803700 ELSE 00803800 BEGIN 00803900 MM:= *+9; 00804000 YY:= *-1; 00804100 END; 00804200 00804300 DATE_KDAY:= (1461*YY) DIV 4 + (153*MM+2) DIV 5 + DD MOD 100; 00804400 END DATE_KDAY; 00804500 00804600 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00804700 INTEGER PROCEDURE DATE_KDATE (JULIAN); 00804800 VALUE JULIAN; 00804900 INTEGER JULIAN; 00805000 BEGIN COMMENT 00805100 CONVERTS THE JULIAN DAY NUMBER (1 = 01-MAR-1900) TO A GREGORIAN 00805200 DATE OF THE FORM YYYYMMDD, RETURNING THE RESULT AS THE FUNCTION 00805300 VALUE. 00805400 ADAPTED FROM CACM ALGORITHM 199, R.G. TANTZEN, COMM. ACM, 00805500 VOL.8, AUG.1963, P.444. 00805600 ; 00805700 INTEGER 00805800 W, 00805900 YY, 00806000 MM, 00806100 DD; 00806200 00806300 W:= 4*JULIAN - 1; 00806400 YY:= W DIV 1461; 00806500 DD:= (W - 1461*YY + 4) DIV 4; 00806600 W:= 5*DD - 3; 00806700 MM:= W DIV 153; 00806800 DD:= (W - 153*MM + 5) DIV 5; 00806900 IF MM < 10 THEN 00807000 MM:= *+3 00807100 ELSE 00807200 BEGIN 00807300 MM:= *-9; 00807400 YY:= *+1; 00807500 END; 00807600 00807700 DATE_KDATE:= ((YY+1900)*100 + MM)*100 + DD; 00807800 END DATE_KDATE; 00807900 00808000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00808100 INTEGER PROCEDURE DATE_INCREMENT (GREGORIAN, DAYS); 00808200 VALUE GREGORIAN, DAYS; 00808300 INTEGER GREGORIAN, DAYS; 00808400 BEGIN COMMENT 00808500 INCREMENTS THE GREGORIAN DATE BY THE NUMBER OF DAYS (MAY BE 00808600 NEGATIVE) SPECIFIED, RETURNING A NEW GREGORIAN DATE AS THE 00808700 FUNCTION VALUE. 00808800 ; 00808900 00809000 DATE_INCREMENT:= DATE_KDATE (DATE_KDAY (GREGORIAN) + DAYS); 00809100 END DATE_INCREMENT; 00809200 00809300 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00809400 INTEGER PROCEDURE DATE_DIFFERENCE (GREGORIAN1, GREGORIAN2); 00809500 VALUE GREGORIAN1, GREGORIAN2; 00809600 INTEGER GREGORIAN1, GREGORIAN2; 00809700 BEGIN COMMENT 00809800 COMPUTES THE NUMBER OF DAYS BETWEEN THE TWO DATES. IF GREGORIAN1 00809900 IS EARLIER THAN GREGORIAN2, THE RESULT WILL BE NEGATIVE. 00810000 ; 00810100 00810200 DATE_DIFFERENCE:= DATE_KDAY (GREGORIAN1) - DATE_KDAY (GREGORIAN2); 00810300 END DATE_DIFFERENCE; 00810400 00810500 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00810600 INTEGER PROCEDURE DATE_WEEKDAY (GREGORIAN); 00810700 VALUE GREGORIAN; 00810800 INTEGER GREGORIAN; 00810900 BEGIN COMMENT 00811000 COMPUTES THE DAY OF THE WEEK FROM THE GREGORIAN DATE: 0=SUNDAY, 00811100 6=SATURDAY. 00811200 ; 00811300 00811400 DATE_WEEKDAY:= (DATE_KDAY (GREGORIAN) + 3) MOD 7; 00811500 END DATE_WEEKDAY; 00811600 00811700 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00811800 INTEGER PROCEDURE DATE_JULIANTOGREGORIAN (JULIAN); 00811900 VALUE JULIAN; 00812000 INTEGER JULIAN; 00812100 BEGIN COMMENT 00812200 CONVERTS THE JULIAN DATE (YYDDD OR YYYYDDD) TO A GREGORIAN DATE 00812300 (YYYYMMDD). 00812400 ; 00812500 INTEGER 00812600 YY, 00812700 DDD; 00812800 00812900 YY:= JULIAN DIV 1000; 00813000 DDD:= JULIAN MOD 1000 - 1; 00813100 DATE_JULIANTOGREGORIAN:= 00813200 DATE_KDATE (DATE_KDAY (YY*10000 + 0101) + DDD); 00813250 END DATE_JULIANTOGREGORIAN; 00813300 00813400 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00813500 INTEGER PROCEDURE DATE_GREGORIANTOJULIAN (GREGORIAN); 00813600 VALUE GREGORIAN; 00813700 INTEGER GREGORIAN; 00813800 BEGIN COMMENT 00813900 CONVERTS THE GREGORIAN DATE (YYMMDD OR YYYYMMDD) TO A JULIAN 00814000 DATE (YYDDD), RETURNING THE JULIAN DATE AS THE FUNCTION RESULT. 00814100 ; 00814200 INTEGER 00814300 YY, 00814400 DDD; 00814500 00814600 YY:= GREGORIAN DIV 10000; 00814700 DDD:= DATE_DIFFERENCE (GREGORIAN, YY*10000 + 0101) + 1; 00814800 DATE_GREGORIANTOJULIAN:= (YY MOD 100)*1000 + DDD; 00814900 END DATE_GREGORIANTOJULIAN; 00815000 00815100 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00815200 PROCEDURE DATE_DECODETIME6 (T6, YYYYMMDD, SECONDS); 00815300 VALUE T6; 00815400 00815450 REAL T6; 00815500 INTEGER YYYYMMDD, SECONDS; 00815600 BEGIN COMMENT 00815700 CONVERTS A TIME(6) VALUE TO TWO INTEGERS, THE DATE IN YYYYMMDD 00815800 FORMAT AND THE TIME OF DAY IN HHMMSS FORMAT. 00815900 ; 00816000 00816300 YYYYMMDD:= DATE_JULIANTOGREGORIAN (T6.TIME6DATEF+TIME6DATEBIAS); 00816400 SECONDS:= T6.TIME6TIMEF * TIME6TICK; 00816500 END DATE_FORMATTIME6; 00816800 00816900 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00817000 STRING PROCEDURE DATE_FORMATTIME6 (T6); 00817100 VALUE T6; 00817200 REAL T6; 00817300 BEGIN COMMENT 00817400 CONVERTS A TIME(6) VALUE TO A STRING IN THE FORMAT 00817500 DOW, MM/DD/YY @ HH:MM:SS 00817600 WHERE "DOW" IS THE DAY OF WEEK (MON, TUE, ...). 00817700 ; 00817800 INTEGER 00817900 DOW, 00818000 T6DATE, 00818100 T6TIME; 00818200 EBCDIC ARRAY 00818300 MSG [0:29]; 00818400 EBCDIC VALUE ARRAY 00818500 WEEKDAYS ("SUNMONTUEWEDTHUFRISAT"); 00818600 00818700 T6DATE:= DATE_JULIANTOGREGORIAN (T6.TIME6DATEF+TIME6DATEBIAS); 00818800 T6TIME:= T6.TIME6TIMEF * TIME6TICK; 00818900 DOW:= DATE_WEEKDAY (T6DATE); 00819000 00819100 REPLACE MSG BY 00819200 WEEKDAYS[DOW*3] FOR 3, " ", 00819300 T6DATE DIV 100 MOD 100 FOR 2 DIGITS, "/", 00819400 T6DATE MOD 100 FOR 2 DIGITS, "/", 00819500 T6DATE DIV 10000 FOR 2 DIGITS, " ", 00819600 T6TIME DIV 3600 FOR 2 DIGITS, ":", 00819700 T6TIME DIV 60 MOD 60 FOR 2 DIGITS, ":", 00819800 T6TIME MOD 60 FOR 2 DIGITS; 00819900 DATE_FORMATTIME6:= STRING (MSG, 21); 00820000 END DATE_FORMATTIME6; 00820100 $ ENDSEGMENT 00899900