Pages

Wednesday, March 22, 2017

Determine the end of month using CL

get end of month date only using cl

The idea for this post came from several people who asked me the same question: "How to find the date of the end of the month? only using CL". When I quizzed them they explained that this was asked during an interview. If anyone asks me for help I always ask them how they would do it, and they all had pretty much the same solution, but struggled with how to determine if February should have 28 or 29 days. They asked how I would have done it. I came up with two solutions that I will share here.

The first version is very similar to what they can come up with. In this example the date is in *DMY format.

01  PGM

02  DCL VAR(&QDATE) TYPE(*CHAR) LEN(6)
03  DCL VAR(&MONTH) TYPE(*CHAR) LEN(2)
04  DCL VAR(&MONTHEND) TYPE(*CHAR) LEN(8)

05  RTVSYSVAL SYSVAL(QDATE) RTNVAR(&QDATE)
06  CHGVAR VAR(&MONTH) VALUE(%SST(&QDATE 3 2))

07  SELECT
08    WHEN COND((&MONTH = '01') +
              *OR (&MONTH = '03') +
              *OR (&MONTH = '05') +
              *OR (&MONTH = '07') +
              *OR (&MONTH = '08') +
              *OR (&MONTH = '10') +
              *OR (&MONTH = '12')) +
09           THEN(CHGVAR VAR(%SST(&QDATE 1 2)) VALUE('31'))

10    WHEN COND((&MONTH = '04') +
              *OR (&MONTH = '06') +
              *OR (&MONTH = '09') +
              *OR (&MONTH = '11')) +
11           THEN(CHGVAR VAR(%SST(&QDATE 1 2)) VALUE('30'))

12    OTHERWISE  CMD(DO)
13      CHGVAR VAR(%SST(&QDATE 1 2)) VALUE('29')
14      CVTDAT DATE(&QDATE) TOVAR(&QDATE) TOSEP(*NONE)
15      MONMSG MSGID(CPF0000) +
                 EXEC(CHGVAR VAR(%SST(&QDATE 1 2)) +
                               VALUE('28'))
16    ENDDO
17  ENDSELECT

18  CVTDAT DATE(&QDATE) TOVAR(&MONTHEND) TOFMT(*YYMD) +
             TOSEP(*NONE)

19  ENDPGM

Line 5: I retrieve the current date from the system value QDATE.

Line 6: I substring the month number from the current date using the substring built in function, %SST.

Line 7: Rather than use multiple if statements I can use a select command to make the code more readable.

Lines 8 and 9: For those months with 31 days I change the first two positions of the date field with 31.

Lines 10 and 11: The same goes for the months with 30 days.

Line 12: What about February? This is the part the questioners could not come up with an easy solution for.

Line 13: I change the day number to 29.

Line 14: I can use Convert Date command, CVTDAT, to validate 29th February. I use the same variable for the from and to date parameters, DATE and TOVAR, and I do not want any date separator characters in the to date, TOSEP(*NONE).

Line 15: If 29th February 2017 is not a valid date, which it is not, then the CVTDAT would error. This Monitor Message command, MONMSG, "catches" the error, and changes the day number to 28.

Line 18: I have added this as I would like the final date to be YYYYMMDD rather than DDMMYY, as you cannot sort dates if they are in *DMY. The to format has to be *YYMMD as *ISO inserts date separators whether I want them or not.

If I had been asked to do this in RPG I would use an embedded SQL statement:

  dcl-s MonthEnd date ;

  exec sql SET :MonthEnd = LAST_DAY(CURRENT_DATE) ;

So how could I put that into a CL program?

Those of you who are regular readers of this site know that I like the Run SQL command, RUNSQL, in CL. Alas, RUNSQL does not support all the types of SQL statements that RPG does, for example the SET I used in my RPG example is not supported by the RUNSQL command.

After some attempts I came up with the following:

01  PGM

02  DCLF FILE(QTEMP/WORKFILE)

03  DLTF FILE(QTEMP/WORKFILE)
04  MONMSG MSGID(CPF0000)

