| 
PGM PARM(&DTAQUAL)
DCL VAR(&DTAQUAL) TYPE(*CHAR) LEN(20)
DCL VAR(&RT) TYPE(*CHAR) LEN(2050)
DCL VAR(&LG) TYPE(*CHAR) LEN(4)
DCL VAR(&LG2) TYPE(*CHAR) LEN(4)
DCL VAR(&STR) TYPE(*CHAR) LEN(4)
DCL VAR(&WDATA) TYPE(*CHAR) LEN(2000)
DCL VAR(&ZONED) TYPE(*CHAR) LEN(24)
DCL VAR(&LEN) TYPE(*DEC) LEN(5 0)
DCL VAR(&POS) TYPE(*DEC) LEN(5 0)
DCL VAR(&FIN) TYPE(*DEC) LEN(5 0)
DCL VAR(&ATR) TYPE(*DEC) LEN(5 0)
DCL VAR(&WDEC) TYPE(*CHAR) LEN(9)
DCL VAR(&CMD) TYPE(*CHAR) LEN(2500)
DCL VAR(&SEP) TYPE(*CHAR) LEN(1) VALUE('''')
DCL VAR(&MODIF) TYPE(*LGL)
DCLF FILE(EDTDAD)
/* 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 MCH0000) EXEC(GOTO ERREUR)
/* CORPS DU PROGRAMME */
IF (%SST(&DTAQUAL 1 1) *EQ '*') CHGVAR &TEXTE &DTAQUAL
ELSE +
RTVOBJD OBJ(%SST(&DTAQUAL 11 10)/%SST(&DTAQUAL 1 10)) +
OBJTYPE(*DTAARA) TEXT(&TEXTE)
CHGVAR &NOM %SST(&DTAQUAL 1 10)
CHGVAR %BIN(&LG) 2050
CHGVAR %BIN(&LG2) 2000
CHGVAR %BIN(&STR) -1
/* LECTURE DES CARACTERISTIQUES ET DU CONTENU DE LA DATA AREA */
ENCORE: CHGVAR &POS 0
CALL QWCRDTAA PARM(&RT &LG &DTAQUAL &STR &LG2 X'00000000')
CHGVAR &LIB %SST(&RT 19 10)
CHGVAR &TYPE %SST(&RT 9 10)
|
|
CHGVAR &LEN %BIN(&RT 29 4) CHGVAR &WDATA %SST(&RT 37 &LEN) CHGVAR &LENW &LEN CHGVAR &IN61 '0' /* ROLLDOWN NON AUTORISÉ */ /* *DEC */ IF (&TYPE *EQ '*DEC') THEN(DO) CHGVAR &SEP ' ' CHGVAR &IN60 '0' /* ROLLUP NON AUTORISÉ */ CHGVAR &IN62 '1' /* AFFICHAGE DES DECIMALES*/ /* CONVERTION PACKÉ -> ETENDU */ CALL CVTPKD PARM(&LEN &WDATA &ZONED) CHGVAR &POS (24 - &LEN + 1) CHGVAR &WDATA %SST(&ZONED &POS &LEN) CHGVAR &FIN &LEN CHGVAR &DEC %BIN(&RT 33 4) /* GESTION DÉCIMALES(POS ",") */ IF (&DEC > 0) DO CHGVAR &POS (&LEN - &DEC + 1) CHGVAR %SST(&WDATA &POS 1) ',' CHGVAR &POS (24 - &DEC + 1) CHGVAR &WDEC %SST(&ZONED &POS &DEC) CHGVAR &POS (&LEN - &DEC + 2) CHGVAR %SST(&WDATA &POS &DEC) %SST(&WDEC 1 &DEC) CHGVAR &FIN (&FIN + 1) CHGVAR &LEN (&LEN + 1) ENDDO CHGVAR &DATA &WDATA CHGVAR &POS 1 ENDDO /* NON DEC*/ ELSE DO /* *LGL OU *CHAR(SEUL CAS OU ROLLUP POSSIBLE)*/ CHGVAR &IN62 '0' /* AFFICHAGE NBR DE DEC */ DEFIL: IF (&POS = 0) CHGVAR &POS 1 /* DEFILEMENT ==> MEMORISATION DES MODIFS */ ELSE CHGVAR %SST(&WDATA &POS &FIN) &DATA IF &IN80 DO /* ROLLUP */ CHGVAR &POS (&POS + 800) CHGVAR &IN61 '1' ENDDO IF &IN81 DO /* ROLLDOWN */ CHGVAR &POS (&POS - 800) IF (&POS = 1) CHGVAR &IN61 '0' ENDDO |
|
CHGVAR &FIN (&POS + 799) IF (&FIN > &LEN) DO CHGVAR &FIN &LEN CHGVAR &IN60 '0' ENDDO ELSE CHGVAR &IN60 '1' CHGVAR &DATA %SST(&WDATA &POS &FIN) ENDDO /* CROCHET DE FIN */ IF (&FIN *GE &LEN) DO CHGVAR &ATR (&LEN - &POS + 2) IF (&ATR < 801) CHGVAR %SST(&DATA &ATR 1) ']' ENDDO /* POSITIONS */ CHGVAR &P1 (&POS - 1) CHGVAR &P2 (&P1 + 50) CHGVAR &P3 (&P2 + 50) CHGVAR &P4 (&P3 + 50) CHGVAR &P5 (&P4 + 50) CHGVAR &P6 (&P5 + 50) CHGVAR &P7 (&P6 + 50) CHGVAR &P8 (&P7 + 50) CHGVAR &P9 (&P8 + 50) CHGVAR &P10 (&P9 + 50) CHGVAR &P11 (&P10 + 50) CHGVAR &P12 (&P11 + 50) CHGVAR &P13 (&P12 + 50) CHGVAR &P14 (&P13 + 50) CHGVAR &P15 (&P14 + 50) CHGVAR &P16 (&P15 + 50) /* FIN DE DATA AREA ? */ IF (&P2 > &FIN) CHGVAR &P2 0 IF (&P3 > &FIN) CHGVAR &P3 0 IF (&P4 > &FIN) CHGVAR &P4 0 IF (&P5 > &FIN) CHGVAR &P5 0 IF (&P6 > &FIN) CHGVAR &P6 0 IF (&P7 > &FIN) CHGVAR &P7 0 IF (&P8 > &FIN) CHGVAR &P8 0 IF (&P9 > &FIN) CHGVAR &P9 0 IF (&P10 > &FIN) CHGVAR &P10 0 IF (&P11 > &FIN) CHGVAR &P11 0 |
|
IF (&P12 > &FIN) CHGVAR &P12 0
IF (&P13 > &FIN) CHGVAR &P13 0
IF (&P14 > &FIN) CHGVAR &P14 0
IF (&P15 > &FIN) CHGVAR &P15 0
IF (&P16 > &FIN) CHGVAR &P16 0
/***********************/
/* AFFICHAGE DU FORMAT */
/***********************/
AFFICHE: SNDRCVF
IF &IN03 DO
IF &MODIF +
SNDPGMMSG MSG('Data area' *BCAT &NOM *BCAT 'modifiée') +
MSGTYPE(*COMP)
RETURN
ENDDO
IF &IN05 GOTO ENCORE
IF (&IN80 *OR &IN81) GOTO DEFIL
/***********************/
/* ENTREE = MODIF. */
/***********************/
CHGVAR %SST(&WDATA &POS &FIN) &DATA
IF COND(%SST(&DTAQUAL 1 1) *EQ '*') THEN(CHGVAR +
VAR(&CMD) VALUE('CHGDTAARA ' *CAT &NOM +
*BCAT &SEP *CAT %SST(&WDATA 1 &LEN) *CAT +
&SEP))
ELSE CMD(CHGVAR VAR(&CMD) VALUE('CHGDTAARA ' *CAT +
&LIB *TCAT '/' *CAT &NOM *BCAT &SEP *CAT +
%SST(&WDATA 1 &LEN) *CAT &SEP))
/* LA CDE DE MODIF EST PASSÉE À QCMDEXC */
CALL QCMDEXC PARM(&CMD 2500)
CHGVAR &MODIF '1'
GOTO ENCORE
/*----------------------------------------*/
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 |
