******************************************************************
      * To compile:
      *
      *      CRTBNDRPG  PGM(XXX/MSGSFLRPG) SRCFILE(XXX/QRPGLESRC)
      *
      *****************************************************************
     Fmsgsfldf  cf   e             workstn
     F                                     infds(info)
      *
     Dpsds            sds
     D sds_proc          *proc                                                  Procedure name
      *
     Dinfo             ds
     D cfkey                 369    369
      *
     Dexit             C                   const(X'33')
     Dcancel           C                   const(X'3C')
     Denter            C                   const(X'F1')
      *
     d   msgId         s              7A
     d   msgLoc        s             20A   inz('SFLMSGF   *LIBL     ')
     d   msgRplDta     s              1A   inz(' ')
     d   msgRplDtaLen  s              4B 0 inz(0)
     d   msgType       s             10A   inz('*DIAG')
     d   msgQueue      s            276A   inz('*')
     d   msgCallStack  s              4B 0 inz(0)
     d   msgKey        s              4A   inz(' ')
     d   msgErr        s              4B 0 inz(0)
     d   msgrmv        s             10A   inz('*ALL')

     c                   dou       (cfkey = exit) or (cfkey = cancel)
     c                   write     msgctl
     c                   exfmt     screen1
     C                   eval      msgKey = *blanks
     C                   exsr      rmvmsg

     c                   select
     c                   when      cfkey = enter
     C                   if        first_name <> 'Kevin'
     C                   movel(p)  'SFL0001'     msgId
     C                   exsr      sndmsg
     C                   endif

     C                   if        last_name <> 'Vandever'
     C                   movel(p)  'SFL0002'     msgId
     C                   exsr      sndmsg
     C                   endif
     c
     c                   endsl

     c                   enddo
      *
     C                   eval      *inlr = *on
      *
      * Send message subroutine
      *
     c     sndmsg        begsr

     c                   call      'QMHSNDPM'
     c                   parm                    msgId
     c                   parm                    msgLoc
     c                   parm                    msgRplDta
     c                   parm                    msgRplDtaLen
     c                   parm                    msgType
     c                   parm                    msgQueue
     c                   parm                    msgCallStack
     c                   parm                    msgKey
     c                   parm                    msgErr

     c                   endsr

      *
      * Remove message subroutine
      *
     c     rmvmsg        begsr

     c                   call      'QMHRMVPM'
     c                   parm                    msgQueue
     c                   parm                    msgCallStack
     c                   parm                    msgKey
     c                   parm                    msgRmv
     c                   parm                    msgErr

     c                   endsr