× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



On Thu, 21 Feb 2002, Mark A. Manske wrote:
>
> Long/in-sane answer is yes; IF you want a VERY large C/L program with loops
> and other really
> bizarre things to make it work.  Basically you would have all the "tables"
> for the months, and
> take into account the leap years... blah blah - basically like the old days
> when we had
> just RPGII - really messy stuff - but can be done.

Heh... "loops and other really bizarre things".  Yeah, those loops man,
those things are waaaay out there. :)

Unfortunately, the original poster wasn't very clear on what he was trying
to do.  The first/last work day of the month?  Or just the first/last day?
What does he have to calculate it from?  The current date?  Some date from a
file?

But, maybe this will help.  Here's CL code to calculate the first & last
calendar date of a month from a date given as a parm.  The date is in
CYYMMDD format for compat. with the '*DATE' parm type used with a *CMD
object -- but small changes could make it work with any date format...

IMHO, this is fairly simple code.


PGM    PARM(&SOMEDATE)  /* CYYMMDD FORMAT */

             DCL        VAR(&SOMEDATE) TYPE(*CHAR) LEN(7)
             DCL        VAR(&MONTHSTR) TYPE(*CHAR) LEN(7)
             DCL        VAR(&MONTHEND) TYPE(*CHAR) LEN(7)
             DCL        VAR(&NEXT)     TYPE(*CHAR) LEN(7)
             DCL        VAR(&JUL)      TYPE(*CHAR) LEN(7)
             DCL        VAR(&YREND)    TYPE(*CHAR) LEN(8)
             DCL        VAR(&YEAR)     TYPE(*CHAR) LEN(3)
             DCL        VAR(&MONTH)    TYPE(*CHAR) LEN(2)
             DCL        VAR(&CYY)      TYPE(*DEC)  LEN(3 0)
             DCL        VAR(&MM)       TYPE(*DEC)  LEN(2 0)
             DCL        VAR(&NJUL)     TYPE(*DEC)  LEN(7 0)


/* FIGURE OUT START OF &SOMEDATE'S MONTH: */
             CHGVAR     VAR(&YEAR)  VALUE(%SST(&SOMEDATE 1 3))
             CHGVAR     VAR(&MONTH) VALUE(%SST(&SOMEDATE 4 2))
             CHGVAR     VAR(&MONTHSTR) VALUE(&YEAR *CAT &MONTH *CAT +
                          '01')

/* HOW ABOUT THE NEXT MONTH'S START? */
             CHGVAR     VAR(&CYY) VALUE(&YEAR)
             CHGVAR     VAR(&MM) VALUE(&MONTH)
             CHGVAR     VAR(&MM) VALUE(&MM + 1)
             IF (&MM > 12) THEN(DO)
                  CHGVAR  VAR(&CYY) VALUE(&CYY + 1)
                  CHGVAR  VAR(&MM)  VALUE(1)
             ENDDO
             CHGVAR     VAR(&YEAR) VALUE(&CYY)
             CHGVAR     VAR(&MONTH) VALUE(&MM)
             CHGVAR     VAR(&NEXT) VALUE(&YEAR *CAT &MONTH *CAT '01')

/* THE END OF THE MONTH IS ONE DAY LESS THAN THE "NEXT MONTH START" +
    (AND WE'LL HAVE TO COMPENSATE FOR CROSSING OVER YEARS)         */
             CVTDAT     DATE(&NEXT) TOVAR(&JUL) FROMFMT(*CYMD) +
                          TOFMT(*LONGJUL) TOSEP(*NONE)
             CHGVAR     VAR(&NJUL) VALUE(&JUL)
             CHGVAR     VAR(&NJUL) VALUE(&NJUL - 1)
             CHGVAR     VAR(&JUL) VALUE(&NJUL)
             IF  (%SST(&JUL 4 3) *EQ '000') THEN(DO)
                  CHGVAR VAR(&NJUL) VALUE(&NJUL - 1)
                  CHGVAR VAR(&JUL) VALUE(&NJUL)
                  CHGVAR VAR(&YREND) VALUE(%SST(&JUL 1 4) *CAT '1231')
                  CVTDAT DATE(&YREND) TOVAR(&MONTHEND) FROMFMT(*YYMD) +
                          TOFMT(*CYMD) TOSEP(*NONE)
             ENDDO
             ELSE DO
                  CVTDAT  DATE(&JUL) TOVAR(&MONTHEND) +
                          FROMFMT(*LONGJUL) TOFMT(*CYMD) TOSEP(*NONE)
             ENDDO

/* SHOW OFF OUR NEW DATES */
             SNDUSRMSG  MSG('Start of month: ' *CAT &MONTHSTR)
             SNDUSRMSG  MSG('  End of month: ' *CAT &MONTHEND)

ENDPGM




As an Amazon Associate we earn from qualifying purchases.

This thread ...

Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 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.