File structure and programming in Cobol
Contributed by K. L. Moorthi (TMA)

1

identification division.
program-id. TMA1.

environment division.
configuration section.
source-computer. ibm-pc.
object-computer. ibm-pc.

input-output section.
file-control.
select payin assign to disk.
select sortfile assign to disk.
select sortedfile assign to disk.
select payout assign to disk
organization is indexed
access mode is sequential
record key is o-empno.

data division.
file section.

fd payin
label records are standard
value of file-id is "empin1.dat"
data record is pay-in.

01 pay-in.
02 i-empno pic 9(5).
02 i-empname pic x(20).
02 i-hrsworked pic 999.
02 i-rate pic 999.

sd sortfile
data record is sort-file.

01 sort-file.
02 s-empno pic 9(5).
02 s-empname pic x(20).
02 s-hrsworked pic 999.
02 s-rate pic 999.

fd sortedfile
label records are standard
value of file-id is "empsort1.dat"
data record is sorted-file.

01 sorted-file.
02 empno-s pic 9(5).
02 empname-s pic x(20).
02 hrsworked-s pic 999.
02 rate-s pic 999.

fd payout
label records are standard
value of file-id is "empout1.dat"
data record is pay-out.

01 pay-out.
02 o-empno pic 9(5).
02 o-empname pic x(20).
02 o-hrsworked pic 999.
02 o-rate pic 999.
02 total-earn.
03 o-basic pic 9(6).
03 o-ot pic 9(6).
03 o-hra pic 9(6).
03 o-da pic 9(6).
03 o-total-all pic 9(7).
02 total-ded.
03 o-mth-tax pic 9(6).
02 o-total pic 9(7).

working-storage section.

01 d-empno pic z(5).
01 d-empname pic x(20).
01 d-hrsworked pic zz9.
01 d-rate pic zz9.
01 d-basic pic z(6)9.99.
01 d-ot pic z(6)9.99.
01 d-hra pic z(6)9.99.
01 d-da pic z(6)9.99.
01 d-total-all pic z(6)9.99.
01 d-tax pic z(6)9.99.
01 d-netsal pic z(6)9.99.

01 hrs pic 9(3) usage comp sync.
01 hrs-bal pic 9(3) usage comp sync.
01 basic pic 9(6) usage comp sync.
01 ot pic 9(6) usage comp sync.
01 hra pic 9(6) usage comp sync.
01 da pic 9(6) usage comp sync.
01 total-all pic 9(7) usage comp sync.
01 total-earns pic 9(7) usage comp sync.
01 tax pic 9(6) usage comp sync.
01 total pic 9(7) usage comp sync.
01 yly-total pic 9(7) usage comp sync.

01 ctr pic 9.
01 eof pic 9.
01 cfm pic x.
01 headline pic x(80) value all "-".

screen section.

01 clrscr.
02 blank screen.

procedure division.

* Main Screen *

main.

display clrscr.
move 0 to ctr.
display "Main Menu".
display "01 Entry".
display "02 View".
display "03 Exit".
display "Choice 1 / 2 / 3".
accept ctr.

if ctr > 0 and ctr < 4
go to entry
disp
eoj depending on ctr
else
go to main.

* File Creation *

entry.

open extend payin.
move "y" to cfm.
perform accinput until cfm = "n".
close payin.
perform sorting.
perform calc.
go to main.

accinput.

display clrscr.
move "n" to cfm.
move 0 to i-empno
i-hrsworked
i-rate.
move spaces to i-empname.

display "Employee Details".
display "Employee No : ".
accept i-empno.
display "Employee Name : ".
accept i-empname.
display "Hours Worked : ".
accept i-hrsworked.
display "Rate Per Hour : ".
accept i-rate.
write pay-in.

display "Continue y / n : ".
accept cfm.

* Sorting *

sorting.

sort sortfile on ascending key s-empno
using payin
giving sortedfile.

* Calculation *