05  RUNSQL SQL('CREATE TABLE QTEMP.WORKFILE +
06              (MONTHEND) +
07              AS (SELECT LAST_DAY(CURRENT_DATE) +
08                    FROM SYSIBM.SYSDUMMY1) +
09              WITH DATA') +
10           COMMIT(*NC)

11  RCVF

12  CVTDAT DATE(&MONTHEND) TOVAR(&MONTHEND) +
             FROMFMT(*ISO) TOFMT(*YYMD) TOSEP(*NONE)

13  ENDPGM

Line 2: I am declaring a file. As this is a work file it will exist in QTEMP, where all work files should.

Line 3: If the file already exists, delete it. I could have used DROP TABLE in a RUNSQL statement, but wanted to show that the Delete file command, DLTF, deletes SQL created tables as well as DDS files.

Line 4: If the file does not exist I do not want the program to error, hence the Monitor Message command.

Lines 5 – 10: This may look complicated, but it is not. I am going to create a table on the fly. The new table will be created in QTEMP, line 5, with one field called MONTHEND, line 6. Into this table I am inserting a value from another table/file, lines 7 and 8. I am using the LAST_DAY function, as I did in my RPG example, to get the last day of today's month. SYSIBM.SYSDUMMY1 is, as its name suggests a dummy. It does exist, and it is used like this as good SQL practice to show that whatever is selected is not from this table/file. WITH DATA, line 9, indicates that data from the select is inserted into the new table.

Line 11: Now I have the end of the current month in my work table I need to read the table. The Receive File command, RCVF, does that. As only one file is defined within the program I do not have to give the file or record format name. As I know there is going to be a row/record within the table I am not checking to see if end of file is encountered when I do this.

Line 12: As I did in the other example CL program I am converting the date to *YYMMDD. The value retrieved from the table is in *ISO format, therefore, I do have to give that in the FROMFMT parameter of the command.

Personally I like the second example better than the first. If I was on the interview and was challenged that this approach is not strictly CL I would argue that the RUNSQL is part of CL and this approach is valid.

Before I get messages from people telling me that helping people with interview questions is "cheating", in my opinion it is not as this is a learning experience for those who did not know how to do this.

 

You can learn more about this from the IBM website:

 

This article was written for IBM i 7.3, and should work for earlier releases too.


Addendum

Thank you to everyone how has posted their suggestions in the comments, below. One I really liked was the one made by Ringer, counting down from 31 to 28 and using the CVTDAT to validate if the date is good, see here. He did not give example code so I thought I would show my interpretation:

01  PGM

02  DCL VAR(&QDATE) TYPE(*CHAR) LEN(6)
03  DCL VAR(&MONTHEND) TYPE(*CHAR) LEN(8)

04  RTVSYSVAL SYSVAL(QDATE) RTNVAR(&QDATE) /* Date in DMY */

05  CHGVAR VAR(%SST(&QDATE 1 2)) VALUE('31')
06  CVTDAT DATE(&QDATE) TOVAR(&QDATE) TOSEP(*NONE)
07  MONMSG MSGID(CPF0555) EXEC(DO)
08    CHGVAR VAR(%SST(&QDATE 1 2)) VALUE('30')
09    CVTDAT DATE(&QDATE) TOVAR(&QDATE) TOSEP(*NONE)
10    MONMSG MSGID(CPF0555) EXEC(DO)
11      CHGVAR VAR(%SST(&QDATE 1 2)) VALUE('29')
12      CVTDAT DATE(&QDATE) TOVAR(&QDATE) TOSEP(*NONE)
13      MONMSG MSGID(CPF0555) EXEC(DO)
14        CHGVAR VAR(%SST(&QDATE 1 2)) VALUE('28')
15      ENDDO
16    ENDDO
17  ENDDO

18  CVTDAT DATE(&QDATE) TOVAR(&MONTHEND) TOFMT(*YYMD) +
             TOSEP(*NONE)

19  ENDPGM

Remember that in this example the system date format is *DMY.

Line 5: Change the day's part of the date to 31.

Line 6: Validate the date using the CVTDAT command. I do not have to give the From and To date formats as I am just using the default, *JOB, but I do not want date separators inserted into the To date.

Line 7: Message CPF0555 only happens if the date is invalid. If the date is valid the logic goes down to line 17.

Lines 8 – 10: As the date using 31 was not valid let me try with 30.

Lines 11 – 13: The only month that will reach here is February. Now to determine if this is a leap year using 29 as the day of the month.

Line 14: If all the above has failed then this month has to February and it is not a leap year, therefore, the end of the month is the 28th.

38 comments:

  1. I saw something like this: use day 31 and CVTDAT. If error, sub 1 to day and CVTDAT... Repeat until no error.

    Obviously not the best approach :)

    ReplyDelete
  2. I was going to suggest: start at today's date, convert to Julian, and loop with adding 1 until error. I like the solution by Anonymous (try 31, 30, 29, 28).

    ReplyDelete
  3. create field with 1st day of next month in CL,
    convert to julian to substract 1 day
    and convert back

    ReplyDelete
  4. create field with 1st day of next month,
    convert to julian to subtract 1 day,
    and convert back

    ReplyDelete
    Replies
    1. Succinct & clever. Thanks.

      Delete
    2. i did something similar using lillian dates where date addition works better than using julian. (i used julian dates and subtracted a number of days from the julian day, wound up with an error because it was the beginning of the year...)

      Delete
  5. PGM (&MONTH &YEAR &LSTDAY)
    DCL &MONTH *DEC (2 0)
    DCL &YEAR *DEC (4 0)
    DCL &LSTDAY *DEC (2 0)
    DCL &VECTOR *CHAR 24 ('31283130313031330313031')
    DCL &DELTA *DEC (2 0) (0)
    DCL &R *DEC (4 0)
    CHGVAR &R (&YEAR / 4)
    CHGVAR &R (&R * 4)
    CHGVAR &R (&YEAR -&R)
    IF ((&R *EQ 0) *AND (&MONTH *EQ 2)) THEN(CHGVAR &DELTA 1 )
    CHGVAR &R ( ((&MONTH -1) *2)+1)
    CHGVAR &LSTDAY %SST(&VECTOR &R 2)
    CHGVAR &LSTDAY (&LSTDAY + &DELTA)
    ENDPGM

    How does it work?
    Well February has a day extra in leap years (Leap years are every 4 years ) so we calc the remainder (by means of dividing into a no dec position result, multiplying it back and substracting the original value) of year / 4 if it is zero, then it is a leap year.If it is a leap year and month is two we set a delta value to 1 -default zero-. Now we use a string as a vector we translate the vector index (the month) to a position multiplying the position by the lenght of the entry (2) and use sub string to pick the two chars that contains the last day of month for this month and we add the delta, and ta da!!!! I think it can not be done shorter ...

    ReplyDelete
    Replies
    1. Whenever you divide the year by 4, you also must divide it by 100 and 400. Years divisible by 4 are not leap years if they are divisible by 100 but not by 400. 2000 was a leap year, 2100 is not. Let's call it our Y2.1K problem.

      Delete
    2. Your solution is pure CL and you would have met the requirement had you remembered tbe leap year rule that Bruce reminded us of.

      Delete
    3. I judged those rules not relevant, but alas, here is a revised version?

      PGM (&MONTH &YEAR &LSTDAY)
      DCL &MONTH *DEC (2 0)
      DCL &YEAR *DEC (4 0)
      DCL &LSTDAY *DEC (2 0)
      DCL &VECTOR *CHAR 24 ('31283130313031330313031')
      DCL &DELTA *DEC (2 0) (1)
      DCL &D4 *DEC (4 0)
      DCL &D100 *DEC (4 0)
      DCL &D400 *DEC (4 0)
      CHGVAR &D4 (&YEAR / 4)
      CHGVAR &D4 ((&D4 * 4) - &YEAR)
      CHGVAR &D100 (&YEAR / 100)
      CHGVAR &D100 ((&D100 * 100) - &YEAR)
      CHGVAR &D400 (&YEAR / 400)
      CHGVAR &D400 ((&D400 * 400) - &YEAR)
      IF (&D4 *NE 0) THEN(CHGVAR &DELTA 0)
      IF (&D4 *NE 0) THEN(CHGVAR &DELTA 0)
      ELSE IF (&D100 *NE 0) THEN(CHGVAR &DELTA 1)
      ELSE IF (&D400 *NE 0) THEN(CHGVAR &DELTA 0)
      CHGVAR &D4 ( ((&MONTH -1) *2)+1)
      CHGVAR &LSTDAY %SST(&VECTOR &D4 2)
      CHGVAR &LSTDAY (&LSTDAY + &DELTA)
      ENDPGM

      Delete
  6. Or, if you already have a procedure in a service program that does just that, you can call that procedure in from CL-program.

    /* */
    /* dcl-pr getCurrentMonthsLastDate char(8); */
    /* end-pr; */
    /* */
    /* CRTCLMOD MODULE(myLib/TEST) */
    /* SRCFILE(myLib/QCLSRC) */
    /* SRCMBR(TEST) */
    /* REPLACE(*NO) */
    /* DBGVIEW(*SOURCE) */
    /* */
    /* CRTPGM PGM(myLib/TEST) */
    /* BNDDIR(WMS) */

    PGM

    DCL VAR(&endOfMonth) TYPE(*char) LEN(8)

    CALLPRC PRC(getCurrentMonthsLastDate) RTNVAL(&endOfMonth)

    ENDPGM
    Kind regards
    Jan

    ReplyDelete
  7. I too like the CVTDAT idea from 31 days down to 28. My first thought was that using the CEEDAYS API would be faster but I tested it and it's roughly about 50% (Feb 2017 28 days) to 400% slower (March 2017 31 days) than CVTDAT in this case.

    Ringer

    ReplyDelete
  8. An alternative SQL statement that eliminates the need for the SYSDUMMY1 table is:

    CREATE TABLE QTEMP.WORKFILE (MONTHEND) AS (VALUES LAST_DAY(CURRENT_DATE)) WITH DATA

    ReplyDelete
    Replies
    1. I'd not create a table but a view.

      Delete
    2. What table would you create the view over?

      Delete
    3. Oh, over the system 'dummy'?

      Delete
    4. If you are adverse to using sysdumm1 you could:

      create view lastday as
      select last_day(current_date) lastdays from (values(1)) f

      Delete
    5. I don't think I have ever seen a values-clause used before, I had to look it up. When I created the view the base table was qsys2.qsqptab.

      Delete
    6. I tried creating a view, but when the RCVF was executed, it had an error of CPF4278-Query definition template 0 not valid. When I created a table, then it worked.

      Delete
  9. Now imagine if the RUNSQL command supported host variables. But that's another topic for another day.

    ReplyDelete
    Replies
    1. I wish the RUNSQL command did. :(

      It would have made this scenario a lot simpler.

      Delete
    2. Me too. That would be an incredible addition to CL. Wow, I can think of so many places I could have used that in the past.

      Delete
  10. It works at v7r1:
    "This article was written for IBM i 7.3, and should work for earlier releases too"

    ReplyDelete
    Replies
    1. Thank you for letting me know.

      Sometimes it is hard to know what will and will not work on earlier releases as there have been so many enhancements to 7.1 and 7.2 via the TRs.

      Delete
  11. I haven't done CL in quite a while so I apologize if there's a better way nowadays. I would handle problems like that by creating a fake array to store all the last month days "31283130..." then substring out the appropriate value based on the month that you need a value for. Check if you're in a leap year for February with the modulus trick (YYYY mod 4) if there is no remainder it’s a leap year.

    Well, it looks like sanotto beat me to this solution!

    ReplyDelete
  12. Here is another code example of Ringer's solution:
    PGM
    DCL VAR(&QDATE) TYPE(*CHAR) LEN(6)
    DCL VAR(&DAY) TYPE(*INT)
    DCL VAR(&MONTHEND) TYPE(*CHAR) LEN(8)

    RTVSYSVAL SYSVAL(QDATE) RTNVAR(&QDATE) /* Date in MDY */

    DOFOR VAR(&DAY) FROM(31) TO(28) BY(-1)
    CHGVAR VAR(%SST(&QDATE 3 2)) VALUE(&DAY)
    CVTDAT DATE(&QDATE) TOVAR(&QDATE) TOSEP(*NONE)
    MONMSG MSGID(CPF0555) EXEC(ITERATE)
    LEAVE
    ENDDO

    CVTDAT DATE(&QDATE) TOVAR(&MONTHEND) TOFMT(*YYMD) +
    TOSEP(*NONE)
    ENDPGM

    I like the RUNSQL version that Simon came up with because it can be used to solve other date problems in CL, for example doing date math (somedate - x days).

    ReplyDelete
  13. If the exercise was to use pure CL, then you met the requirements except for, perhaps' the use of the CVTDAT routine. If one is permitted to use routines then one could call the cee date functions from CL. Basically take the first of the current month and add one month then subtract one day.

    ReplyDelete
  14. It was not my idea but rather Anonymous'. I was just testing the speed of CVTDAT vs CEEDAYS which I got backwards (wrong!). The CEEDAYS API is faster.

    DCL VAR(&QDate6) TYPE(*CHAR) LEN(6)
    DCL VAR(&GoodDate8) TYPE(*CHAR) LEN(8)
    DCL VAR(&Lilian) TYPE(*INT ) LEN(4)
    DCL VAR(&DayMax) TYPE(*Int ) LEN(4)
    DCL VAR(&Day ) TYPE(*Int ) LEN(4)
    DCL VAR(&DayA ) TYPE(*CHAR) LEN(2)

    RTVSYSVAL SYSVAL(QDATE) RTNVAR(&QDate6)
    CVTDAT DATE(&QDate6) TOVAR(&GoodDate8) FROMFMT(*SYSVAL) +
    TOFMT(*YYMD) TOSEP(*NONE)
    /* 31 or 31 days */
    ChgVar Var(&DayMax) Value(31)
    /* February is 29 or 28 days */
    If ( %SST(&GoodDate8 5 2) = '02' ) Then(Do)
    ChgVar Var(&DayMax) Value(29)
    EndDo

    DoFor Var(&Day) From(&DayMax) TO(28) BY(-1)
    ChgVar Var(&DayA ) Value(&Day)
    ChgVar Var(&GoodDate8) Value(%SST(&GoodDate8 1 6) *CAT &DayA)
    CALLPRC PRC(CEEDAYS) PARM(&GoodDate8 'YYYYMMDD' &Lilian *OMIT)
    MONMSG MSGID(CEE2508) Exec(Do)
    Iterate
    EndDo
    Leave
    EndDo

    Ringer

    ReplyDelete
  15. One might ask the interviewer why they want me to waste my time coding this self flagellation in CL.

    ReplyDelete
  16. Here's my take (such as it is).

    The primary things I think about when writing something like this are 1) simplicity, and 2) readability. Efficiency is also a factor, but saving 5 or 10 milliseconds is not going to come into play in this case.

    Simplicity speaks for itself. By readability I mean - if someone else looks at the code will they know what it's doing and whether it's correct at a glance?

    (Also, the readability part definitely applies to me revisiting something months or years down the road that I "forgot" I wrote :)

    So, to me the "pure" CL solution - using a list of potential end days based on a short list of months - and adjusting for leap years - lives up to both simplicity and readability.

    (Adjusting for "leap centuries" in 2017 seems a bit silly. Our android overlords will address the Y21K problem when the time comes :)

    I know the temptation of every good programmer is to create "tricky" and/or "elegant" solutions to nearly everything. (Hey! Look at this slick solution I came up with that eliminates 2 lines of code!). But, that thinking tends to lead us down the dark path of confusing and un-maintainable code in the future.

    The arrays and counters using CVTDAT are "cute", but they aren't actually simple - especially for someone who doesn't use CVTDAT very often, and has to look up what it does. (Also - using MONMSG as a "false logic" construct always bothers me).

    Although I absolutely love SQL, I would not do the DCLF approach because the file has to exist before compilation. Someone doing a mass recompile (it happens) might not know that, and would have to figure out why the CL did not compile.

    (In my opinion, ALL files used as DCLF declarations in CL programs should be persistent. I'm very sorry to say this, but if I was the interviewer, you would have failed as soon as I saw a QTEMP file in the DCLF. I seriously can't see how that could ever be acceptable).

    Using API's requires knowledge of using API's, so it it not really a simple, readable CL solution.

    If IBM ever allows host variables for RUNSQL, I might switch to that methodology. It is both simple and readable.

    ReplyDelete
  17. Hey, here's and even better challenge.

    Using only CL - calculate the "day of week name" for a month end date. So, for the end of month date you already calculated, is it a Monday? Tuesday? ???

    I look forward to some of the ideas your readers might come up with.

    ReplyDelete
  18. Wally, use CEEDAYS, CEEDATE combo. If the interview says that is not totally CL, then I'd say change the system date, retrieve QDAYOFWEEK and ask which solution they like better and smile. :o) I certainly wouldn't limit a carpenter to only using a hammer when a screwdriver is the better tool for the task.

    Ringer

    ReplyDelete
  19. Simon, I see you operate similarly to me. If it compiles... it must work.

    CHGVAR VAR(%SST(&QDATE 1 2)) VALUE('31')
    Replaces the MONTH portion of the date. I saw several of the other solutions caught that so kudos to those guys.

    I vote for Brian's code example of Ringer's solution. Very efficient and readable.

    At our shop we don't "mess around" with dates in CL programs very much. We pass them along to other programs but they're converted to CCYYMMDD format prior to passing.

    I enjoyed the article and the enthusiasm of all the participants. Keep'em coming

    ReplyDelete
  20. Dang it, right after I posted I finally saw that your system uses DMY format for the system date. My sincere apologies.

    ReplyDelete
  21. When I try to compile the CL I receive this error: "CPD0852 - File WORKFILE in library QTEMP not found." What am I missing? I have created the file in QTEMP in my session and added QTEMP to the top of my library list and tried it again and still the same error. I am trying to CL method using RUNSQL.

    ReplyDelete
    Replies
    1. If you can see WORKFILE in QTEMP, and QTEMP is top of your user part of your library list. The obvious question is are you compiling interactive or in batch?

      Delete

To prevent "comment spam" all comments are moderated.
Learn about this website's comments policy here.

Some people have reported that they cannot post a comment using certain computers and browsers. If this is you feel free to use the Contact Form to send me the comment and I will post it for you, please include the title of the post so I know which one to post the comment to.