最新消息:雨落星辰是一个专注网站SEO优化、网站SEO诊断、搜索引擎研究、网络营销推广、网站策划运营及站长类的自媒体原创博客

ibm midrange - Program keep hitting CPF5032 error in rpgle - Stack Overflow

programmeradmin10浏览0评论

I have to do a testing for this program(create by my senior). Basically this program is a patching program, the only thing this program do will check the record and then update the file with a new field. this is the purpose for this program. When I do a testing by calling this program, it hit an error which is CPF5032. When I do a STRDBG, the error hit when the program want to chain a file:-

C     kySOOUTN      Chain     RSOOUTN                            32

Below is the source code:

FDDPAR1    IF   E           K DISK                                         
FPCM00056F IF   E           K DISK    Prefix(in_)                          
FSOOUTNL1  UF   E           K DISK    Rename(RSOOUTN:RSOOUTNL1)            
F                                     Prefix(l1_)                          
FSOOUTN    UF   E           K DISK    Infds(DSSOOUTN)                      
FPCM00056WAIF A E           K DISK    Rename(RSOOUTN:RPCM056WA)            
FPCM00056WBIF A E           K DISK    Rename(RSOOUTN:RPCM056WB)            
***************************************************************************
D*-- Variable Declaration --*                                              
D/copy qsysrefrle,prSSDATE                                                 
 * VARIABLE                                                                
D INFILE          S             10                                         
D WKUPD           S             25    Inz('Record Updated')                
D wk_SOPRSQ       S                   Like(l1_SOPRSQ) Inz                  
D                                                                          
D DSSOOUTN        DS                                                       
D  IFFILE                83     92                                         
D  LENSOOUTN            125    126B 0                                      
D                                                                          
** 1=new changes, 2=old data                                               
D MNTSOOUTN       DS                  LikeRec(RSOOUTN)                     
D                                     DIM(2)                               
D/COPY QMBSREFRLE,MBQTXHD                                                  
***************************************************************************
C*Key list                                                                 
 *                                                                         
C     kySOOUTN      Klist                                                  
C                   Kfld                    l1_SOORGC                      
C                   Kfld                    l1_SOTMPL                      
C                   Kfld                    l1_SOLOCA                      
 *                                                                         
***************************************************************************
C*-- Program Mainline --*                                                  
C                   Read      RDDPAR1                                      
 * Base user upload of new Email Template ID                               
C                   Read      RSOOUTNL1                              30    
C                   Dow       *IN30 = *Off                                 
C                   ExSr      SrUpdSOOUTN                                  
C                   Read      RPCM00056F                             30    
C                   EndDo                                                  
 *                                                                         
C                   Eval      *InLR = '1'                                  
 ****************************************************************          
 *  SUBROUTINE: SrUpdSOOUTN                                     *          
 *  PURPOSE   : Update record from SOOUTN                       *
 ****************************************************************
C     SrUpdSOOUTN   BEGSR                                        
C                                                                
C                   Eval      wk_SOPRSQ = 900                    
C     kySOOUTN      Chain     RPCM00056F                         
C                   If        %Found(PCM00056F)                  
C                   Eval      wk_SOPRSQ = 100                    
C                   EndIf                                        
 *                                                               
C                   Clear                   RPCM056WA              
C                   Clear                   RPCM056WB              
C     kySOOUTN      Chain(N)  RSOOUTN       MNTSOOUTN(2)         32
C     kySOOUTN      Chain     RSOOUTN                            32
C                   If        *In32 = *Off                         
C                   Write     RPCM056WB                            
C                                                                  
C                   Eval      SOPRSQ = wk_SOPRSQ                   
C                   Eval      MNLUID = 'PCM00056'                  
C                   Eval      MNLWID = 'PCM00056'                  
C                   Eval      MNLDT8 = NEXTD7         
C                   Time                    MNLTIM    
C                   Eval      MNLSRC = 'PCM00056'     
                    Update    RSOOUTN %fields(SOPRSQ: 
                                              MNLUID: 
                                              MNLWID: 
                                              MNLDT8: 
                                              MNLTIM: 
                                              MNLSRC);
C                   Write     RPCM056WA               
C     kySOOUTN      Chain(N)  RSOOUTN       MNTSOOUTN(1)         33
C                   Eval      INFILE = 'SOOUTN'                    
C                   EvAL      MNTREQ = '*MAINT'                    
C                   ExSr      SrMNTCTL                             
C                   EndIf                                          
 *                                                                 
C                   ENDSR

This is an error: Error CPF5032

I do a research about this, and the file was lock during running this program, but my senior said that this one just call the program and then the test will done. please kindly help me.

发布评论

评论列表(0)

  1. 暂无评论