Caller – The Detail(s)

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

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();

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

Download Now!169 Downloads

Caller – The Detail(s)

Code400

Caller – The Detail(s)

Leave a Reply Cancel reply