/* =============================================================== */
/* Prompt for a range of dates and submit to batch.                */
/* =============================================================== */
/* To compile:                                                     */
/*   CRTCLPGM PGM(xxx/JKL003C) SRCFILE(xxx/QCLSRC) SRCMBR(JKL003C) */
/* =============================================================== */

pgm

   dclf JKL003D

   dcl  &MsgTxt      *char  78
   dcl  &MsgKey      *char   4
   dcl  &Sender      *char  80
   dcl  &DaysDiff    *dec    5
   dcl  &CurrDate    *char   6
   dcl  &BgnWindow   *char   6
   dcl  &EndWindow   *char   6
   dcl  &EarlyDays   *dec    5    value(-60)
   dcl  &LateDays    *dec    5    value( 30)

   MonMsg     cpf0000    exec(GoTo Error)

Prelims:

   /* Determine the name of the program */
   SndPgmMsg  msg('/* */') ToPgmQ(*same) +
                MsgType(*info) KeyVar(&MsgKey)
   RcvMsg     PgmQ(*same) MsgType(*info) MsgKey(&MsgKey) +
                Rmv(*yes) Sender(&Sender)
   ChgVar     Var(&PgmNam) Value(%SST(&Sender 27 10))

   RtvJobA    Date(&CurrDate)

   /* Message JKL1002 needs to report the earliest and latest */
   /* acceptable dates.                                       */
   CallPrc    AddDays (&CurrDate &EarlyDays) RtnVal(&BgnWindow)
   CallPrc    AddDays (&CurrDate &LateDays)  RtnVal(&EndWindow)

   RmvMsg     Clear(*all)

   /* loop until F3 pressed or data is valid */

GetInput:

   SndF       RcdFmt(MSGCTL)
   SndRcvF    RcdFmt(FORMAT01)

   If (&IN03) Then(Do)
      SndPgmMsg Msg('Request was cancelled.') MsgType(*comp)
      Return
   EndDo

   RmvMsg  Clear(*all)
   ChgVar  Var(&In51) Value('0')
   ChgVar  Var(&In52) Value('0')

   /* make sure the beginning date is a valid date */
   CallPrc IsNotValidDate  Parm(&SBgnDate) RtnVal(&In51)
   If (&In51) Then(Do)
      SndPgmMsg  MsgID(JKL1003) MsgF(JKLMSG) +
                   MsgDta(&SBgnDate) ToPgmQ(*same)
   EndDo

   /* If the ending date was keyed, make sure it is */
   /* a valid date.                                 */
   If (&SEndDate *ne ' ') Then(Do)
      CallPrc IsNotValidDate  Parm(&SEndDate) RtnVal(&In52)
      If (&In52) Then(Do)
         SndPgmMsg  MsgID(JKL1003) MsgF(JKLMSG) +
                      MsgDta(&SEndDate) ToPgmQ(*same)
      EndDo
   EndDo

   /* If the ending date was not filled in and the beginning */
   /* date is valid, assume ending date is beginning date.   */
   if (&SEndDate *eq ' ' *and *not &In51) Then(Do)
      ChgVar  Var(&SEndDate)   Value(&SBgnDate)
   EndDo

   /* If a date is valid, check for reasonableness. */

   /* The ending date must be after the beginning date. */
   If (*not &In51 *and *not &In52) do
      CallPrc DaysDiff (&SBgnDate &SEndDate) RtnVal(&DaysDiff)
      If (&DaysDiff *lt 0) Then(Do)
         ChgVar     Var(&In51) Value('1')
         ChgVar     Var(&In52) Value('1')
         SndPgmMsg  MsgID(JKL1001) MsgF(JKLMSG) ToPgmQ(*same)
      EndDo
   EndDo

   /* The dates must not be too far into the future */
   /* or into the past.                             */
   If (*not &In51) Then(Do)
      CallPrc DaysDiff (&CurrDate &SBgnDate) RtnVal(&DaysDiff)
      If ((&DaysDiff *lt &EarlyDays) +
      *or (&DaysDiff *gt &LateDays)) Then(Do)
         ChgVar     Var(&In51) Value('1')
         SndPgmMsg  MsgID(JKL1002) MsgF(JKLMSG) +
                      MsgDta(&BgnWindow *cat &EndWindow) ToPgmQ(*same)
      EndDo
   EndDo

   If (*not &In52) Then(Do)
      CallPrc DaysDiff (&CurrDate &SEndDate) RtnVal(&DaysDiff)
      If ((&DaysDiff *lt &EarlyDays) +
      *or (&DaysDiff *gt &LateDays)) Then(Do)
         ChgVar     Var(&In52) Value('1')
         SndPgmMsg  MsgID(JKL1002) MsgF(JKLMSG) +
                      MsgDta(&BgnWindow *cat &EndWindow) ToPgmQ(*same)
      EndDo
   EndDo

   If (&In51 *or &In52) Then(Do)
      GoTo GetInput
   EndDo

EndInput:

   /* Insert commands to process input here */
   SbmJob   Cmd(Dsplibl) Job(SomeJob)
   SndPgmMsg Msg('Your request has been submitted for +
                   processing.') MsgType(*comp)
   Return

Error:

   RcvMsg     MSGQ(*PgmQ) MsgType(*excp) MSG(&MsgTxt)
   MonMsg     MsgID(cpf0000)
   SndPgmMsg  MSG(&MsgTxt) ToPgmQ(*same)
   MonMsg     MsgID(cpf0000)
   GoTo       GetInput

EndPgm:
EndPgm