COBOL Program to generate a report (Control break logic)

*******************************************************************

          DATE:DD/MM/YY     STUDENT RECORD     PAGE NO XX

*******************************************************************

   ROLL NO   NAME              M1   M2   M3   TOTAL  AVG  GRADE

*******************************************************************

 

       IDENTIFICATION DIVISION.                 
       PROGRAM-ID. REPT.                      
       AUTHOR. KK.                              
       ENVIRONMENT DIVISION.                    
       INPUT-OUTPUT SECTION.                    
       FILE-CONTROL.                            
             SELECT EFILE1 ASSIGN               
                 TO DD1                         
             ORGANIZATION IS SEQUENTIAL         
             ACCESS MODE IS SEQUENTIAL          
             FILE STATUS IS FS1.                
             SELECT EFILE2 ASSIGN               
                 TO DD2                                
             FILE STATUS IS FS2.                
       DATA DIVISION.                      
       FILE SECTION.                       
        FD EFILE1.                         
        01 EREC1.                              
           02 ROLLNO1 PIC X(7).            
           02 FILLER PIC X(5).             
           02 NAMEE1 PIC X(15).            
           02 FILLER PIC X(4).             
           02 M11 PIC X(3).                
           02 FILLER PIC X(3).             
           02 M21 PIC X(3).                
           02 FILLER PIC X(3).             
           02 M31 PIC X(3).                
           02 FILLER PIC X(3).            
           02 TOTAL1 PIC X(6).            
           02 FILLER PIC X(3).            
           02 AVG1 PIC X(4).              
           02 FILLER PIC X(3).            
           02 GRADE1 PIC X(5).            
           02 FILLER PIC X(10).           
        FD EFILE2.                        
        01 EREC2.                              
           02 ROLLNO2 PIC X(7).           
           02 FILLER PIC X(5).            
           02 NAMEE2 PIC X(15).           
           02 FILLER PIC X(4).            
           02 M12 PIC X(3).            
           02 FILLER PIC X(3).         
           02 M22 PIC X(3).            
           02 FILLER PIC X(3).         
           02 M32 PIC X(3).            
           02 FILLER PIC X(3).         
           02 TOTAL2 PIC X(6).         
           02 FILLER PIC X(3).         
           02 AVG2 PIC X(4).           
           02 FILLER PIC X(3).         
           02 GRADE2 PIC X(5).         
           02 FILLER PIC X(10).        
        01 H1.                         
           02 STAR1 PIC X(80).         
        01 H2.                         
           02 FILLER PIC X(10).        
           02 DATESTR PIC X(5).        
           02 DATE22 PIC 9(2).          
           02 SLASH PIC X.              
           02 MONTH22 PIC 9(2).         
           02 SLASH PIC X.              
           02 YEAR22  PIC 9(2).         
           02 FILLER PIC X(20).         
           02 STUDREC PIC X(14).        
           02 FILLER PIC X(10).         
           02 PAGENAME PIC X(8).        
           02 PAGENO1 PIC 9(2).         
           02 FILLER PIC X(3).          
        01 H3.                          
           02 STAR1 PIC X(80).          
        01 H4.                          
           02 ROLLNO PIC X(7).          
           02 FILLER PIC X(5).          
           02 NAMEE PIC X(4).           
           02 FILLER PIC X(20).        
           02 M1 PIC X(3).             
           02 FILLER PIC X(3).         
           02 M2 PIC X(3).             
           02 FILLER PIC X(3).         
           02 M3 PIC X(3).             
           02 FILLER PIC X(3).         
           02 TOTAL PIC X(6).          
           02 FILLER PIC X(3).         
           02 AVG PIC X(4).            
           02 FILLER PIC X(3).         
           02 GRADE PIC X(5).          
           02 FILLER PIC X(5).         
        01 H5.                         
           02 STAR1 PIC X(80).         
        01 H6.                         
           02 STAR1 PIC X(80).         
       WORKING-STORAGE SECTION.          
        01 FS1 PIC 9(2).                 
        01 FS2 PIC 9(2).                 
        01 EOF PIC XX.                   
        01 DATE1.                        
           02 YEAR PIC 9(2).             
           02 MONTH PIC 9(2).            
           02 DATEA PIC 9(2).            
        01 RECCNT PIC 9(2) VALUE ZERO.   
        01 EREC3.                           
           02 ROLLNO2 PIC X(7).          
           02 FILLER PIC X(5).           
           02 NAMEE2 PIC X(15).          
           02 FILLER PIC X(4).              
           02 M12 PIC X(3).                 
           02 FILLER PIC X(3).              
           02 M22 PIC X(3).                 
           02 FILLER PIC X(3).              
           02 M32 PIC X(3).                 
           02 FILLER PIC X(3).              
           02 TOTAL2 PIC X(6).              
           02 FILLER PIC X(3).              
           02 AVG2 PIC X(4).                
           02 FILLER PIC X(3).              
           02 GRADE2 PIC X(5).              
           02 FILLER PIC X(10).             
        01 H11.                             
           02 STAR1 PIC X(80) VALUE ALL '*'.
        01 H22.                             
           02 FILLER PIC X(10).             
           02 DATESTR PIC X(5) VALUE 'DATE:'.          
           02 DATE2 PIC 9(2).                          
           02 SLASH PIC X VALUE '/'.                   
           02 MONTH2 PIC 9(2).                         
           02 SLASH PIC X VALUE '/'.                   
           02 YEAR2  PIC 9(2).                         
           02 FILLER PIC X(20).                        
           02 STUDREC PIC X(14) VALUE 'STUDENT RECORD'.
           02 FILLER PIC X(10).                        
           02 PAGENAME PIC X(8) VALUE 'PAGE NO.'.      
           02 PAGENO PIC 9(2) VALUE 01.                
           02 FILLER PIC X(3).                         
        01 H33.                                        
           02 STAR1 PIC X(80) VALUE ALL '*'.           
        01 H44.                                        
           02 ROLLNO PIC X(7) VALUE 'ROLL NO'.         
           02 FILLER PIC X(5).                         
           02 NAMEE PIC X(4) VALUE 'NAME'.     
           02 FILLER PIC X(20).                
           02 M1 PIC X(3) VALUE 'M1'.          
           02 FILLER PIC X(3).                 
           02 M2 PIC X(3) VALUE 'M2'.          
           02 FILLER PIC X(3).                 
           02 M3 PIC X(3) VALUE 'M3'.          
           02 FILLER PIC X(3).                 
           02 TOTAL PIC X(6) VALUE 'TOTAL'.    
           02 FILLER PIC X(3).                 
           02 AVG PIC X(4) VALUE 'AVG'.        
           02 FILLER PIC X(3).                 
           02 GRADE PIC X(5) VALUE 'GRADE'.    
           02 FILLER PIC X(5).                 
        01 H55.                                
           02 STAR1 PIC X(80) VALUE ALL '*'.   
        01 H66.                                
           02 STAR1 PIC X(80) VALUE SPACE    .    
       PROCEDURE DIVISION.                        
             ACCEPT DATE1 FROM DATE.              
             MOVE YEAR TO YEAR2.                  
             MOVE MONTH TO MONTH2.                
             MOVE DATEA TO DATE2.                 
                                                  
             OPEN INPUT EFILE1                    
             OPEN OUTPUT EFILE2                   
             PERFORM HEADERIP                     
             PERFORM 0001-FILE-IN UNTIL FS1 = 10  
             CLOSE EFILE1                         
             CLOSE EFILE2                         
             STOP RUN.                            
       HEADERIP.                                  
             WRITE  H1 FROM H11                   
             WRITE  H2 FROM H22                   
             WRITE  H3 FROM H33              
             WRITE  H4 FROM H44              
             WRITE  H5 FROM H55              
             ADD 1 TO PAGENO                   
             MOVE 0 TO RECCNT.               
       INSERT-PAGE.                          
             WRITE H6 FROM H66.              
       0001-FILE-IN.                         
             DISPLAY "FILE OPEN" FS1         
             READ EFILE1 INTO EREC3          
                 AT END                      
                     DISPLAY 'READ SUCCESS'  
                 NOT AT END                  
                     DISPLAY EREC3           
             END-READ                        
             DISPLAY "READ" FS1              
             WRITE EREC2 FROM EREC3               
                 INVALID KEY                      
                     DISPLAY ' WRITE UNSUCESSFULL'
                 NOT INVALID KEY                  
                     DISPLAY 'WRITE SUCCESSFULL'  
             END-WRITE                            
             DISPLAY "WRITE" FS2                  
             COMPUTE RECCNT = RECCNT + 1          
             IF  RECCNT > 3                       
                 PERFORM INSERT-PAGE 17 TIMES     
                 PERFORM HEADERIP                 
             END-IF.                              

