      * ================================================ * 
      *  JMD le 11/08/2010                               * 
      *  Copie du contenue d'un fichier message (MSGF)   * 
      *  dans un fichier physique pour faciliter la      * 
      *  recherche des libells messages ou des MSGID    * 
      *                                                  * 
      *  Fonctionne avec le fichier de sortie MSGFPF.    * 
      *  Pour l'excution lancer la commande :           * 
      *                                                  * 
      *  call cpyfmsgf parm(Ficmsgf   Bibmsgf   )        * 
      *                                                  * 
      * ================================================ * 
     Hoption(*srcstmt:*nodebugIo)
     Hdftactgrp(*NO)

     **--------------------------------------------------------------------
      * PURPOSE  . . . :  Dump a message file to a PF

     **--------------------------------------------------------------------
     FMSGFPF    O    E             DISK
     **--------------------------------------------------------------------
      * Input parameteres
     **--------------------------------------------------------------------
     D MSGFTOPF        PR                  EXTPGM('MSGFTOPF')
     D   $msgFile                    10
     D   $msgFileLib                 10
     D MSGFTOPF        PI
     D   $msgFile                    10
     D   $msgFileLib                 10

      *---------------------------------------------------------------
      * Define RTVMSG API
      *---------------------------------------------------------------
     Drtvmsg           PR                  extpgm('QMHRTVM')
     D rtvVariable                 2096
     D rtvVarLen                     10I 0 CONST
     D rtvFormat                      8    CONST
     D rtvID                          7    CONST
     D rtvMsgQ                       20    CONST
     D rtvMsgDta                    100    CONST
     D rtvMsgDtaLen                  10I 0 CONST
     D rtvReplaceVar                 10    CONST
     D rtvReturnCtl                  10    CONST
     D apiErr                       272
     D rtvOption                     10
     D rtvCCSIDCnvT                  10I 0 CONST
     D rtvCCSIDRplD                  10I 0 CONST
      *---------------------------------------------------------------
      * Define API error structure
      *---------------------------------------------------------------
     D apiErr          DS
     D   ErrBytesProv                10I 0 inz(272)
     D   ErrBytesAvai                10I 0
     D   ErrMsgId                     7
     D   ErrMsgSev                    1
     D   ErrMsgDta                  256
      *---------------------------------------------------------------
      * Define RTVMSG API receiver area
      *---------------------------------------------------------------
     D RTVM0300        DS
     D   rtvbytesRet                 10I 0
     D   rtvbytesAvl                 10I 0
     D   rtvMsgSev                   10I 0
     D   rtvAlertIdx                 10I 0
     D   rtvAlertOpt                  9
     D   rtvLogInd                    1
     D   rtvMsgID                     7
     D   rtvReserve1                  3
     D   rtvSubVar#                  10I 0
     D   rtvCCSIDText                10I 0
     D   rtvCCSIDRplT                10I 0
     D   rtvCCSIDRetT                10I 0
     D   rtvDftRpyOff                10I 0
     D   rtvDftRpyLen                10I 0
     D   rtvMsgOff                   10I 0
     D   rtvMsgLenRet                10I 0
     D   rtvMsgLenAvl                10I 0
     D   rtvMsgHOff                  10I 0
     D   rtvMsgHLnRet                10I 0
     D   rtvMsgHLnAvl                10I 0
     D   rtvSubVarRet                10I 0
     D   rtvSubVarAvl                10I 0
     D   rtvSubVarElm                10I 0
     D   rtvData                   2000
      *---------------------------------------------------------------
      * Program variables
      *---------------------------------------------------------------
     D msgFileLib      s             20
     D msgData         s            100
     D rcvID           s              7
     D rtvOption       s             10
     D rtvCCSIDCnvT    s             10I 0 inz(0)
     D rtvCCSIDRplD    s             10I 0 inz(0)

      *---------------------------------------------------------------
      * Read all messages until the end
      *---------------------------------------------------------------
     C                   Eval      msgFileLib = $msgFile
     C                   Eval      %subst(msgFileLib:11) = $msgFileLib
     C                   Eval      rtvOption = '*FIRST'
     C                   Dou       (rtvMsgID = *blanks or ErrMsgID <> *blanks)
     C                   callP     rtvmsg(RTVM0300:
     C                                    %len(RTVM0300):
     C                                    'RTVM0300':
     C                                    rcvID:
     C                                    msgFileLib:
     C                                    msgData:
     C                                    %len(msgData):
     C                                    '*NO       ':
     C                                    '*NO       ':
     C                                    apiErr:
     C                                    rtvOption:
     C                                    rtvCCSIDCnvT:
     C                                    rtvCCSIDRplD)
     C                   If        rtvMsgID <> *blanks and
     C                             ErrMsgID  = *Blanks
     C                   Eval      msgID     = rtvMsgID
     C                   z-add     rtvMsgSev     msgSev
     C                   Eval      msgFirst  = %subst(rtvData:9:rtvMsgLenAvl)
     C                   Eval      msgSecnd  =
     C                             %subst(rtvData:9+rtvMsgLenAvl:rtvMsgHlnAvl)
     c                   eval      mnu = $msgFile
     c                   eval      lib  = $msgFileLib
     C                   if        *in10 = *off 
     C                   eval      cpt = 0      
     C                   eval      *in10 = *on  
     C                   endif                  
     C                   eval      cpt = cpt + 1
     C                   write     PFREC
     C                   Eval      rcvID     = rtvMsgID
     C                   Eval      rtvOption = '*NEXT'
     C                   Endif
     C                   EndDo
     C                   Eval      *INLR = *On
     C                   Return