|
midrange.com
I use this (inserted in the trigger PGM)
There is also an API retriving the call stack entry avaible at V5R2 if i
remember correctly.
*
* API Réception, envoi message ................................
D Qusec DS
D QusBPrv 1 4B 0
D QusBAvl 5 8B 0
D Qusei 9 15
D Quserved 16 16
*
* Réception format RCVM0200 ...................................
D RCVM0200 DS 120
D Program 111 120
*
* Variables diverses API message ..............................
D Pm_MsgId S 7 Inz(*BLANKS)
D Pm_MsgF S 20 Inz(*BLANKS)
D Pm_MsgDta S 12 Inz('pgm?')
D Pm_Length S 9B 0
D Pm_MType S 10 Inz('*INFO')
D Pm_MKey S 4 Inz(*BLANKS)
D Pm_CSEntry S 10 Inz('*')
D Pm_Counter S 9B 0
D Pm_Format S 8 Inz('RCVM0200')
D Pm_Wait S 9B 0 Inz(0)
D Pm_Action S 10 Inz('*REMOVE')
D SysPgmExc S 10 Inz('??????????')
.....
*
* Récupération nom PGM qui a déclenché le trigger ........................
C Eval QusBPrv = 16
C Eval Pm_Length = 4
c Eval pm_counter=5
*
C Call(E) '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
C If QusBAvl > 0
C Return
C EndIf
*
C Clear RCVM0200
C Eval Pm_Length = 120
C Call(e) '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
C If QusBAvl > 0
C Return
C EndIf
*
c Eval SysPgmExc = Program
*
----- Original Message -----
From: "Tomasz Skor¿a" <t.skorza@xxxxxxxxxxxxx>
To: <midrange-l@xxxxxxxxxxxx>
Sent: Thursday, February 09, 2006 1:13 PM
Subject: 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.