calc.

open input sortedfile
output payout.
move 0 to eof.
perform read1.
perform init thru move1 until eof = 1.
close sortedfile
payout.

read1.

read sortedfile at end move 1 to eof.

init.

move 0 to hrs
hrs-bal
basic
ot
hra
da
total-all
total-earns
yly-total
tax
total.

salcalc.

if hrsworked-s > 200
compute hrs-bal = hrsworked-s - 200
compute basic = 200 * rate-s
else
compute basic = hrsworked-s * rate-s.
compute ot rounded = hrs-bal * (rate-s * 1.5).
compute hra rounded = basic * 20 / 100.
compute da rounded = basic * 10 / 100.
compute total-all = ot + hra + da.
compute total-earns = basic + total-all.
compute yly-total = total-earns * 12.
if yly-total < 100000
compute tax = 0
else
if yly-total > 99999 and yly-total < 500000
compute tax rounded = (yly-total - 10000) * 10 / 100
else
compute tax rounded = (yly-total - 500000) * 20 / 100
compute tax rounded = tax + 50000.
compute tax rounded = tax / 12.
compute total = total-earns - tax.

move1.

move empno-s to o-empno
move empname-s to o-empname
move hrsworked-s to o-hrsworked
move rate-s to o-rate
move basic to o-basic
move ot to o-ot
move hra to o-hra
move da to o-da
move total-all to o-total-all
move tax to o-mth-tax
move total to o-total
write pay-out.
perform read1.

* View *

disp.

open input payout.
move "y" to cfm.
perform keyinput thru dispout until cfm = "n".
close payout.
go to main.

readout.

read payout at end close payout.

keyinput.

display clrscr.
display "Employee Details - View".
display "Employee Number : ".
accept o-empno.
start payout key is = o-empno
invalid key go to err-msg.
perform readout.

move2.

move o-empno to d-empno.
move o-empname to d-empname.
move o-hrsworked to d-hrsworked.
move o-rate to d-rate.
move o-basic to d-basic.
move o-ot to d-ot.
move o-hra to d-hra.
move o-da to d-da.
move o-total-all to d-total-all.
move o-mth-tax to d-tax.
move o-total to d-netsal.

dispout.

display "Employee No : " d-empno.
display "Employee Name : " d-empname.
display "Hours Worked : " d-hrsworked.
display "Rate Per Hour : " d-rate.
display "Basic Pay : " d-basic.
display "Overtime : " d-ot.
display "H R A : " d-hra.
display "D A : " d-da.
display "Total Allowance : " d-total-all.
display "Tax This Month : " d-tax.
display "Total Deductions : " d-tax.
display "Nett Salary : " d-netsal.
perform contnue.

err-msg.

display "Wrong Employee Number ......".
perform contnue.

if cfm = "y"
go to keyinput
else
close payout
go to main.

contnue.
display "Continue y / n : ".
accept cfm.

* End of Job *

eoj.
stop run.

--------------------------------------------------------------------------------

Three indexed files stored on the disk contain the tables, write a COBOL program to create an indexed master file from the transaction records with the given format.
Contributed by Anupma Bakshi

Solution:
IDENTIFICATION DIVISION
PROGRAM-ID STUDENT
ENVIRONMENT DIVISION
INPUT-OUTPUT SECTION

FILE-CONTROL

SELECT TRANS-FILE ASSIGN TO DISK
SELECT MAST-FILE ASSIGN TO DISK
SELECT FILE 1 ASSIGN TO DISK
SELECT FILE 2 ASSIGN TO DISK
SELECT FILE 3 ASSIGN TO DISK

DATA DIVISION
FILE SECTION

