| 
PGM
DCL &REP *LGL
DCL &PRB *LGL
MONMSG CPF1907 EXEC(GOTO APPSYS2)
MONMSG CPF0000 EXEC(GOTO PROBLEME)
/* DATA AREA POUR STOCKER LES CLE DE MSG */
CHKOBJ OBJ(QTEMP/CMDKEY) OBJTYPE(*DTAARA)
MONMSG CPF9801 EXEC(DO)
CRTDTAARA DTAARA(QTEMP/CMDKEY) TYPE(*CHAR) LEN(400)
GOTO MESSAGE
ENDDO
MONMSG CPF0000
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('REFSBS +
déja actif.Appel recursif non admis.') +
MSGTYPE(*ESCAPE)
RETURN
APPSYS2: RCLRSC
CHGVAR &REP '1'
PROBLEME: CHGVAR &PRB '1'
GOTO REPRISE
MESSAGE: RMVMSG CLEAR(*ALL)
SNDPGMMSG MSG('/* Références croisées */') +
TOPGMQ(*EXT) MSGTYPE(*RQS)
RCVMSG PGMQ(*EXT) MSGTYPE(*RQS) RMV(*NO)
DEBUT:
/* TOUTES LES LISTES SERONT FAITES VIA */
/* UN USER SPACE DANS QTEMP */
/* SI LE *USRSPC N'EXISTE PAS ==> CREATION */
CHKOBJ OBJ(QTEMP/LISTJOBQ) OBJTYPE(*USRSPC)
MONMSG CPF9801 EXEC(DO)
RCVMSG MSGTYPE(*EXCP)
CALL QUSCRTUS PARM('LISTJOBQ QTEMP ' +
'JOBQLIST ' +
X'00000FFF' +
' ' +
'*CHANGE ' +
'USER SPACE POUR LISTE DES JOBQ' )
ENDDO
CHKOBJ OBJ(QTEMP/ACTSBS) OBJTYPE(*USRSPC)
MONMSG CPF9801 EXEC(DO)
|
|
RCVMSG MSGTYPE(*EXCP)
CALL QUSCRTUS PARM('ACTSBS QTEMP ' +
'SBSLIST ' +
X'00000FFF' +
' ' +
'*CHANGE ' +
'USER SPACE POUR LISTE DES SBSD' )
ENDDO
/* APPEL DU PGM LISTE DES SBS */
OVRDBF DSPSBSP1 QTEMP/DSPSBSP1
CALL ACTSBSL
REPRISE: DLTOVR DSPSBSP1
MONMSG CPF0000
DLTUSRSPC QTEMP/ACTSBS
MONMSG CPF0000
DLTUSRSPC QTEMP/LISTJOBQ
MONMSG CPF0000
IF &REP DO
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Reprise +
apres annulation') TOPGMQ(*EXT) +
MSGTYPE(*STATUS)
CHGVAR &REP '0'
CHGVAR &PRB '0'
GOTO DEBUT
ENDDO
DLTDTAARA QTEMP/CMDKEY
MONMSG CPF0000
IF COND(&PRB) THEN(SNDPGMMSG MSGID(CPF9898) +
MSGF(QCPFMSG) MSGDTA('Erreur interne à +
REFSBS.Voir historique.') MSGTYPE(*ESCAPE))
/* FIN NORMALE */
ENDPGM
|
