Sample COBOL Program's

Programe1:
IDENTIFICATION DIVISION.
       PROGRAM-ID.CLASS1.
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT CLASS ASSIGN TO "CLASS.TXT" ORGANIZATION IS
            LINE SEQUENTIAL.        
       DATA DIVISION.
       FILE SECTION.
       FD CLASS.
       01 SREC1.         
          02 NAME1 PIC A(20).
          02 ROLL PIC X(10).
          02 ID1 PIC 9.
       01 SREC2.         
          02 NAME2 PIC A(20).
          02 PH1 PIC 9(10).
          02 ID2 PIC 9.
       WORKING-STORAGE SECTION.
       01 C1 PIC X.
       01 C2 PIC X.
       01 C3 PIC X.
       01 C4 PIC X.
       01 FLAG PIC 9 VALUE 0.
       01 FLAG1 PIC 9 VALUE 0.   
       PROCEDURE DIVISION.
       P1.
           DISPLAY SPACES AT 0102.
           DISPLAY "Roll OR Phone" AT 0201.
           ACCEPT C1 AT 0230.
           IF C1 = "R"
           OPEN EXTEND CLASS
           PERFORM P2 UNTIL C2 = "N"
           CLOSE CLASS
           ELSE
           IF C1 = "P"
           OPEN EXTEND CLASS
           PERFORM P3 UNTIL C3 = "N"
           CLOSE CLASS.
           DISPLAY "CONTINUE PROCESS" AT 0701.
           ACCEPT C4 AT 0720.
           IF C4 = "Y"
           GO TO P1
           ELSE
           IF C4 = "N"
           NEXT SENTENCE.
      *     DISPLAY "ENTER UR ID" AT 0801.
      *     ACCEPT ID AT 0830.
           OPEN INPUT CLASS.
           PERFORM P4 UNTIL FLAG1 = 1.
           CLOSE CLASS.
           IF FLAG1 = 1
           DISPLAY "*****************"
           STOP RUN.
       P2.
           DISPLAY "ID1" AT 0301.
           ACCEPT ID1 AT 0320.
           DISPLAY "NAME1" AT 0401.
           ACCEPT NAME1 AT 0420.
           DISPLAY "ROLL" AT 0501.
           ACCEPT ROLL AT 0520.
           WRITE SREC1.
           DISPLAY "CONTINUE" AT 0601.
           ACCEPT C2 AT 0620.
       P3.
           DISPLAY "ID2" AT 0335.
           ACCEPT ID2 AT 0345.
           DISPLAY "NAME2" AT 0435.
           ACCEPT NAME2 AT 0445.
           DISPLAY "PHONE" AT 0535.
           ACCEPT PH1 AT 0545.
           WRITE SREC2.
           DISPLAY "CONTINUE" AT 0635.
           ACCEPT C3 AT 0645.
       P4.
           READ CLASS AT END MOVE 1 TO FLAG1.
           IF ID1 = 1
           DISPLAY "NAME IS  " NAME1
           DISPLAY "ROLL IS  " ROLL      
           MOVE 0 TO FLAG1
           ELSE
           IF ID2 = 2
           DISPLAY "NAME IS  " NAME2
           DISPLAY " PHONE IS  " PH1          
           MOVE 0 TO FLAG1.

