| 
PGM PARM(&BIB)
/* ===================================================================== */
/* BUT : lister les RÉCEPTEURS DE JOURNAUX AFIN DE LES DÉTRUIRE */
/* sauf ceux attachés */
/* ===================================================================== */
DCL VAR(&COMPTEUR) TYPE(*INT)
DCL VAR(&TAILLE) TYPE(*INT) VALUE(32767)
DCL VAR(&DEBUT) TYPE(*INT)
DCL VAR(&RETOUR) TYPE(*CHAR) LEN(30)
DCL VAR(&QUAL) TYPE(*CHAR) LEN(20) VALUE(*ALL)
DCL VAR(&BIB) TYPE(*CHAR) LEN(10)
DCL VAR(&pointeur) TYPE(*PTR)
DCL VAR(&Data) TYPE(*char) STG(*BASED) +
BASPTR(&pointeur)
DCL VAR(&DEBUTS) TYPE(*INT) STG(*DEFINED) DEFVAR(&DATA)
1)
DCL VAR(&NOMBRE) TYPE(*INT) STG(*DEFINED) DEFVAR(&DATA +
5)
DCL VAR(&TAILLEP) TYPE(*INT)
/* VARIABLES UTILISEES PAR LA GESTION DE MESSAGES */
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)
DLTUSRSPC QTEMP/DLTLIBRCV
MONMSG MSGID(CPF2105) EXEC(RCVMSG PGMQ(*SAME) +
MSGTYPE(*EXCP))
/* CRÉATION DU USER SPACE */
CALL QUSCRTUS PARM('DLTLIBRCV QTEMP' /* USRSPC */ +
' ' /* ATTRIBUT */ +
&TAILLE /* TAILLE */ +
X'00' /* VAL INITIALE */ +
'*USE' /* DROITS */ +
'POUR DLTLIBRCV')
/* REMPLISSAGE, LISTE DES OBJETS */
CHGVAR VAR(%SST(&QUAL 11 10)) VALUE(&BIB)
CALL QUSLOBJ PARM('DLTLIBRCV QTEMP' /* USRSPC */ +
'OBJL0100' /* FORMAT */ +
|
|
&QUAL /* bib/obj */ +
'*JRNRCV' /* type */ +
)
CHGVAR VAR(&DEBUT) VALUE(125) /* DEBUT DE LISTE */
CHGVAR VAR(&TAILLE) VALUE(4)
CALL PGM(QUSRTVUS) PARM('DLTLIBRCV QTEMP' &DEBUT +
&TAILLE &DEBUTS)
CHGVAR VAR(&DEBUT) VALUE(133) /* NOMBRE DE POSTES */
CALL PGM(QUSRTVUS) PARM('DLTLIBRCV QTEMP' &DEBUT +
&TAILLE &NOMBRE)
CHGVAR VAR(&DEBUT) VALUE(137) /* TAILLE D'1 POSTE */
CALL PGM(QUSRTVUS) PARM('DLTLIBRCV QTEMP' &DEBUT +
&TAILLE &TAILLEP)
CHGVAR VAR(&DEBUT) VALUE(&DEBUTS + 1) /* DEBUT */
CHGVAR VAR(&TAILLE) VALUE(30) /* lg de retour */
DOFOR VAR(&COMPTEUR) FROM(1) TO(&NOMBRE) BY(1)
CALL PGM(QUSRTVUS) PARM('DLTLIBRCV QTEMP' &DEBUT +
&TAILLE &RETOUR)
DLTJRNRCV JRNRCV(%SST(&RETOUR 11 10)/%SST(&RETOUR 1 10))
MONMSG MSGID(CPF7022)
CHGVAR &DEBUT (&DEBUT + &TAILLEP)
ENDDO
/* RENVOI DES MESSAGES DE TYPE *COMP SI FIN NORMALE */
COMPMSG:
DLTUSRSPC QTEMP/DLTLIBRCV
SNDPGMMSG MSG('Ménage sur les récepteurs de journaux +
effectué') TOPGMQ(*PRV (*PGMBDY)) +
MSGTYPE(*COMP)
return
/* RENVOI DU MESSAGE D'ERREUR RECU */
ERREUR:
RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) TOPGMQ(*PRV (*PGMBDY)) +
MSGTYPE(*ESCAPE)
|
|
ENDPGM |
