DLTLIBRCV5

             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(&QUAL) TYPE(*CHAR) LEN(20) VALUE(*ALL)
             DCL        VAR(&BIB) TYPE(*CHAR) LEN(10)
             DCL        VAR(&pointeur) TYPE(*PTR)


             DCL        VAR(&ptrinfos) TYPE(*PTR)
             DCL        VAR(&DATA) TYPE(*CHAR) STG(*BASED) LEN(16) +
                          BASPTR(&PTRINFOS)
             DCL        VAR(&DEBUT) TYPE(*INT) STG(*DEFINED) DEFVAR(&DATA)
             DCL        VAR(&NOMBRE) TYPE(*INT) STG(*DEFINED) DEFVAR(&DATA +
                          9)
             DCL        VAR(&TAILLE) TYPE(*INT) STG(*DEFINED) DEFVAR(&DATA +
                          13)


             DCL        VAR(&ptrretour) TYPE(*PTR)
             DCL        VAR(&RETOUR) TYPE(*CHAR) STG(*BASED) LEN(30) +
                          BASPTR(&PTRRETOUR)

             DCL        VAR(&OBJ) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
                          DEFVAR(&RETOUR)
             DCL        VAR(&OBJLIB) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
                          DEFVAR(&RETOUR 11)
             DCL        VAR(&OBJTYPE) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
                          DEFVAR(&RETOUR 21)




 /* 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       PGM(QUSCRTUS) PARM('DLTLIBRCV QTEMP' /* USRSPC   */ +
                                            '          '      /* ATTRIBUT */ +

                                            X'0000FFFF'       /* TAILLE   */ +
                                            X'00'             /* VAL INIT */ +
                                            '*USE'            /* DROITS   */ +
                                            'POUR DLTLIBRCV') /* TEXTE    */
 /* 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     */       +
                               )
 /* positionnement sur début du USer Space */
             CALL       PGM(QUSPTRUS) PARM('DLTLIBRCV QTEMP' &Pointeur)
 /* récupération de &DATA, donc de &DEBUT &TAILLE et &NOMBRE    */
             chgvar     &ptrinfos &pointeur
             CHGVAR     %OFFSET(&ptrinfos) VALUE(%OFFSET(&ptrinfos) + 124)


 /* positionnement début de liste (on place &retour DANS le User Space) */
             chgvar     &ptrretour &pointeur
             CHGVAR     %OFFSET(&ptrretour) VALUE(%OFFSET(&ptrretour) + +
                          &DEBUT )

             DOFOR      VAR(&COMPTEUR) FROM(1) TO(&NOMBRE) BY(1)


                DLTJRNRCV  JRNRCV(&OBJLIB/&OBJ)
               MONMSG     MSGID(CPF7022)


               if         (&compteur < &nombre) then(do)
                  CHGVAR     %OFFSET(&ptrretour) VALUE(%OFFSET(&ptrretour) +
                               + &TAILLE)
               ENDDO
             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