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.
1 2 3 | * CALLER_CP - run previous program name d ReturnPreviousProgramName... d pr 10 |
Caller
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 | 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 |
Caller_TST
1 2 3 4 5 6 7 8 9 10 |
You can also do this with SQL — This is OS version dependent.
1 | SELECT * FROM TABLE(QSYS2.STACK_INFO('*')) A |

Caller – Procedure
Procedure to return calling program
169 Downloads
Caller – The Detail(s)