| 
PGM PARM(&FILLIB &MBR &TOFILLIB &TOMBR &OPTION)
DCL &FILLIB *CHAR 20
DCL &FIL *CHAR 10
DCL &LIB *CHAR 10
DCL &MBR *CHAR 10
DCL &TOFILLIB *CHAR 20
DCL &TOFIL *CHAR 10
DCL &TOLIB *CHAR 10
DCL &TOMBR *CHAR 10
DCL &OPTION *CHAR 8
DCL &EXISTE *LGL VALUE('1')
DCL &ACTION *CHAR 1
/* 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 &FIL %SST(&FILLIB 1 10)
CHGVAR &LIB %SST(&FILLIB 11 10)
CHKOBJ OBJ(&LIB/&FIL) OBJTYPE(*FILE) MBR(&MBR) +
AUT(*USE)
CHGVAR &TOFIL %SST(&TOFILLIB 1 10)
CHGVAR &TOLIB %SST(&TOFILLIB 11 10)
IF (&TOMBR *EQ '*SAME') THEN(CHGVAR &TOMBR &MBR)
CHKOBJ OBJ(&TOLIB/&TOFIL) OBJTYPE(*FILE) MBR(&TOMBR) +
AUT(*USE)
MONMSG CPF9815 EXEC(CHGVAR &EXISTE '0')
IF (*NOT &EXISTE) CHGVAR &OPTION *REPLACE
ELSE DO
IF (&OPTION *EQ '*NONE') DO
SNDUSRMSG MSG('Membre ' !! &TOMBR *BCAT 'existe déja +
dans ' !! &TOFIL *BCAT 'de ' !! &TOLIB +
*TCAT '.(C-cancel, A-add, R-replace)') +
VALUES(C A R) DFT(C) MSGRPY(&ACTION)
IF (&ACTION *EQ 'C') THEN(DO)
SNDPGMMSG MSG('Déplacement de membre arreté suite à +
|
|
réponse C') MSGTYPE(*DIAG)
RETURN
ENDDO
IF (&ACTION *EQ 'A') THEN(CHGVAR &OPTION '*ADD')
IF (&ACTION *EQ 'R') THEN(CHGVAR &OPTION '*REPLACE')
ENDDO
IF (&OPTION *EQ '*NEW') DO
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Membre +
' !! &TOMBR *BCAT 'existe déja dans ' !! +
&TOFIL *BCAT 'de ' !! &TOLIB) +
MSGTYPE(*ESCAPE)
RETURN
ENDDO
ENDDO
COPIE: CPYSRCF FROMFILE(&LIB/&FIL) TOFILE(&TOLIB/&TOFIL) +
FROMMBR(&MBR) TOMBR(&TOMBR) MBROPT(&OPTION)
RMVM FILE(&LIB/&FIL) MBR(&MBR)
/* 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(CPF9999) +
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 |
