Date Routines#
Library of routines supporting the input, storage and manipulation of dates.
General Information
Author: Paul B. Loux
Language: ACTION!
Compiler/Interpreter: ACTION!
Published: 1986
Requirements: EntryD() utilizes "EntryS()" (universal string entry routine), "PrintM()" (output formatter), and the "ValD()" function provided herein.
EntryS() is available under the name ENTRYS.ACT PrintM() is available under the name PRINTM.ACT
Four routines are provided to facilitate the storage and manipulation of dates. The CARD FUNC ValD(<string>) will convert a date in string format to a unique CARD value. The CARD returned by this function can be used to compute the number of calender days between two dates. The string can have non-numeric characters; for instance "12/31/85" is legal. Used together with its converse, PROC StrD(CARD number,<string>), it is also possible to find the calender date which falls a given number of days before or after a reference date. The string returned by StrD() contains only numbers; formatting must be performed separately.
PROC Day(CARD number,<string>) provides the day of the week corresponding to a given calender date, as represented by a CARD value generated by ValD().
CARD FUNC EntryD() obtains a date from the keyboard. It uses EntryS(), the universal string entry utility; therefore it has the associated features of error checking, timeout, etc. EntryD() will assure the validity of the entered date, check it against optional minimum and maximum dates, and echo succesful entry in mm-dd-yy format, by use of PrintM(). The calling program provides the entry buffer, so EntryD() can be used to return a CARD value (as with ValD()) or to obtain an unformatted string (as with StrD()).
PROC PrintM(<String>,<mask>) and its variants *ME,*MD,and *MDE can be used to print a date in any format desired, such as "mm-dd-yy".
To facilitate usage into the next century, the date computations include a 40-year offset. Thus, the date "043020" is presumed to mean April 30, 2020. Therefore, date computations are only valid for dates within the range from 1-1-1940 through 12-31-2039. ValD() and StrD() are consistent in this regard.
Note that more efficient storage results from use of CARD values (2 bytes) rather than strings (5 or 6 bytes plus length byte). This technique also facilitates ease in sorting data by date.
Technical note: in general, any string variable should be pre- extended to its maxmium length prior to making a call which will use it to pass data.
;************************************ ;* * ;*(C)Copyright 1986 by Paul B. Loux * ;* * ;* These routines are in the public * ;* domain, and are not to be sold * ;* for a profit. They may be freely * ;* distributed, provided that this * ;* header remains in place. Use and * ;* enjoy! PBL, CIS 72337,2073. * ;* * ;************************************ ; ; File: DATES.LIB ; ; Desciption: Library of routines ; supporting the input, storage ; and manipulation of dates. ; ; Requirements: EntryD() utilizes ; "EntryS()" (universal string ; entry routine), "PrintM()" ; (output formatter), and the ; "ValD()" function provided ; herein. ; ; EntryS() is available under the ; name ENTRYS.ACT ; ; PrintM() is available under the ; name PRINTM.ACT ; ;************************************ ; ; CARD FUNC ValD() ; PROC StrD() ; PROC Day() ; CARD FUNC EntryD() ; ;************************************ ; ; Four routines are provided to ; facilitate the storage and ; manipulation of dates. The ; CARD FUNC ValD(<string>) will ; convert a date in string format ; to a unique CARD value. The ; CARD returned by this function ; can be used to compute the ; number of calender days between ; two dates. The string can have ; non-numeric characters; for ; instance "12/31/85" is legal. ; Used together with its converse, ; PROC StrD(CARD number,<string>), ; it is also possible to find ; the calender date which falls ; a given number of days before ; or after a reference date. ; The string returned by StrD() ; contains only numbers; formatting ; must be performed separately. ; ; PROC Day(CARD number,<string>) ; provides the day of the week ; corresponding to a given calender ; date, as represented by a CARD ; value generated by ValD(). ; ; CARD FUNC EntryD() obtains a ; date from the keyboard. It uses ; EntryS(), the universal string ; entry utility; therefore it has ; the associated features of error ; checking, timeout, etc. EntryD() ; will assure the validity of the ; entered date, check it against ; optional minimum and maximum ; dates, and echo succesful entry ; in mm-dd-yy format, by use of ; PrintM(). The calling program ; provides the entry buffer, so ; EntryD() can be used to return ; a CARD value (as with ValD()) ; or to obtain an unformatted ; string (as with StrD()). ; ; PROC PrintM(<String>,<mask>) and ; its variants *ME,*MD,and *MDE ; can be used to print a date in ; any format desired, such as ; "mm-dd-yy". ; ; To facilitate usage into the next ; century, the date computations ; include a 40-year offset. Thus, ; the date "043020" is presumed to ; mean April 30, 2020. Therefore, ; date computations are only valid ; for dates within the range from ; 1-1-1940 through 12-31-2039. ; ValD() and StrD() are consistent ; in this regard. ; ; Note that more efficient storage ; results from use of CARD values ; (2 bytes) rather than strings ; (5 or 6 bytes plus length byte). ; This technique also facilitates ; ease in sorting data by date. ; ; Technical note: in general, any ; string variable should be pre- ; extended to its maxmium length ; prior to making a call which ; will use it to pass data. ; ; ;************************************ ; ; "ValD()" ; ; Convert a date string into ; a unique CARD value. Input ; expected: ; ; "010185" ; "1-01-85" ; "Date: 01/01/85" ; etc. ; ; NOT: "1/1/85" ; CARD FUNC ValD(BYTE ARRAY dateS) BYTE ARRAY digits(0)="......" BYTE ARRAY month(0)="..", day(0)="..", year(0)=".." BYTE mm,dd,yy BYTE dmax,bad_date BYTE len1 BYTE len2 BYTE ctr,tmp BYTE xtmp,ztmp CARD value INT offset len1=dateS(0) len2=6 DO ; assure only digits tmp=dateS(len1) IF (tmp>47 AND tmp <58) THEN digits(len2)=tmp len2==-1 FI len1==-1 UNTIL len1=0 OR len2=0 OD IF len2>1 THEN ; 4 or less #'s RETURN(0) FI IF len2=1 THEN ; 5 #'s digits(1)=48 ; '0 FI digits(0)=6 SCopyS(month,digits,1,2) SCopyS(day,digits,3,4) SCopyS(year,digits,5,6) mm=ValB(month) dd=ValB(day) yy=ValB(year) bad_date=0 IF mm>12 OR ; legal date mm<1 OR ; checks dd<1 THEN bad_date=1 FI IF mm=2 THEN IF yy MOD 4 THEN dmax=28 ELSE dmax=29 FI ELSEIF mm=4 OR mm=6 OR mm=9 OR mm=11 THEN dmax=30 ELSE dmax=31 FI IF dd>dmax THEN bad_date=1 FI IF bad_date THEN RETURN(0) FI IF yy<40 THEN ; 40 year offset yy==+100 FI IF mm<3 THEN xtmp=0 ztmp=(yy-1)/4 ELSE xtmp=(4*mm + 23)/10 ztmp=yy/4 FI mm==-1 value=365*yy+31*mm+dd+ztmp-xtmp RETURN(value) ;************************************ ; ; "StrD()" ; ; Restores a date compressed ; to a CARD value by ValD(), ; into a fixed length string ; of six digital characters; ; no formating is performed. ; Example output: ; ; "010185" ; ; Note: calling program must ; pre-extend string "dateS" ; to six places. ; PROC StrD(CARD dateC BYTE ARRAY dateS) BYTE ARRAY mm(0)="..", dd(0)="..", yy(0)=".." BYTE POINTER ptr1,ptr2 INT m,d,y,r,s,t,y1,ly BYTE dmax y=0 y1=0 IF dateC>36524 THEN ; yy=1** dateC==-36525 FI IF dateC>29220 THEN ; # too big dateC==-7305 y1=20 FI IF dateC<61 THEN ; handle yr=0 dateC==+1461 y1=-4 FI y=dateC/365 r=dateC-(y*365)-y/4 IF r<31 THEN y==-1 r=dateC-(y*365)-y/4 FI IF r>59 then s=7 ELSE s=0 FI m=(r+s)/31 ly=(y/4)-((y-1)/4) IF m<3 THEN t=ly ELSE t=(4*m+23)/10 FI IF m=2 THEN IF y MOD 4 =0 THEN dmax=29 ELSE dmax=28 FI ELSEIF m=4 OR m=6 OR m=9 OR m=11 THEN dmax=30 ELSE dmax=31 FI d=r-31*(m-1)+t IF d>dmax THEN m==+1 IF m<3 THEN t=ly ELSE t=(4*m+23)/10 FI d=r-31*(m-1)+t FI IF m=13 THEN y==+1 m==-12 FI y==+y1 StrI(m,mm) StrI(d,dd) StrI(y,yy) SCopy(dateS,"000000") ptr1=mm+1 ptr2=dateS+1 IF mm(0)=1 THEN ptr2==+1 ptr2^=ptr1^ ELSE ptr2^=ptr1^ ptr1==+1 ptr2==+1 ptr2^=ptr1^ FI ptr1=dd+1 ptr2=dateS+3 IF dd(0)=1 THEN ptr2==+1 ptr2^=ptr1^ ELSE ptr2^=ptr1^ ptr1==+1 ptr2==+1 ptr2^=ptr1^ FI ptr1=yy+1 ptr2=dateS+5 IF yy(0)=1 THEN ptr2==+1 ptr2^=ptr1^ ELSE ptr2^=ptr1^ ptr1==+1 ptr2==+1 ptr2^=ptr1^ FI RETURN ;************************************ ; ; "Day()" ; ; Day of the week computation ; ; Returns variable-length string ; containing corresponding day ; of the week for the CARD value ; supplied. String can be easily ; massaged to obtain upper case ; only, first three letters,etc. ; ; Note: string "day" must be ; pre-xtended to 9 places by the ; the calling program, to allow ; room for "Wednesday" response. ; PROC Day(CARD dateC BYTE ARRAY day) CARD ref=[31412] ; Wednesday 1/1/86 INT dif BYTE num,dir BYTE ARRAY ptr CARD ARRAY dow(7) dow(0)="Wednesday" dow(1)="Thursday" dow(2)="Friday" dow(3)="Saturday" dow(4)="Sunday" dow(5)="Monday" dow(6)="Tuesday" dow(7)="Wednesday" dir=0 dif=dateC-ref IF dif<0 THEN dif=-dif dir=1 FI num=dif MOD 7 IF dir THEN num=7-num FI ptr=dow(num) SCopy(day,ptr) RETURN ;************************************ ; ; ; CARD FUNC EntryD() ; ; Data entry utility used to ; gather a calender date from ; the keyboard in the "mmddyy" ; format. The routine performs ; checks for illegal dates and ; echoes a valid response in ; "mm-dd-yy" format. Returns ; date as a CARD value as per ; ValD(), or as an unformatted ; string as per StrD(). ; ; This function uses both the ; EntryS() data entry utility ; and the PrintM() formatter. ; ; Calling options include the ; screen coordinates; high and ; low checks; null-entry flag; ; and exit flag, per EntryS(). ; ; ;************************************ INCLUDE "ENTRYS.ACT" INCLUDE "PRINTM.ACT" ;************************************ MODULE CARD FUNC EntryD(BYTE ARRAY field BYTE col,row,nullok,xit CARD min_date,max_date BYTE POINTER err_ptr) BYTE bad_date,accept,ctr, min,max,typec CARD value BYTE POINTER ptr1,ptr2 INT chk min=5 IF nullok THEN min=0 FI IF max_date=0 THEN max_date=51134 ; 12-31-39 FI max=6 typec=5 ; pos int accept=0 chk=0 DO POSITION(row,col) PRINT(" ") ENTRYS(field,min,max,typec,xit, col,row,err_ptr) IF err_ptr^#0 THEN RETURN(0) FI bad_date=0 IF field(0)=0 THEN IF nullok=1 THEN RETURN(0) ELSE bad_date=1 FI FI value=ValD(field) IF value=0 THEN bad_date=1 ELSEIF value<min_date OR value>max_date THEN bad_date=2 FI IF bad_date=1 THEN MSG(8) ELSEIF bad_date=2 THEN MSG(7) ELSE accept=1 FI UNTIL accept OD POSITION(col,row) PRINTM(field,"<Z/<Z/ZZ") RETURN(value) ;************************************ ; ; Example of usage of Date functions. PROC Test5() BYTE ARRAY date_field="......" BYTE ARRAY dow="........." BYTE x,y CARD date_val,min_date,max_date BYTE errcde BYTE POINTER err_ptr errcde=0 err_ptr=@errcde min_date=0 max_date=0 PUT(125) POSITION(1,5) x=22 y=5 PRINT("Enter date (mmddyy): ") date_val=EntryD(date_field,x,y,0,0, min_date,max_date, err_ptr) PUTE() PRINTE("The CARD value representing") PRINT("this date is ") PRINTC(date_val) PRINTE(".") PUTE() PRINTE("StrD() gives us back the string") StrD(date_val,date_field) PRINT("representation, ") PRINT(date_field) PRINTE(".") PUTE() PRINTE("Adding 31 days to this date") PRINT("gives us a CARD value of ") date_val==+31 PRINTC(date_val) PRINTE(".") PUTE() PRINTE("The date corresponding to this") PRINT("CARD value is ") StrD(date_val,date_field) PRINT(date_field) PRINTE(".") PUTE() PRINTE("The ValD() of this date gives") PRINT("back the CARD value, ") date_val=ValD(date_field) PRINTC(date_val) PRINTE(".") PUTE() PRINTE("The day of the week for these") PRINTE("two days is as follows:") PUTE() PRINT(date_field) PRINT(" ") Day(date_val,dow) PRINTE(dow) date_val==-31 StrD(date_val,date_field) PRINT(date_field) PRINT(" ") Day(date_val,dow) PRINTE(dow) PUTE() PRINTE("Done...") RETURN