Tuesday, 5 February 2013

COBOL Prog to update record from PS file

COBOL Prog to update record from PS file :

IDENTIFICATION DIVISION.                 
PROGRAM-ID. FILUPDT.                     
ENVIRONMENT DIVISION.                    
CONFIGURATION SECTION.                   
OBJECT-COMPUTER. IBM-390.                
SOURCE-COMPUTER. IBM-390.                
INPUT-OUTPUT SECTION.                    
FILE-CONTROL.                            
    SELECT INFILE ASSIGN TO DD1          
    ORGANIZATION IS SEQUENTIAL           
    ACCESS MODE IS SEQUENTIAL            
    FILE STATUS IS FS1.                  
DATA DIVISION.                           
FILE SECTION.                            
FD INFILE                                
    LABEL RECORDS ARE STANDARD           
    BLOCK CONTAINS 0 RECORDS             
    RECORDING MODE IS F.                 
01 INREC.                                
    05 EID                   PIC X(05).      
    05 FILLER            PIC X(01).      
    05 ENAME            PIC X(06).      
    05 FILLER            PIC X(01).      
    05 ESAL                PIC 9(05).      
    05 FILLER            PIC X(62).
      
WORKING-STORAGE SECTION.                 
01 FS1                         PIC X(02).      
01 SWITCH                PIC X(01).      
    88 EOF                    VALUE 'Y'.      
    88 NOT-EOF           VALUE 'N'.      
PROCEDURE DIVISION.                      
    SET NOT-EOF TO TRUE.                 
    PERFORM OPEN-PARA.                   
    PERFORM UPDT-PARA UNTIL EOF.         
    PERFORM CLOSE-PARA.                  
    STOP RUN.                            
OPEN-PARA.                               
    OPEN I-O INFILE                      

    DISPLAY ' INPUT OPEN STATUS ' FS1.   
UPDT-PARA.                               
    IF FS1 = '00'                        
        READ INFILE                      
          AT END                         
              SET EOF TO TRUE            
          NOT AT END                     
              IF EID = '21600'           
                MOVE 99999 TO ESAL       
                REWRITE INREC            
                DISPLAY INREC            
              END-IF                     
        END-READ                         
    END-IF.                              
CLOSE-PARA.                              
    CLOSE INFILE                         
    DISPLAY ' CLOSE FILE STATUS ' FS1.   


3 comments: