CPP de le cde DSPUSRIDXI

BoTTom | 
             PGM        PARM(&USRIDXQ)
             DCL &USRIDXQ *CHAR 20
             DCLF DSPUSRIDXD
             DCL &RTNVAR *CHAR 60
             DCL &BIN *CHAR 4
 /* 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 %BIN(&BIN) 60
 ECRAN:
             CALL QUSRUIAT PARM(&RTNVAR &BIN 'IDXA0100' +
                                 &USRIDXQ X'00000000')
             CHGVAR &USRIDX %SST(&RTNVAR 9 10)
             CHGVAR &USRIDXL %SST(&RTNVAR 19 10)
             IF (%SST(&RTNVAR 29 1) = 'F') THEN(DO)
                                 CHGVAR &IN40 '0'
                                 CHGVAR &FIXEDVARY 'Fixe'
                                 CHGVAR &ENTRYLEN %BIN(&RTNVAR 37 4)
             ENDDO
             ELSE DO
                                 CHGVAR &IN40 '1'
                                 CHGVAR &FIXEDVARY 'Variable'
                                 CHGVAR &ENTRYLEN %BIN(&RTNVAR 41 4)
                                 CHGVAR &LGMAX    %BIN(&RTNVAR 37 4)
             ENDDO
             IF (%SST(&RTNVAR 30 1) = '0') CHGVAR &FORCE 'non'
             ELSE CHGVAR &FORCE 'oui'
             CHGVAR &KEYLEN %BIN(&RTNVAR 45 4)
             IF (&KEYLEN = 0) CHGVAR &KEY 'non'
             ELSE CHGVAR &KEY 'oui'
             IF (%SST(&RTNVAR 32 1) = '0') CHGVAR &OPTIMIZE 'Direct'
             ELSE CHGVAR &OPTIMIZE 'Séquentiel'
             CHGVAR &NBADD %BIN(&RTNVAR 49 4)
             CHGVAR &NBSUP %BIN(&RTNVAR 53 4)
             CHGVAR &NBRTV %BIN(&RTNVAR 57 4)
             SNDRCVF
             IF &IN03 GOTO COMPMSG
 
             CHGVAR &USRIDXQ (&USRIDX *CAT &USRIDXL)

| 
             GOTO ECRAN
 /* 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




©AF400