|
I have attached a RPGLE pgm and it display file that will do this for you. -----Original Message----- From: owner-midrange-l@midrange.com [mailto:owner-midrange-l@midrange.com]On Behalf Of oludare Sent: Wednesday, August 23, 2000 4:35 PM To: RPG AS/400 UserGroup; AS/400 Midrange Usergroup Subject: Calculating Working(business) days Importance: High 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
midrange.com
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=Exit'
A COLOR(BLU)
A 23 12'F10=Calculate 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=Exit'
A COLOR(BLU)
A 23 12'F9=Calculate 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)
* 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
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