Programe2:
       IDENTIFICATION DIVISION.
       PROGRAM-ID.CLASS1.
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT CLASS ASSIGN TO "CLASS.TXT" ORGANIZATION IS
            LINE SEQUENTIAL.        
       DATA DIVISION.
       FILE SECTION.
       FD CLASS.
       01 SREC1.         
          02 NAME1 PIC A(20).
          02 ROLL PIC X(10).
          02 ID1 PIC 9.
       01 SREC2.         
          02 NAME2 PIC A(20).
          02 PH1 PIC 9(10).
          02 ID2 PIC 9.
       WORKING-STORAGE SECTION.
       01 C1 PIC X.
       01 C2 PIC X.
       01 C3 PIC X.
       01 C4 PIC X.
       01 FLAG PIC 9 VALUE 0.
       01 FLAG1 PIC 9 VALUE 0.   
       PROCEDURE DIVISION.
       P1.
           DISPLAY SPACES AT 0102.
           DISPLAY "Roll OR Phone" AT 0201.
           ACCEPT C1 AT 0230.
           IF C1 = "R"
           OPEN EXTEND CLASS
           PERFORM P2 UNTIL C2 = "N"
           CLOSE CLASS
           ELSE
           IF C1 = "P"
           OPEN EXTEND CLASS
           PERFORM P3 UNTIL C3 = "N"
           CLOSE CLASS.
           DISPLAY "CONTINUE PROCESS" AT 0701.
           ACCEPT C4 AT 0720.
           IF C4 = "Y"
           GO TO P1
           ELSE
           IF C4 = "N"
           NEXT SENTENCE.
      *     DISPLAY "ENTER UR ID" AT 0801.
      *     ACCEPT ID AT 0830.
           OPEN INPUT CLASS.
           PERFORM P4 UNTIL FLAG1 = 1.
           CLOSE CLASS.
           IF FLAG1 = 1
           DISPLAY "*****************"
           STOP RUN.
       P2.
           DISPLAY "ID1" AT 0301.
           ACCEPT ID1 AT 0320.
           DISPLAY "NAME1" AT 0401.
           ACCEPT NAME1 AT 0420.
           DISPLAY "ROLL" AT 0501.
           ACCEPT ROLL AT 0520.
           WRITE SREC1.
           DISPLAY "CONTINUE" AT 0601.
           ACCEPT C2 AT 0620.
       P3.
           DISPLAY "ID2" AT 0335.
           ACCEPT ID2 AT 0345.
           DISPLAY "NAME2" AT 0435.
           ACCEPT NAME2 AT 0445.
           DISPLAY "PHONE" AT 0535.
           ACCEPT PH1 AT 0545.
           WRITE SREC2.
           DISPLAY "CONTINUE" AT 0635.
           ACCEPT C3 AT 0645.
       P4.
           READ CLASS AT END MOVE 1 TO FLAG1.
           IF ID1 = 1
           DISPLAY "NAME IS  " NAME1
           DISPLAY "ROLL IS  " ROLL      
           MOVE 0 TO FLAG1
           ELSE
           IF ID2 = 2
           DISPLAY "NAME IS  " NAME2
           DISPLAY " PHONE IS  " PH1          
           MOVE 0 TO FLAG1.

