|
|
 |
|
|
|
|
 |
|
|
|
This image is a "part" in Visual Age RPG and is available to use in client/server Windows applications. The following
code is unrelated to this image however I felt there was reason to show what is currently available to us RPG programmers.
|
|
|
|
Here's what I did to get the last previous Friday to any date:
.....
D LastFriday s d DatFmt(*iso)
D DateTest s d DatFmt(*iso) INZ(D'1999-01-02')
D DateAnyDay s d DatFmt(*iso)
* Get the last Friday from any given date:
* (Please be satisfied that the INZ date above is
* earlier than any date you anticipate processing.)
C DateAnyDay SubDur DateTest Tmp7:*D 7 0
C Tmp7 Div 7 Tmp7
C mvr Tmp7
C Eval Tmp7=tmp7+1
C DateAnyDay SubDur Tmp7:*D LastFriday
I suppose you can do this for any day of the week just by
changing the Tmp7=tmp7+? to a number that works?
|
A way to figure day-of-week
*********************************************************************
* Description: *
* This is an example project to show VRPG and to show an easy way *
* to find the day-of-week for today, whatever today is. Obviously *
* one could easily adapt this for any date, and for the Original *
* Program Model RPG. I'm aware that RPGLE has easier ways. *
* It works from 1901 through 2099; 1900 & 2100 aren't leap years. *
* (Note that this program is shown in RPGLE, but it is easily *
* coded in RPG too.) *
* Booth Martin, 1997, Booth@MartinVT.com *
* *
*********************************************************************
* Compile-time array: AL = days to first of a month, not leap year:
* Compile-time array: AR = days to first of a month, leap year:
* Compile-time array: ARD = DAYS of the week(The field we want).
DAL S 3S 0 DIM(12) PERRCD(12) CTDATA
DAR S 3S 0 DIM(12) PERRCD(12) CTDATA
DARD S 9A DIM(7) PERRCD(7) CTDATA
* .................................................................
* (EXIT pushbutton was pressed)
C PSB0000D BEGACT PRESS FRA0000B
C MOVE *ON *INLR
C ENDACT
* .................................................................
* (Initialization of ENTRY box)
C ENT0000E BEGACT CREATE FRA0000B
* .............
* Step 1: find the # of days through the end of last year:
C *YEAR SUB 1 LASTY 4 0
C LASTY MULT 365.25 DAYS 7 0
* .............
* Step 2: add the days so far this year:
* Is it Leap year? (TESTLY if = 0, then its leap year.)
C *YEAR MULT 25 TESTLY 2 0
* Days so far this year, to the first of this month:
C Z-ADD UMONTH I 2 0
C TESTLY IFNE *ZEROS
C ADD AR(I) DAYS
C ELSE
C ADD AL(I) DAYS
C END
* Then, add in the days so far this month:
C ADD UDAY DAYS
* .............
* Step 3: Now we have the total number of days since 01/01/0001.
* By removing all full weeks since 01/01/0001 we will have
* established today's "offset" from 01/01/0001. That
* "offset" is the remainder, and is useful as an array index.
C DAYS DIV 7 DAYS
C MVR I
* .............
* Step 4: Logically the remainder can only be 0 - 6.
* But 0 is a lousy index so by adding 1 we assure
* that the index will be 1-7, and therefore useful.
C ADD 1 I
* .............
* Step 5: Now, with the index, look up the day of the week.
C MOVE ARD(I) TODAY 9
* A frequently asked question is "Hey, how did you know what day
* to start with in the ARD array?" Simple. The first time I
* did this I started it with Sunday. It was off by one day so I
* started the array with Monday instead; then I was off by two
* days. But Saturday worked fine.
* .................................................................
* Step 6: fill the display window fields:
C 'ENT0000E' SETATR TODAY 'text'
C MOVE *DATE fieldf 10
C 'ENT0000F' SETATR fieldf 'text'
* .................................................................
C ENDACT
*
** FebMarAprMayJunJulAugSepOctNovDec (AR days, not leap year)
000031059090120151181212243273304334
** (AL days, leap year.
000031060091121152182213244274305335
** DAYS of the week: (becomes "TODAY") (ARD Day-of-week)
Saturday Sunday Monday Tuesday WednesdayThursday Friday
|
This program uses RPGILE to find the number of days since a known Friday, and then removes the full weeks, leaving an offset that we can use to add to today to give us the next Friday from today, whatever today is.
An ILE program to retrieve next Friday:
************ Beginning of data ******************************************
* PROGRAM TO figure out next friday, whatever "next friday" might be, *
* from today, or if the parm is filled in, from the date in the parm. *
* The program is called and is useful for due-dates, payroll reports, *
* or any other case of needing to know the end of the week for any day.*
* *
* *
* DATE PROGRAMMER ACTION *
* 5/97 BOOTH MARTIN *
* *
hdatfmt(*mdy)
D DateIn s d DATFMT(*ISO)
D Inz(*sys)
D DateTest s d DATFMT(*ISO)
D Inz(d'05/02/97')
* Actually, the date returned to the calling program will be the next
* same-day-of-the-week as the INZ value. Use any valid date in this field.
* Since I've used a Fridy, it'll return a Friday. For the next Thursday
* you'd use any Thursday in the INZ field, for example, '05/01/97'.
C* _________________________________________________________________________
C* Note: If PARM coming in is *zeros, then next Friday from today is wanted.
C *ENTRY PLIST
C PARM Date 6 0
C* _________________________________________________________________________
C* If the PARM coming in is zeros then we'll use the initialized *SYS date.
C* Otherwise we will test the validity of the date. If not valid we'll also
C* use the *SYS date; otherwise we'll use the PARM date.
C* _________________________________________________________________________
C Date IfNE *Zeros
C *mdy test(d) Date 99
C *in99 IfEQ *Off
C *mdy MOVE Date DateIn
C End
C End
C*
C DateIn subdur DateTest days:*d 7 0
C days div 7 days
C mvr indx 1 0
C 7 sub indx indx
C adddur indx:*d DateIn
C *mdy move DateIn Date
C return
*********************************************************
|
|
| |