FD FILE 1 LABEL`RECORDS ARE STANDARD
VALUE OF FILE-ID IS "FILE1.DAT"
01 FILE1-REC
02 STUDENT-NO PIC X(10)
02 STUDENT-NAME PIC X(20)
02 STUDENT ADD PIC X(10)

FD FILE2 LABEL RECORDS ARE STANDARD
VALUE OF FILE-ID IS "FILE2.DAT"
01 FILE2-REC
02 PROG-CODE PIC X(5)
02 DURATION PIC X(2)
02 FEE PIC X(6)

FD FILE3 LABEL RECORDS ARE STANDARD
VALUE OF FILE-ID IS "FILE3.DAT"
01 FILE3-REC
02 LEVEL-NO PIC X(1)
02 LEVEL-DISC PIC X(14)

FD MAST-FILE LABEL RECORDS ARE STANDARD
VALUE OF FILE-ID IS "MAST.DAT"
01 MAST-REC
02 STUDENT-NO PIC X(10)
02 STUDENT-NAME PIC X(20)
02 STUDENT-ADD PIC X(30)
02 PROJ-CODE PIC X(5)
02 FEE PIC X(6)
02 LEVEL-NO PIC X(1)
02 LEVEL-DESC PIC X(14)

FD TRANS-REC LABEL RECORDS ARE STANDARD
VALUE OF FILE-ID IS "TRANS.DAT"
01 TRANS-REC
02 STUDENT-NO PIC X(10)
02 PROJ-CODE PIC X(5)
02 LEVEL-NO PIC X(1)

WORKING-STORAGE SECTION

77 ANS PIC X VALUE SPACES
77 KY PIC 9 VALUE 0

PROCEDURE DIVISION

OPEN-PARA

OPEN FILE1

DISP-PARA

DISPLAY(1,1)ERASE

INP-PARA

DISPLAY(5,5)ERASE
DISPLAY(3,14)"****"
DISPLAY(4,14)"Enter Records"
DISPLAY(5,14)"***********"
DISPLAY(6,10)"STUDENT-NO"
DISPLAY(7,10)"STUDENT-NAME"
DISPLAY(8,10)"STUDENT-ADD"
DISPLAY(9,10)"**************"

ACCEPT-PARA

ACCEPT(6,20)STUDENT-NO OF FILE1
ACCEPT(7,20)STUDENT-NAME OF FILE1
ACCEPT(8,20)STUDENT-ADD OF FILE1
WRITE FILE1

RESP-PARA

DISPLAY(10,10)"Want to add more?(y/n)"

ACCEPT ANS

IF ANS = "y" OR ANS="Y"

GO TO INP-PARA
CLOSE FILE1
GO TO OPEN1-PARA

OPEN1-PARA

OPEN FILE2

DISP-PARA

DISPLAY(1,1)ERASE

INP1-PARA

DISPLAY(5,10)ERASE
DISPLAY(3,14)"*****"
DISPLAY(4,14)"Enter RecordS"
DISPLAY(6,10)"PROGRAMME CODE"
DISPLAY(7,10)"DURATION"
DISPLAY(8,10)"FEE"

ACCEPT1-PARA

ACCEPT(6,20) PROJ-CODE OF FILE2
ACCEPT(7,20) DURATION OF FILE2
ACCEPT(8,20) FEE OF FILE2
WRITE FILE2

RESP1-PARA

DSIPALY(16,45)"Want to add more records?(y/n)"

ACCEPT ANS

IF ANS = "y" OR ANS="Y"

GO TO INS1-PARA
CLOSE FILE2
GO TO OPEN2-PARA

OPEN2-PARA

OPEN FILE3

DISP2-PARA

DSIPLAY(1,1)ERASE

IMP2-PARA

DISPLAY(5,5)ERASE
DISPLAY(3,14)"****"
DISPLAY(4,14)"Enter records"
DISPLAY(5,14)"***********"
DISPLAY(6,10)"LEVEL NUMBER"
DISPLAY(7,10)"LEVEL DESCRIPTION"

ACCEPT2-PARA

ACCEPT(6,20)LEVEL-NO OF FILE3
ACCEPT(7,20)LEVEL-DESC OF FILE3
WRITE FILE3

RESP2-PARA

DISPLAY(16,45)"Want to add more records?(y/n)"
ACCEPT ANS
IF ANS = "y" OR ANS = "Y"
GOT TO INP2-PARA
CLOSE FILE3
GO TO OPEN3-PARA

OPEN3-PARA

OPEN TRANS-FILE

DISP3-PARA

DISPLAY(5,5)ERASE
DISPLAY(3,14)"*****"
DISPLAY(4,14)"Enter Records"
DISPLAY(5,15)"***********"
DISPLAY(6,15)"STUDENT-NO"
DISPLAY(7,15)"PROJ-CODE"
DISPLAY(8,10)"LEVEL-NO"

ACCP3-PARA

ACCEPT(6,20)STUDENT-NO OF TRANS-FILE
ACCEPT(7,20)PROJ-CODE OF TRANS-FILE
ACCEPT(8,20)LEVEL-NO OF TRANS-FILE
WRITE TRANS-FILE

RESP3-PARA

DISPLAY(16,45)"Want to enter more records?(y/n)"
ACCEPT ANS
IF ANS="y" OR ANS="Y"
GO TO INP3-PARA
CLOSE TRANS-FILE
GO TO FINAL-PARA

FINAL-PARA

DISPLAY(1,1)ERASE
OPEN INPUT FILE1
OPEN INPUT FILE2
OPEN INPUT FILE3
OPEN INPUT TRANS-FILE
OPEN OUTPUT MAST-FILE

FREAD-PARA

READ TRANS-FILE AT END
CLOSE TRANS-FILE
GO TO FDISP-PARA

FDISP-PARA

READ FILE1 AT END CLOSE FILE1
READ FILE2 AT END CLOSE FILE2
READ FILE3 AT END CLOSE FILE3

STOP RUN

DISPLAY(1,1)ERASE
DISPLAY(6,12)"OUTPUT SCREEN"
DISPLAY(7,10)"****************"
DISPLAY(8,10)STUDENT-NO
DISPLAY(9,10)STUDENT-NAME
DISPLAY(10,10)STUDENT-ADD
DISPLAY(11,10)PROJ-CODE
DISPLAY(12,10)FEE
DISPLAY(13,10)LEVEL-NO
DISPLAY(14,10)LEVEL-DESC
DISPLAY(16,45)"Press any key to continue!"

ACCEPT KY

Question 2: Write a programme in COBOL for sorting an array using any sorting procedure.
Solution :
Let us use Bubble sort for sorting the array, assuming that the number of elements in the array are Z.

DATADIVISION

WORKING-STORAGE SECTION

01 REC-A
02 TABLE OCCURS 10 TIMES INDEXED BY AI
03 ROLL-NO PIC 9(3)
03 STUDENT-NM PIC X(20)
03 MARK-OBTAINE PIC 9(3)

01 DATA
02 A PIC 9(3) COMP
02 B PIC 9(3) COMP
02 C PIC 9(3) COMP
02 Z PIC 9(3) COMP VALUE IS 10
02 FLAG PIC 9(3) COMP VALUE IS 1
02 TEMP-ROLLNO PIC 9(6) V99

PROCEDURE DIVISION

PERFORM A-PARA
A-PARA
PEFORM B-PARA VARYING A FROM 1 BY 1
UNTIL A=Z
B-PARA
MOVE 0 TO FLAG
SUBTRACT A FROM Z GIVING C
PERFORM DATA-COMPARISION
VARYING B FROM 1 BY 1 UNTIL B>C
DATA-COMPARISON
SET A TO B
IF ROLL-NO(A1)>ROLL-NO(A1+1)
MOVE ROLL-NO(A1) TO TEMP-ROLL-NO
MOVE ROLL-NO()A1+1) TO ROLL-NO(A1)
MOVE TEMP-ROLL-NO(A1) TO ROLL-NO(A1+1)
END-PARA

STOP RUN