RE: Who envoked that trigger program?

["Phil" <sublime78ska@xxxxxxxxx>]

I asked this two weeks ago and got two good responses.

To see the others, search the archives for 'trigger buffer'.  The date was
12/8/01.

Phil

>
>
> The following program returns the name of a program up in the
> call stack. YOu give as a parameter how up you want to go (1 in
> your case).
>
>              PGM        PARM(&NIVRECA &PGMID)
>
>              DCL        VAR(&NIVRECA) TYPE(*CHAR) LEN(2)
>              DCL        VAR(&NIVREC) TYPE(*DEC) LEN(2 0)
>              DCL        VAR(&NIVTST) TYPE(*DEC) LEN(2 0)
>              DCL        VAR(&NIVTRV) TYPE(*DEC) LEN(2 0)
>              DCL        VAR(&NIVBIN) TYPE(*CHAR) LEN(4)
>              DCL        VAR(&RCVVAR) TYPE(*CHAR) LEN(512)
>              DCL        VAR(&APIERRCDE) TYPE(*CHAR) LEN(8) +
>                           VALUE(X'0000000000000000')
>              DCL        VAR(&MSGKEY) TYPE(*CHAR) LEN(4)
>              DCL        VAR(&PGMID) TYPE(*CHAR) LEN(10)
>              DCL        VAR(&PGMIDPR) TYPE(*CHAR) LEN(10)
>
> /* initialisation                                                    */
>              CHGVAR     VAR(&NIVREC) VALUE(&NIVRECA)
>              CHGVAR     VAR(&NIVTST) VALUE(2)
>              CHGVAR     VAR(&NIVTRV) VALUE(0)
>
>  DOUNTIL:
>              IF         COND(&NIVREC *EQ &NIVTRV) THEN(GOTO +
>                           CMDLBL(FINDO))
>
>              CHGVAR     VAR(%BIN(&NIVBIN)) VALUE(&NIVTST)
>              CALL       PGM(QMHSNDPM) PARM(' ' ' ' 'Dummy' +
>                           X'00000005' '*INFO' '*' &NIVBIN &MSGKEY +
>                           &APIERRCDE)
>              MONMSG     MSGID(CPF0000) EXEC(DO)
> /* on a depasser le "call stack"                                     */
>              CHGVAR     VAR(&PGMID) VALUE(*ERR)
>              GOTO       CMDLBL(FINDO)
>              ENDDO
>              CALL       PGM(QMHRCVPM) PARM(&RCVVAR X'00000200' +
>                           'RCVM0300' '*' &NIVBIN '*ANY' &MSGKEY +
>                           X'00000000' '*REMOVE' &APIERRCDE)
>              CHGVAR     VAR(&PGMID) VALUE(%SST(&RCVVAR 472 10))
> /* on ignore le CLPEP qui existe en mode ILE                         */
>              IF         COND(&PGMID *NE &PGMIDPR) THEN(DO)
>              CHGVAR     VAR(&NIVTRV) VALUE(&NIVTRV + 1)
>              CHGVAR     VAR(&PGMIDPR) VALUE(&PGMID)
>              ENDDO
>              CHGVAR     VAR(&NIVTST) VALUE(&NIVTST + 1)
>              GOTO       CMDLBL(DOUNTIL)
>  FINDO:
>
>              ENDPGM
>
> Denis Robitaille
> Directeur services techniques
> Cascades Inc
> 819 363 5187
> fax 819 363 5177

>


_________________________________________________________
Do You Yahoo!?
Get your free @yahoo.com address at http://mail.yahoo.com