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

2

identification division.
program-id. depreciation.

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

input-output section.
file-control.
select inrec assign to disk.
select sortrec assign to disk.
select sortedrec assign to disk.
select outrec assign to disk.

data division.
file section.
fd inrec
label records are standard
value of file-id is "deprn.dat"
data record is in-rec.

01 in-rec.
02 i-machine-no pic 9(5).
02 i-machine-name pic x(15).
02 i-machine-value pic 9(5).
02 i-year-purchase pic 9(4).
02 i-deprn-yrs pic 99.

fd outrec
label records are standard
value of file-id is "deprn1.dat"
data record is out-rec.

01 out-rec.
02 o-machine-no pic 9(5).
02 o-machine-name pic x(15).
02 o-machine-value pic 9(5).
02 o-year-purchase pic 9(4).
02 o-deprn-yrs pic 99.
02 o-deprn-value pic 9(5).

sd sortrec
data record is sort-rec.

01 sort-rec.
02 s-machine-no pic 9(5).
02 s-machine-name pic x(15).
02 s-machine-value pic 9(5).
02 s-year-purchase pic 9(4).
02 s-deprn-yrs pic 99.
02 s-deprn-value pic 9(5).

fd sortedrec
label records are standard
value of file-id is "sortdepn.dat"
data record is sorted-rec.

01 sorted-rec.
02 machine-no-s pic 9(5).
02 machine-name-s pic x(15).
02 machine-value-s pic 9(5).
02 year-purchase-s pic 9(4).
02 deprn-yrs-s pic 99.
02 deprn-value-s pic 9(5).

working-storage section.

01 heading.
02 head-ing pic b(18)x(22)b value spaces.
02 head-yrs pic z9b value zero.
02 filler pic x(7)b value "Year(s)".
02 head-asofrom pic x(5)b value spaces.
02 head-yr pic 9999b(18) value zero.

01 head.
02 filler pic x(3) value spaces.
02 filler pic x(12) value "Asset No : ".
02 h-machine-no pic zzzz9b(4) value zero.
02 filler pic x(14) value "Asset Name : ".
02 h-machine-name pic x(12)b(4) value spaces.
02 filler pic x(17) value "Asset Value :".
02 h-machine-value pic zz,zz9bbb value zero.

01 head1.
02 filler pic x(4) value spaces.
02 filler pic x(20) value "Year Purchased : ".
02 h1-year-purchase pic 9(4)b(5) value zero.
02 filler pic x(11) value "Life Yrs : ".
02 h1-deprn-yrs pic z9b(5) value zero.
02 filler pic x(20) value "Yly Deprn Value : ".
02 h1-deprn-value pic zz,zz9bbb value zero.

01 head2.
02 filler pic x(6) value spaces.
02 filler pic x(5)b(7) value "Year".
02 filler pic x(15)b(7) value "Depreciation".
02 filler pic x(15)b(7) value "Acc Deprn".
02 filler pic x(10)b(8) value "Bal Value".

01 head3.
02 filler pic x(80) value all "-".

01 head4.
02 filler pic x(23) value spaces.
02 filler pic x(20)b(10) value "End of Asset No : ".
02 h4-machine-no pic zzzz9b(22) value zero.

01 head5.
02 filler pic x(8) value spaces.
02 filler pic x(10) value "Sorted By".
02 sortname pic x(28)b(8) value spaces.
02 headname pic x(18)b(8) value spaces.

01 write-rec.

02 filler pic x(6) value spaces.
02 w-year pic zzz9b(11) value zero.
02 w-deprn pic zz,zz9b(14) value zero.
02 w-acc-deprn pic zz,zz9b(16) value zero.
02 w-bal-amt pic zz,zz9 value zero.

01 ctr pic 9.
01 ctr1 pic 99.
01 cfm pic x.
01 eof pic 9.
01 pyear pic 9999.
01 reqd-yrs pic 99.

01 deprn pic 9(5).
01 add-acc-deprn pic 9(5).
01 m-value pic 9(5).
01 temp pic 99.
01 addyr pic 9999.
01 deprn-yrs-chart pic 99.

01 yps pic 9(4).
01 mvs pic 9(5).

screen section.
01 clrscr.
02 blank screen.

procedure division.

* Main *

main.

display clrscr.
move 0 to ctr.
display "Main Menu".
display "1 Entry".
display "2 Calculation".
display "3 View".
display "4 Exit".
display "Choice (1 / 2 / 3 / 4)".
accept ctr.

if ctr > 0 and ctr < 5
go to entry
calc
sort1
eoj depending on ctr
else
go to main.

* Input *

entry.

open extend inrec.
move "y" to cfm.
perform init thru inputacc until cfm = "n".
close inrec.
go to main.

init.

move zero to i-machine-no
i-machine-value
i-year-purchase
i-deprn-yrs.
move spaces to i-machine-name.

inputacc.

display clrscr.
display "Entries".
display "Asset Number :".
accept i-machine-no.
display "Asset Name :".
accept i-machine-name.
display "Asset Value :".
accept i-machine-value.
display "Year Purchased :".
accept i-year-purchase.
display "Life in Years :".
accept i-deprn-yrs.
write in-rec.
display "Continue y / n :".
accept cfm.

* calculation *

calc.

open input inrec
output outrec.
move 0 to eof
ctr1.
perform read1.
perform move1 until eof = 1.
close inrec
outrec.
go to main.

read1.

read inrec at end move 1 to eof.

move1.

move 0 to deprn.
compute deprn rounded = (i-machine-value / i-deprn-yrs).
move i-machine-no to o-machine-no.
move i-machine-name to o-machine-name.
move i-machine-value to o-machine-value.
move i-year-purchase to o-year-purchase.
move i-deprn-yrs to o-deprn-yrs.
move deprn to o-deprn-value.
write out-rec.
perform read1.

* sorting *

sort1.

display clrscr.
move 0 to ctr.
move spaces to sortname.
move "Machine Number" to sortname
sort sortrec on ascending key s-machine-no
using outrec
giving sortedrec.
go to disp.

* view *

disp.

open input sortedrec.
move 0 to eof
pyear.
display clrscr.
display "Current year YYYY (ex. 1989) :".
accept pyear.
perform disp1.
perform multidisp.
close sortedrec.
go to main.

multidisp.

display clrscr.
move 0 to ctr.
display "Order of View".
display "01 All - As of the Year Entered".
display "02 Obsolete".
display "03 No of Years Required".
display "Choice (1 / 2 / 3) :".
accept ctr.

if ctr = 1
move "= > All Items" to headname
display head5
perform allitems until eof = 1

else

if ctr = 2

move "= > Obsolete Items" to headname
display head5
perform obsolete until eof = 1

else

if ctr = 3

display clrscr
move 0 to reqd-yrs
display "Enter No of Yrs Required :"
accept reqd-yrs
move "= > Active Items" to headname
display head5
perform reqdyrsonly until eof = 1

else

go to multidisp.

disp1.

read sortedrec at end move 1 to eof.

initialize1.

move 0 to addyr
ctr1
temp
m-value
add-acc-deprn
h4-machine-no
h-machine-no
h-machine-value
h1-year-purchase
h1-deprn-yrs
h1-deprn-value
deprn-yrs-chart.
move spaces to h-machine-name.

yr-calc1.

compute deprn-yrs-chart = pyear - year-purchase-s.

* All Items *

allitems.

perform initialize1.
perform yr-calc1.

if deprn-yrs-chart < deprn-yrs-s

compute deprn-yrs-chart = deprn-yrs-chart + 1
move deprn-yrs-chart to temp

else

move deprn-yrs-s to temp.

perform proc.


* Obsolete Items Only *

obsolete.

perform initialize1.
perform yr-calc1.

compute deprn-yrs-chart = deprn-yrs-chart + 1.

if deprn-yrs-s < deprn-yrs-chart

move deprn-yrs-s to temp
perform proc

else

perform disp1.

* Required Number of Years *

reqdyrsonly.

perform initialize1.
perform yr-calc1.

compute deprn-yrs-chart = pyear - year-purchase-s.

compute deprn-yrs-chart = deprn-yrs-chart + 1.

if ( deprn-yrs-s < reqd-yrs or deprn-yrs-s = reqd-yrs ) and
( deprn-yrs-s > deprn-yrs-chart or
deprn-yrs-s = deprn-yrs-chart )

move deprn-yrs-s to temp
perform proc

else

if deprn-yrs-chart = deprn-yrs-s
move 0 to yps mvs

compute deprn-yrs-chart = deprn-yrs-s - reqd-yrs
compute yps = year-purchase-s + deprn-yrs-chart
compute mvs = machine-value-s -
( deprn-value-s * deprn-yrs-chart )
perform move4
move reqd-yrs to temp
head-yrs
move deprn-yrs-chart to ctr1
move yps to addyr
head-yr
move mvs to h-machine-value
m-value
perform head50

else
perform disp1.

proc.

