PGM        PARM(&USRIDXQ &INSERTYP &ENTRY2000)
             DCL &USRIDXQ *CHAR 20
             DCL &INSERTYP *CHAR 4
             DCL &ENTRY2000 *CHAR 2000
             DCL &BIN *CHAR 4
             DCL &RTNVAR *CHAR 48
             DCL &RTNLIB *CHAR 10
             DCL &RTNADD *CHAR 4
             DCL &VAR2000 *CHAR 2000
             DCL &LG *DEC (5 0)
             DCL &LGENT *DEC (5 0)
             DCL &OFFSET *CHAR 8 X'0000000000000001'
 /* VARIABLES UTILISEES PAR LA GESTION DE MESSGAES */
             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   */
 
             MONMSG     MSGID(CPF0000) EXEC(GOTO ERREUR)
 
             CHGVAR &LGENT %BIN(&ENTRY2000 1 2)
             CHGVAR &VAR2000 %SST(&ENTRY2000 3 &LGENT)
 
             CHGVAR %BIN(&BIN) 48
             CALL QUSRUIAT PARM(&RTNVAR &BIN 'IDXA0100' +
                                 &USRIDXQ X'00000000')
 
             IF (%SST(&RTNVAR 29 1) = 'F') THEN(DO)
               CHGVAR &LG %BIN(&RTNVAR 37 4) /* LG FIXE */
               IF (&LGENT > &LG) THEN(CHGVAR %BIN(&BIN) &LG)
               ELSE CHGVAR %BIN(&BIN) &LGENT
             ENDDO
             ELSE DO
               CHGVAR &LG %BIN(&RTNVAR 41 4) /* LG MAXI */
               IF (&LGENT > &LG) THEN(CHGVAR %BIN(&BIN) &LG)
               ELSE CHGVAR %BIN(&BIN) &LGENT
               CHGVAR   %SST(&OFFSET 1 4) &BIN
               CHGVAR   %BIN(&BIN) 2000
             ENDDO
             CALL QUSADDUI PARM(&RTNLIB &RTNADD     &USRIDXQ +
                                &INSERTYP &VAR2000 &BIN      +
                                &OFFSET X'00000001' X'00000000')
 /* 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 SWTICH     */
 
 /* 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