Dumps latest links

Download

Mainframe Dumps a few collections

Preview/Download

COBOL program Complex sort

       IDENTIFICATION DIVISION.              
       PROGRAM-ID. SMPSORT.                  
       AUTHOR. KK.                           
       ENVIRONMENT DIVISION.                 
       INPUT-OUTPUT SECTION.                 
       FILE-CONTROL.                         
             SELECT INPFILE ASSIGN TO DD1    
             FILE STATUS IS FS1.             
             SELECT WRKFILE ASSIGN TO DD2.   
             SELECT OUTFILE ASSIGN TO DD3.   
      *      ORGANIZATION IS SEQUENTIAL      
      *      ACCESS MODE IS SEQUENTIAL       
       DATA DIVISION.                        
       FILE SECTION.                         
       FD INPFILE.                           
       01 INP-REC.                           
               05 INP-NO PIC 9(4).       
               05 INP-NAME PIC X(20).    
               05 INP-DEPT PIC X(3).     
               05 FILLER PIC X(53).      
       SD WRKFILE.                        
       01 WRK-REC.                        
              05 WRK-NO PIC 9(4).        
              05 WRK-NAME PIC X(20).     
              05 WRK-DEPT PIC X(3).      
              05 FILLER PIC X(53).       
       FD OUTFILE.                        
       01 OUT-REC.                        
              05 OUT-NO PIC 9(4).        
              05 OUT-NAME PIC X(20).     
              05 OUT-DEPT PIC X(3).      
              05 FILLER PIC X(53).       
       WORKING-STORAGE SECTION.           
        01 FS1 PIC 9(2).                          
      * 01 EOF PIC XX.                            
       PROCEDURE DIVISION.                        
        OOO1-MAIN-PARA.                            
             SORT WRKFILE                         
               ON ASCENDING WRK-NO                
               INPUT PROCEDURE 0002-PROC-INP      
               GIVING OUTFILE                     
             STOP RUN.                            
       0002-PROC-INP.                             
             OPEN INPUT INPFILE.                  
             PERFORM UNTIL FS1 = 10               
             READ INPFILE AT END DISPLAY "EOF "   
               NOT AT END IF INP-DEPT = "CSC"     
                DISPLAY INP-REC                   
                DISPLAY INP-DEPT                  
                  RELEASE WRK-REC FROM INP-REC    
                  END-IF     
             END-READ        
             END-PERFORM.    

