PGM PARM(&DTFLIF)
/*-------------------------------------------------------------------*/
DCL &DTFLIF *CHAR 20    /*  Bibliothèque est dtaara de départ        */
DCL &DTF    *CHAR 10    /*  Dtaara de départ                         */
DCL &LIF    *CHAR 10    /*  Bibliothèque de départ                   */
DCL &VAL    *CHAR 2000  /*  NOUVELLE VALEUR                          */
DCL &IN03   *CHAR 1     /*  INDICATEUR DE MISE A JOUR                */
DCL &TXT    *CHAR 80    /*  Message de premier niveau (erreur)       */
/*-------------------------------------------------------------------*/
MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERR))
/* Formatage des variable recu                                      */
             CHGVAR     VAR(&DTF) VALUE(%SST(&DTFLIF 01 10))
             CHGVAR     VAR(&LIF) VALUE(%SST(&DTFLIF 11 10))
             IF         COND((&DTF *NE '*LDA') *AND (&DTF *NE +
                          '*PDA') *AND (&DTF *NE 'GDA')) THEN(DO)
             CHKOBJ     OBJ(&LIF/&DTF) OBJTYPE(*DTAARA)
             DSPDTAARA  DTAARA(&LIF/&DTF) OUTPUT(*PRINT)
             ENDDO
             ELSE       CMD(DO)
             DSPDTAARA  DTAARA(&DTF) OUTPUT(*PRINT)
             ENDDO
/* controle syntaxe commande                                        */
             CHKOBJ     OBJ(QTEMP/DSPDTA) OBJTYPE(*FILE)
MONMSG     MSGID(CPF9801) EXEC(DO)
             CRTPF      FILE(QTEMP/DSPDTA) RCDLEN(132) TEXT('fichier +
                          dspdtaara')
                          GOTO SUIT1
             ENDDO
             CLRPFM DSPDTA
  SUIT1:
             CPYSPLF    FILE(QPDSPDTA) TOFILE(QTEMP/DSPDTA) +
                          SPLNBR(*LAST)
             DLTSPLF    FILE(QPDSPDTA) SPLNBR(*LAST)
             CALL       PGM(EDTDTAARAG) PARM(&IN03)
             IF         COND(&IN03 *EQ '0') THEN(DO)
             RTVDTAARA  DTAARA(QTEMP/PARM) RTNVAR(&VAL)
             IF         COND((&DTF *NE '*LDA') *AND (&DTF *NE +
                          '*PDA') *AND (&DTF *NE 'GDA')) THEN(DO)
             CHGDTAARA  DTAARA(&LIF/&DTF) VALUE(&VAL)
             ENDDO
             ELSE       CMD(DO)
             CHGDTAARA  DTAARA(&DTF) VALUE(&VAL)
             ENDDO
             ENDDO

             GOTO FIN
/*                                                                  */
/* Sous programme de controle d'erreurs                             */
/*                                                                  */
 ERR:        RCVMSG     MSGTYPE(*EXCP) MSG(&TXT)
             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&TXT) +
                          MSGTYPE(*ESCAPE)
/*                                                                  */
/* Fin de programme                                                 */
/*                                                                  */
FIN:
             IF         COND(&IN03 *EQ '0') THEN(SNDPGMMSG +
                          MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Mise +
                          à jour de la data area' *BCAT &DTF *BCAT +
                          'effectuée') MSGTYPE(*COMP))
             ELSE       CMD(SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
                          MSGDTA('Data area non modifiée') +
                          MSGTYPE(*INFO))
 ENDPGM