*--------------------------------------------------
      *  Procedure definition
      *--------------------------------------------------

     D OffSetDat       PR                  extpgm('OFFSETDAT')
     D OPR                            1a   const                                Operation code 0/1
     D YRS                            3p 0 const                                Years to offset
     D MOS                            5p 0 const                                Months to offset
     D DAS                            5p 0 const                                Days to offsett
     D DATE                           7a   const                                Date to offset from
     D OFFDAT                         7a                                        Date offset to

      *--------------------------------------------------
      *  Procedure Interface
      *--------------------------------------------------

     D OffSetDat       PI
     D OPR                            1a   const                                Operation code 0/1
     D YRS                            3p 0 const                                Years to offset
     D MOS                            5p 0 const                                Months to offset
     D DAS                            5p 0 const                                Days to offsett
     D DATE                           7a   const                                Date to offset from
     D OFFDAT                         7a                                        Date offset to

      *--------------------------------------------------
      *  Fields used in calculations
      *--------------------------------------------------

     D DDATE           s               d   datfmt(*ymd) inz(*sys)               Date to offset from
     D DOFFDAT         s               d   datfmt(*ymd)                         Date offset to

      *--------------------------------------------------
      *  Constants used for indicator identification
      *--------------------------------------------------

     D ERRDatCnv       c                   CONST(90)

      *           should be sent back to the main program.
      *
     DMsg              c                   'Limit exceeded for total duration'
     Dmsgfloc          c                   'QCPFMSG   *LIBL     '

     DProgramVar       ds
     D msglen                  1      4B 0
     D stkctr                  5      8B 0
     D rtvlen                  9     12B 0
     D msgqln                 13     16B 0
     D pgmwtt                 17     20B 0
      *
     Dmsgerr           ds
     D provid                  1      4B 0 inz(56)
     D avail                   5      8B 0
     D rtnmsg                  9     15
     D rsvr                   16     16
     D rtndta                 17     56
      *
      /EJECT
      *--------------------------------------------------
      *  MAIN Section...

      *  The DATE(0000000) value implies *CURRENT date. Use any
      *    supplied date, but '0000000' keeps the INZ(*SYS) value
      *    resulting in current system date.

     C                   if        DATE <> '0000000'
     C     *cymd0        move      DATE          DDATE
     C                   endif


      *  OPR (operation type) determines whether the durations are
      *    added or subtracted. The OPR(1) value causes ADDDUR;
      *    otherwise, SUBDUR.

     C                   if        OPR = *on

     C     DDATE         adddur    YRS:*years    DOFFDAT                90
     C                   if        not *in(ERRDatCnv)
     C                   adddur    MOS:*months   DOFFDAT                90
     C                   endif
     C                   if        not *in(ERRDatCnv)
     C                   adddur    DAS:*days     DOFFDAT                90
     C                   endif

     C                   else

     C     DDATE         subdur    YRS:*years    DOFFDAT                90
     C                   if        not *in(ERRDatCnv)
     C                   subdur    MOS:*months   DOFFDAT                90
     C                   endif
     C                   if        not *in(ERRDatCnv)
     C                   subdur    DAS:*days     DOFFDAT                90
     C                   endif
      *
     C                   endif

      * Return the calculated date to the caller in *cymd0 format.
     C                   if        *in(ERRDatCnv)
     C                   exsr      SndMsg
     C                   endif
      *

     C     *cymd0        move      DOFFDAT       OFFDAT

     C                   eval      *inlr = *on
     C                   return
      *--------------------------------------------------
      /EJECT
     C     SndMsg        Begsr

     C                   Call      'QMHSNDPM'
     C                   PARM      'CPF9898'     msgid             7
     C                   PARM      msgfloc       msgf             20
     C                   PARM      msg           msgdta           40
     C                   PARM      40            msglen
     C                   PARM      '*ESCAPE   '  msgtype          10
     C                   PARM      '*         '  stkent           10
     C                   PARM      2             stkctr
     C                   PARM                    msgkey            4
     C                   PARM                    msgerr
      *
     C                   Endsr