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
