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]
Procedure to return calling program