Habe das Programm etwas modifiziert, da es bei mir einen etwas anderen Zweck erfüllt.
Brauchtst es nur als RPGLE umzuwandeln und fertisch.
Das Programm liefert den Programmname/Bibliothek des aufrufenden Programmes zurück.
Gruß
DVE

PHP-Code:
     *
     D GetCaller       PR                  Extpgm('QWVRCSTK')                                       
     D                             2000                                                             
     D                               10I 0                                                          
     D                                8    CONST                                                    
     D                               56                                                             
     D                                8    CONST                                                    
     D                               15                                                             
     **                                                                     --**                    
     D Var             DS         65534                                                             
     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 APIErrorDS      DS                                                                           
     D                               10I 0 Inz( %Size( APIErrorDS ) )                               
     D  BytesAvail                   10I 0 Inz( *Zero )                                             
     D                                7    Inz( *Blanks )                                           
     D                                1    Inz( X'00' )                                             
     D  errmsg                 9     15                                                             
     D                              256    Inz( *Blanks )                                           
     **                                                                     --**                    
     D JobIdInf        DS                                                                           
     D  JIDQName                     26    Inz( *Blank )                                            
     D  JIDIntID                     16                                                             
     D  JIDRes3                       2    Inz(*Allx'00')                                           
     D  JIDThreadInd                 10I 0 Inz(2)                                                   
     D  JIDThread                     8    Inz(*Allx'00')                                           
     ** beginn hauptprogramm                                                --**                    
     D ReaStack        DS           256                                                             
     D  EntryLen                     10I 0                                                          
     D  PgmName                      10    Overlay(ReaStack:25)                                     
     D  PgmLib                       10    Overlay(ReaStack:35)                                     
     D  QWVSI01                      10    OVERLAY(ReaStack:117)                                    
     D                                                                                              
     D ProgramName     DS            20                                                             
     D  Programm                     10                                                             
     D  Library                      10                                                             
      *                                                                                             
     D                SDS                                                                           
     D  ThisPgm                1     10                                                             
      *                                                                                             
     ** beginn hauptprogramm                                                --**                    
     c     *entry        plist                                                                      
     c                   parm                    ReturnCode        7                                
     c                   parm                    ProgramName      20                                
      *                                                                                             
     c                   movel(p)  '*'           JIDQName                                           
     c                   movel(p)  *BLANKS       ReturnCode                                         
      *                                                                                             
     c                   z-add     0             timea             6 0                              
     c                   z-add     0             zahl              6 0                              
     c     errmsg        doueq     *blanks                                                          
     c     errmsg        oreq      'CPF3C53'                                                        
     c     zahl          orge      3                                                                
     c                   reset                   APIErrorDS                                         
     C                   CallP     GetCaller(Var:VarLen:'CSTK0100':JobIdInf                         
     C                             :'JIDF0100':APIErrorDS)                                          
     c                   time                    timeb             6 0                              
     c     timea         ifne      timeb                                                            
     c                   add       1             zahl                                               
     c                   z-add     timeb         timea                                              
     c                   endif                                                                      
     c                   enddo                                                                      
     c     errmsg        ifeq      *BLANKS                                                          
     c                   movel     *BLANKS       ProgramName                                        
     C                   Do        Entries                                                          
     C                   Eval      ReaStack  = %subst(Var:Offset + 1)                               
     C                   Eval      Offset    = Offset + EntryLen                                    
      * programm und programmlib nach array                                                         
     c     PgmName       ifne      'QCMD'                                                           
     c     PgmName       andne     ThisPgm                                                          
     c     ProgramName   andeq     *BLANKS                                                          
     c                   movel(p)  PgmName       Programm                                           
     c                   movel(p)  Pgmlib        Library                                            
     c                   endif                                                                      
      *                                                                                             
     C                   Enddo                                                                      
     c                   else                                                                       
     c                   movel     *blanks       ProgramName                                        
     c     '*'           cat       errmsg:0      ProgramName                                        
     c                   movel(p)  errmsg        ReturnCode                                         
     c                   endif                                                                      
      *                                                                                             
     C                   return