Procedure prototypes (in PRCRTN_P copybook):


D CheckRtnKeys    PR            10I 0 Extproc('CheckRtnKeys')          
D   ExitKey                      1A   Options(*Nopass)                 
D   CancelKey                    1A   Options(*Nopass)                 
 *---------------------------------------------------------------------
D SetExitKey      PR            10I 0 Extproc('SetExitKey')            
D   ExitValue                    1N   Options(*Nopass)                 
 *---------------------------------------------------------------------
D SetCancelKey    PR            10I 0 Extproc('SetCancelKey')          
D   CancelValue                  1N   Options(*Nopass)                 
 *---------------------------------------------------------------------


Source for module PRCRTN:


H NOMAIN                                                               
 *=====================================================================
D/COPY QRPGLECPY,PRCRTN_P                                             
D/COPY QSYSINC/QRPGLESRC,QUSEC                                                 
D/COPY QSYSINC/QRPGLESRC,QUSRJOBI                                      
D QUSI0600_Len    S             10I 0 Inz(%len(QUSI0600))              
D JOBI0600        S              8A   Inz('JOBI0600')                  
 *                                                                     
D qJob            S             26A   Inz('*')                         
 *                                                                     
 *=====================================================================
 * CheckRtnKeys                                                        
 *=====================================================================
P CheckRtnKeys    B                   Export                           
D                 PI            10I 0                                  
D  ExitKey                       1A   Options(*Nopass)                 
D  CancelKey                     1A   Options(*Nopass)                 
 *---------------------------------------------------------------------
 *                                                                     
C                   Clear                   QUSI0600                   
C                   Clear                   QUSEC                      
C                   Call(e)   'QUSRJOBI'                               
C                   Parm                    QUSI0600                   
C                   Parm                    QUSI0600_Len               
C                   Parm                    JOBI0600                   
C                   Parm                    qJob                       
C                   Parm                    QUSIJID05                  
C                   Parm                    QUSEC                      
 *                                                                     
C                   If        %addr(ExitKey) <> *Null                  
C                   Eval      ExitKey = QUSEK                          
C                   Endif                                              
C                   If        %addr(CancelKey) <> *Null                
C                   Eval      CancelKey = QUSCK00                      
C                   Endif                                              
 *                                                                     
C                   If        %error or                                
C                             BytesAvail > 0                           
C                   Exsr      *PSSR                                    
C                   Endif                                              
 *                                                                     
C                   Return    0                                        
 *                                                                     
C     *PSSR         Begsr                                              
C                   Return    1                                        
C                   Endsr                                              
 *                                                                     
P                 E                                                    
 *=====================================================================
 * SetExitKey                                                          
 *=====================================================================
P SetExitKey      B                   Export                           
D                 PI            10I 0                                  
D P_KeyValue                     1N   Options(*Nopass)                 
 *---------------------------------------------------------------------
D ChgJobInfDS     DS                                                   
D   NbrVarLenRcd                10I 0 Inz(1)                           
D   KeyID                       10I 0 Inz(1)                           
D   KeyDataLen                  10I 0 Inz(4)                           
D   KeyData                      4A   Inz                              
D     KeyValue                   1N   Overlay(KeyData:1)               
 *---------------------------------------------------------------------
 *                                                                     
C                   If        %parms > 0                               
C                   Eval      KeyValue = P_KeyValue                    
C                   Else                                               
C                   Eval      KeyValue = *On                           
C                   Endif                                              
 *                                                                     
C                   Clear                   QUSEC                      
C                   Eval      BytesProv = %len(QUSEC)                  
C                   Call(e)   'QWCCCJOB'                               
C                   Parm                    ChgJobInfDS                
C                   Parm                    QUSEC                      
 *                                                                     
C                   If        %error or                                
C                             BytesAvail > 0                           
C                   Exsr      *PSSR                                    
C                   Endif                                              
 *                                                                     
C                   Return    0                                        
 *                                                                     
C     *PSSR         Begsr                                              
C                   Return    1                                        
C                   Endsr                                              
 *                                                                     
P                 E                                                    
 *=====================================================================
 * SetCancelKey                                                        
 *=====================================================================
P SetCancelKey    B                   Export                           
D                 PI            10I 0                                  
D P_KeyValue                     1N   Options(*Nopass)                 
 *---------------------------------------------------------------------
D ChgJobInfDS     DS                                                   
D   NbrVarLenRcd                10I 0 Inz(1)                           
D   KeyID                       10I 0 Inz(2)                           
D   KeyDataLen                  10I 0 Inz(4)                           
D   KeyData                      4A   Inz                              
D     KeyValue                   1N   Overlay(KeyData:1)               
 *---------------------------------------------------------------------
 *                                                                     
C                   If        %parms > 0                               
C                   Eval      KeyValue = P_KeyValue                    
C                   Else                                               
C                   Eval      KeyValue = *On                           
C                   Endif                                              
 *                                                                     
C                   Clear                   QUSEC                      
C                   Eval      BytesProv = %len(QUSEC)                  
C                   Call(e)   'QWCCCJOB'                               
C                   Parm                    ChgJobInfDS                
C                   Parm                    QUSEC                      
 *                                                                     
C                   If        %error or                                
C                             BytesAvail > 0                           
C                   Exsr      *PSSR                                    
C                   Endif                                              
 *                                                                     
C                   Return    0                                        
 *                                                                     
C     *PSSR         Begsr                                              
C                   Return    1                                        
C                   Endsr                                              
 *                                                                     
P                 E                                                    


Binder source for service program PRCRTNS1R:


             STRPGMEXP  SIGNATURE('PRCRTNS1R')
                                            
             EXPORT     SYMBOL('CheckRtnKeys')
             EXPORT     SYMBOL('SetExitKey')
             EXPORT     SYMBOL('SetCancelKey')
             
             ENDPGMEXP                      


Command to create service program PRCRTNS1R:


CRTSRVPGM                 
  SRVPGM(QGPL/PRCRTNS1R)   
  MODULE(PRCRTN)         
  EXPORT(*SRCFILE)        
  SRCFILE(QSRVSRC)        
  SRCMBR(*SRVPGM)         
  ACTGRP(*CALLER)         
  OPTION(*DUPPROC *DUPVAR)