*********************************************************************
* 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@ibm.net *
* 802-476-7942 *
*********************************************************************
* 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
|
************ 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
*********************************************************
|