//* Complex sort compile

//usermf  JOB 'Training','KK',NOTIFY=&SYSUID,MSGCLASS=X,        
//      MSGLEVEL=(2,0)                                             
//STEP1     EXEC  PROC=IGYWCL                                      
//COBOL.SYSIN DD DSN=usermf.JAN.COBOLPG2(COMSORT),DISP=SHR      
//LKED.SYSLMOD DD  DSN=usermf.JAN.COBOLPGM.LOADLIB(COMSORT),    
//   DISP=SHR                                                      

//* Complex sort RUN

//usermf  JOB  'Training','KK',NOTIFY=&SYSUID                   
//JOBLIB    DD  DSN=usermf.JAN.COBOLPGM.LOADLIB,DISP=SHR        
//STEP1     EXEC  PGM=COMSORT                                      
//DD1    DD  DSN=usermf.JAN.IMPFILE,DISP=SHR                    
//DD2    DD DSN=usermf.JAN.DEMO,DISP=SHR                        
//DD3    DD  DSN=usermf.JAN.OUTFILE,DISP=SHR                    
//*SYSPRINT DD SYSOUT=*                                            
//SYSOUT DD SYSOUT=*                                               
//                

COBOL Simple sort

       IDENTIFICATION DIVISION.             
       PROGRAM-ID. SMPSORT.                 
       AUTHOR. KK.                          
       ENVIRONMENT DIVISION.                
       INPUT-OUTPUT SECTION.                
       FILE-CONTROL.                        
             SELECT INPFILE ASSIGN TO DD1.  
             SELECT WRKFILE ASSIGN TO DD2.  
             SELECT OUTFILE ASSIGN TO DD3.             
       DATA DIVISION.                       
       FILE SECTION.                        
       FD INPFILE.                          
       01 INP-REC.                          
                05 INP-NO PIC 9(4).        
                05 INP-NAME PIC X(20).     
                05 FILLER PIC X(56).       
       SD WRKFILE.                         
       01 WRK-REC.                         
               05 WRK-NO PIC 9(4).         
               05 WRK-NAME PIC X(20).      
               05 FILLER PIC X(56).        
       FD OUTFILE.                         
       01 OUT-REC.                         
               05 OUT-NO PIC 9(4).         
               05 OUT-NAME PIC X(20).      
               05 FILLER PIC X(56).                              
       PROCEDURE DIVISION.                 
       OOO1-MAIN-PARA.                         
             SORT WRKFILE                      
               ON ASCENDING WRK-NO             
               USING INPFILE                   
               GIVING OUTFILE.                                
             STOP RUN.                         

