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

Add new attachment

Only authorized users are allowed to upload new attachments.
« This page (revision-1) was last changed on 13-Mar-2010 15:20 by Carsten Strotmann