Programe3:

 000100        IDENTIFICATION DIVISION.               
 000200        PROGRAM-ID. FLITE.                     
 000300        ENVIRONMENT DIVISION.                  
 000400        INPUT-OUTPUT SECTION.                  
 000500        FILE-CONTROL.                          
 000600            SELECT FLITES ASSIGN TO OFLITES.   
 000700            SELECT PRINT ASSIGN TO OPRINT.     
 000800        DATA DIVISION.                         
 000900        FILE SECTION.                          
 001000        FD FLITES                              
 001010            RECORDING MODE F.                  
 001100        01 IREC.                               
 001200         02 FILLER PIC X.                      
 001300         02 DATE1 PIC X(5).                    
 001400         02 CITY-PAIR PIC X(7).                
 001500         02 AIR-ID PIC X(2).                   

 001600         02 FLITE-NO PIC X(4).    
 001700         02 CLASS1 PIC X.         
 001710           88 A1 VALUES "Y".      
 001720           88 A2 VALUES "F".      
 001730           88 A3 VALUES "C".      
 001900         02 FILLER PIC X(60).     
 002000        FD PRINT                  
 002010            RECORDING MODE F.     
 002100        01 I2REC.                 
 002200         02 FILLER PIC X.         
 002300         02 DATE2 PIC X(5).       
 002310         02 FILLER PIC XX.        
 002400         02 CITY-PAIR2 PIC X(7).  
 002410         02 FILLER PIC XX.        
 002500         02 AIR-ID2 PIC X(2).     
 002510         02 FILLER PIC XX.        
 002600         02 FLITE-NO2 PIC X(4).   
 002610         02 FILLER PIC XX.        
 002700         02 CLASS2 PIC X.         
                           
 002710         02 FILLER PIC XX.          
 002800         02 MILGE2 PIC Z(5).        
 002810         02 FILLER PIC XX.          
 002820         02 NEWMILGE1 PIC 9(5).     
 002900         02 FILLER PIC X(38).       
 002910        01 TOT.                     
 002920         02 FILLER PIC X(30).       
 002930         02 TOTAL2 PIC ZZZ,ZZZ.     
 002931         02 FILLER PIC X.           
 002932         02 BONUSTOT2 PIC Z(5).     
 002940         02 FILLER PIC X(37).       
 003000        WORKING-STORAGE SECTION.    
 003100        COPY M5.                    
 003110        01 FLAG PIC 9 VALUE 0.      
 003120        01 TOTAL PIC 9(6) VALUE 0.  
 003130        01 BONUSTOT PIC 9(5).       
 003140        01 MILGE PIC 9(5).          
 003200        PROCEDURE DIVISION.         
 003300        P1.                         
                             
  003601            OPEN INPUT FLITES.                   
 003602            OPEN OUTPUT PRINT.                   
 003603            READ FLITES AT END MOVE 1 TO FLAG.   
 003604            PERFORM P2 UNTIL FLAG = 1.           
 003605            MOVE TOTAL TO TOTAL2.                
 003606            MOVE BONUSTOT TO BONUSTOT2.          
 003607            WRITE TOT.                           
 003608            CLOSE FLITES.                        
 003609            CLOSE PRINT.                         
 003620            STOP RUN.                            
 005300        P2.                                      
 005310            PERFORM SP.                          
 005400            IF A1                                
 005500            MOVE MILGE TO NEWMILGE1              
 005510            ELSE IF A2                           
 005520            COMPUTE NEWMILGE1 = MILGE * 1.50     
 005540            ELSE IF A3                           
 005550            COMPUTE NEWMILGE1 = MILGE * 1.25.    
 005560            IF NEWMILGE1 < 500                   

 005570            MOVE 500 TO NEWMILGE1.                                      
 005600            MOVE DATE1 TO DATE2.                                        
 005610            MOVE CITY-PAIR TO CITY-PAIR2.                               
 005620            MOVE AIR-ID TO AIR-ID2.                                     
 005630            MOVE FLITE-NO TO FLITE-NO2.                                 
 005640            MOVE CLASS1 TO CLASS2.                                      
 005650            MOVE MILGE TO MILGE2.                                       
 005660            COMPUTE TOTAL = TOTAL + MILGE.                              
 005670            COMPUTE BONUSTOT = BONUSTOT + NEWMILGE1.                    
 005700            WRITE I2REC.                                                
 005800            READ FLITES AT END MOVE 1 TO FLAG.                          
 005900        SP.                                                             
 006000            SET NDX TO 1.                                               
 006100            SEARCH C-P VARYING NDX                                      
 006200            WHEN CITY-PAIR(1:3) = ORG(NDX) AND                          
 006300            CITY-PAIR(5:3) = DEST(NDX) OR CITY-PAIR(1:3) = DEST(NDX)    
 006400            AND CITY-PAIR(5:3) = ORG(NDX)                               
 006500            MOVE ACT-MIL(NDX) TO MILGE.                                 
                                                                                   
