|
midrange.com
Hi,
I did it successfully by the API QWVRCSTK and created following procedure,
which is used in all our trigger programs:
*****************************************************************
* Procedure: YRtvCaller *
* Function : Retrieve information on calling program *
* *
* This procedure returns a DS with informations *
* on the application program, which has called *
* the program where this procedure was executed. *
* Programs from library QSYS are ignored. *
* *
* Parameter: p$CurPgm Current program name. *
* Name of the program, which called *
* this procedure. *
* This program will be ignored in *
* the current call stack list. *
* Returnval: $RtvCaller *
* Pgm Program (or Serviceprogram) *
* PgmLib Program Library *
* Mod Module (if ILE Program) *
* ModLib Module Library (if ILE Program) *
* ActGrp Activation Group *
* Proc Procedure (if ILE Program) *
* *
* Author : Werner Noll *
*****************************************************************
P YRtvCaller B Export
D YRtvCaller PI Like($RtvCaller)
D p$CurPgm 10A Const
D #VarLen S 10I 0 Inz(%size($CSTK0100_1))
D i1 S 5U 0
D JobIdInf DS
D JIDQName 26 Inz('*')
D JIDIntID 16
D JIDRes3 2 Inz(*loval)
D JIDThreadInd 10I 0 Inz(1)
D JIDThread 8 Inz(*loval)
/free
CallP QWVRCSTK($CSTK0100_1:#VarLen:'CSTK0100':JobIdInf:'JIDF0100':
$APIErrDS);
For i1= 1 to yyEntryCount;
$CSTK0100_2 = %subst($CSTK0100_1:yyOffset + 1);
If yyDspmntPrc <> *zeros;
$RtvCaller.Proc=%subst($CSTK0100_2:(yyDspmntPrc + 1):yyLenPrc);
Else;
$RtvCaller.Proc=*blanks;
Endif;
yyOffset = yyOffset + yyEntryLen;
If $RtvCaller.Proc='YRTVCALLER' or yyPgmLib='QSYS' or
yyPgmNam=p$CurPgm;
Iter;
Endif;
$RtvCaller.Pgm =yyPgmNam;
$RtvCaller.PgmLib=yyPgmLib;
$RtvCaller.Mod =yyModNam;
$RtvCaller.ModLib=yyModLib;
$RtvCaller.ActGrp=yyActGrpNam;
Leave;
EndFor;
Return $RtvCaller;
/end-free
P YRtvCaller E
Hope it helps!
Regards,
Werner Noll
-----Ursprüngliche Nachricht-----
Von: midrange-l-bounces@xxxxxxxxxxxx
[mailto:midrange-l-bounces@xxxxxxxxxxxx] Im Auftrag von Tomasz Skorza
Gesendet: Donnerstag, 9. Februar 2006 13:14
An: midrange-l@xxxxxxxxxxxx
Betreff: Problem with trigger
Hi guys
I read an arcticle on isersies network and I try to get caller ID in trigger
program
(http://www.iseriesnetwork.com/artarchive/index.cfm?fuseaction=viewarticle&C
O_ContentID=2690&channel=art&subart=issue&issueid=258 )
The problem is that I get always program name as QDBDUR - it seems that
program don't want "go back" and retrieve all call stack entries.
Calling caller (P74CALL) in trigger is:
C Call 'P74CALL'
C Parm WhoCalled
C Parm @PGM Caller
C*
C Clear Loop
C Dou %Subst(WhoCalled:1:1) <> 'Q'
C Or Loop = 11.
C Eval Loop = (Loop + 1)
C Movel(p) WhoCalled Caller
C Movel *BLANKS WhoCalled
C Call 'P74CALL'
C Parm WhoCalled
C Parm Caller
c Enddo
Could you help me why it don't work?
P74CALL is:
*************** Beginning of data
*************************************************************************
* System API error code
D Qusec DS
D QusBPrv 1 4B 0
D QusBAvl 5 8B 0
D Qusei 9 15
D Quserved 16 16
* Type definition for the RCVM0200 format
D RCVM0200 DS 120
D Program 111 120
****************************************************************
* Standalone Field Definitions *
****************************************************************
****************************************************************
* Main Program *
****************************************************************
* Set error code structure not to use exceptions
C Z-Add 16 QusBPrv
* Set length of message data
C Z-Add 12 Pm_Length
* Send program message
C Call 'QMHSNDPM'
C Parm Pm_MsgId
C Parm Pm_MsgF
C Parm Pm_MsgDta
C Parm Pm_Length
C Parm Pm_MType
C Parm Pm_CSEntry
C Parm Pm_Counter
C Parm Pm_MKey
C Parm Qusec
* Check for errors
C If QusBAvl > 0
C Exsr *PSSR
C EndIf
* Clear return data structure
C Clear RCVM0200
* Set length of message information
C Z-Add 120 Pm_Length
* Receive program message
C Call 'QMHRCVPM'
C Parm RCVM0200
C Parm Pm_Length
C Parm Pm_Format
C Parm Pm_CSEntry
C Parm Pm_Counter
C Parm Pm_MType
C Parm Pm_MKey
C Parm Pm_Wait
C Parm Pm_Action
C Parm Qusec
* Check for errors
C If QusBAvl > 0
C Exsr *PSSR
C EndIf
C Move Program Caller
C Return
****************************************************************
* *PSSR - Error Handling Subroutine *
****************************************************************
C *PSSR Begsr
C Return
C Endsr
Regards
Do you have any idea what is wrong?
Tomasz Skorza
--
This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing list
To post a message email: MIDRANGE-L@xxxxxxxxxxxx To subscribe, unsubscribe,
or change list options,
visit: http://lists.midrange.com/mailman/listinfo/midrange-l
or email: MIDRANGE-L-request@xxxxxxxxxxxx Before posting, please take a
moment to review the archives at http://archive.midrange.com/midrange-l.
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
