| 
PGM PARM(&QUAL)
DCL &QUAL *CHAR 20
DCL &FIC *CHAR 10
DCL &LIB *CHAR 10
DCL &TXT *CHAR 50
DCL &DAT13 *CHAR 13
DCL &DAT7 *CHAR 7
DCL &CDE *CHAR 10
DCL &ATTR *CHAR 10
/* 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)
/* CORPS DU PROGRAMME */
CHGVAR &FIC %SST(&QUAL 1 10)
CHGVAR &LIB %SST(&QUAL 11 10)
RTVOBJD OBJ(&LIB/&FIC) OBJTYPE(*FILE) RTNLIB(&LIB) +
OBJATR(&ATTR) TEXT(&TXT) SAVDATE(&DAT13) +
SAVCMD(&CDE)
IF ((%SST(&ATTR 1 2) *NE 'PF') & +
(%SST(&ATTR 1 2) *NE 'LF')) THEN(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Il ne +
s''agit pas d''un fichier Base de +
données') TOPGMQ(*SAME) MSGTYPE(*ESCAPE)
ENDDO
CHGVAR &DAT7 %SST(&DAT13 1 7)
CHKOBJ OBJ(QTEMP/£££££FMT) OBJTYPE(*USRSPC)
MONMSG CPF9801 EXEC(DO)
RCVMSG MSGTYPE(*EXCP)
CALL QUSCRTUS PARM('£££££FMT QTEMP' ' ' X'000000FF' +
X'00' '*USE' '£££££FMT')
ENDDO
CHKOBJ OBJ(QTEMP/£££££FLD) OBJTYPE(*USRSPC)
MONMSG CPF9801 EXEC(DO)
RCVMSG MSGTYPE(*EXCP)
CALL QUSCRTUS PARM('£££££FLD QTEMP' ' ' X'000000FF' +
|
|
X'00' '*USE' '£££££FLD')
ENDDO
CHKOBJ OBJ(QTEMP/£££££DBR) OBJTYPE(*USRSPC)
MONMSG CPF9801 EXEC(DO)
RCVMSG MSGTYPE(*EXCP)
CALL QUSCRTUS PARM('£££££DBR QTEMP' ' ' X'000000FF' +
X'00' '*USE' '£££££DBR')
ENDDO
CALL PGM(DSPDBIG) PARM(&FIC &LIB &TXT &DAT7 &CDE)
RETURN
/*----------------------------------------*/
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
|
