RE: Month Start/Month End

On Thu, 21 February 2002, Scott Klement wrote:

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

Yeah, but REAL CL programmers use loops.  :-)

Hope this spaghetti mess below is readable. Maybe the nesting level is too 
deep. It accepts a 2-character/digit Month and 4-character/digit Year:

   pgm            ( +
                    &pMM     +
                    &pYYYY   +
                  )

   dcl        &pMM         *char      2
   dcl        &pYYYY       *char      4


   dcl        &tDD         *char      2
   dcl        &tDDd        *dec      (2)

   dcl        &cDATE       *char      8

   dcl        &tDATE       *char      7


/* Set the first DD-day to test...           */


   chgvar     &tDDd        ( 31 )


/* Try this DD-day...                        */

Nxt_DD:

   chgvar     &tDD           &tDDd


/* See if it converts, i.e., is valid...     */

   cvtdat     date( &PMM *CAT &TDD *CAT &PYYYY ) +
                tovar( &TDATE ) fromfmt( *MDYY ) +
                tofmt( *LONGJUL ) tosep( *NONE )

/* If not valid, try the previous dd-day...  */

   monmsg   ( CPF0555 )  exec( do )
      chgvar     &tDDd          ( &tDDd - 1 )
      goto       Nxt_DD
   enddo


/*                                           */
/* When DD-day converts, we're done...       */
/*                                           */

 End_DD:

   sndpgmmsg  msgid( CPF9898) msgf( QCPFMSG ) +
      msgdta( 'EOM:' *bcat &pYYYY *cat '/' *cat &pMM +
      *cat '/' *cat &tDD ) topgmq( *EXT )

   return

   endpgm

And yes I realize I didn't include any 'start-of-month' code. I figured that's 
an exercise for others.

Tom Liotta



--
Tom Liotta
The PowerTech Group, Inc.
19426 68th Avenue South
Kent, WA 98032
Phone  253-872-7788
Fax  253-872-7904
http://www.400Security.com


___________________________________________________
The ALL NEW CS2000 from CompuServe
 Better!  Faster! More Powerful!
 250 FREE hours! Sign-on Now!
 http://www.compuserve.com/trycsrv/cs2000/webmail/