Re: Get trigger caller program

This procedure is a part of a stack services service program. I would be
happy to send the entire service program if you are interested.

//* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
//* XVCSTK_GetTriggerProgram
//* Get name of program causing trigger to fired.
//* Function send a message to the database program used for the
//* insert or update. When it find it, it knows that the previous
//* program is the program that caused the insert or update.
//* In - Trigger Event.
//* Out - None
//* Returns - Name of program
//* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
dcl-proc XVCSTK_GetTriggerProgram Export;
dcl-pi *N VarChar(10);
InTriggerEvent Char(1) Value;
end-pi;

dcl-s PtrReturnMessage Pointer Inz(%Addr(MessageBuffer));
dcl-ds ReturnMessage LikeDs(TD_ReturnMessage) Based(ptrReturnMessage);
dcl-ds ErrorReturn LikeDs(TD_StdErrorModel) Inz(*LikeDs);

dcl-c INSERT_PROGRAM 'QDBPUT';
dcl-c UPDATE_DELETE_PROGRAM 'QDBUDR';

dcl-s MessageBuffer Char(8192);

dcl-s MessageBackLength Int(10) Inz(%Size(MessageBuffer));
dcl-s ReturnMessageKey Char(4);

dcl-s CallStackEntry Char(10);
dcl-s Msg Char(1024);

If Not (InTriggerEvent = XVCSTK_TRIGGER_EVENT_INSERT Or
InTriggerEvent = XVCSTK_TRIGGER_EVENT_DELETE Or
InTriggerEvent = XVCSTK_TRIGGER_EVENT_UPDATE Or
InTriggerEvent = XVCSTK_TRIGGER_EVENT_READ);
Msg = 'Trigger event is not valid event. Must a XVCSTK_TRIGGER_EVENT
value';
XVERRH_Throw('CPF9898':
CPF_MESSAGE_FILE_NAME:
Msg);
EndIf;

If InTriggerEvent = XVCSTK_TRIGGER_EVENT_INSERT;
CallStackEntry = INSERT_PROGRAM;
Else;
CallStackEntry = UPDATE_DELETE_PROGRAM;
EndIf;

SendProgramMessage('CPF9898':
CPF_MESSAGE_FILE_NAME:
'Test': // Message to send
4: // Length of message
'*INFO': // Type of message
CallStackEntry: // Program name to search for
1: // Stack counter to go back
ReturnMessageKey: // Message key returned
ErrorReturn);
If ErrorReturn.BytesAvailable > 0;
Msg = 'Unknown error in Send Message API. Message Id = ' +
ErrorReturn.MessageId;
XVERRH_Throw('CPF9898':
CPF_MESSAGE_FILE_NAME:
Msg);
EndIf;

ReceiveProgramMessage(MessageBuffer: // Buffer to receive message into
MessageBackLength: // Length of buffer
'RCVM0200': // Message format
'*': // Use the current pgm queue
0: // Call stack counter
'*INFO': // Program type to receive
ReturnMessageKey: // Message key returned
0: // Wait Time
'*REMOVE': // How to handle message
ErrorReturn);
If ErrorReturn.BytesAvailable > 0;
Msg = 'Unknown error in Send Message API. Message Id = ' +
ErrorReturn.MessageId;
XVERRH_Throw('CPF9898':
CPF_MESSAGE_FILE_NAME:
Msg);
EndIf;

Return %Trim(ReturnMessage.ReceivingProgramName);

end-proc;

On Tue, Oct 5, 2021 at 8:56 AM Kevin Bucknum <Kevin@xxxxxxxxxxxxxxxxxxx>
wrote:

Mine looks for specific programs in the stack, and it reads the whole
stack. I do however look at the library of the program in the stack, and
throw out any that are in QSYS. Not sure if that would help or not. I would
think something like the below would work.

Pseudo code

getnext = false;
Read Stack Entry.
If entry = trigger program;
Getnext = true;
Endif;
if getnext = true and entry.library <> 'QSYS';
Return thisentry;
Endif;
repeat your loop.

On Tue, 2021-10-05 at 10:49 -0400, Art Tostaine, Jr. wrote:
Does anyone have a program that's getting "who called me" for a trigger?
I've tried several versions that are available on line. The one I'm
currently using is returning QRNXIO for many of the transactions. I guess
it's crawling back too far.

Thanks, Art

[https://www.medtronsoftware.com/img/MedtronMinilogo.bmp]
Kevin Bucknum

Senior Programmer Analyst

MEDDATA / MEDTRON

120 Innwood Drive
Covington LA 70433
Local: 985-893-2550<tel:985-893-2550>
Toll Free: 877-893-2550<tel:877-893-2550>
https://www.medtronsoftware.com


CONFIDENTIALITY NOTICE

This document and any accompanying this email transmission contain
confidential information, belonging to the sender that is legally
privileged. This information is intended only for the use of the
individual or entity named above. The authorized recipient of this
information is prohibited from disclosing this information to any other
party and is required to destroy the information after its stated need has
been fulfilled. If you are not the intended recipient, or the employee of
agent responsible to deliver it to the intended recipient, you are hereby
notified that any disclosure, copying, distribution or action taken in
reliance on the contents of these documents is STRICTLY PROHIBITED. If you
have received this email in error, please notify the sender immediately to
arrange for return or destruction of these documents.
--
This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing list
To post a message email: MIDRANGE-L@xxxxxxxxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: https://lists.midrange.com/mailman/listinfo/midrange-l
or email: MIDRANGE-L-request@xxxxxxxxxxxxxxxxxx
Before posting, please take a moment to review the archives
at https://archive.midrange.com/midrange-l.

Please contact support@xxxxxxxxxxxxxxxxxxxx for any subscription related
questions.

Help support midrange.com by shopping at amazon.com with our affiliate
link: https://amazon.midrange.com