Re: trigger buffer -- RPG400-L

This is working except for assuming the pgm that
updated the file doesn't start with Q.  SQL and UPDDTA
start with Q.  Assuming I want to go up only 1 level
returns the trigger pgm name.  Going up 2 works if the
RPG pgm uses native I/O.  I didn't count but if
embedded sql is used you have to up a few higher.

Are these fixed numbers?  Can I rely upon them?  Or
can they be different?

Thanks,

Phil

--- Denis Robitaille <DRobitaille@cascades.com> wrote:
> 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
>
>
> >>> sublime78ska@yahoo.com 12/06/01 11:08am >>>
> Is there any way to get the pgm name that did the
> update/insert/delete from the trigger buffer?  Or
> anywhere else besides the journal?
>
> My need is to block all pgms except the maintenance
> pgm from updating the file.
>
> Thanks,
>
> Phil
>
>
>
> _______________________________________________
> This is the RPG programming on the AS400 / iSeries
> (RPG400-L) mailing list
> To post a message email: RPG400-L@midrange.com
> To subscribe, unsubscribe, or change list options,
> visit:
> http://lists.midrange.com/cgi-bin/listinfo/rpg400-l
> or email: RPG400-L-request@midrange.com
> Before posting, please take a moment to review the
> archives
> at http://archive.midrange.com/rpg400-l.
>


__________________________________________________
Do You Yahoo!?
Send your FREE holiday greetings online!
http://greetings.yahoo.com