00010000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00010100 %% WFL DATE MODULE (ALGORITHM 199) %% 00010200 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00011000 %% %% 00011010 %% Copyright (c) 2002: %% 00011020 %% Paradigm Corporation %% 00011030 %% San Diego, California USA %% 00011040 %% http://www.digm.com %% 00011050 %% %% 00011060 %% Licensed under the Simple Public License (SimPL) 2.0 %% 00011070 %% %% 00011080 %% This material may be copied and used under the terms of %% 00011090 %% that license. This copyright notice must be preserved and %% 00011100 %% appropriate credit given in any derivative materials. %% 00011110 %% %% 00011120 %% This material is offered AS-IS WITH NO WARRANTY. Paradigm hereby %% 00011130 %% disclaims all warranties respecting this material, expressed or %% 00011140 %% implied, including without limitation warranty of design, %% 00011150 %% merchantability, fitness for a particular purpose and against %% 00011160 %% infringement. %% 00011170 %% %% 00015000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00015001 % 2002-11-22 P.KIMPEL 00015002 % ORIGINAL VERSION, FROM PROTOTYPE OF 2001-02-10. 00015003 % 2010-05-19 P.KIMPEL 00015010 % PREPARE FOR UNITE SCR; INSERT SIMPL 2.0 LICENSE. 00015011 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00019900 00020000 CONSTANT 00020100 DATEMAXV = 21000228, % MAX VALID DATE 00020200 DATEMINV = 19000301, % MIN VALID DATE 00020300 DATEYEARBIASV = 1900, % CENTURY BIAS YEAR 00020400 DATESUNDAYV = 0, 00022000 DATEMONDAYV = 1, 00022100 DATETUESDAYV = 2, 00022200 DATEWEDNESDAYV = 3, 00022300 DATETHURSDAYV = 4, 00022400 DATEFRIDAYV = 5, 00022500 DATESATURDAYV = 6; 00022600 00100000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00100100 SUBROUTINE DATEKDAY (INTEGER GREGORIAN VALUE, INTEGER JULDAY); 00100200 % CONVERTS THE GREGORIAN DATE (YYYYMMDD OR YYMMDD) TO A JULIAN DAY 00100300 % NUMBER, RETURNING THE RESULT IN "JULDAY". THE JULIAN DAY NUMBER 00100400 % IS BASED ON 1900-03-01 (DAY 1). NOT VALID FOR DATES BEFORE 00100500 % 1900-03-01 OR AFTER 2100-02-28. ADAPTED FROM CACM ALGORITHM 00100600 % 199, R.G. TANTZEN, COMM. ACM, VOL.8, AUG.1963, P.444. 00100700 BEGIN 00100750 INTEGER 00100800 YY, 00100900 MM, 00101000 DD; 00101100 00101200 YY:= GREGORIAN DIV 10000; 00101300 IF YY GEQ DATEYEARBIASV THEN 00101400 YY:= YY-DATEYEARBIASV; 00101500 00101600 DD:= GREGORIAN MOD 10000; 00101700 MM:= DD DIV 100; 00101800 IF MM > 2 THEN 00101900 MM:= MM-3 00102000 ELSE 00102100 BEGIN 00102200 MM:= MM+9; 00102300 YY:= YY-1; 00102400 END; 00102500 00102600 JULDAY:= (1461*YY) DIV 4 + (153*MM+2) DIV 5 + DD MOD 100; 00102700 END DATEKDAY; 00102800 00102900 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00103000 SUBROUTINE DATEKDATE (INTEGER JULDAY VALUE, INTEGER GREGORIAN); 00103100 % CONVERTS THE JULIAN DAY NUMBER (1 = 1900-03-01) TO A GREGORIAN 00103200 % DATE OF THE FORM YYYYMMDD, RETURNING THE RESULT AS "GREGORIAN". 00103300 % ADAPTED FROM CACM ALGORITHM 199, R.G. TANTZEN, COMM. ACM, 00103400 % VOL.8, AUG.1963, P.444. 00103500 BEGIN 00103550 INTEGER 00103600 W, 00103700 YY, 00103800 MM, 00103900 DD; 00104000 00104100 W:= 4*JULDAY - 1; 00104200 YY:= W DIV 1461; 00104300 DD:= (W - 1461*YY + 4) DIV 4; 00104400 W:= 5*DD - 3; 00104500 MM:= W DIV 153; 00104600 DD:= (W - 153*MM + 5) DIV 5; 00104700 IF MM < 10 THEN 00104800 MM:= MM+3 00104900 ELSE 00105000 BEGIN 00105100 MM:= MM-9; 00105200 YY:= YY+1; 00105300 END; 00105400 00105500 GREGORIAN:= ((YY+DATEYEARBIASV)*100 + MM)*100 + DD; 00105600 END DATEKDATE; 00105700 00120000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00120100 SUBROUTINE DATEINCREMENT (INTEGER GREGORIAN VALUE, INTEGER DAYS VALUE, 00120200 INTEGER RESULT); 00120300 % INCREMENTS THE GREGORIAN DATE BY THE NUMBER OF DAYS (MAY BE 00120400 % NEGATIVE) SPECIFIED, RETURNING A NEW GREGORIAN DATE AS RESULT. 00120500 BEGIN 00120550 INTEGER 00120600 JULDAY; 00120700 00120800 DATEKDAY (GREGORIAN, JULDAY); 00120900 DATEKDATE (JULDAY+DAYS, RESULT); 00121000 END DATEINCREMENT; 00121100 00121200 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00121300 SUBROUTINE DATEDIFFERENCE (INTEGER GREGORIAN1 VALUE, 00121400 INTEGER GREGORIAN2 VALUE, INTEGER DAYS); 00121500 % COMPUTES THE NUMBER OF DAYS BETWEEN THE TWO DATES. IF GREGORIAN1 00121600 % IS EARLIER THAN GREGORIAN2, THE RESULT WILL BE NEGATIVE. 00121700 BEGIN 00121750 INTEGER 00121800 J1, 00121900 J2; 00122000 00122100 DATEKDAY (GREGORIAN1, J1); 00122200 DATEKDAY (GREGORIAN2, J2); 00122300 DAYS:= J1-J2; 00122400 END DATEDIFFERENCE; 00122500 00122600 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00122700 SUBROUTINE DATEWEEKDAY (INTEGER GREGORIAN VALUE, INTEGER DAY); 00122800 % COMPUTES THE DAY OF THE WEEK FROM THE GREGORIAN DATE: 0=SUNDAY, 00122900 % 6=SATURDAY. 00123000 BEGIN 00123050 INTEGER 00123100 JULDAY; 00123200 00123300 DATEKDAY (GREGORIAN, JULDAY); 00123400 DAY:= (JULDAY+3) MOD 7; 00123500 END DATEWEEKDAY; 00123600 00123700 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00123800 SUBROUTINE DATEJULIANTOGREGORIAN (INTEGER JULIAN VALUE, INTEGER GREGORIAN); 00123900 % CONVERTS THE JULIAN DATE (YYDDD OR YYYYDDD) TO A GREGORIAN DATE 00124000 % (YYYYMMDD). 00124100 BEGIN 00124150 INTEGER 00124200 JULDAY, 00124300 YY, 00124400 DDD; 00124500 00124600 YY:= JULIAN DIV 1000; 00124700 DDD:= JULIAN MOD 1000 - 1; 00124800 DATEKDAY (YY*10000 + 0101, JULDAY); 00124900 DATEKDATE (JULDAY+DDD, GREGORIAN) 00125000 END DATEJULIANTOGREGORIAN; 00125100 00125200 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00125300 SUBROUTINE DATEGREGORIANTOJULIAN (INTEGER GREGORIAN VALUE, INTEGER JULIAN); 00125400 % CONVERTS THE GREGORIAN DATE (YYMMDD OR YYYYMMDD) TO A JULIAN 00125500 % DATE (YYYYDDD), RETURNING THE JULIAN DATE AS THE FUNCTION RESULT. 00125600 BEGIN 00125650 INTEGER 00125700 YY, 00125800 DDD; 00125900 00126000 YY:= GREGORIAN DIV 10000; 00126100 DATEDIFFERENCE (GREGORIAN, YY*10000 + 0101, DDD); 00126200 JULIAN:= YY*1000 + DDD + 1; 00126300 END DATEGREGORIANTOJULIAN; 00126400 00150000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00150100 SUBROUTINE DATEVALIDATE (INTEGER GREGORIAN VALUE, BOOLEAN VALID); 00150200 % TESTS THE GREGORIAN DATE TO SEE IF IT IS A VALID DATE. IF SO, 00150300 % "VALID" IS RETURNED AS TRUE. 00150400 BEGIN 00150500 BOOLEAN 00150600 RESULT:= FALSE; 00150700 INTEGER 00150800 YY, 00150900 MM, 00151000 DD, 00151100 JULDAY, 00151200 NEWGREG; 00151300 00151400 YY:= GREGORIAN DIV 10000; 00151500 DD:= GREGORIAN MOD 100; 00151600 MM:= (GREGORIAN DIV 100) MOD 100; 00151700 IF MM > 0 THEN 00151800 IF MM LEQ 12 THEN 00151900 IF DD > 0 THEN 00152000 IF DD LEQ 28 THEN 00152100 RESULT:= TRUE 00152200 ELSE 00152300 BEGIN 00152400 DATEKDAY (GREGORIAN, JULDAY); 00152500 DATEKDATE (JULDAY, NEWGREG); 00152600 IF GREGORIAN MOD 1000000 = NEWGREG MOD 1000000 THEN 00152700 RESULT:= TRUE; 00152800 END; 00152900 00153000 VALID:= RESULT; 00153100 END DATEVALIDATE; 00153200 00199800 %%%%%%%%%%%%%%%%%%%%%%%%%%%% END DATE MODULE %%%%%%%%%%%%%%%%%%%%%%%%%%% 00199900