Programe4:
       IDENTIFICATION DIVISION.
       PROGRAM-ID. LAB6.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT SORTINPT ASSIGN TO SORTINPT.
           SELECT PRINTOUT ASSIGN TO PRINTOUT.
           SELECT SORTWORK ASSIGN TO SORTWORK.
       DATA DIVISION.
       FILE SECTION.
       FD SORTINPT
            RECORD CONTAINS 80
            RECORDING MODE IS F.
       01 IN-REC PIC X(80).
       FD PRINTOUT
            RECORD CONTAINS 80
            RECORDING MODE IS F.
       01 OUT-REC PIC X(80).
       SD SORTWORK
            RECORD CONTAINS 80.
       01 SORT-REC.
            02 S-NAME-EXP PIC X(30).
            02 S-NAME PIC X(18).
            02 FILLER PIC X(3).
            02 S-PHONE PIC X(8).
            02 FILLER PIC X(21).
       WORKING-STORAGE SECTION.
       77 E-O-F PIC 9 VALUE 0.
            88 EOF VALUE 1.
       77 CNT PIC 9(4).
       77 PTR PIC 9(4).
       01 WS-REC.
            02 WS-NAME-EXP PIC X(30).
            02 WS-IN-REC.
               05 WS-NAME PIC X(30).
               05 FILLER PIC X(3).
               05 WS-PHONE PIC X(8).
               05 FILLER PIC X(29).
       01 WS-OUTREC.
            02 WS-NAME-EXP1 PIC X(30).
            02 WS-IN-REC1.
               05 WS-NAME1 PIC X(30).
               05 FILLER PIC X(3).
               05 WS-PHONE1 PIC X(8).
               05 FILLER PIC X(29).
       PROCEDURE DIVISION.
       MAIN-PARA.
            DISPLAY SPACES.
            SORT SORTWORK ON ASCENDING KEY S-NAME-EXP
                 INPUT PROCEDURE IS PROC-IN
                 OUTPUT PROCEDURE IS PROC-OUT.
            STOP RUN.
       PROC-IN.
            OPEN INPUT SORTINPT.
            READ SORTINPT INTO WS-IN-REC AT END MOVE
                 1 TO E-O-F.
            PERFORM UNTIL EOF
               PERFORM FORMAT-NAME
               RELEASE SORT-REC FROM WS-REC
               READ SORTINPT INTO WS-IN-REC AT END MOVE 1 TO
                    E-O-F
               END-READ
               END-PERFORM.
            CLOSE SORTINPT.
       FORMAT-NAME.
            MOVE SPACES TO WS-NAME-EXP.
            MOVE 1 TO PTR.
            UNSTRING WS-NAME DELIMITED BY SPACE OR "." INTO
                WS-NAME-EXP COUNT IN CNT
                WITH POINTER PTR
            END-UNSTRING.
            IF CNT = 2
                EVALUATE TRUE
                   WHEN WS-NAME-EXP(1:2) = "DR"
                       MOVE "DOCTOR" TO WS-NAME-EXP
                       MOVE WS-NAME(PTR:) TO WS-NAME-EXP(8:)
                   WHEN WS-NAME-EXP(1:2) = "FT"
                       MOVE "FORT" TO WS-NAME-EXP
                       MOVE WS-NAME(PTR:) TO WS-NAME-EXP(6:)
                   WHEN WS-NAME-EXP(1:2) = "MR"
                       MOVE "MISTER" TO WS-NAME-EXP
                       MOVE WS-NAME(PTR:) TO WS-NAME-EXP(8:)
                   WHEN WS-NAME-EXP(1:2) = "MT"
                       MOVE "MOUNT" TO WS-NAME-EXP
                       MOVE WS-NAME(PTR:) TO WS-NAME-EXP(6:)
                   WHEN WS-NAME-EXP(1:2) = "ST"
                       MOVE "SAINT" TO WS-NAME-EXP
                       MOVE WS-NAME(PTR:) TO WS-NAME-EXP(7:)
                   WHEN OTHER
                       MOVE WS-NAME TO WS-NAME-EXP
                END-EVALUATE
                ELSE
                   MOVE WS-NAME TO WS-NAME-EXP
                END-IF.
       PROC-OUT.
              MOVE 0 TO E-O-F.
              OPEN OUTPUT PRINTOUT.
              RETURN SORTWORK RECORD INTO WS-REC AT END MOVE
                     1 TO E-O-F.
              PERFORM UNTIL EOF
                     MOVE WS-REC TO WS-OUTREC
                     WRITE OUT-REC FROM WS-OUTREC
               RETURN SORTWORK RECORD INTO WS-REC AT END MOVE
                       1 TO E-O-F
                   END-RETURN
                END-PERFORM.
                CLOSE PRINTOUT.

Programe5:
       IDENTIFICATION DIVISION.
       PROGRAM-ID. PRIMENEW.
       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01 NUM PIC 99.
       77 I PIC 99 VALUE 1.
       01 Q1 PIC 99.
       77 R1 PIC 99.
       01 C1 PIC 99 VALUE 0.
       PROCEDURE DIVISION.
       P1.
           DISPLAY "ENTER THE NUMBER".
           ACCEPT NUM.
           PERFORM P2 VARYING I FROM 1 BY 1 UNTIL I > NUM.
           IF (C1 > 2)
               DISPLAY "THE NUMBER IS NOT PRIME" AT 0905
           ELSE
               DISPLAY "THE NUMBER IS PRIME".
           STOP RUN.
       P2.
           DIVIDE NUM BY I GIVING Q1 REMAINDER R1.
           IF (R1 = 0)
               COMPUTE C1 = C1 + 1
           ELSE
               MOVE C1 TO C1.

0 comments:

Computers TopOfBlogs Technology Blogs Mainframe interview question and answers,mainframe jobs,cobol,vsam,jcl,cics,db2,rdbms,mvs,tso,ispf,ibm,hcl,tcs,cts,wibro Blog Directory