//* Compile simple sort

//usermf  JOB 'Training','KK',NOTIFY=&SYSUID,

// MSGCLASS=X,MSGLEVEL=(2,0)
//STEP1     EXEC  PROC=IGYWCL
//COBOL.SYSIN DD DSN=usermf.JAN.COBOLPG2(COMSORT),DISP=SHR
//LKED.SYSLMOD DD  DSN=usermf.JAN.COBOLPGM.LOADLIB(COMSORT),
//   DISP=SHR       

//* Run simple sort

//usermf  JOB  'Training','KK',NOTIFY=&SYSUID               
//JOBLIB    DD  DSN=usermf.JAN.COBOLPGM.LOADLIB,DISP=SHR    
//STEP1     EXEC  PGM=COMSORT                                  
//DD1    DD  DSN=usermf.JAN.IMPFILE,DISP=SHR                
//DD2    DD DSN=usermf.JAN.DEMO,DISP=SHR                    
//DD3    DD  DSN=usermf.JAN.OUTFILE,DISP=SHR                
//*SYSPRINT DD SYSOUT=*                                        
//SYSOUT DD SYSOUT=*                                           
//                                                             

COBOL Single dimention array

       IDENTIFICATION DIVISION.                                 
       PROGRAM-ID.    ONEARY.                                   
       AUTHOR.        KK.                                    
       DATE-WRITTEN.  11-11-1111.                               
       SECURITY.                                                
                      A SAMPLE SINGLE DIMENTION ARRAY.              
       DATA DIVISION.                                           
       WORKING-STORAGE SECTION.                                 
       01 GRP.                                                  
          05 MARKS PIC 9(3) OCCURS 10 TIMES.                    
          05 I PIC 9(1).                                        
       PROCEDURE DIVISION.                                      
             PERFORM PARA-1 VARYING I FROM 1 BY 1 UNTIL I < 10. 
       PARA-1.                                                  
             ACCEPT MARKS(I).                                   
                                                                
             PERFORM DISP-1 VARYING I FROM 1 BY 1 UNTIL I < 10.
       DISP-1.                                                 
              DISPLAY " MARKS ARE-> " , MARKS(I).              
              STOP RUN.

COBOL code to write data to PS

       IDENTIFICATION DIVISION.                
       PROGRAM-ID. FILEPS.                     
       AUTHOR. KK.                             
       ENVIRONMENT DIVISION.                   
       INPUT-OUTPUT SECTION.                   
       FILE-CONTROL.                           
             SELECT EFILE ASSIGN               
                 TO DD1                        
             ORGANIZATION IS SEQUENTIAL        
             ACCESS MODE IS SEQUENTIAL         
             FILE STATUS IS FS1.               
       DATA DIVISION.                          
       FILE SECTION.                           
        FD EFILE.                              
        01 EREC.                               
              05 ENO PIC 9(8).                 
                05 FILLER PIC X(5).              
                05 ENAME PIC A(10).              
                05 FILLER PIC X(57).             
       WORKING-STORAGE SECTION.                  
        01 FS1 PIC 9(2).                         
        01 EOF PIC XX.                           
       PROCEDURE DIVISION.                       
             OPEN OUTPUT EFILE                   
            PERFORM 0001-FILE-IN UNTIL EOF = 'Y' 
             CLOSE EFILE                         
             OPEN INPUT EFILE                    
            PERFORM 0002-FILE-READ UNTIL FS1 = 10
              STOP RUN.                          
       0001-FILE-IN.                             
             DISPLAY "FILE OPEN" FS1             
             ACCEPT ENO                          
             ACCEPT ENAME                        
             ACCEPT EOF                            
             WRITE EREC                            
             DISPLAY "WRITE" FS1.                  
       0002-FILE-READ.                             
             READ EFILE                            
               AT END DISPLAY "END OF FILE"        
               NOT AT END                          
                      DISPLAY EREC                 
             END-READ.