|
midrange.com
On Thu, 7 Dec 2000 Troy.C.Dills@blum.com wrote:
> Hi all,
> would anyone be willing share a subprocedure or lead me in the
> direction of writing a subprocedure which takes a date and parameters
> passed (if any), tests it for a valid date, with the ability to add
> days and depending upon the parameters sent (parm of days in my case),
> use the business days (in other words I don't want to use Saturday or
> Sunday as a valid date, use Mondays date if it falls on the weekend),
> for a new valid business day date. I'm new to programming with ILE and
> any information would be greatly appreciated. I read Brad Stones
> article on ILE in iSeries 400 Expert Journal and it helped me
> understand the concepts alot but I have a long way to go for
> understanding ILE it completely (and yes Brad if you get this message
> I am sucking up in case you have any input). If this is not enough
> information please let me know and I will be more specific as to what
> I will be using it for.
>
> Thanks
> Troy
>
Hi Troy,
Some of the things you're asking for could be interpreted in more than
one way. However, I've whipped up a 5-minute example of what I THINK
you're asking for... if its not exactly what you want, maybe
it'll give you enough information to get your own routine to work. :)
Here's my example code:
D DateCvt PR 10I 0
D iso_date 8P 0 value
D result D
D daystoadd 5I 0 value options(*nopass)
D nextbusday 1A const options(*nopass)
D new_date S D
D Msg S 50A
D char_date S 10A
C* This stuff is examples of using the DateCvt proc
C* (and also tests my code)
C* Basic validity checking
c if DateCvt(20000930: new_date) < 0
c eval Msg = 'Hey, whats wrong with Sept 30?'
c dsply Msg
c endif
c if DateCvt(20000931: new_date) < 0
c eval Msg = 'There are only 30 days in Sept!'
c dsply Msg
c endif
C* This just adds 3 days to Jan 17, doesn't look for
C* Sat/Sun dates at all:
c if DateCvt(20010117: new_date: 3) < 0
c eval Msg = 'Hey, whats wrong with Jan 17?'
c dsply Msg
c endif
c *ISO move new_date char_date
c eval Msg = 'Date should be Jan 20: ' +
c char_date
c dsply Msg
C* Since Jan 20th is a saturday, this should make it Jan 22nd:
c if DateCvt(20010117: new_date: 3: 'Y') < 0
c eval Msg = 'Hey, whats wrong with Jan 17?'
c dsply Msg
c endif
c *ISO move new_date char_date
c eval Msg = 'Date should be Jan 22: ' +
c char_date
c dsply Msg
c eval *inlr = *on
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* DateCvt: Converts an ISO (yyymmdd) date to a date-type
* field if the date is valid. Can optionally add
* some days to the date, and optionally push
* saturdays and sundays forward to a monday.
*
* Required Parms:
* iso_date = date in ISO (yyyymmdd) format that this
* procedure is to accept as input.
* result = date-type field returned.
*
* Optional Parms:
* daystoadd = number of days that should be added to
* the result after being converted to a date field.
* nextbusday = if set to 'Y', this routine will find
* the next monday date, if the result would've
* otherwise been a saturday or sunday.
*
* Return Value:
* Returns -1 if the date is not valid
* Returns 0 upon success.
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P DateCvt B EXPORT
D DateCvt PI 10I 0
D iso_date 8P 0 value
D result D
D daystoadd 5I 0 value options(*nopass)
D nextbusday 1A const options(*nopass)
D SomeSunday S D inz(d'2000-12-03')
D Diff S 10I 0
D DayOfWeek S 5I 0
C* test date for validity:
c *ISO test(D) iso_date 99
c if *in99=*On
c return -1
c endif
C* move the valid date to the result:
c *ISO move iso_date result
C* if desired, add some days:
c if %parms > 2
c adddur daystoadd:*D result
c endif
C* if desired, check for a sat or sunday, and push the date
C* forward to monday...
c if %parms > 3 and nextbusday = 'Y'
c result subdur SomeSunday diff:*D
c diff div 7 diff
c mvr dayofweek
c if dayofweek = 0
c adddur 1:*D result
c endif
c if dayofweek = 6
c adddur 2:*D result
c endif
c endif
C* return success:
c return 0
P E
+---
| This is the RPG/400 Mailing List!
| To submit a new message, send your mail to RPG400-L@midrange.com.
| To subscribe to this list send email to RPG400-L-SUB@midrange.com.
| To unsubscribe from this list send email to RPG400-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-2025 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.
