Finding the factorial using a subroutine

       IDENTIFICATION DIVISION.
       PROGRAM-ID FACTFIND-MAIN.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       77 N PIC 99.
       77 FACT PIC 9(6).
       77 EDFACT PIC Z(5)9.
       PROCEDURE DIVISION.
       MAIN-PARA.
           DISPLAY "Enter a number : ".
           ACCEPT N.
           CALL "PRO0102.COB" USING N FACT.
           MOVE FACT TO EDFACT.
           DISPLAY "Factorial of " N "is: " EDFACT.
           STOP RUN.

Subroutine with file name PRO0102.COB
       IDENTIFICATION DIVISION.
       PROGRAM-ID FACTFIND-SUB.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       77 I PIC 99.
       LINKAGE SECTION.
       77 N1 PIC 9(2).
       77 FACT1 PIC 9(6).
       PROCEDURE DIVISION USING N1 FACT1.
       MAIN-PARA.
           MOVE 1 TO FACT1.
           PERFORM FIND VARYING I FROM 2 BY 1 UNTIL I > N1.
           EXIT PROGRAM.
       FIND.
           MULTIPLY I BY FACT1.

Matrix addition and subtraction

       IDENTIFICATION DIVISION.
       PROGRAM-ID.
       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01 MATRIX.
         02 MAT OCCURS 10 TIMES.
           03 A PIC 9(4) OCCURS 10 TIMES.
           03 B PIC 9(4) OCCURS 10 TIMES.
           03 C PIC 9(4) OCCURS 10 TIMES.
           03 D PIC 9(4) OCCURS 10 TIMES.
       77 M PIC 9(3).
       77 N PIC 9(3).
       77 I PIC 9(3).
       77 J PIC 9(3).
       77 EMAT PIC -ZZZ9.
       PROCEDURE DIVISION.
       MAIN-PARA.
           DISPLAY "Enter the matrix dimensions".
           ACCEPT M.
           ACCEPT N.
           DISPLAY "Enter the fist matrix element".
           PERFORM READ-MAT1-PARA VARYING I FROM 1 BY 1 UNTIL I > M
                 AFTER J FROM 1 BY 1 UNTIL J > N.
           DISPLAY "Enter the second matrix element".
           PERFORM READ-MAT2-PARA VARYING I FROM 1 BY 1 UNTIL I > M
                 AFTER J FROM 1 BY 1 UNTIL J > N.
           DISPLAY (1 1) ERASE.
           PERFORM MAT-ADD-PARA VARYING I FROM 1 BY 1 UNTIL I > M
                 AFTER J FROM 1 BY 1 UNTIL J > N.
          PERFORM MAT-SUB-PARA VARYING I FROM 1 BY 1 UNTIL I > M
                 AFTER J FROM 1 BY 1 UNTIL J > N.
           PERFORM MAT-DIS-PARA VARYING I FROM 1 BY 1 UNTIL I > M
                 AFTER J FROM 1 BY 1 UNTIL J > N.
           STOP RUN.
       READ-MAT1-PARA.
           ACCEPT A(I J).
       READ-MAT2-PARA.
           ACCEPT B(I J).
       MAT-ADD-PARA.
           COMPUTE C(I J) = A(I J) + B(I J).
       MAT-SUB-PARA.
           COMPUTE D(I J) = A(I J) - B(I J).
       MAT-DIS-PARA.
           COMPUTE COL = J * 7 - 2.
           COMPUTE LIN = I + 4.
           MOVE A(I J) TO EMAT.
           DISPLAY (LIN, COL) EMAT.
           COMPUTE COL = J * 7 + 23.
           MOVE B(I J) TO EMAT.
           DISPLAY (LIN, COL) EMAT.
           COMPUTE COL = J * 7 - 2.
           COMPUTE LIN = I + 11.
           MOVE C(I J) TO EMAT.
           DISPLAY (LIN, COL) EMAT.
           COMPUTE COL = J * 7 + 23.
           MOVE D(I J) TO EMAT.
           DISPLAY (LIN, COL) EMAT.
         

Subroutine to recalculate the B-pay as per the following. If the jobcode is 1 then add 100. If it is 2 add 750 else add 500.

Identification Division.
       Program-ID.
       Environment Division.
       Data Division.
       Working-Storage Section.
       01  Emp-Data.
           02 Empno PIC X(6).
           02 Name PIC A(20).
           02 JobCode PIC 9.
           02 B-Pay PIC 9(6).
       77 BP-Plus-Bonus PIC 9(6).
       Procedure Division.
       Main-Para.
           Display "Enter Employee Number :".
           Accept Empno.
           Display "Enter Employee Name : ".
           Accept Name.
           Display "Enter Job Code (1/2/any): ".
           Accept JobCode.
           Display "Enter Basic Salary :".
           Accept B-Pay.
           CALL "PRO112.COB" USING B-Pay JobCode BP-Plus-Bonus.
           Display (1, 1) Erase.
           Display "Employee Number       : " Empno.
           Display "Employee Name         : " Name.
           Display "Employee Job Code     : " JobCode.
           Display "Employee Basic Salary : " B-Pay.
           Display "B-Pay with bonus      : " BP-Plus-Bonus.
           STOP RUN.

Subroutine file name : PRO112.COB

       Identification Division.
       Program-ID. BONUS-CAL.
       Environment Division.
       Data Division.
       LINKAGE SECTION.
       77 JOBCODE1 PIC 9.
       77 BPAY PIC 9(6).
       77 BONUS PIC 9(6).
       PROCEDURE DIVISION USING BPAY JOBCODE1 BONUS.
       MAIN-PARA.
           IF JOBCODE1 = 1
              ADD BPAY 1000 GIVING BONUS
           ELSE
              IF JOBCODE1 = 2
                 ADD BPAY 750 GIVING BONUS
              ELSE
                 ADD BPAY 500 GIVING BONUS.
           EXIT PROGRAM.

Program to merge two files

IDENTIFICATION DIVISION.
       PROGRAM-ID. MERGE-SEQFILES.
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT INFILE1 ASSIGN TO DISK
           ORGANIZATION IS LINE SEQUENTIAL.
           SELECT INFILE2 ASSIGN TO DISK
           ORGANIZATION IS LINE SEQUENTIAL.
           SELECT OUTFILE ASSIGN TO DISK
           ORGANIZATION IS LINE SEQUENTIAL.
           SELECT WFILE ASSIGN TO DISK.   
       DATA DIVISION.
       FILE SECTION.
       FD INFILE1
      LABEL RECORDS ARE STANDARD
           VALUE OF FILE-ID IS "STD1.DAT".
       01 FILE1-REC.
          02 RNO PIC X(5).
          02 SN PIC X(15).
          02 CL PIC X(4).
          02 MARKS PIC 9(3).
       FD INFILE2
      LABEL RECORDS ARE STANDARD
           VALUE OF FILE-ID IS "STD2.DAT".
       01 FILE2-REC.
           02 RNO PIC X(5).
           02 SN PIC X(15).
           02 CL PIC X(4).
           02 MARKS PIC 9(3).
       FD OUTFILE
      LABEL RECORDS ARE STANDARD
           VALUE OF FILE-ID IS "MRGSTD.DAT".
       01 OUT-REC PIC X(27).
       SD WFILE.
       01 S-REC.
           02 SRNO PIC X(5).
           02 SSN PIC X(15).
           02 SCL PIC X(4).
           02 SMARKS PIC 9(3).
       PROCEDURE DIVISION.
       MAIN-PARA.
           MERGE WFILE ON ASCENDING KEY SSN

Program to Sort

      IDENTIFICATION DIVISION.
       PROGRAM-ID.
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT FILE1 ASSIGN TO DISK
           ORGANIZATION IS LINE SEQUENTIAL.
           SELECT FILE2 ASSIGN TO DISK
           ORGANIZATION IS LINE SEQUENTIAL.
           SELECT WFILE ASSIGN TO DISK.
       DATA DIVISION.
       FILE SECTION.
       FD FILE1
           LABEL RECORDS ARE STANDARD
           VALUE OF FILE-ID "STUD.DAT".
       01 FILE1-REC.
           02 RNO PIC 9(5).
           02 SN PIC X(20).
           02 CL PIC X(5).
           02 MARKS PIC 9(3).
       FD FILE2
           LABEL RECORDS ARE STANDARD
           VALUE OF FILE-ID "STRSTD.DAT".
       01 FILE2-REC PIC X(33).
       SD WFILE.
       01 S-REC.
           02 SRNO PIC 9(5).
           02 SSN PIC X(20).
           02 SCL PIC X(5).
           02 SMARKS PIC 9(3).
       PROCEDURE DIVISION.
       MAIN-PARA.
           SORT WFILE ON ASCENDING KEY SRNO
                USING FILE1 GIVING FILE2.
           STOP RUN.
         

Sorting

       IDENTIFICATION DIVISION.
       PROGRAM-ID.
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT FILE1 ASSIGN TO DISK
           ORGANIZATION IS LINE SEQUENTIAL.
           SELECT FILE2 ASSIGN TO DISK
           ORGANIZATION IS LINE SEQUENTIAL.
           SELECT WFILE ASSIGN TO DISK.
       DATA DIVISION.
       FILE SECTION.
       FD FILE1
           LABEL RECORDS ARE STANDARD
           VALUE OF FILE-ID "STUD.DAT".
       01 FILE1-REC.
           02 RNO PIC 9(5).
           02 SN PIC X(20).
           02 CL PIC X(5).
           02 MARKS PIC 9(3).
       FD FILE2
           LABEL RECORDS ARE STANDARD
           VALUE OF FILE-ID "STRSTD.DAT".
       01 FILE2-REC PIC X(33).
       SD WFILE.
       01 S-REC.
           02 SRNO PIC 9(5).
           02 SSN PIC X(20).
           02 SCL PIC X(5).
           02 SMARKS PIC 9(3).
       PROCEDURE DIVISION.
       MAIN-PARA.
           SORT WFILE ON ASCENDING KEY SRNO
                USING FILE1 GIVING FILE2.
           STOP RUN.
         

Relative file creation

       IDENTIFICATION DIVISION.
       PROGRAM-ID.
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT SFILE ASSIGN TO DISK
           ORGANIZATION IS RELATIVE
           ACCESS MODE IS RANDOM
           RECORD KEY SNO.
       DATA DIVISION.
       FILE SECTION.
       FD SFILE
      LABEL RECORDS ARE STANDARD
    VALUE OF FILE-ID IS "STD.REL".
       01 SREC.
   02 SNM PIC X(10).
   02 M PIC 9(3).
       WORKING-STORAGE SECTION.
       77 SNO PIC 9(5).
       77 CH PIC X VALUE SPACE.
       PROCEDURE DIVISION.
       MAIN-PARA.
           OPEN OUTPUT SFILE.
           PERFORM READ-DATA UNTIL CH = "N" OR "n".
           CLOSE SFILE.
           STOP RUN.
       READ-DATA.
           DISPLAY "ENTER REGISTRATION NUMBER: ".
           ACCEPT SNO.
           DISPLAY "ENTER STUDENT NAME: ".
           ACCEPT SNM.
           DISPLAY "ENTER MARKS SCORED: ".
           ACCEPT M.
           WRITE SREC INVALID KEY DISPLAY "INVALID DATA.".
           DISPLAY "CONTINUE (Y/N).".
           ACCEPT CH.