|
midrange.com
oludare wrote:
> 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)
It's not fancy, but here is mine:
**********************************************************************************************
*
*
* PROGRAM: SUB099 Author: Jeff Crosby
*
*
*
* FUNCTION: Given a date and the number of days or business days to
add, determine that *
* date.
*
*
*
* INPUT: InDate - The given date. The form is YYYYMMDD.
*
* DaysToAdd - The number of days away from that date. Can
be plus or minus. *
* DayType - "B" means add business days, anything else
means regular days. *
* LDA is not used.
*
* External indicators (switches) are not used.
*
*
*
* PROCESS: This subprogram converts the given date to *ISO. Then, if
the DayType field *
* is "B", determines the actual number of days that converts
to. Then the *
* number of days is added and the resulting *ISO date is
converted back to *
* YYYYMMDD.
*
*
*
* This routine would serve no useful purpose as a main
program *
* program.
*
*
*
* OUTPUT: OutDate - The computed date as YYYYMMDD.
*
*
*
* EXIT: When this is done. This subprogram remains in memory until
the calling *
* program goes to EOJ.
*
*
*
*- - - - - - - - - - - - - CHANGE HISTORY - - - - - - - - - - - - -
*
* Ini-
*
* Date tials Description of modifications.
*
* -------- ----- -----------------------------
*
*
*
* 07/25/96 JLC Initial write.
*
*
*
**********************************************************************************************
H/EJECT
H
D/EJECT
*
* Parameter fields
*
D Adjust S 1P 0
D DaysToAdd S 11P 0
D DayType S 1
D InDate S 8S 0
D OutDate S 8S 0
*
* Work fields
*
D ActDays S 11P 0
D ActWeeks S 7P 0
D DayNum S 1P 0
D DayNumOrg S 1P 0
D ExtraDays S 1P 0
D Sunday S D Datfmt(*ISO)
D Inz(D'1996-01-07')
D WDaysToAdd S Like(DaysToAdd)
D WrkDateISo S D Datfmt(*ISO)
D WrkDays S 11P 0
D WrkWeeks S 11P 0
C/EJECT
* Entry parameter list
C *ENTRY PLIST
C PARM InDate
C PARM DaysToAdd
C PARM DayType
C PARM OutDate
* Main processing
* Clear output date
C Eval OutDate = *Zero
* Move to *ISO field
C *ISO Move Indate WrkDateISO
* Determine what day of the week the it is (1=Monday,
* 2=Tuesday, etc.)
C Exsr GetDayOfWk
* If the input date is a Saturday or Sunday on a business day
* compute, go back to Friday
C If DayType = 'B' and
C DayNum > 5
C Eval Adjust = DayNum - 5
C Subdur Adjust:*D WrkDateISO
C Eval DayNum = 5
C Endif
* Save the original day number
C Eval DayNumOrg = DayNum
*
* Determine the actual number of days to add:
*
* If business days
C If DayType = 'B'
* Determine how many full weeks of business days there are,
* and how many extra days.
C If DaysToAdd >= *Zero
C DaysToAdd Div 5 ActWeeks
C Mvr ExtraDays
C Else
C Eval WDaysToAdd = DaysToAdd * -1
C WDaysToAdd Div 5 ActWeeks
C Mvr ExtraDays
C Eval ActWeeks = ActWeeks * -1
C Eval ExtraDays = ExtraDays * -1
C Endif
* The actual days to add is 7 days for every full
* week plus the days beyond a full week.
C Eval ActDays = (ActWeeks * 7) + ExtraDays
* If all days
C Else
C Eval ActDays = DaysToAdd
c Endif
* Add the days away to it.
C Adddur ActDays:*D WrkDateISO
* Determine what day of the week the it is (1=Monday, 2=Tuesday, etc.)
C Exsr GetDayOfWk
* On a business day add, if it came out on a weekend or crossed a weekend,
* go 2 more days whatever direction.
C If DayType = 'B'
C If DayNum > 5 or
C (DayNumOrg + Extradays) > 5 or
C (DayNumOrg + Extradays) < *Zero
C If DaysToAdd >= *Zero
C Adddur 2:*D WrkDateISO
C Else
C Subdur 2:*D WrkDateISO
C Endif
C Endif
C Endif
* Move to return field
C *ISO Move WrkDateISO OutDate
* Return
C Return
C/EJECT
*
* Determine the day of the week for the date
*
C GetDayOfWk Begsr
* Determine what day of the week the in date is (1=Monday, 2=Tuesday,
etc.)
C WrkDateISO Subdur Sunday WrkDays:*D
C WrkDays Div 7 WrkWeeks
C Mvr DayNum
C If DayNum < 1
C Eval DayNum = DayNum + 7
C Endif
C Endsr
--
-Jeff
The opinions expressed are my own and not necessarily
the opinion of my company. Unless I say so.
+---
| This is the Midrange System Mailing List!
| To submit a new message, send your mail to MIDRANGE-L@midrange.com.
| To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com.
| To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---
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.