perform move4.
perform head50.

move4.

* head1

move "Depreciation Chart for " to head-ing.

if ( ctr = 1 or ctr = 2 )

if deprn-yrs-chart > deprn-yrs-s

move deprn-yrs-s to head-yrs
move "As of" to head-asofrom
move pyear to head-yr

else

move deprn-yrs-chart to head-yrs
move "As of" to head-asofrom
move pyear to head-yr

else

if ctr = 3

move deprn-yrs-s to head-yrs
move "From " to head-asofrom
move year-purchase-s to head-yr.

* head2

move machine-value-s to h-machine-value
m-value.
move machine-no-s to h-machine-no

* tail1
h4-machine-no.

move machine-name-s to h-machine-name.

* head3

move year-purchase-s to h1-year-purchase.
move deprn-yrs-s to h1-deprn-yrs.
move deprn-value-s to h1-deprn-value.

* head4

* body

* tail2

* general

move year-purchase-s to addyr.

head50.

display clrscr.
display head3
heading
head3
head
head3
head1
head3
head2
head3.
perform loop1 temp times.
display head3
head4
head3.
display " ".
perform disp1.

loop1.

compute ctr1 = ctr1 + 1.

if ctr1 = deprn-yrs-s

move m-value to w-deprn
compute add-acc-deprn = add-acc-deprn + m-value
compute m-value = m-value - m-value

else

move deprn-value-s to w-deprn
compute add-acc-deprn = add-acc-deprn + deprn-value-s
compute m-value = m-value - deprn-value-s.

move addyr to w-year.
move add-acc-deprn to w-acc-deprn.
move m-value to w-bal-amt.

add 1 to addyr.
display write-rec.

**************
* end of job *
**************

eoj.

stop run.

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

Contributed by praveen kumar agarwal.

comments: solution for cs-03 tma problem no:2

identification division.
program-id. deprcalc.
environment division.
data division.
working-storage section.
01 dep-table.
02 item-no occurs 10 times.
03 item-name pic a(20).
03 purchase-price pic 9(6).
03 yr-purchase pic 9(4).
03 remain-val pic 9(5).
03 useful-life pic 9.
77 depreciation pic 9(6) usage is comp-3.
77 i pic 9.
77 depr-year pic 9(4).
77 no-of-year pic 9 value 1.
77 intr pic x.
screen section.
01 blank-screen.
03 blank screen.
01 screen-display.
03 blank screen.
03 line 1 column 1 value "__________________________________
- "_______________".
03 line 2 column 20 value "DEPRECIATION TABLE".
03 line 3 column 1 value "__________________________________
- "_______________".
03 LINE 4 COLUMN 1 VALUE "DEPRECIATION PURCHASE EXPIRY
- "SALVAGE DEPR".
03 LINE 5 COLUMN 1 VALUE " AMOUNT YEAR LIFE
- "VALUE YEAR".
03 line 6 column 1 value "__________________________________
- "_______________".
procedure division.
mainpara.
move 1 to i.
move i to lin.
perform read-depr 10 times.
move 1 to i.
move 7 to lin.
display screen-display.
perform disp-table 10 times.
stop run.
read-depr.
display (1, 10) "accept item name".
accept (1, 40) item-name(i).
display (2, 10) "accept purchase price".
accept (2, 40) purchase-price(i).
display (3, 10) "accept year purchased".
accept (3, 40) yr-purchase(i).
display (4, 10) "accept remaining value".
accept (4, 40) remain-val(i).
display (5, 10) "accept useful life of asset".
accept (5, 40) useful-life(i).
add 1 to i.
display blank-screen.
add 1 to lin.
disp-table.
if lin > 24
display blank-screen
display screen-display
move 7 to lin
move 1 to no-of-year.
perform calc-depr.
if useful-life(i) > 5
move 5 to no-of-year
else
move useful-life(i) to no-of-year.
perform disp-depr no-of-year times.
* no-of-year = useful-life(i) or
* no-of-year = 5 times.
add 1 to i.
add 2 to lin.
calc-depr.
compute depreciation = (purchase-price(i) - remain-val(i) )
/ useful-life(i).
move yr-purchase(i) to depr-year.
disp-depr.
display (lin, 3) depreciation.
display (lin, 16) yr-purchase(i).
display (lin, 26) useful-life(i).
display (lin, 37) remain-val(i).
display (lin, 44) depr-year.
add 1 to depr-year, lin, no-of-year.
if lin > 24
display (23, 10) "press any key to continue"
accept intr
display blank-screen
move 1 to lin.