Several users submitted code to help IBLearning determine the future end of month based on any given date.
Here are three code examples that they sent in.
Option 1
---------------------------------------------------------------------------------------------------------------------------------------------
* Determine Last Day of Month
D DateIn S D DATFMT(*MDY)
D DS
D DateEnd D DATFMT(*ISO)
D DateDay 2 OVERLAY(DateEnd:9)
C*
* Pass in Date Parameter (format is mmddyy)
C*
C *ENTRY PLIST
C PARM BDX 6
C*
* Calculate Number of Days in Month
C*
C MOVE BDX DATE6 6 0
C *MDY MOVE DATE6 DateIn
*
C DateIn ADDDUR 1:*M DateEnd
C EVAL DateDay = '01'
* DateEnd = End of Current Month
C SUBDUR 1:*D DateEnd
* DateEnd = End of Next Month
C ADDDUR 1*M DateEnd
Option 2
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++
DTESTDATE S D
D WRKDATE S 6
D DOM S 2 0
CL0N01Factor1+++++++Opcode&ExtFactor2+++++++Result++++++++Len++D+HiLoEq
C *MDY0 MOVE WRKDATE TESTDATE
C EXTRCT TESTDATE:*D DOM
C EVAL DOM = (DOM - 1)
C SUBDUR DOM:*DAYS TESTDATE
C ADDDUR 2:*MONTHS TESTDATE
C SUBDUR 1:*DAYS TESTDATE
WRKDATE will be the date the user will enter in and should be a valid date in MMDDYY format.
EX. WRKDATE = 102504 (MMDDYY)
Move WRKDATE into date field TESTDATE.
EX. TESTDATE = 102504 (MMDDYY)
EXTRCT - will put the days of the month into DOM.
EX. DOM = 25
Subtract one day from DOM.
EX. DOM = 24
SUBDUR - subtracts the number of days from TESTDATE. This will give you the first of the month.
EX. TESTDATE = 100104 (MMDDYY)
ADDDUR - will add 2 months to testdate. Now you have the first of the month two months ahead.
EX. TESTDATE = 120104 (MMDDYY)
SUBDUR - will sub 1 day from TESTDATE and you have now have the the last day of the month.
EX TESTDATE = 113004 (MMDDYY)
So now TESTDATE will have Nov. 30 2004, which is the end of the month.
Since TESTDATE is a date field and using SUBDUR, ADDDUR this will handle leap years.
Option 3
Here's an old CL one user says he uses to solve this question.
PGM PARM(&DATE &RTNDATE)
DCL VAR(&DATE) TYPE(*CHAR) LEN(8)
DCL VAR(&RTNDATE) TYPE(*CHAR) LEN(8)
DCL VAR(&DAY_C) TYPE(*CHAR) LEN(2)
DCL VAR(&MONTH_C) TYPE(*CHAR) LEN(2)
DCL VAR(&YEAR_C) TYPE(*CHAR) LEN(4)
DCL VAR(&DAY_N) TYPE(*DEC) LEN(2 0)
DCL VAR(&MONTH_N) TYPE(*DEC) LEN(2 0)
DCL VAR(&YEAR_N) TYPE(*DEC) LEN(4 0)
DCL VAR(&DATJUL) TYPE(*CHAR) LEN(5)
CVTDAT DATE(&DATE) TOVAR(&DATJUL) FROMFMT(*YYMD) +
TOFMT(*JUL) TOSEP(*NONE)
MONMSG MSGID(CPF0000) EXEC(DO)
SNDPGMMSG MSG('Format de date incorrect.')
GOTO CMDLBL(FIN)
ENDDO
CHGVAR VAR(&MONTH_N) VALUE(%SST(&DATE 5 2))
CHGVAR VAR(&YEAR_N) VALUE(%SST(&DATE 1 4))
CHGVAR VAR(&MONTH_N) VALUE(&MONTH_N + 1)
IF COND(&MONTH_N = 13) THEN(DO)
CHGVAR VAR(&MONTH_N) VALUE(1)
CHGVAR VAR(&YEAR_N) VALUE(&YEAR_N + 1)
ENDDO
CHGVAR VAR(&MONTH_C) VALUE(&MONTH_N)
CHGVAR VAR(&YEAR_C) VALUE(&YEAR_N)
CHGVAR VAR(&DAY_N) VALUE(31)
CHECK: CHGVAR VAR(&DAY_C) VALUE(&DAY_N)
CHGVAR VAR(&RTNDATE) VALUE(&YEAR_C *TCAT &MONTH_C +
*TCAT &DAY_C)
CVTDAT DATE(&RTNDATE) TOVAR(&DATJUL) +
FROMFMT(*YYMD) TOFMT(*JUL) TOSEP(*NONE)
MONMSG MSGID(CPF0555) EXEC(DO)
CHGVAR VAR(&DAY_N) VALUE(&DAY_N - 1)
GOTO CMDLBL(CHECK)
ENDDO
SNDPGMMSG MSG(&DATE *CAT ' ' *CAT ' = ' *CAT &RTNDATE)
FIN: ENDPGM
Option 4
Here is code that takes advantage of the fact when you add months to a date such as 2005-01-31, the result will always be the last day of the month. Basically, the code is seeded with January 31 and whole months are then added to get the result.
Duserin s 10 inz('1999-12-15')
Ddate s d
Dmonth s 2 0
Dyear s 4 0
/free
date=%date(userin) + %months(1);
month=%subdt(date:*months);
year=%subdt(date:*years);
date=%date(%char(year) + '-01-31') + %months(month-1);
/end-free
