| 
PGM PARM(&UDF &UDL &UDM &A &B &C &D &E &F &G &H &J &L &N + &O &P &R &S &T &U &V &W &X) /*****************************************************************/ /*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>*/ /* CE PROGRAMME EST UNE COPIE DU PGM DE MEME NOM SE TROUVANT */ /* DANS QUSRTOOL. */ /* IL A POUR BUT DE MONTRER L'UTILISATION DES FENETRES SDD */ /* (LE PGM ORIGINAL UTILISAIT UNE AUTRE TECHNIQUE VIA UN PGM */ /* BASIC, L'APPEL DE PGM A DONC ETE MODIFIE). */ /*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<*/ /*****************************************************************/ /* */ /* NAME: TPSCLUDO */ /* */ /* DESCRIPTIVE NAME: SHOW WINDOW OF ACTIVE USER-DEFINED */ /* OPTIONS */ /* */ /* FUNCTION: THIS PROGRAM ALONG WITH A BASIC PROGRAM */ /* CALLED TPSBASUD SHOWS A POP-UP WINDOW OF */ /* OF THE ACTIVE USER-DEFINED OPTIONS IN YOUR */ /* PDM SESSION. THE ACTIVE USER-DEFINED OPTIONS */ /* ARE THOSE CONTAINED IN THE LIBRARY, FILE, */ /* AND MEMBER DEFINED IN THE CHANGE DEFAULTS */ /* DISPLAY. THIS PROGRAM IS BEST INITIATED */ /* THROUGH A PDM USER-DEFINED OPTION. */ /* */ /* INPUT: ALL THE VALID REPLACEMENT VARIABLES FOR */ /* PDM USER-DEFINED OPTIONS. THESE ARE: */ /* */ /* &U - ACTIVE USER-DEFINED OPTION FILE */ /* &V - ACTIVE USER-DEFINED OPTION LIBRARY */ /* &W - ACTIVE USER-DEFINED OPTION MEMBER */ /* &A - OBJECT ATTRIBUTE */ /* &B - LIST TYPE */ /* &C - OPTION */ /* &D - MEMBER CHANGE DATE */ /* &E - RUN IN BATCH */ /* &F - FILE NAME */ /* &G - JOB DESCRIPTION LIBRARY */ /* &H - JOB DESCRIPTION */ /* &J - JOB DESCRIPTION (LIBRARY/JD) */ /* &L - LIBRARY NAME */ /* &N - ITEM NAME */ /* &O - OBJECT LIBRARY */ |
|
/* &P - COMPILE IN BATCH */ /* &R - REPLACE OBJECT */ /* &S - ITEM TYPE WITHOUT '*' */ /* &T - ITEM TYPE WITH '*' */ /* &U - ACTIVE USER-DEFINED OPTION FILE */ /* &V - ACTIVE USER-DEFINED OPTION LIBRARY */ /* &W - ACTIVE USER-DEFINED OPTION MEMBER */ /* &X - ITEM TEXT */ /* */ /* THE FOLLOWING IS THE USER-DEFINED OPTION USED TO CALL */ /* THIS PROGRAM: */ /* */ /* CALL PGM(AF4TOOL/TPSCLUDO) PARM(&U &V &W &A &B &C '&D' */ /* &E '&F' &G &H '&J' &L &N &O &P &R '&S' '&T' &U &V &W &X) */ /* */ /* CHANGE ACTIVITY: */ /* */ /* FLAG REASON VER DATE ORIGIN COMMENTS */ /* ---- ------- ---- ------ ------ ----------------------- */ /* $A1=PTG01134 D300 900103 EPOON : LOWER CASE PARAMETERS */ /*****************************************************************/ /* PGM PARM(&UDF &UDL &UDM &A &B &C &D &F &J &L &N &O &S &T &*/ DCL VAR(&UDF) TYPE(*CHAR) LEN(10) DCL VAR(&UDL) TYPE(*CHAR) LEN(10) DCL VAR(&UDM) TYPE(*CHAR) LEN(10) DCL VAR(&A) TYPE(*CHAR) LEN(10) DCL VAR(&B) TYPE(*CHAR) LEN(10) DCL VAR(&C) TYPE(*CHAR) LEN(2) DCL VAR(&D) TYPE(*CHAR) LEN(8) DCL VAR(&E) TYPE(*CHAR) LEN(10) DCL VAR(&F) TYPE(*CHAR) LEN(10) DCL VAR(&G) TYPE(*CHAR) LEN(10) DCL VAR(&H) TYPE(*CHAR) LEN(10) DCL VAR(&J) TYPE(*CHAR) LEN(21) DCL VAR(&L) TYPE(*CHAR) LEN(10) DCL VAR(&N) TYPE(*CHAR) LEN(10) DCL VAR(&O) TYPE(*CHAR) LEN(10) DCL VAR(&P) TYPE(*CHAR) LEN(10) DCL VAR(&R) TYPE(*CHAR) LEN(10) DCL VAR(&S) TYPE(*CHAR) LEN(10) DCL VAR(&T) TYPE(*CHAR) LEN(10) DCL VAR(&U) TYPE(*CHAR) LEN(10) DCL VAR(&V) TYPE(*CHAR) LEN(10) DCL VAR(&W) TYPE(*CHAR) LEN(10) |
|
DCL VAR(&X) TYPE(*CHAR) LEN(50)
DCL VAR(&UDOPT) TYPE(*CHAR) LEN(250)
DCL VAR(&UDCMD) TYPE(*CHAR) LEN(550) VALUE(' ')
DCL VAR(&RETCOD) TYPE(*CHAR) LEN(1)
DCL VAR(&DONE) TYPE(*CHAR) LEN(1)
DCL VAR(&CURCHR) TYPE(*CHAR) LEN(1)
DCL VAR(&IDX) TYPE(*DEC) LEN(4 0) VALUE(0)
DCL VAR(&VARL) TYPE(*DEC) LEN(4 0) VALUE(0)
DCL VAR(&TMPVL) TYPE(*DEC) LEN(4 0) VALUE(0)
DCL VAR(&CMDIDX) TYPE(*DEC) LEN(4 0) VALUE(0)
DCL VAR(&ERMSG) TYPE(*CHAR) LEN(630) VALUE(' ')
/* ??? ALCOBJ OBJ((&UDL/&UDF *FILE *SHRRD &UDM)) WAIT(0) */
CHGVAR VAR(%SST(&UDOPT 1 1)) VALUE('X')
CHGVAR VAR(%SST(&UDOPT 250 1)) VALUE('X')
CHGVAR VAR(&RETCOD) VALUE('X')
OVRDBF FILE(PDMMODEL) TOFILE(&UDL/&UDF) MBR(&UDM)
/*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>*/
/* LES LIGNES SUIVANTES SONT MODIFIEES OU AJOUTEES POUR AF400 */
OVRDSPF FILE(PDMOPTWD) TOFILE(AF4TOOL/PDMOPTWD)
CALL PGM(AF4TOOL/PDMOPTW) PARM(&UDOPT &RETCOD)
QSYS/MONMSG MSGID(RPG9001) EXEC(GOTO CMDLBL(ERROR))
QSYS/MONMSG MSGID(CPA0701) EXEC(GOTO CMDLBL(INUSE))
DLTOVR FILE(PDMOPTWD)
/* FIN DES MODIFS AF400 */
/*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<*/
DLTOVR PDMMODEL
IF COND(&RETCOD = 'C') THEN(GOTO ENDP)
/* ================================================================ */
/* LOOP THROUGH USER DEFD OPTION STRING, REPLACING PDM VARIABLES... */
/* ================================================================ */
LOOP: CHGVAR VAR(&IDX) VALUE(&IDX + 1)
IF COND(&IDX > 250) THEN(GOTO CMDLBL(EXCMD))
CHGVAR VAR(&CMDIDX) VALUE(&CMDIDX + 1)
IF COND(%SST(&UDOPT &IDX 1) = '&') THEN(GOTO +
CMDLBL(SUB))
ELSE CMD(DO)
CHGVAR VAR(%SST(&UDCMD &CMDIDX 1)) VALUE(%SST(&UDOPT +
&IDX 1))
ENDDO
GOTO CMDLBL(LOOP)
/* ================================================================ */
/* END OF LOOP */
/* ================================================================ */
EXCMD: CALL PGM(QCMDEXC) PARM(&UDCMD 550)
|
|
QSYS/MONMSG MSGID(CPF6801) EXEC(GOTO CMDLBL(ENDP))
QSYS/MONMSG MSGID(CPF9999) EXEC(GOTO CMDLBL(ERROR))
GOTO CMDLBL(ENDP)
SUB: CHGVAR VAR(&IDX) VALUE(&IDX + 1)
CHGVAR VAR(&DONE) VALUE('1') /* INIT TO VALID +
VARIABLE FOUND */
CHGVAR VAR(&CURCHR) VALUE(%SST(&UDOPT &IDX 1))
IF COND(&CURCHR = 'A' *OR &CURCHR = 'a') THEN(DO)
/* àA1C*/
CHGVAR VAR(%SST(&UDCMD &CMDIDX 10)) VALUE(&A)
CHGVAR VAR(&VARL) VALUE(10)
GOTO TRIM
ENDDO
ELSE CMD(IF COND(&CURCHR = 'B' *OR &CURCHR = 'b') +
THEN(DO))
/* àA1C*/
CHGVAR VAR(%SST(&UDCMD &CMDIDX 10)) VALUE(&B)
CHGVAR VAR(&VARL) VALUE(10)
GOTO TRIM
ENDDO
ELSE CMD(IF COND(&CURCHR = 'C' *OR &CURCHR = 'c') +
THEN(DO))
/* àA1C*/
CHGVAR VAR(%SST(&UDCMD &CMDIDX 2)) VALUE(&C)
CHGVAR VAR(&VARL) VALUE(2)
GOTO TRIM
ENDDO
ELSE CMD(IF COND(&CURCHR = 'D' *OR &CURCHR = 'd') +
THEN(DO))
/* àA1C*/
CHGVAR VAR(%SST(&UDCMD &CMDIDX 8)) VALUE(&D)
CHGVAR VAR(&VARL) VALUE(8)
GOTO TRIM
ENDDO
ELSE CMD(IF COND(&CURCHR = 'E' *OR &CURCHR = 'e') +
THEN(DO))
/* àA1C*/
CHGVAR VAR(%SST(&UDCMD &CMDIDX 4)) VALUE(&E)
CHGVAR VAR(&VARL) VALUE(4)
GOTO TRIM
ENDDO
ELSE CMD(IF COND(&CURCHR = 'G' *OR &CURCHR = 'g') +
THEN(DO))
/* àA1C*/
|
|
CHGVAR VAR(%SST(&UDCMD &CMDIDX 10)) VALUE(&G)
CHGVAR VAR(&VARL) VALUE(10)
GOTO TRIM
ENDDO
ELSE CMD(IF COND(&CURCHR = 'H' *OR &CURCHR = 'h') +
THEN(DO))
/* àA1C*/
CHGVAR VAR(%SST(&UDCMD &CMDIDX 10)) VALUE(&H)
CHGVAR VAR(&VARL) VALUE(10)
GOTO TRIM
ENDDO
ELSE CMD(IF COND(&CURCHR = 'F' *OR &CURCHR = 'f') +
THEN(DO))
/* àA1C*/
CHGVAR VAR(%SST(&UDCMD &CMDIDX 10)) VALUE(&F)
CHGVAR VAR(&VARL) VALUE(10)
GOTO TRIM
ENDDO
ELSE CMD(IF COND(&CURCHR = 'J' *OR &CURCHR = 'j') +
THEN(DO))
/* àA1C*/
CHGVAR VAR(%SST(&UDCMD &CMDIDX 21)) VALUE(&J)
CHGVAR VAR(&VARL) VALUE(21)
GOTO TRIM
ENDDO
ELSE CMD(IF COND(&CURCHR = 'L' *OR &CURCHR = 'l') +
THEN(DO))
/* àA1C*/
CHGVAR VAR(%SST(&UDCMD &CMDIDX 10)) VALUE(&L)
CHGVAR VAR(&VARL) VALUE(10)
GOTO TRIM
ENDDO
/* REACHED CL LIMIT OF 10 NESTED ELSES */
ELSE CMD(CHGVAR VAR(&DONE) VALUE('0'))
IF COND(&DONE = '1') THEN(GOTO CMDLBL(LOOP))
ELSE CMD(IF COND(&CURCHR = 'N' *OR &CURCHR = 'n') +
THEN(DO))
/* àA1C*/
CHGVAR VAR(%SST(&UDCMD &CMDIDX 10)) VALUE(&N)
CHGVAR VAR(&VARL) VALUE(10)
GOTO TRIM
ENDDO
ELSE CMD(IF COND(&CURCHR = 'O' *OR &CURCHR = 'o') +
THEN(DO))
|
|
/* àA1C*/
CHGVAR VAR(%SST(&UDCMD &CMDIDX 10)) VALUE(&O)
CHGVAR VAR(&VARL) VALUE(10)
GOTO TRIM
ENDDO
/* REACHED CL LIMIT OF 10 NESTED ELSES */
ELSE CMD(CHGVAR VAR(&DONE) VALUE('0'))
IF COND(&DONE = '1') THEN(GOTO CMDLBL(LOOP))
ELSE CMD(IF COND(&CURCHR = 'P' *OR &CURCHR = 'p') +
THEN(DO))
/* àA1C*/
CHGVAR VAR(%SST(&UDCMD &CMDIDX 4)) VALUE(&P)
CHGVAR VAR(&VARL) VALUE(4)
GOTO TRIM
ENDDO
ELSE CMD(IF COND(&CURCHR = 'R' *OR &CURCHR = 'r') +
THEN(DO))
/* àA1C*/
CHGVAR VAR(%SST(&UDCMD &CMDIDX 10)) VALUE(&R)
CHGVAR VAR(&VARL) VALUE(10)
GOTO TRIM
ENDDO
ELSE CMD(IF COND(&CURCHR = 'S' *OR &CURCHR = 's') +
THEN(DO))
/* àA1C*/
CHGVAR VAR(%SST(&UDCMD &CMDIDX 10)) VALUE(&S)
CHGVAR VAR(&VARL) VALUE(10)
GOTO TRIM
ENDDO
ELSE CMD(IF COND(&CURCHR = 'T' *OR &CURCHR = 't') +
THEN(DO))
/* àA1C*/
CHGVAR VAR(%SST(&UDCMD &CMDIDX 10)) VALUE(&T)
CHGVAR VAR(&VARL) VALUE(10)
GOTO TRIM
ENDDO
ELSE CMD(IF COND(&CURCHR = 'U' *OR &CURCHR = 'u') +
THEN(DO))
/* àA1C*/
CHGVAR VAR(%SST(&UDCMD &CMDIDX 10)) VALUE(&U)
CHGVAR VAR(&VARL) VALUE(10)
GOTO TRIM
ENDDO
ELSE CMD(IF COND(&CURCHR = 'V' *OR &CURCHR = 'v') +
|
|
THEN(DO))
/* àA1C*/
CHGVAR VAR(%SST(&UDCMD &CMDIDX 10)) VALUE(&V)
CHGVAR VAR(&VARL) VALUE(10)
GOTO TRIM
ENDDO
ELSE CMD(IF COND(&CURCHR = 'W' *OR &CURCHR = 'w') +
THEN(DO))
/* àA1C*/
CHGVAR VAR(%SST(&UDCMD &CMDIDX 10)) VALUE(&W)
CHGVAR VAR(&VARL) VALUE(10)
GOTO TRIM
ENDDO
ELSE CMD(IF COND(&CURCHR = 'X' *OR &CURCHR = 'x') +
THEN(DO))
/* àA1C*/
CHGVAR VAR(%SST(&UDCMD &CMDIDX 50)) VALUE(&X)
CHGVAR VAR(&VARL) VALUE(50)
GOTO TRIM
ENDDO
ELSE CMD(DO)
CHGVAR VAR(&IDX) VALUE(&IDX - 1)
CHGVAR VAR(%SST(&UDCMD &CMDIDX 1)) VALUE(%SST(&UDOPT +
&IDX 1))
ENDDO
GOTO CMDLBL(LOOP)
TRIM: CHGVAR VAR(&CMDIDX) VALUE(&CMDIDX + &VARL)
CHGVAR VAR(&TMPVL) VALUE(&VARL)
TRIMLOOP: IF COND(%SST(&UDCMD &CMDIDX 1) ^= ' ') THEN(GOTO +
CMDLBL(LOOP))
CHGVAR VAR(&TMPVL) VALUE(&TMPVL - 1)
IF COND(&TMPVL >= 0) THEN(CHGVAR VAR(&CMDIDX) +
VALUE(&CMDIDX - 1))
ELSE CMD(GOTO CMDLBL(LOOP))
GOTO CMDLBL(TRIMLOOP)
ERROR: CHGVAR VAR(&ERMSG) VALUE('Erreur dans la commande, +
Voir l''historique- CDE : ' *BCAT &UDCMD)
/* SNDMSG MSG(&ERMSG) TOUSR(*REQUESTER) */
SNDPGMMSG MSG(&ERMSG)
GOTO CMDLBL(ENDP)
INUSE: CHGVAR VAR(&ERMSG) VALUE('Option en cours +
d''utilisation')
SNDPGMMSG MSG(&ERMSG)
GOTO CMDLBL(ENDP)
|
|
ERROR2: SNDPGMMSG MSG(&ERMSG) ENDP: RCLRSC ENDPGM |
