|
Joel, this code subtract EDATE from #SYSDT and result is send to DYSLFT. Then you can subtract 7 from DYSLFT to achieve 7 days before today's date. Create an source file for RPGLE, add the attached as a member and compile it to use in your RPG/400 program. C MOVEL #TODAY #SYSDT C CALL 'SUBDAT' C PARM RTNCDE C PARM #SYSDT STRDAT C PARM STRFMT C PARM EDATE ENDDAT C PARM ENDFMT C DYSLFT PARM DURATN C PARM DURFMT C C DYSLFT SUB 7 DYSLFT ----- Original Message ----- From: "Joel Kahsay" <jkahsay@hotmail.com> To: <oludare@ix.netcom.com> Sent: Wednesday, April 19, 2000 9:59 AM Subject: Re: Date calculation in rpg > Hi dare and thank you > > I have RPG/400 can you show me an example? > > Joel > > > ______________________________________________________ > Get Your Private, Free Email at http://www.hotmail.com >
midrange.com
0010 H datfmt(*ISO)
0020 D dtStart S D
0030 D dtEnd S D
0040 D nDays S 7P 0
** ERROR return codes
0050 D BADSTRDTE C Const(201)
0060 D BADSTRFMT C Const(202)
0070 D BADENDDTE C Const(203)
0080 D BADENDFMT C Const(204)
0090 D BADDURFMT C Const(205)
0100 D NODATEDUR C Const(206)
0110 D rtnCode S 7P 0
0120 D StartDate S 7P 0
0130 D StartFmt S 10A
0140 D EndDate S 7P 0
0150 D endFmt S 10A
0160 D nDur S 7P 0
0170 D durFmt S 10A
0180 C *ENTRY PList
0190 C Parm rtnCode
0200 C Parm StartDate
0210 C Parm startFmt
0220 C Parm EndDate
0230 C Parm endFmt
0240 C Parm nDur
0250 C Parm durFmt
0260 C Select
0270 C When startFmt = '*MDY'
0280 C *MDY TEST(D) startDate 73
0290 C n73*MDY Move startDate dtStart
0300 C When startFmt = '*YMD'
0310 C *YMD TEST(D) startDate 73
0320 C n73*YMD Move startDate dtStart
0330 C When startFmt = '*DMY'
0340 C *DMY TEST(D) startDate 73
0350 C N73*DMY Move startDate dtStart
0360 C When startFmt = '*JUL'
0370 C *JUL TEST(D) startDate 73
0380 C n73*JUL Move startDate dtStart
0390 C When startFmt = '*CYMD'
0400 C *CYMD TEST(D) startDate 73
0410 C n73*CYMD Move startDate dtStart
0420 C other
0430 C eval rtncode = BADSTRFMT
0440 C return
0450 C endSL
0460 C If *IN73
0470 C eval rtncode = BADSTRDTE
0480 C return
0490 C endif
0500 C if endFmt = *BLANKS
0510 C eval endFmt = startFmt
0520 C endIf
0530 C Select
0540 C When endFmt = '*MDY'
0550 C *MDY TEST(D) endDate 73
0560 C n73*MDY Move endDate dtEnd
0570 C When endFmt = '*YMD'
0580 C *YMD TEST(D) endDate 73
0590 C n73*YMD Move endDate dtEnd
0600 C When endFmt = '*DMY'
0610 C *DMY TEST(D) endDate 73
0620 C n73*DMY Move endDate dtEnd
0630 C When endFmt = '*JUL'
0640 C *JUL TEST(D) endDate 73
0650 C n73*JUL Move endDate dtEnd
0660 C When endFmt = '*CYMD'
0670 C *CYMD TEST(D) endDate 73
0680 C n73*CYMD Move endDate dtEnd
0690 C other
0700 C eval rtncode = BADENDFMT
0710 C endSL
0720 C If *IN73
0730 C eval rtncode = BADENDDTE
0740 C return
0750 C endif
0760 C Select
0770 C When durFmt = '*DAYS' or
0780 C durFmt = '*D' or durFmt = '*DAY'
0790 C dtEnd SubDur dtStart nDur:*DAYS
0800 C When durFmt = '*MONTHS' or
0810 C durFmt = '*M' or durFmt = '*MONTH'
0820 C dtEnd SubDur dtStart nDur:*MONTHS
0830 C When durFmt = '*YEARS' or
0840 C durFmt = '*Y' or durFmt = '*YEAR'
0850 C dtEnd SubDur dtStart nDur:*YEARS
0860 C When durFmt = '*WEEKS' or
0870 C durFmt = '*W' or durFmt = '*WEEK'
0880 C dtEnd SubDur dtStart nDays:*DAYS
0890 C nDays Div 7 nDur
0900 C other
0910 C eval rtncode = BADDURFMT
0920 C endSL
0930 C MOVE *ON *INLR
0940 C return
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.
