PGM        PARM(&FICLIB &path)
             dcl &ficlib   *char   20
             dcl &path     *char   256
             dcl &rcdlen   *dec   (5 0)
 /* VARIABLES UTILISEES PAR LA GESTION DE MESSAGES */
             DCL        &ERRORSW *LGL                     /* SWITCH  */
             DCL        &MSGID *CHAR LEN(7)               /* ID MSG  */
             DCL        &MSGDTA *CHAR LEN(100)            /* DATA    */
             DCL        &MSGF *CHAR LEN(10)               /* FICHIER */
             DCL        &MSGFLIB *CHAR LEN(10)            /* BIBLI   */
 
             COPYRIGHT  TEXT(Volubis)
             MONMSG     MSGID(CPF0000) EXEC(GOTO ERREUR)
 
 /* CORPS DU PROGRAMME */
 
             CHKOBJ     OBJ(%SST(&FICLIB 11 10)/%SST(&FICLIB 1 10)) +
                          OBJTYPE(*FILE) AUT(*READ)
 
      /* creation du suer space pour rtvdblen */
 
             DLTUSRSPC  USRSPC(QTEMP/CPYDBSTMF)
              MONMSG     MSGID(CPF0000) EXEC(RCVMSG RMV(*YES))
             call quscrtus parm('CPYDBSTMF QTEMP'      +
                                'cpydbstmf'            +
                                x'000000FF'            +
                                x'00'                  +
                                '*USE'                 +
                                'user space temporaire')
 
  /* fonction RPG-IV, retrouve la lg (du plus grand format) */
             CALLPRC    PRC(RTVDBLEN) PARM(&FICLIB) RTNVAL(&RCDLEN)
 
  /* création d'un fichier temporaire et copie */
             DLTF       FILE(QTEMP/CPYDBSTMF)
              MONMSG     MSGID(CPF0000) EXEC(RCVMSG RMV(*YES))
             CRTPF      FILE(QTEMP/CPYDBSTMF) RCDLEN(&RCDLEN)
 
             CPYF       FROMFILE(%SST(&FICLIB 11 10)/%SST(&FICLIB 1 +
                          10)) TOFILE(QTEMP/cpydbstmf) +
                          MBROPT(*REPLACE) FMTOPT(*NOCHK)
 
             CPYTOSTMF  +
                          FROMMBR('qsys.lib/qtemp.lib/cpydbstmf.file +

                          /cpydbstmf.mbr') TOSTMF(&PATH) +
                          STMFCODPAG(1252)
 
 /* RENVOI DES MESSAGES DE TYPE *COMP SI FIN NORMALE */
 COMPMSG:    RCVMSG     MSGTYPE(*COMP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
                          MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB)
             IF         (&MSGID *EQ '       ') RETURN  /* FIN DU PGM */
             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
                          MSGDTA(&MSGDTA) MSGTYPE(*COMP)
             GOTO       COMPMSG /* BOUCLE SUR MESSAGES *COMP      */
 
 
              /*----------------------------------------*/
 ERREUR:      /*        GESTION DES ERREURS             */
              /*----------------------------------------*/
             IF         &ERRORSW SNDPGMMSG MSGID(CPF9899) +
                          MSGF(QCPFMSG) MSGTYPE(*ESCAPE) /* 2EME FOIS*/
                                                         /* ARRET PGM*/
             CHGVAR     &ERRORSW '1' /* MISE EN PLACE DU SWITCH     */
 
 /* RENVOI DES MESSAGES DE TYPE *DIAG SI FIN ANORMALE */
 DIAGMSG:    RCVMSG     MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID) +
                          MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB)
             IF         (&MSGID *EQ '       ') GOTO EXCPMSG
             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
                          MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
             GOTO       DIAGMSG /* BOUCLE SUR MESSAGES *DIAG      */
 
 /* RENVOI DU MESSAGE D'ERREUR                        */
 EXCPMSG:    RCVMSG     MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
                          MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB)
             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
                          MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
             ENDPGM