AW: Retrieve the name of the caller

Hi,

I usually use the following simple CL-Programm:
             PGM        PARM(&P$CALLER &P$CALLED)

             DCL        VAR(&P$CALLER) TYPE(*CHAR) LEN(10)
             DCL        VAR(&P$CALLED) TYPE(*CHAR) LEN(10)

             DCL        VAR(&MSGKEY)   TYPE(*CHAR) LEN(4)
             DCL        VAR(&SENDER)   TYPE(*CHAR) LEN(80)
/* -----------------------------------------------------------------*/
             SNDPGMMSG  MSG('TEST') TOPGMQ(*PRV (&P$CALLED))   +
                          MSGTYPE(*RQS) KEYVAR(&MSGKEY)

             RCVMSG     PGMQ(*PRV (&P$CALLED)) MSGKEY(&MSGKEY) +
                          SENDER(&SENDER)

             CHGVAR     VAR(&P$CALLER) VALUE(%SST(&SENDER 56 10))
             ENDPGM

P$Called is the current program (program status datastructure position
1-10).
P$Caller is returned and contains the caller program.

Mit freundlichen Gru?en / Best regards

Birgitta

"Shoot for the moon, even if you miss, you'll land among the stars."
(Les Brown)

-----Ursprungliche Nachricht-----
Von: rpg400-l-bounces@xxxxxxxxxxxx
[mailto:rpg400-l-bounces@xxxxxxxxxxxx]I
m Auftrag von Alan Shore
Gesendet: Donnerstag, 8. Juni 2006 20:05
An: RPG programming on the AS400 / iSeries
Betreff: Re: Retrieve the name of the caller



Praveen - I use the following API within the code
0002.00 H option(*srcstmt:*nodebugio) indent('| ')
0003.00  * PROGRAM STATUS DATA STRUCTURE
0004.00  /copy prdsrc/copybook,psds
0005.00
*---------------------------------------------------------------------
0006.00  * Stand Alone Fields - TOP
0007.00
*---------------------------------------------------------------------
0008.00 D CallingPgmNam   s                   like(Pgmnam)
0009.00 D CallingPgmLib   s                   like(Pgmlib)
0010.00
*---------------------------------------------------------------------
0011.00  * Stand Alone Fields - BOTTOM
0012.00
*---------------------------------------------------------------------
0013.00 D GetCaller       PR                  Extpgm('QWVRCSTK')
0014.00 D                             2000
0015.00 D                               10I 0
0016.00 D                                8    CONST
0017.00 D                               56
0018.00 D                                8    CONST
0019.00 D                               15
0020.00
0021.00 D Var             DS          2000
0022.00 D  BytAvl                       10I 0
0023.00 D  BytRtn                       10I 0
0024.00 D  Entries                      10I 0
0025.00 D  Offset                       10I 0
0026.00 D  EntryCount                   10I 0
0027.00 D VarLen          S             10I 0 Inz(%size(Var))
0028.00 D ApiErr          S             15
0029.00 D JobIdInf        DS
0030.00 D  JIDQName                     26    Inz('*')
0031.00 D  JIDIntID                     16
0032.00 D  JIDRes3                       2    Inz(*loval)
0033.00 D  JIDThreadInd                 10I 0 Inz(1)
0034.00 D  JIDThread                     8    Inz(*loval)
0035.00
0036.00
0037.00 D Entry           DS           256
0038.00 D  EntryLen                     10I 0
0039.00 D  PgmNam                       10    Overlay(Entry:25)
0040.00 D  PgmLib                       10    Overlay(Entry:35)
0041.00
0042.00  *****************************************************************
0043.00 c                   eval      CallingPgmNam = *blanks
0044.00 c                   eval      CallingPgmLib = *blanks
0045.00 C                   CallP
GetCaller(Var:VarLen:'CSTK0100':JobIdInf
0046.00 C                             :'JIDF0100':ApiErr)
0047.00 C                   Do        EntryCount
0048.00 C                   Eval      Entry = %subst(Var:Offset + 1)
0049.00 c                   if        CallingPgmNam = *blanks and
0050.00 c                             CallingPgmLib = *blanks
0051.00 c                   if        PgmNam = psdsPgmName and
0052.00 c                             PgmLib = psdsPgmLib
0053.00 C                   Else
0054.00 c                   eval      CallingPgmNam = Pgmnam
0055.00 c                   eval      CallingPgmLib = Pgmlib
0056.00 C                   Endif
0057.00 C                   Endif
0058.00 C                   Eval      Offset = Offset + EntryLen
0059.00 C                   Enddo
  0060.00  *
0061.00
0062.00 c                   move      *on           *inlr
0063.00 c                   return

The fields that begin psds are from the program data structure.



Alan Shore

NBTY, Inc
(631) 244-2000 ext. 5019
AShore@xxxxxxxx





             "praveen gunda"
             <praveen.gunda@gm
             ail.com>                                                   To
             Sent by:                  "RPG programming on the AS400 /
             rpg400-l-bounces+         iSeries" <rpg400-l@xxxxxxxxxxxx>
             alanshore=nbty.co                                          cc
             m@xxxxxxxxxxxx
                                                                   Subject
                                       Retrieve the name of the caller
             06/08/2006 11:57
             AM


             Please respond to
              RPG programming
              on the AS400 /
                  iSeries
             <rpg400-l@midrang
                  e.com>






How can I get the name of the called program from inside the current
program?

Eg: PgmA calls PgmB

inside PgmB how can I get the name of the called Program, which in this
case
should be PgmA
--
This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing list
To post a message email: RPG400-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/rpg400-l.