This procudure will return the calling program's name
Included in zip file are example of using the procedure
procedure compiled with pdm option 15 then CRTPGM to get program referencing the procedure. (or binding directory)
Included in zip file are example of using the procedure
procedure compiled with pdm option 15 then CRTPGM to get program referencing the procedure. (or binding directory)
Code:
h nomain expropts(*resdecpos) *============================================= * Program - CALLER * Purpose - return the name of the program that called the * program that uses this procedure. * Written - 07/01/04 * Author - Jamie Flanary * Program Description * This program will return the program name that called the * program that uses this procedure. * The CALLER_CP copy member should be used by programs that * call this procedure to obtain the procedure prototype fields. * * InProgram Char 10 Input/OutPut * * Indicator Usage * None *============================================= /COPY QPRCSRC,CALLER_CP * Work fields 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 ProgramName 111 120 ************************************************* * Standalone Field Definitions ************************************************* * Program message parameters d Pm_MsgId S 7 Inz(*BLANKS) d Pm_MsgF S 20 Inz(*BLANKS) d Pm_MsgDta S 12 Inz('Who are you?') 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 Inz(4) d Pm_Format S 8 Inz('RCVM0200') d Pm_Wait S 9B 0 Inz(0) d Pm_Action S 10 Inz('*REMOVE') d WorkProgram S 10 * Beginning of procedure P CALLER B EXPORT * Procedure interface d CALLER PI 256 d InProgram 10 VALUE c exsr Hskpg c eval WorkProgram = InProgram * * 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 * * 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 * c eval WorkProgram = ProgramName c return WorkProgram *============================================= * HSKPG - OneTime run subroutine *============================================= c HSKPG begsr c endsr *============================================= P CALLER E