A quick method to determine the name of the calling program in RPG400

From: "Peter Connell" 
Infinitely, IBM has kindly provided us with QWVRCSTK at V5.
Here's a "quickee" I whipped up to prove it.

D GetCaller       PR                  Extpgm('QWVRCSTK')
D                             2000
D                               10I 0
D                                8    CONST
D                               56
D                                8    CONST
D                               15

D Var             DS          2000
D  BytAvl                       10I 0
D  BytRtn                       10I 0
D  Entries                      10I 0
D  Offset                       10I 0
D  EntryCount                   10I 0
D VarLen          S             10I 0 Inz(%size(Var))
D ApiErr          S             15

D JobIdInf        DS
D  JIDQName                     26    Inz('*')
D  JIDIntID                     16
D  JIDRes3                       2    Inz(*loval)
D  JIDThreadInd                 10I 0 Inz(1)
D  JIDThread                     8    Inz(*loval)

D Entry           DS           256
D  EntryLen                     10I 0
D  PgmNam                       10    Overlay(Entry:25)
D  PgmLib                       10    Overlay(Entry:35)
D
C                   CallP     GetCaller(Var:VarLen:'CSTK0100':JobIdInf
C                             :'JIDF0100':ApiErr)
C                   Do        EntryCount
C                   Eval      Entry = %subst(Var:Offset + 1)
C                   Eval      Offset = Offset + EntryLen
C                   Enddo
C                   Eval      *InLR = *on

[report a broken link by clicking here]