RPGIV @ Work

A unique site for RPG and System i Lovers

Welcome!

Hi, this site will provide all what you need in System i and RPG developments.

My Name is Chamara Withanachchi, System i Expert and RPG Developer. And in the field for last 11 years.

I hope you will find lot of valuable information from this site

Retrieve Called Program Print E-mail
User Rating: / 0
PoorBest 
Written by Chamara Withanachchi   
 * Program status information data structure .....
D                SDS                              
D  S@PGM            *PROC                         
D  Device               244    253                
D  S@USER               254    263                

D qwvrcstk        pr                  ExtPgm('QWVRCSTK')               
D                             2000a                                    
D                               10i 0                                  
D                                8a   const                            
D                               56a                                    
D                                8a   const                            
D                               15a                                    
                                                                       
 **********************************************************************
 * Procedure Definitions                                              *
 **********************************************************************
D getCaller       pr            10a                                    

C                   Eval      calledBy = getCaller()

 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 * Procedure getCaller contains the code to retrieve the calling program's name   
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
P getCaller       B                                                               
                                                                                  
D getCaller       PI            10a                                               
                                                                                  
D idx             S              5i 0                                             
D varlen          S             10i 0 inz(%size(var))                             
D apierr          S             15                                                
                                                                                  
D var             DS          2000                                                
D  bytavl                       10i 0                                             
D  bytrtn                       10i 0                                             
D  entries                      10i 0                                             
D  offset                       10i 0                                             
                                                                                  
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    inz                                         
D  entrylen                     10i 0                                             
D  pgmnam                       10    overlay(entry:25)                           
D  pgmlib                       10    overlay(entry:35)                           
                                                                                  
C                   Callp(e)  qwvrcstk(var:varlen:'CSTK0100':jobidinf:            
C                             'JIDF0100':apierr)                                  
C                   For       idx = 1 to entries                                  
C                   Eval      entry = %subst(var:offset + 1)                      
                                                                                  
 * - it is assumed that only system jobs will be in QSYS library and ignores them.
 * - it is assumed that only system jobs will begin with 'Q' and ignores them.    
C                   If        pgmnam <> S@PGM and pgmlib <> 'QSYS'                
C                             and %subst(pgmnam:1:1) <> 'Q'                       
C                   Leave                                                         
C                   EndIf                       
C                   Eval      offset += entrylen
C                   EndFor                      
                                                
C                   Return    pgmnam            
                                                
P getCaller       E                             
                                                

User Comments

Please login or register to add comments

<Previous   Next>