Caller_CP – This procedure returns the name of the previous program.  If called from command line would be – RETURNPROGRAM = ‘QUOMAIN ‘

Use this process of a copy book containing the PR statement and in some cases a shareable datastructure to reduce the effort in adding the procedure to programs.

[cc lang=”php”]

* CALLER_CP – run previous program name
d ReturnPreviousProgramName…
d pr 10

[/cc]

Caller

[cc lang=”php”]

H NOMAIN EXPROPTS(*RESDECPOS)
* PROGRAM – CALLER
* PURPOSE – return previous program name
* WRITTEN – 11/02/17
* AUTHOR – Jamie Flanary

d Qusec ds
d QusBPrv 10i 0
d QusBAvl 10i 0
d Qusei 7
d Quserved 1

d APIError ds Qualified
d BytesP 1 4I 0 inz(%size(apiError))
d BytesA 5 8I 0 inz(0)
d Messageid 9 15
d Reserved 16 16
d messagedta 17 256
* Type definition for the RCVM0200 format
d RCVM0200 DS 120
d Programname 111 120

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 10i 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 10i 0 Inz(4)
d Pm_Format s 8 Inz(‘RCVM0200’)
d Pm_Wait s 10i 0 Inz(0)
d Pm_Action s 10 Inz(‘*REMOVE’)
*
* Begin Procedure
*
p ReturnPreviousProgramName…
p B export

/copy qprcsrc,CALLER_CP

* Procedure Interface
d ReturnPreviousProgramName…
d pi 10

d $sendmsg pr ExtPgm(‘QMHSNDPM’)
d MessageID 7A Const
d QualMsgF 20A Const
d MsgData 256A Const
d MsgDtaLen 10I 0 Const
d MsgType 10A Const
d CallStkEnt 10A Const
d CallStkCnt 10I 0 Const
d Messagekey 4A
d ErrorCode 256A

d $receivemsg pr ExtPgm(‘QMHRCVPM’)
d RCVM0200 120
d Pm_Length 10i 0
d Pm_Format 8
d Pm_CSEntry 10
d Pm_Counter 10i 0
d Pm_MType 10
d Pm_MKey 4
d Pm_Wait 10i 0
d Pm_Action 10
d Qusec like(Qusec)

/free
reset ProgramName;
qusbprv = 16;
Pm_length = 12;
$sendmsg(Pm_Msgid :
Pm_Msgf :
Pm_MsgDta :
Pm_Length :
Pm_MType :
Pm_CSEntry :
Pm_Counter :
Pm_MKey :
APIError
);
clear RCVM0200;
Pm_length = 120;
$receivemsg( RCVM0200:
Pm_Length:
Pm_Format:
Pm_CSEntry:
Pm_Counter:
Pm_MType:
Pm_MKey:
Pm_Wait:
Pm_Action:
Qusec
);
return ProgramName;
/end-free
p ReturnPreviousProgramName…
p e

[/cc]

Caller_TST

[cc lang=”php”]

H DFTACTGRP(*NO) OPTION(*SRCSTMT: *NODEBUGIO) BNDDIR(‘UTILITIES’)
/copy qprcsrc,CALLER_CP

d ReturnProgram s 10 inz

*inlr = *on;

//return the caller program name
reset returnProgram;
returnProgram = ReturnPreviousProgramName();

[/cc]

You can also do this with SQL —  This is OS version dependent.

[cc lang=”php”] SELECT * FROM TABLE(QSYS2.STACK_INFO(‘*’)) A[/cc]

Caller – Procedure
Caller – Procedure

Procedure to return calling program

Caller – The Detail(s)