     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                                                                            
