| 
PGM PARM(&USRIDXQ &SELECT)
DCL &USRIDXQ *CHAR 20
DCL &SELECT *CHAR 4010
DCL &OFFSET *CHAR 16
DCL &NBENTRY *CHAR 4 X'00000000'
DCL &RTNLIB *CHAR 10
DCL &CRITERE *CHAR 4000
DCL &CRITERL *CHAR 4 X'00000000'
DCL &CRITEROFF *CHAR 4 X'00000000'
DCL &TEST *CHAR 4
DCL &VAL1 *CHAR 2000
DCL &VAL2 *CHAR 2000
DCL &LG1 *DEC (5 0)
DCL &LG2 *DEC (5 0)
DCL &RTNVARLG *DEC (5 0)
DCL &NBELEM *DEC (3 0)
DCL &X0 *CHAR 1 X'00'
DCL &X6 *CHAR 4 X'00000006'
DCL &X8 *CHAR 4 X'00000008'
DCL &RETOURLG *DEC (5 0)
DCL &MAX *CHAR 4
DCL &NBRMV *DEC (7 0)
DCL &NBRMVC *CHAR 7
/* 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(&MAX) 4095
/* CONTROLES */
CHGVAR &NBELEM %BIN(&SELECT 1 2)
IF (&NBELEM = 0) +
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA('Paramètre SELECT doit être +
renseigné') MSGTYPE(*ESCAPE)
CHGVAR &TEST %SST(&SELECT 3 4)
CHGVAR &LG1 %BIN(&SELECT 7 2)
IF (&LG1 ^= 0) CHGVAR &VAL1 %SST(&SELECT 9 &LG1)
IF COND((&LG1 *EQ 0) *OR ((&LG1 *EQ 1) *AND +
(%SST(&VAL1 1 1) = &X0))) THEN(DO)
|
|
IF COND((&TEST < &X6) *OR (&TEST = &X8)) +
THEN(SNDPGMMSG MSGID(CPF9898) +
MSGF(QCPFMSG) MSGDTA('VALEUR 1 doit être +
renseignée') MSGTYPE(*ESCAPE))
ENDDO
CHGVAR &LG2 %BIN(&SELECT 2009 2)
IF (&LG2 ^= 0) CHGVAR &VAL2 %SST(&SELECT 2011 &LG2)
IF COND((&LG2 *EQ 0) *OR ((&LG2 *EQ 1) *AND +
(%SST(&VAL2 1 1) = &X0))) THEN(DO)
IF COND(&TEST = &X8) THEN(SNDPGMMSG +
MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA('VALEUR 2 doit être renseignée') +
MSGTYPE(*ESCAPE))
ENDDO
IF (&TEST = &X8) THEN(DO) /* *RANGE */
IF (&LG1 < &LG2) CHGVAR %BIN(&CRITERL) &LG2
ELSE CHGVAR %BIN(&CRITERL) &LG1
CHGVAR &CRITERE (&VAL1 *CAT &VAL2)
CHGVAR %BIN(&CRITEROFF) 2000
ENDDO
ELSE DO
IF (&TEST *LT &X6) THEN(DO) /* <> *FIRST , *LAST */
CHGVAR %BIN(&CRITERL) &LG1
CHGVAR &CRITERE (&VAL1)
ENDDO
ENDDO
/* APPEL API */
CALL QUSRMVUI PARM( &NBENTRY ' ' X'00000000' &OFFSET +
X'00000010' &RTNLIB +
&USRIDXQ 'IDXE0100' &MAX +
&TEST &CRITERE &CRITERL &CRITEROFF +
X'00000000')
CHGVAR &NBRMV %BIN(&NBENTRY)
CHGVAR &NBRMVC &NBRMV
SNDPGMMSG MSG(&NBRMVC *CAT ' entrée(s) supprimée(s)') +
MSGTYPE(*COMP)
/* 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 |
