Return to the RPG Tips
3 Routines for Calculating Working(business)days
Calculates the number of business days between two dates
end_date subdur begin_date #_of_days:d*
eval #_of_weeks = %div(#_of_days: 7)
eval days_left = %rem(#_of_days: 7)
eval #_of_days = (#_of_weeks * 5) + days_left
===============================================================================
===============================================================================
Calculates the number of business days between two dates
Barbara Morris
* file HOLIDAYS
A R REC
A DATE L
A DESC 50A
A K DATE
Fholidays if e k disk prefix(holiday)
D d1 s d
D d2 s d
D d s 10i 0
D getDayNum pr 10i 0
D date d const
D makeWeekDay pr d
D date d const
D whichway 10a const
D dayNum1 s 10i 0
D dayNum2 s 10i 0
D numWeekends s 10i 0
C *entry plist
C parm d1
C parm d2
* Make sure neither date falls on Saturday or Sunday
C eval d1 = makeWeekDay (d1 : 'forward')
C eval d2 = makeWeekDay (d2 : 'back')
* Get the number of days between the dates
C d2 subdur d1 numdays:*days 5 0
* Get the number of weekends between the dates
* (Since we made sure we weren't on the weekend, these will
* be full weekends)
C eval numWeekends = numDays / 7
* Is there an extra weekend?
* Monday = 3 ... Friday = 7
* If d2 has a lower day number than d1, then there is one more weekend
C eval dayNum1 = getDayNum (d1)
C eval dayNum2 = getDayNum (d2)
C if dayNum2 < dayNum1
C eval numWeekends = numWeekends + 1
C endif
C eval numDays = numDays - numWeekends * 2
* Check holidays
C d1 setll holidays
C if %found
* Read through holidays until we get past the current date
C read #Junkf
C dow not %eof
C if holidayDate > d2
* We've seen all the holidays between our dates
C leave
C endif
C read holidays
C eval numDays = numDays - 1
C enddo
C endif
C numdays dsply
C seton lr
P makeWeekDay b
D makeWeekDay pi d
D date d const
D whichway 10a const
D days s 10i 0
D workdate s d
D SaturdayNum C 1
D SundayNum C 2
C eval days = getDayNum (date)
* We have 1 = Saturday, 2 = Sunday ... 7 = Friday
C if days > 2
C return date
C endif
C if whichway = 'forward'
C select
* Saturday + 2 days = Monday
C when days = SaturdayNum
C eval days = 2
* Sunday + 1 days = Monday
C when days = SundayNum
C eval days = 1
C endsl
C else
C select
* Saturday - 1 days = Friday
C when days = SaturdayNum
C eval days = -1
* Sunday - 2 days = Friday
C when days = SundayNum
C eval days = -2
C endsl
C endif
* Adjust forward or backward to Monday or Friday
C date adddur days:*days workdate
C return workdate
P makeWeekDay e
P getDayNum b
D getDayNum pi 10i 0
D date d const
D days s 10i 0
D Friday c D'2000-08-04'
C date subdur Friday days:*days
C days div 7 days
C mvr days
C if days < 1
C eval days = days + 7
C endif
C return days
P getDayNum e
==============================================================================
==============================================================================
Calculating Working(business) days
Hi guys,
Is there a tool or utility that can be use to calculate a date from a given date with a duration of 'n' business days (Mon-Fri).
(assume no holidays)
Dare
- ------=_NextPart_000_0036_01C00D2D.A9D80590
Content-Type: text/plain;
name="datecalcd.txt"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
filename="datecalcd.txt"
A DSPSIZ(24 80 *DS3)
A PRINT
A CA03
A CA09
A CA10
A R DATECALC01
A SETOF(80 'Invalid date')
A 1 29'Date Calculator (ADDDUR)'
A DSPATR(HI)
A 3 2'Type date, duration, press Enter.'
A COLOR(BLU)
A 5 2'Date . . . . . . .'
A INDATE 8A B 5 24DSPATR(HI)
A 5 50'(*MDY format-slashes required)'
A 6 2'Duration . . . . .'
A INDURATION 9Y 0B 6 24DSPATR(HI)
A EDTCDE(Q)
A 7 4'Type . . . . . .'
A INDURTYPE 2Y 0B 7 24DSPATR(HI)
A SNGCHCFLD
A CHOICE(1 '>Months')
A CHOICE(2 '>Days')
A CHOICE(3 '>Years')
A 10 2'ADDDUR Results'
A 11 4'*MDY format . . :'
A DMDY 8A O 11 24
A 11 44'*ISO format . . :'
A DISO 10A O 11 64
A 12 4'*DMY format . . :'
A DDMY 8A O 12 24
A 12 44'*USA format . . :'
A DUSA 10A O 12 64
A 13 4'*YMD format . . :'
A DYMD 8A O 13 24
A 13 44'*EUR format . . :'
A DEUR 10A O 13 64
A 14 4'*JUL format . . :'
A DJUL 6A O 14 24
A 14 44'*JIS format . . :'
A DJIS 10A O 14 64
A 16 2'EXTRCT Results'
A 17 4'Year . . . . . :'
A EXTRYEAR 4S 0O 17 24
A 18 4'Month . . . . . :'
A EXTRMONTH 2S 0O 18 24
A 19 4'Day . . . . . . :'
A EXTRDAY 2S 0O 19 24
A 21 2'Day of week . . . :'
A DAYOFWEEK 9A O 21 24
A 23 2'F3=3DExit'
A COLOR(BLU)
A 23 12'F10=3DCalculate duration between two-
A dates'
A COLOR(BLU)
A 1 2'User:'
A 1 8USER
A DSPATR(HI)
A 1 58SYSNAME
A DSPATR(HI)
A DSPATR(RI)
A 1 72DATE
A EDTCDE(Y)
A 2 72TIME
A 5 34'Invalid date'
A 80 DSPATR(HI)
A 80 DSPATR(BL)
A N80 DSPATR(ND)
A 6 39'(Duration should be negative to su-
A btract)'
A R DATECALC02
A SETOF(81 'Invalid Date')
A SETOF(82 'Invalid Date')
A 1 29'Date Calculator (SUBDUR)'
A DSPATR(HI)
A 3 2'Type dates, press Enter.'
A COLOR(BLU)
A 5 2'First date . . . .'
A INDATE 8A B 5 24DSPATR(HI)
A 5 49'(*MDY format-slashes required)'
A 6 2'Second date . . . .'
A INDATE2 8A B 6 24DSPATR(HI)
A 6 49'(*MDY format-slashes required)'
A 8 2'Difference'
A 9 4'In years . . . :'
A DIFFYEARS 9Y 0O 9 24EDTCDE(Q)
A 10 4'In months . . . :'
A DIFFMONTHS 9Y 0O 10 24EDTCDE(Q)
A 11 4'In days . . . . :'
A DIFFDAYS 9Y 0O 11 24EDTCDE(Q)
A 23 2'F3=3DExit'
A COLOR(BLU)
A 23 12'F9=3DCalculate new date'
A COLOR(BLU)
A 1 57SYSNAME
A DSPATR(HI)
A DSPATR(RI)
A 1 72DATE
A EDTCDE(Y)
A 2 72TIME
A 1 2'User:'
A 1 8USER
A DSPATR(HI)
A 5 34'Invalid Date'
A 81 DSPATR(HI)
A 81 DSPATR(BL)
A N81 DSPATR(ND)
A 6 34'Invalid Date'
A 82 DSPATR(HI)
A 82 DSPATR(BL)
A N82 DSPATR(ND)
- ------=_NextPart_000_0036_01C00D2D.A9D80590
Content-Type: text/plain;
name="datecalcr.txt"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
filename="datecalcr.txt"
* Program will calculate new date or duration between two dates.
FDateCalcD CF E WORKSTN INFDS(InfDS)
*------------------------------------- File information data structure
D InfDS DS
D KeyPress 369 369
*----------------------------------------------------- Key definitions
D F03Key C CONST(X'33')
D F09Key C CONST(X'39')
D F10Key C CONST(X'3A')
*------------------------------------------- Miscellaneous definitions
D BaseDate S D INZ(D'1899-12-31')
D DayOfWeek S 9 BASED(DayPtr)
D DayPtr S * INZ(%ADDR(Days))
D Mode S 2 0
D WorkField S 5 0
D Days S 9 DIM(7) ctdata perrcd(7)
D DS
D DateIn D DATFMT(*MDY)
D InDate OVERLAY(DateIn)
D DateIn2 D DATFMT(*MDY)
D InDate2 OVERLAY(DateIn2)
D DateMDY D DATFMT(*MDY)
D DMDY OVERLAY(DateMDY)
D DateDMY D DATFMT(*DMY)
D DDMY OVERLAY(DateDMY)
D DateYMD D DATFMT(*YMD)
D DYMD OVERLAY(DateYMD)
D DateJUL D DATFMT(*JUL)
D DJUL OVERLAY(DateJUL)
D DateISO D DATFMT(*ISO)
D DISO OVERLAY(DateISO)
D DateUSA D DATFMT(*USA)
D DUSA OVERLAY(DateUSA)
D DateEUR D DATFMT(*EUR)
D DEUR OVERLAY(DateEUR)
D DateJIS D DATFMT(*JIS)
D DJIS OVERLAY(DateJIS)
=
*---------------------------------------------------------------------
*
* Main Program Logic
C EVAL InDurType = 2
C EVAL Mode = 1
C DOU KeyPress = F03Key
C SELECT
C WHEN Mode = 1
C EXFMT DateCalc01
C WHEN Mode = 2
C EXFMT DateCalc02
C ENDSL
C SELECT
C WHEN KeyPress = F03Key
C LEAVE
C WHEN KeyPress = F09Key
C EVAL Mode = 1
C WHEN KeyPress = F10Key
C EVAL Mode = 2
C WHEN Mode = 1
C Test DateIn 80
C *in80 Caseq *off AddDate
C EndCs
C WHEN Mode = 2
C Test DateIn 81
C Test DateIn2 82
C If *in81 = *off and *in82 = *off
C Exsr SubDate
C EndIf
C ENDSL
C ENDDO
C EVAL *INLR = *ON
C RETURN
=
*---------------------------------------------------------------------
*
* Subroutine - AddDate - ADDDUR Mode
*
C AddDate BEGSR
C SELECT
C WHEN InDurType = 1
C DateIn ADDDUR InDuration:*M DateISO
C WHEN InDurType = 3
C DateIn ADDDUR InDuration:*Y DateISO
C OTHER
C DateIn ADDDUR InDuration:*D DateISO
C ENDSL
C MOVE DateISO DateMDY
C MOVE DateISO DateDMY
C MOVE DateISO DateYMD
C MOVE DateISO DateJUL
C MOVE DateISO DateUSA
C MOVE DateISO DateEUR
C MOVE DateISO DateJIS
C EXTRCT DateISO:*Y ExtrYear
C EXTRCT DateISO:*M ExtrMonth
C EXTRCT DateISO:*D ExtrDay
C DateISO SUBDUR BaseDate WorkField:*D
C DIV 7 WorkField
C MVR WorkField
C EVAL DayPtr = %ADDR(Days(WorkField + 1))
C ENDSR
=
*---------------------------------------------------------------------
*
* Subroutine - SubDate - SUBDUR Mode
*
C SubDate BEGSR
C DateIn SUBDUR DateIn2 DiffYears:*Y
C DateIn SUBDUR DateIn2 DiffMonths:*M
C DateIn SUBDUR DateIn2 DiffDays:*D
C ENDSR
**CTDATA Days
Sunday Monday Tuesday WednesdayThursday Friday Saturday
[report a broken link by clicking here]