home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
trl14db.zip
/
TRLPRG.EXE
/
WEEKDAYS.PRG
< prev
next >
Wrap
Text File
|
1990-10-22
|
2KB
|
65 lines
***********
* WEEKDAYS.PRG
* by Leonard Zerman and Tom Rettig
* Placed in the Public Domain by Tom Rettig Associates, 10/22/1990.
*
* SYNTAX: DO WEEKDAYS WITH <date>, <days>
* RETURN: <expD> of <date> plus or minus <days> not counting weekends
***********
PARAMETERS date1, number1
PRIVATE tr_startdt, tr_nbr_days, tr_weeks, tr_cntr
tr_startdt = date1
tr_nbr_days = number1
IF tr_nbr_days = 0
tr_retd = tr_startdt
IF (fox)
RETURN (tr_retd)
ELSE
RETURN
ENDIF
ENDIF
IF DOW( tr_startdt ) = 1
IF tr_nbr_days > 0
tr_startdt = tr_startdt + 1
tr_nbr_days = tr_nbr_days - 1
ELSE
tr_startdt = tr_startdt - 2
tr_nbr_days = tr_nbr_days + 1
ENDIF
ENDIF
IF DOW( tr_startdt ) = 7
IF tr_nbr_days > 0
tr_startdt = tr_startdt + 2
tr_nbr_days = tr_nbr_days - 1
ELSE
tr_startdt = tr_startdt - 1
tr_nbr_days = tr_nbr_days + 1
ENDIF
ENDIF
IF tr_nbr_days = 0
tr_retd = tr_startdt
IF (fox)
RETURN (tr_retd)
ELSE
RETURN
ENDIF
ENDIF
tr_weeks = INT( tr_nbr_days / 5 )
tr_startdt = tr_startdt + ( tr_weeks * 7 )
tr_cntr = ABS( tr_nbr_days ) - ABS( tr_weeks * 5 )
DO WHILE tr_cntr > 0
IF tr_nbr_days > 0
tr_startdt = tr_startdt + 1
ELSE
tr_startdt = tr_startdt - 1
ENDIF
IF .NOT. ( DOW( tr_startdt ) = 1 .OR. DOW( tr_startdt ) = 7 )
tr_cntr = tr_cntr - 1
ENDIF
ENDDO
tr_retd = tr_startdt
IF fox
RETURN (tr_retd)
ENDIF
* eof weekdays *