PASCAL.. Student Database Information System.

{

Description: Student Database. Create a new text file and then run the program. It will ask for the path of the text file and the use the program. the password is 'vyomw'.
}

{+r$}
program databse;
uses graph , crt;
const
directory = 'f:pascal gi' ;
type
stdname = string[40];
searcharray = array[1..1000] of integer;
student = record
name : stdname;
stdnum : real;
semester : real;
gpa : real;
end;
stdarray = array[1..1000] of student;

var
unchangeable : integer;
class : stdarray;
choice : char;
i , driver , mode : integer;
path3 : string ;
indata1 , backup : text ;
search1 : searcharray;
label 1 , 2 , 3 ;
procedure decryptor(var decstring : stdname);
var
loop : integer;
begin
for loop := 1 to length(decstring) do
decstring[loop] := chr(ord(decstring[loop]) - 121);
end;
procedure intdecrypt(var num : real);
begin
num := num - 27;
num := num / 2;
end;
procedure gpadecrypt(var num : real);
begin
num := num + 0.26;
num := num * 3.29;
num := num / 2.69;
end;
procedure encryptor(var encstring : stdname);
var
loop : integer;
begin
for loop := 1 to length(encstring) do
encstring[loop] := chr(ord(encstring[loop]) + 121);
end;
procedure gpaencrypt(var num : real);
begin
num := num * 2.69;
num := num / 3.29;
num := num - 0.26;
end;
procedure intencrypt(var num : real);
begin
num := num * 2;
num := num + 27;
end;
procedure emptier;
var
i : integer;
begin
for i := 1 to 1000 do
begin
class[i].stdnum := 0;
class[i].semester := 0;
class[i].gpa := 0;
class[i].name := '';
search1[i] := 0;
end;
end;
procedure searcher;
var
b , x , m : integer;
choice , seperator : char;
search : real;
label 1 , 2 , 3 , 4;
begin

2: write('Please enter the student number to search ');
readln(search);
intencrypt(search);
reset(indata1);
x := 1;
while not eof(indata1) do
begin;
readln(indata1, search1[x]);
if (search = search1[x]) then
goto 1;
x := x + 1 ;
if eof(indata1) then
begin
writeln('Student number not found ');
4: write('Do you want to search for more ');
readln(choice);
if (choice = 'y') or (choice = 'Y') then
begin
for b := 1 to 50 do
begin
writeln('')
end;
goto 2
end
else
goto 3;
end;

end;

1 : for m := 1 to 50 do
writeln('');
writeln('Search result found ') ;
writeln('') ;
reset(indata1);
writeln('');
for m := 1 to x do
begin
read(indata1 , class[m].stdnum);
read(indata1 , class[m].semester);
read(indata1 , class[m].gpa);
read(indata1 , seperator);
readln(indata1 , class[m].name);
end;
intdecrypt(class[x].stdnum);
writeln('Student Number ' , class[x].stdnum:4:0);
decryptor(class[x].name);
writeln('Name ' , class[x].name);
intdecrypt(class[x].semester);
writeln('Semester ' , class[x].semester:1:0);
gpadecrypt(class[x].gpa);
writeln('GPA ' , class[x].gpa:1:2);
writeln('');
writeln('');
goto 4;
3: end;
procedure save;
begin
append(indata1);
intencrypt(class[i].stdnum);
write(indata1 , class[i].stdnum:1:0 , ' ' );
intencrypt(class[i].semester);
write(indata1 , class[i].semester:1:0 , ' ' );
gpaencrypt(class[i].gpa);
write(indata1 , class[i].gpa:1:2 , ' ');
encryptor(class[i].name);
writeln(indata1 , class[i].name);
close(indata1);
end;
procedure newrecord;

var
t , h : integer;
n : real;
choice1 , choices : char;
label 1 , 2 , 3 , 4, 5 , 6 ;
begin

1: for t := 1 to 50 do
writeln('');
writeln('please enter as directed') ;
write('Student # ');
readln(class[i].stdnum);
write('Student Name ');
readln(class[i].name);
write('Semester ');
readln(class[i].semester);
write('GPA ');
readln(class[i].gpa);
5: reset(indata1);
if not eof(indata1) then
begin
repeat
readln(indata1 , n); ;
intdecrypt(n);
if n = class[i].stdnum then

begin
writeln('Duplicate Student Number not allowed ');
write('Please enter another student no ');
readln(class[i].stdnum);
goto 5;
end;
until eof(indata1) ;
end;
if eof(indata1) then
goto 3;

3: if (class[i].semester > 8) or (class[i].semester < 1) then
begin
for h := 1 to 50 do
writeln('');
write('Error in data.... Please Renter the Semester Value ') ;
readln(class[i].semester) ;
goto 3;
end;
4: if (class[i].gpa > 4.0) or (class[i].gpa < 1.0) then
begin
write('Error in data.... Please Renter the GPA ');
readln(class[i].gpa);
goto 4;
end;
save;
i := i + 1;
writeln('');

2: write('Do you want to enter more data ');

read(choice1);
writeln('');
if (choice1 = 'y') or (choice1 = 'Y') then
goto 1 ;
write('Are You Sure.... ');
readln(choices);
if (choices = 'N') or (choices = 'n') then
goto 2
else


end;
procedure delrec;
label 1, 2 ;
var
h1 , h2 , h3 , f1 , d : integer;
delstd : real;
begin
d := i;
i := 1;
emptier;
reset(indata1);
write('Please enter the student number you want to delete ');
readln(delstd);
for i := 1 to 1000 do
begin
read(indata1 , class[i].stdnum);
intdecrypt(class[i].stdnum);
read(indata1 , class[i].semester);
intdecrypt(class[i].semester);
read(indata1 , class[i].gpa);
gpadecrypt(class[i].gpa);
readln(indata1 , class[i].name);
decryptor(class[i].name);
if eof(indata1) then
begin
h2 := i;
goto 1 ;
end;
end;
1: close(indata1);
for h1 := 1 to h2 do
if (class[h1].stdnum = delstd) then
begin
h3 := h1 - 1;
writeln(h3);
rewrite(indata1);
for f1 := 1 to h3 do
begin
intencrypt(class[f1].stdnum);
write(indata1 , class[f1].stdnum:4:0 ,' ' );
intencrypt(class[f1].semester);
write(indata1 , class[f1].semester:1:0 , ' ');
gpaencrypt(class[f1].gpa);
write(indata1 , class[f1].gpa:1:2);
encryptor(class[f1].name);
writeln(indata1 , class[f1].name);
end;
h3 := h1 + 1;
for f1 := h3 to h2 do
begin
intencrypt(class[f1].stdnum);
write(indata1 , class[f1].stdnum:4:0 , ' ');
intencrypt(class[f1].semester);
write(indata1 , class[f1].semester:1:0 , ' ');
gpaencrypt(class[f1].gpa);
write(indata1 , class[f1].gpa:1:2);
encryptor(class[f1].name);
writeln(indata1 , class[f1].name);
end;
goto 2;
end;
2: i := d;
emptier;
end;
procedure password;
var
c : string;
e : integer;

label 1 ;
begin
e := 0;
clrscr;
1: write('Please enter your password ');
repeat
e := e + 1;
c[e] := readkey;
if ord(c[e]) = 13 then
else
write('*');
until (ord(c[e]) = 13);
writeln('');
if (c[1] = 'v') and (c[2] = 'y') and (c[3] = 'o') and (c[4] = 'm') and (c[5] = 'w') and (c[6] = chr(13)) then
begin
write('Password Accepted..... Please press any key to continue.');
readkey;
end
else
begin
writeln('Wrong Password');
e := 0;
writeln('');
Write('Do you want to continue...[Y/N] ');
readln(choice);
clrscr;
if (choice = 'y') or (choice = 'Y') then
goto 1
else
choice := 'n';
end;
end;
procedure listrecord;
var
name1 : stdname;
j , h : integer;
seperator , seperator2 ,seperator3 , keys1 : char;
gpa1 , stdnum1 , semester1 : real;
label 1 , 2 ;

begin

for j := 1 to 50 do
writeln('');
writeln('This is the list of all records present in the Database');
reset(indata1);
while not eof(indata1) do
begin
readln(indata1 , stdnum1 ,seperator ,semester1 ,seperator2, gpa1 ,seperator3, name1);
decryptor(name1);
intdecrypt(stdnum1);
intdecrypt(semester1);
gpadecrypt(gpa1);
writeln('Student # ' , stdnum1:1:0);
writeln('Student Name ' , name1);
writeln('Semester ' , semester1:1:0);
writeln('GPA ' , gpa1:1:2);
writeln('');
writeln('Press any key to continue... or type or to exit');
keys1 := readkey;
if (keys1 = 'x') or (keys1 ='X') then
goto 1;
for h := 1 to 50 do
writeln('');

end;
1: writeln('ending');
end;
procedure editrecord;
var
delstd , n : real;
seperator : char;
h1 , h2 , h3 , f1 , d , h4 , h : integer;
label 1, 2 , 3 , 4 ,5 ;
begin
d := i;
i := 1;
emptier;
reset(indata1);
write('Please enter the student number you want to Edit ');
readln(delstd);

for i := 1 to 1000 do
begin
read(indata1,class[i].stdnum);
intdecrypt(class[i].stdnum);
read(indata1,class[i].semester);
intdecrypt(class[i].semester);
read(indata1,class[i].gpa);
gpadecrypt(class[i].gpa);
read(indata1,seperator);
readln(indata1,class[i].name);
decryptor(class[i].name);
if eof(indata1) then
begin
h2 := i;
goto 1 ;
end;
end;
1: close(indata1);
for h1 := 1 to h2 do
if (class[h1].stdnum = delstd) then

begin
h4 := h1;
h3 := h1 - 1;
writeln(h3);
rewrite(indata1);
for f1 := 1 to h3 do
begin
intencrypt(class[f1].stdnum);
write(indata1 , class[f1].stdnum:4:0 ,' ' );
intencrypt(class[f1].semester);
write(indata1 , class[f1].semester:1:0 , ' ');
gpaencrypt(class[f1].gpa);
write(indata1 , class[f1].gpa:1:2 , ' ');
encryptor(class[f1].name);
writeln(indata1 , class[f1].name);
end;

h3 := h1 + 1;
for f1 := h3 to h2 do
begin
append(indata1);
intencrypt(class[f1].stdnum);
intencrypt(class[f1].semester);
gpaencrypt(class[f1].gpa);
encryptor(class[f1].name);
write(indata1,class[f1].stdnum:4:0 , ' ');
write(indata1,class[f1].semester:1:0 , ' ');
write(indata1,class[f1].gpa:1:2 , ' ');
writeln(indata1,class[f1].name);
end;
close(indata1);

end;
clrscr;
writeln('Student # ' ,class[h4].stdnum:1:0);
writeln('Student Name ' ,class[h4].name);
writeln('Semester ' ,class[h4].semester:1:0);
writeln('GPA ' ,class[h4].gpa:1:2);
writeln('');
i := 1;
writeln('Please renter the values to change the record ');
write('Student # ');
readln(class[i].stdnum);
write('Student Name ');
readln(class[i].name);
write('Semester ');
readln(class[i].semester);
write('GPA ');
readln(class[i].gpa);
5: reset(indata1);
if not eof(indata1) then
begin
repeat
readln(indata1 , n); ;

if n = class[i].stdnum then

begin
writeln('Duplicate Student Number not allowed ');
write('Please enter another student no ');
readln(class[i].stdnum);
goto 5;
end;
until eof(indata1) ;
end;
if eof(indata1) then
goto 3;

3: if (class[i].semester > 8) or (class[i].semester < 1) then
begin
for h := 1 to 50 do
writeln('');
write('Error in data.... Please Renter the Semester Value ') ;
readln(class[i].semester) ;
goto 3;
end;
4: if (class[i].gpa > 4.0) or (class[i].gpa < 1.0) then
begin
write('Error in data.... Please Renter the GPA ');
readln(class[i].gpa);
goto 4;
end;
save;
goto 2;
2: i := d;
emptier;
end;


procedure deleterecord;
var
t : integer;
choice : char;
begin
for t := 1 to 50 do
writeln('');
writeln( ' WARNING ---- This will delete all the records in the current database');
write('Do yo want to continue ');
readln(choice);
if (choice = 'y') or (choice = 'Y') then
begin
rewrite(indata1) ;
close(indata1) ;
writeln('Database has been deleted ');
end;

end;
procedure databaser;
var
name1 : stdname;
begin
clrscr;
write('Please enter the path of your databse text file ' );
readln(path3);
assign(indata1 , path3);
end;
procedure backup1;
var
name1 : stdname;
begin
clrscr;
writeln('This will backup your data ');
writeln('Please enter the path of the databse text file to backup data ');
write('>>> ');
readln(name1);
assign(backup , name1);
name1 := '';
rewrite(backup);
reset(indata1);
while not eof(indata1) do
begin
readln(indata1 , name1);
writeln(backup , name1);
end;
writeln('');
writeln('');
writeln('Backup task completed ');
close(indata1);
close(backup);
writeln('press any key to continue ');
readkey;
end;
procedure starter;
var
data : char;
begin
initgraph(driver , mode , directory);
rectangle(10,10 , getmaxx - 10 , 165);
outtextxy(140,15 , 'F A S T - N U S T U D E N T D A T A B A S E ');
outtextxy(135 ,45 ,'PLEASE SELECT YOUR OPTION BY THE BRACKETED LETTER');
outtextxy(12, 75 , '[N]ew Record [E]dit Record [L]ist Record [D]elete Record [S]earch Record' ) ;
outtextxy(12 ,110 ,' [C]lear Databse c[H]ange Databse [B]ackup Databse e[X]it' ) ;
outtextxy(17 , 135 , 'Programming by :- Faraz Younus Bandukda - Farazoftine Software Products ');
data := readkey;
if (data = 'n') or (data = 'N') then
begin
clrscr;
closegraph;
newrecord ;
end;
if (data = 'h') or (data = 'H') then
begin
clrscr;
closegraph;
databaser;
end;
if (data = 'e') or (data = 'E') then
begin
clrscr;
closegraph;
editrecord ;
end;
if (data = 'l') or (data = 'L') then
begin
clrscr;
closegraph;
listrecord ;
end;
if (data = 'c') or (data = 'C') then
begin
clrscr;
closegraph;
deleterecord ;
end;
if (data = 's') or (data = 'S') then
begin
clrscr;
closegraph;
searcher;
end;
if (data = 'x') or (data = 'X') then
begin
unchangeable := 0;
end;
if (data = 'd') or (data = 'D') then
begin
clrscr;
closegraph;
delrec;
end;
if (data = 'b') or (data = 'B') then
begin
clrscr;
closegraph;
backup1;
end;

end;
begin

password;
if (choice = 'n') then
goto 3;
databaser;
emptier;
i := 1;
unchangeable := 1;
while unchangeable >= 1 do
begin
starter;
end;
3 : writeln('');
end.

PASCAL..Randomizes two 3x3 arrays and indicates the numbers whih are common in both the arrays

{
Description: Randomizes two 3x3 arrays and indicates the numbers whih are common in both the arrays otherwise an cross 'x' is shown instead.
}

program randomarray;
uses crt;


type
arr1 = array [1..3,1..3] of integer;

var
a1, a2, a3 : arr1;
i, j : integer;

procedure initialise1(var a_1 : arr1);
begin
for i:=1 to 3 do
begin
for j:=1 to 3 do
begin
a_1[i][j]:=random(10);
end;
end;
end;

procedure initialise2(var a_2 : arr1);
begin
for i:=1 to 3 do
begin
for j:=1 to 3 do
begin
a_2[i][j]:=random(10);
end;
end;
end;

procedure output1(var a_1 : arr1);
begin
for i:=1 to 3 do
begin
for j:=1 to 3 do
begin
write(a_1[i][j],' ');
end;
writeln;
end;
end;

procedure output2(var a_2 : arr1);
begin
for i:=1 to 3 do
begin
for j:=1 to 3 do
begin
write(a_2[i][j],' ');
end;
writeln;
end;
end;

procedure same(var a_1, a_2 : arr1);
begin
for i:=1 to 3 do
begin
for j:=1 to 3 do
begin
if a_1[i][j] = a_2[i][j] then
write(a_1[i][j],' ')
else
write('x ');
end;
writeln;
end;
end;

begin
clrscr;
randomize;
initialise1(a1);
initialise2(a2);
output1(a1);
writeln;
output2(a2);
writeln;
same(a1,a2);
readln;
end.

PASCAL..Program that stores Bank account holder data in file.

{
Description: Program that stores account holder data in file
}
program bank_acount;

{Program that stores account holder data in file
NOTE: make a txt file with name 'acc_file.txt' in the folder before
running this code}


uses crt;

type
name= record
first :string;
second:string;
last :string;
end;

address = record
flat :string;
block :string;
postal :string;
city :string;
province:string;
country :string;
end;

apointer=^acount;
Acount = record
ano :real;
aname :name;
aaddress:address;
credit:real;
next:apointer
end;

acountfile=file of acount;


var
head,tail,temp :apointer;
accountno: real;
acount_choice:char;
check:boolean;
afile:acountfile;
data:acount;
{============================================================================}

{ ERROR MSGS
}
{============================================================================}


PROCEDURE ERROR_MSG;
BEGIN
textcolor(lightred + blink);
writeln;writeln;
writeln('INCORRET NUMBER ENTERED !');
textcolor(15);
writeln('Press any key to continue...');
readkey;
END;

PROCEDURE CHECK_NO(p:apointer;no:real);
begin
check:=false;

while p<> nil do
begin
if P^.ano = no then
check:=true;
p:=p^.next;
end;

end;


{============================================================================}

{ TRANSFER MONEY
}
{============================================================================}


PROCEDURE TRANSFER(p:apointer);
var
q,r:apointer;
ano1,ano2,money: real;
ch:char;
check:boolean;
BEGIN
q:=p;

repeat
begin
clrscr;
writeln;
WRITeln('M O N E Y T R A N S F E R':50);
writeln('=============================':50);
writeln;
check:=false;
write('Enter the account number from which the money is to be
transfer > ');
readln(ano1);

while p<>nil do
begin
if p^.ano=ano1 then
begin
r:=p;
check:=true
end;
p:=p^.next;
end;
p:=q;

if check =false then
begin
writeln('Account not found');
writeln('Press ENTER to enter agian or any other key to exit');
ch:=readkey;
if ord(ch)<>13 then
exit;
end;
end;
until check=true;
check:=false;

repeat
begin
clrscr;
gotoxy(1,2);
WRITeln('M O N E Y T R A N S F E R':50);
writeln('=============================':50);
gotoxy(1,5);
write('Enter the account number from which the money is to be
transfer > ' ,ano1:1:0);
writeln;
write('Enter the account number to which the money is to be
transfer > ');
readln(ano2);
p:=head;
while p<>nil do
begin
if p^.ano=ano2 then
begin
q:=p;
check:=true
end;

p:=p^.next;
end;

if check =false then
begin
writeln('Account not found');
writeln('Press ENTER to enter agian or any other key to
exit');
ch:=readkey;
if ord(ch)<>13 then
exit;
end;
end;
until check=true;


write('Enter the amount to be transfer >' );
readln(money);

if money > (r^.credit-1000) then
begin
writeln('not enough money to be transfer') ;
writeln('press any key to return to main menu');
readkey;
end
else
begin
r^.credit:=r^.credit-money;
q^.credit:=q^.credit+money;
end;

end;



{============================================================================}

{ SEARCH ACCOUNT
}
{============================================================================}


PROCEDURE SEARCH( p:apointer);
var
fname,lname,postal,city: string;
count:integer;
no:real ;
find:char;
procedure print_search(p:apointer);
begin
write('SEARCH NO. > ');
writeln(count);
write('ACCOUNT NUMBER > ');
writeln(p^.ano:1:0);
write('ACCOUNT CREDIT > ');
writeln(p^.credit:1:0);
write('ACCOUNT HOLDER NAME > ');
write(p^.aname.first);
write(' ',p^.aname.second);
writeln(' ',p^.aname.last);
write('ACCOUNT HOLDER ADDRESS > ');
write('Flat:',p^.aaddress.flat);
write(', Block:',p^.aaddress.block);
write(', ',p^.aaddress.city);
write(', ',p^.aaddress.province);
write(', ',p^.aaddress.country);
writeln(', ',p^.aaddress.postal);
writeln;
end;

BEGIN

clrscr;
count:=0;
writeln('S E A R C H A C C O U N T':40);
writeln;
Writeln('1) Search by account numbere ');
Writeln('2) Search by first name');
Writeln('3) Search by last name ');
Writeln('4) Search by postal code');
Writeln('5) Search by city');
Writeln('6) Exit');
writeln;
write('Enter the search criteria > ');
readln(find);
case find of

'1': BEGIN
clrscr;
write('Enter the Account Number > ');
readln(no);
while p<> nil do
begin
if no = p^.ano then
begin
count:=count+1;
print_search(p);
if count mod 3 = 0 then
begin
writeln('Press any key to continue..');
readkey;
end;
end;
p:= p^.next;
end;
END;

'2': BEGIN
clrscr;
write('Enter the first name > ');
readln(fname);
while p<> nil do
begin
if fname = p^.aname.first then
begin
count:=count+1;
print_search(p);
if count mod 3 =0 then
begin
writeln('Press any key to continue..');
readkey;
end;
end;
p:= p^.next;
end;
END;

'3': BEGIN
clrscr;
write('Enter the last name > ');
readln(lname);
while p<> nil do
begin
if lname = p^.aname.last then
begin
count:=count+1;
print_search(p);
if count mod 3=0 then
begin
writeln('Press any key to continue..');
readkey;
end;
end;
p:= p^.next;
end;
END;

'4': BEGIN
clrscr;
write('Enter the Postal Code > ');
readln(postal);
while p<> nil do
begin
if postal = p^.aaddress.postal then
begin
count:=count+1;
print_search(p);
if count mod 3 =0 then
begin
writeln('Press any key to continue..');
readkey;
end;
end;
p:= p^.next;
end;
END;

'5': BEGIN
clrscr;
write('Enter the city name > ');
readln(city);
while p<> nil do
begin
if city = p^.aaddress.city then
begin
count:=count+1;
print_search(p);
if count mod 3 =0 then
begin
writeln('Press any key to continue..');
readkey;
end;
end;
p:= p^.next;
end;
END;

'6': BEGIN
exit;
END;

else
BEGIN
error_msg;
END;
END;{case}

if ((find='1') or(find='2') or(find='3') or
(find='4') or(find='5') or(find='6')) and (count = 0) then
writeln('Name not found');

if ((find='1') or(find='2') or(find='3') or
(find='4') or(find='5') or(find='6') )and((count mod 3
<> 0) or( count=0))then
begin
writeln('Press any key to continue...');
readkey;
end;
search(head);
end;

{============================================================================}

{ CLOSED ACCOUNT
}
{============================================================================}


PROCEDURE Close(p:apointer);
var
r: apointer;
no : real ;
count:integer;
BEGIN
count:=0;
clrscr;
writeln;
WRITE('Enter ACCOUNT NO. to close the account > ');
readln(no);

while p<> nil do
begin
if no = p^.next^.ano then
begin
r:= p^.next;
p^.next:=p^.next^.next;
r^.next:=nil;
dispose (r);
count:=1;
end;
p:= p^.next;
end;

if head^.ano = no then
begin
r:= head;
head:=head^.next;
r^.next:=nil;
dispose (r);
count:=1;
end;



if count=0 then writeln('Account not found') else
Writeln('Record of ',no:10:0,' deleted');
writeln('Press any key to continue...');
readkey;
END;

{============================================================================}

{ READ DATA INTO ACCOUNT
}
{============================================================================}


PROCEDURE READ_DATA(p: apointer);
BEGIN
accountno :=8876543;

repeat
begin
accountno:=accountno+1;
check_no(head,accountno);
end;
until check=false;
p^.ano:=accountno;

repeat
clrscr;

textcolor(11);
writeln('ACCOUNT INFO');
writeln('--------------');
textcolor(15);

writeln('Account No. > ',p^.ano:1:0 );
write ('Account credit > ');
readln(P^.credit);
gotoxy(1,4);
writeln('Account credit > ' ,p^.credit:1:0);

if P^.credit<1000 then
begin
writeln('Minimun acount limit is Rs.1000');
writeln('Press any key to enter again..');
readkey;
end;

until P^.credit>=1000;

writeln;
textcolor(11);
writeln('ACCOUNT HOLDER NAME');
writeln('-------------------');
textcolor(15);

repeat
gotoxy(1,8);
write('Enter the first name >');
readln(p^.aname.first);
until length (p^.aname.first)>0;

repeat
gotoxy(1,9);
write('Enter the second name >');
readln(p^.aname.second);
until length (p^.aname.second)>0;

repeat
gotoxy(1,10);
write('Enter the last name >');
readln(p^.aname.last);
until length (p^.aname.last)>0;

writeln;
textcolor(11);
writeln('ACCOUNT HOLDER ADDRESS');
writeln('----------------------');
textcolor(15);

repeat
gotoxy(1,14);
write('Enter the Plot no./Flat no./House no. >');
readln(p^.aaddress.flat);
until length (p^.aaddress.flat)>0;

repeat
gotoxy(1,15);
write('Enter the Street no./Block no. >');
readln(p^.aaddress.block);
until length (p^.aaddress.block)>0;

repeat
gotoxy(1,16);
write('Enter the Postal Code >');
readln(p^.aaddress.postal);
until length (p^.aaddress.postal)>0;

repeat
gotoxy(1,17);
write('Enter the City >');
readln(p^.aaddress.city);
until length (p^.aaddress.city)>0;

repeat
gotoxy(1,18);
write('Enter the Province >');
readln(p^.aaddress.Province);
until length (p^.aaddress.province)>0;

repeat
gotoxy(1,19);
write('Enter the Country >');
readln(p^.aaddress.country);
until length (p^.aaddress.country)>0;
writeln;
writeln('Data input completed!');
writeln('press any key to return to menu');
readkey;
END;
{============================================================================}

{ MAKE FILE
}
{============================================================================}

PROCEDURE CREATE_FILE(P:APOINTER) ;
BEGIN
rewrite(afile);
while p<>nil do
begin
data:=p^;
write(afile,data);
p:=p^.next;
end;

END;


{============================================================================}

{ READ FORM FILE
}
{============================================================================}


PROCEDURE READ_FILE(TEMP:APOINTER;DATA:ACOUNT);
BEGIN
temp^.ano:=data.ano;
temp^.aname.first :=data.aname.first
;
temp^.aname.second :=data.aname.second
;
temp^.aname.last :=data.aname.last
;
temp^.aaddress.flat :=data.aaddress.flat
;
temp^.aaddress.block :=data.aaddress.block
;
temp^.aaddress.postal :=data. aaddress.postal
;
temp^.aaddress.city :=data.aaddress.city
;
temp^.aaddress.province :=data.aaddress.province
;
temp^.aaddress.country :=data.aaddress.country
;
temp^.credit:= data.credit
;
END;
{============================================================================}

{ OPEN ACCOUNT
}
{============================================================================}


PROCEDURE INSERT_ACCOUNT;
BEGIN

if head = nil then
begin
new(temp);
read_data(temp);
head:=temp;
head^.next:=nil;
end

else
begin
new(temp);
read_data(temp);
temp^.next:=head;
head:=temp;
end
end;

{============================================================================}

{ MAIN MENU
}
{============================================================================}


PROCEDURE Account_option;
var
select : char;
begin

clrscr;

textcolor(9);
writeln;
writeln('ACOUNT OPTIONS':40);
writeln;
textcolor(15);
writeln('1) OPEN ACCOUNT':41);
writeln;
writeln('2) CLOSED ACCOUNT':43);
writeln;
writeln('3) TRANSFER MONEY':43);
writeln;
writeln('4) SEARCH':35);
writeln;
writeln('5) EXIT':33);

writeln;writeln;
textcolor(7);
write('ENTER THE OPTION FROM THE ABOVE MENU >');
readln(acount_choice);

case acount_choice of
'1': begin
gotoxy(1,4);
textcolor(11+blink);
writeln('1) OPEN ACCOUNT':41);
gotoxy(41,17);
delay(1500);
textcolor(15);
insert_account;
Account_option;
end;
'2': begin
gotoxy(1,6);
textcolor(11+blink);
writeln('2) CLOSED ACCOUNT':43);
gotoxy(41,17);
delay(1500);
textcolor(15);
close(head);
Account_option;
end;

'3': begin
gotoxy(1,8);
textcolor(11+blink);
writeln('3) TRANSFER MONEY':43);
gotoxy(41,17);
delay(1500);
textcolor(15);
transfer(head);
Account_option;
end;

'4': begin
gotoxy(1,10);
textcolor(11+blink);
writeln('4) SEARCH':35);
gotoxy(41,17);
delay(1500);
textcolor(15);
search(head);
Account_option;
end;

'5': begin
gotoxy(1,12);
textcolor(11+blink);
writeln('5) EXIT':33);
gotoxy(41,17);
delay(500);
create_file(head);
exit;
end;

else
begin ERROR_MSG; Account_option; end;

end;

end;
{============================================================================}

{ END OF PROCEDURES
}
{============================================================================}


BEGIN
clrscr;
accountno :=8876543;
window(1,1,80,3);
textcolor(11);
writeln('B A N K A C C O U N T S':54);
writeln('=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=':54);
window(1,3,80,25);

assign(afile,'acc_file.txt');
reset(afile);
while not eof(afile) do
begin
if head = nil then
begin
new(temp);
read(afile,data);
READ_FILE (TEMP,DATA);
head:=temp;
head^.next:=nil;
end

else
begin
new(temp);
read(afile,data);
READ_FILE (TEMP,DATA);
temp^.next:=head;
head:=temp;
end
end;
Account_option;
END.

Program for calculating yearly depreciation.

Identification Division.
Program-id. Q1.
Environment Division.
Configuration Section.
Source-Computer. IBM PC.
Object-Computer. IBM PC.
Input-Output Section.
SELECT in-file assign to "IN.DAT" organization is
line sequential.
SELECT out-file assign to "Out.txt".

Data Division.
File Section.
FD in-file.
01 in-rec.
02 in-itemno pic X(5).
02 in-cost pic 9(3)V9(2).
02 in-scrapvalue pic 9(3)v9(2).
02 in-y-o-l pic 99.
FD out-file.
01 out-rec pic X(80).


Working-Storage Section.
77 depreciation pic 9(3).9(2).
77 EOF pic X value "N".
77 Heading1 pic X(80) value all "-".
01 out-format.
02 out-itemno pic X(5).
02 F pic X(15) value spaces.
02 out-depreciation pic 999.99.


Procedure Division.
Main-para.
Open input in-file Output out-file.
Move Heading1 to out-rec.
Write out-rec before advancing 1 line.
Move " YEARLY DEPRECIATION REPORT"
to out-rec.
Write out-rec before advancing 1 line.
Move Heading1 to out-rec.
Write out-rec before advancing 1 line.
Move "ITEM CODE DEPRECIATION" to out-rec.
Write out-rec before advancing 1 line.

Read in-file at end move "Y" to EOF.

Perform calc-para until EOF = "Y".
Display "The Details have been written to file OUT.DAT".
Close in-file , out-file.
Stop Run.
calc-para .
Compute depreciation = ( in-cost - in-scrapvalue ) / in-y-o-l.
Move in-itemno to out-itemno.
Move depreciation to out-depreciation.
Move out-format to out-rec.
Write out-rec before advancing 1 line.
Read in-file at end move "Y" to EOF.

File In SEQUENTIAL.

IDENTIFICATION DIVISION.
PROGRAM-ID. SEQFILE.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT OUT-FILE ASSIGN TO DISK
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD OUT-FILE
LABEL RECORDS ARE STANDARD
VALUE OF FILE-ID IS "STUD1.DAT".
01 OUT-REC.
02 ROLL-NO PIC 9(5).
02 NAME PIC X(20).
02 SUBJECT PIC X(10).
02 MARKS PIC 99.
WORKING-STORAGE SECTION.
77 NUMR PIC 99.
PROCEDURE DIVISION.
MAIN-PARA.
OPEN OUTPUT OUT-FILE.
DISPLAY "ENTER THE NO. OF STUDENTS: ".
ACCEPT NUMR.
PERFORM READ-WRITE-PARA UNTIL NUMR EQUAL TO 0.
CLOSE OUT-FILE.
STOP RUN.
READ-WRITE-PARA.
DISPLAY " ENTER THE ROLL NO.: ".
ACCEPT ROLL-NO.
DISPLAY "ENTER THE NAME OF STUDENT: ".
ACCEPT NAME.
DISPLAY "ENTER NAME OF SUBJECT: ".
ACCEPT SUBJECT.
DISPLAY "ENTER THE MARKS: ".
ACCEPT MARKS.
WRITE OUT-REC
COMPUTE NUMR = NUMR - 1.

Program identifies whethr a given number is prime or not.

IDENTIFICATION DIVISION.
PROGRAM-ID. PRIME.

ENVIRONMENT DIVISION.
DATA DIVISION.

WORKING-STORAGE SECTION.
77 N PIC 9(3).
77 Q PIC 9(3).
77 R PIC 9(3).
77 I PIC 9(3) VALUE 1.

PROCEDURE DIVISION.
PARA-A.
DISPLAY ( 1 , 1 ) ERASE.
DISPLAY ( 2 , 1 ) "ENTER AN INTEGER:".
ACCEPT ( 2 , 20 ) N.

IF N = 1
DISPLAY ( 3 , 1 ) "NUMBER IS NOT PRIME"
GO TO STOP-PARA.

PARA-B.
ADD 1 TO I.
IF I = N
DISPLAY ( 3 , 1 ) "NUMBER IS PRIME"
GO TO STOP-PARA.

DIVIDE N INTO I GIVING Q REMAINDER R.

IF R = 0
DISPLAY ( 3 , 1 ) "NUMBER IS NOT PRIME"
GO TO STOP-PARA.


GO TO PARA-B.



STOP-PARA.
STOP RUN.

Program to compute income tax.

IDENTIFICATION DIVISION.
PROGRAM-ID. Q9.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM PC.
OBJECT-COMPUTER. IBM PC.
INPUT-OUTPUT SECTION.
SELECT IN-FILE ASSIGN TO "Q9IN.DAT" ORGANIZATION IS
LINE SEQUENTIAL.
SELECT OUT-FILE ASSIGN TO "Q9OUT.TXT".

DATA DIVISION.
FILE SECTION.
FD IN-FILE.
01 IN-REC.
02 IN-NAME PIC A(20).
02 IN-INCOME PIC 9(6)V99.
FD OUT-FILE.
01 OUT-REC PIC X(80).


WORKING-STORAGE SECTION.
77 EOF PIC X value "N".
77 HEADING1 PIC X(80) VALUE ALL "-".
77 TAX PIC 9(5)V99.
01 OUT-FORMAT.
02 OUT-NAME PIC X(5).
02 F PIC X(15) VALUE SPACES.
02 OUT-INCOME PIC ***9(3).99.
02 F PIC X(10) VALUE SPACES.
02 OUT-TAX PIC ***9(2).99.

PROCEDURE DIVISION.
MAIN-PARA.
OPEN INPUT IN-FILE OUTPUT OUT-FILE.
READ IN-FILE AT END MOVE "Y" TO EOF.

PERFORM CALC-PARA UNTIL EOF = "Y".
DISPLAY "THE DETAILS HAVE BEEN WRITTEN TO FILE Q9OUT.DAT".
CLOSE IN-FILE , OUT-FILE.
STOP RUN.

CALC-PARA.
IF IN-INCOME IS NOT > 150000
SUBTRACT 50000 FROM IN-INCOME ,
MULTIPLY 0.30 BY IN-INCOME GIVING TAX ,
ADD 9000 TO TAX.
IF IN-INCOME IS NOT > 70000
SUBTRACT 50000 FROM IN-INCOME ,
MULTIPLY 0.20 BY IN-INCOME GIVING TAX ,
ADD 5000 TO TAX.
IF IN-INCOME IS NOT > 50000
SUBTRACT 20000 FROM IN-INCOME ,
MULTIPLY 0.10 BY IN-INCOME GIVING TAX.
IF IN-INCOME IS NOT > 20000
MOVE ZERO TO TAX.
MOVE " INCOME TAX SLIP " TO OUT-REC.
WRITE OUT-REC.
WRITE OUT-REC FROM HEADING1.
MOVE " NAME | INCOME | INCOME-TAX "
TO OUT-REC.
WRITE OUT-REC.
WRITE OUT-REC FROM HEADING1.
MOVE IN-NAME TO OUT-NAME.
MOVE IN-INCOME TO OUT-INCOME.
MOVE TAX TO OUT-TAX.
WRITE OUT-REC FROM OUT-FORMAT.
READ IN-FILE AT END MOVE "Y" TO EOF.

Program to compute salary of employees.

IDENTIFICATION DIVISION.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM PC.
OBJECT-COMPUTER. IBM PC.
INPUT-OUTPUT SECTION.
SELECT IN-FILE ASSIGN TO "Q7IN.DAT" ORGANIZATION IS
LINE SEQUENTIAL.
SELECT OUT-FILE ASSIGN TO "Q7OUT.TXT".

DATA DIVISION.
FILE SECTION.
FD IN-FILE.
01 IN-REC.
02 IN-WORKER-CODE PIC 9999.
02 IN-HRS-WORKED PIC 999.
02 IN-WAGE-RATE PIC 99V99.
FD OUT-FILE.
01 OUT-REC PIC X(80).


WORKING-STORAGE SECTION.
77 EOF PIC X VALUE "N".
77 HEADING1 PIC X(80) VALUE ALL "-".
01 OUT-FORMAT.
02 OUT-WORKER-CODE PIC 9999.
02 F PIC X(10) VALUE SPACES.
02 OUT-HRS-WORKED PIC Z99.
02 F PIC X(10) VALUE SPACES.
02 OUT-WAGE-RATE PIC *9.99.
02 F PIC X(10) VALUE SPACES.
02 OUT-TOTAL-SALARY PIC ****.**.

PROCEDURE DIVISION.
MAIN-PARA.
OPEN INPUT IN-FILE OUTPUT OUT-FILE.
MOVE HEADING1 TO OUT-REC.
WRITE OUT-REC BEFORE ADVANCING 1 LINE.
MOVE " WEEKLY WAGES REPORT"
TO OUT-REC.
WRITE OUT-REC BEFORE ADVANCING 1 LINE .
MOVE HEADING1 TO OUT-REC.
WRITE OUT-REC BEFORE ADVANCING 1 LINE.
MOVE "WORKER CODE | HRS. WORKED | WAGE RATE | NET SALARY(RS.) "
TO OUT-REC.
WRITE OUT-REC BEFORE ADVANCING 1 LINE.

READ IN-FILE AT END MOVE "Y" TO EOF.
PERFORM CALC-PARA UNTIL EOF = "Y".
DISPLAY "THE DETAILS HAVE BEEN WRITTEN TO FILE Q7OUT.DAT".
CLOSE IN-FILE , OUT-FILE.
STOP RUN.

CALC-PARA.
IF IN-HRS-WORKED > 42
COMPUTE OUT-TOTAL-SALARY = 42 * IN-WAGE-RATE
+ ( IN-HRS-WORKED - 42 ) * 2 * IN-WAGE-RATE
ELSE
COMPUTE OUT-TOTAL-SALARY = IN-HRS-WORKED * IN-WAGE-RATE.
MOVE IN-WORKER-CODE TO OUT-WORKER-CODE.
MOVE IN-HRS-WORKED TO OUT-HRS-WORKED.
MOVE IN-WAGE-RATE TO OUT-WAGE-RATE.
MOVE OUT-FORMAT TO OUT-REC.
WRITE OUT-REC BEFORE ADVANCING 1 LINE.

READ IN-FILE AT END MOVE "Y" TO EOF.

Program to Calculate gross dividend.

IDENTIFICATION DIVISION.
PROGRAM-ID. Q3.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM PC.
OBJECT-COMPUTER. IBM PC.
INPUT-OUTPUT SECTION.
SELECT IN-FILE ASSIGN TO "Q3IN.DAT" ORGANIZATION IS
LINE SEQUENTIAL.
SELECT OUT-FILE ASSIGN TO "Q3OUT.TXT".

DATA DIVISION.
FILE SECTION.
FD IN-FILE.
01 IN-REC.
02 IN-FACEVAL PIC 999.
02 IN-RATE PIC V99.
FD OUT-FILE.
01 OUT-REC PIC X(80).


WORKING-STORAGE SECTION.
77 GROSS-DIVIDEND PIC 9(3).9(2).
77 EOF pic X value "N".
77 HEADING1 PIC X(80) VALUE ALL "-".
77 SNO PIC 99 VALUE 0.
01 OUT-FORMAT.
02 OUT-SNO PIC X(5).
02 F PIC X(15) VALUE SPACES.
02 OUT-GROSS-DIVIDEND PIC 99.99.

PROCEDURE DIVISION.
MAIN-PARA.
OPEN INPUT IN-FILE OUTPUT OUT-FILE.
MOVE HEADING1 TO OUT-REC.
WRITE OUT-REC BEFORE ADVANCING 1 LINE.
MOVE " GROSS DIVIDEND REPORT"
TO OUT-REC.
WRITE OUT-REC BEFORE ADVANCING 1 LINE .
MOVE HEADING1 TO OUT-REC.
WRITE OUT-REC BEFORE ADVANCING 1 LINE.
MOVE "SNO GROSS VALUE" to OUT-REC.
WRITE OUT-REC BEFORE ADVANCING 1 LINE.

READ IN-FILE AT END MOVE "Y" TO EOF.

PERFORM CALC-PARA UNTIL EOF = "Y".
DISPLAY "THE DETAILS HAVE BEEN WRITTEN TO FILE Q3OUT.DAT".
CLOSE IN-FILE , OUT-FILE.
STOP RUN.
CALC-PARA.
ADD 1 TO SNO.
COMPUTE GROSS-DIVIDEND = ( IN-FACEVAL * IN-RATE )/ 100.
MOVE SNO TO OUT-SNO.
MOVE GROSS-DIVIDEND TO OUT-GROSS-DIVIDEND.
MOVE OUT-FORMAT TO OUT-REC.
WRITE OUT-REC BEFORE ADVANCING 1 LINE.
READ IN-FILE AT END MOVE "Y" TO EOF.

Program to compute compound interest.

IDENTIFICATION DIVISION.
PROGRAM-ID. Q6.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM PC.
OBJECT-COMPUTER. IBM PC.
INPUT-OUTPUT SECTION.
SELECT IN-FILE ASSIGN TO "Q6IN.DAT" ORGANIZATION IS
LINE SEQUENTIAL.
SELECT OUT-FILE ASSIGN TO "Q6OUT.TXT".

DATA DIVISION.
FILE SECTION.
FD IN-FILE.
01 IN-REC.
02 IN-PRINCIPAL PIC 9(5)V99.
02 IN-ROI PIC 99.
02 IN-TIME PIC 99.
FD OUT-FILE.
01 OUT-REC PIC X(80).


WORKING-STORAGE SECTION.
77 COMPOUND-INTEREST PIC 9(4)V99.
77 EOF PIC X VALUE "N".
77 HEADING1 PIC X(80) VALUE ALL "-".
01 OUT-FORMAT.
02 OUT-PRINCIPAL PIC 9(5)V99.
02 F PIC X(5) VALUE SPACES.
02 OUT-ROI PIC 99.
02 F PIC X(5) VALUE SPACES.
02 OUT-TIME PIC 99.
02 F PIC X(10) VALUE SPACES.
02 OUT-COMPOUND-INTEREST PIC 9999.99.

PROCEDURE DIVISION.
MAIN-PARA.
OPEN INPUT IN-FILE OUTPUT OUT-FILE.
MOVE HEADING1 TO OUT-REC.
WRITE OUT-REC BEFORE ADVANCING 1 LINE.
MOVE " COMPOUND INTEREST CALCULATION"
TO OUT-REC.
WRITE OUT-REC BEFORE ADVANCING 1 LINE .
MOVE HEADING1 TO OUT-REC.
WRITE OUT-REC BEFORE ADVANCING 1 LINE.
MOVE "AMT (RS.) RATE TIME (YR.) COMP. INTEREST (RS.) " to OUT-REC.
WRITE OUT-REC BEFORE ADVANCING 1 LINE.

READ IN-FILE AT END MOVE "Y" TO EOF.
PERFORM CALC-PARA UNTIL EOF = "Y".
DISPLAY "THE DETAILS HAVE BEEN WRITTEN TO FILE Q6OUT.DAT".
CLOSE IN-FILE , OUT-FILE.
STOP RUN.

CALC-PARA.
COMPUTE COMPOUND-INTEREST
= IN-PRINCIPAL * ( 1 + IN-ROI / 100 ) ** IN-TIME
MOVE IN-PRINCIPAL TO OUT-PRINCIPAL.
MOVE IN-ROI TO OUT-ROI.
MOVE IN-TIME TO OUT-TIME.
MOVE COMPOUND-INTEREST TO OUT-COMPOUND-INTEREST.
MOVE OUT-FORMAT TO OUT-REC.
WRITE OUT-REC BEFORE ADVANCING 1 LINE.

READ IN-FILE AT END MOVE "Y" TO EOF.

STRING-UNSTRING

IDENTIFICATION DIVISION.
PROGRAM-ID. STRING-UNSTRING.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
77 FIRST-NAME PIC X(10).
77 MIDDLE-NAME PIC X(10).
77 LAST-NAME PIC X(10).
77 NAME PIC X(30).
77 M PIC X VALUE SPACES.
PROCEDURE DIVISION.
MAIN-PARA.
DISPLAY "ENTER YOUR FIRST NAME :".
ACCEPT FIRST-NAME.
DISPLAY FIRST-NAME.
DISPLAY "ENTER YOUR MIDDLE NAME :".
ACCEPT MIDDLE-NAME.
DISPLAY MIDDLE-NAME.
DISPLAY "ENTER YOUR LAST NAME :".
ACCEPT LAST-NAME.
DISPLAY LAST-NAME.
STRING FIRST-NAME DELIMITED BY SPACES,
M DELIMITED BY SIZE,
MIDDLE-NAME DELIMITED BY SPACES,
M DELIMITED BY SIZE,
LAST-NAME DELIMITED BY SPACES,
INTO NAME.
DISPLAY " THE GIVEN STRINGS AFTER STRING OPERATION IS : ".
DISPLAY NAME.
UNSTRING NAME DELIMITED BY M,
INTO FIRST-NAME,
MIDDLE-NAME,
LAST-NAME.
DISPLAY "THE VARIOUS STRINGS AFTER UNSTRING OPERATION ARE :".
DISPLAY FIRST-NAME
DISPLAY MIDDLE-NAME.
DISPLAY LAST-NAME.
STOP RUN.

Program To Convert Text To Number.

77 NUM PIC 9(5).
77 I PIC 99.
77 J PIC 99.
77 K PIC 99.
77 Q PIC 99.
01 NUM-TABLE1.
02 ONE PIC X(9) VALUE "ONE ".
02 TWO PIC X(9) VALUE "TWO ".
02 THREE PIC X(9) VALUE "THREE ".
02 FOUR PIC X(9) VALUE "FOUR ".
02 FIVE PIC X(9) VALUE "FIVE ".
02 SIX PIC X(9) VALUE "SIX ".
02 SEVEN PIC X(9) VALUE "SEVEN ".
02 EIGHT PIC X(9) VALUE "EIGHT ".
02 NINE PIC X(9) VALUE "NINE ".
02 TEN PIC X(9) VALUE "TEN ".
02 ELEVEN PIC X(9) VALUE "ELEVEN ".
02 TWELVE PIC X(9) VALUE "TWELVE ".
02 THIRTEEN PIC X(9) VALUE "THIRTEEN ".
02 FOURTEEN PIC X(9) VALUE "FOURTEEN ".
02 FIFTEEN PIC X(9) VALUE "FIFTEEN ".
02 SIXTEEN PIC X(9) VALUE "SIXTEEN ".
02 SEVENTEEN PIC X(9) VALUE "SEVENTEEN".
02 EIGHTEEN PIC X(9) VALUE "EIGHTEEN ".
02 NINETEEN PIC X(9) VALUE "NINETEEN ".

01 TABLE1 REDEFINES NUM-TABLE1.
02 TAB11 PIC X(9) OCCURS 19 TIMES.

01 NUM-TABLE2.
02 TWENTY PIC X(9) VALUE "TWENTY ".
02 THIRTY PIC X(9) VALUE "THIRTY ".
02 FORTY PIC X(9) VALUE "FORTY ".
02 FIRTY PIC X(9) VALUE "FIFTY ".
02 SIXTY PIC X(9) VALUE "SIXTY ".
02 SEVENTY PIC X(9) VALUE "SEVENTY ".
02 EIGHTY PIC X(9) VALUE "EIGHTY ".
02 NINETY PIC X(9) VALUE "NINETY ".

01 TABLE2 REDEFINES NUM-TABLE2.
02 TAB22 PIC X(9) OCCURS 8 TIMES.

PROCEDURE DIVISION.
START-PARA.
DISPLAY (1 1) ERASE.
DISPLAY "ENTER ANY NUMBER : ".
ACCEPT NUM.
DIVIDE 1000 INTO NUM GIVING Q REMAINDER NUM.
IF (Q > 0)
IF (Q NOT > 19)
DISPLAY TAB11 (Q), "THOUSAND "
ELSE
DIVIDE 10 INTO Q GIVING Q REMAINDER J
COMPUTE Q = Q - 1
DISPLAY TAB22 (Q) TAB11 (J), "THOUSAND ".
DIVIDE 100 INTO NUM GIVING Q REMAINDER NUM.
IF ( Q > 0)
DISPLAY TAB11 (Q), "HUNDRED "
DIVIDE 10 INTO NUM GIVING Q REMAINDER NUM.
IF (Q > 0)
IF (Q NOT > 1) DISPLAY TAB11 (Q)
ELSE
COMPUTE Q = Q - 1
DISPLAY TAB22 (Q) TAB11 (NUM).
STOP RUN

PROGRAM TO CONVERT NUMBER TO ITS

IDENTIFICATION DIVISION.
PROGRAM-ID. NUM-TO-TEXT.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.

77 NUM PIC 9(9).
77 NUM1 PIC 9(9).
77 I PIC 99.
77 J PIC 99.
77 K PIC 99.
77 Q PIC 99.
01 NUM-TABLE1.
02 ONE PIC X(9) VALUE "ONE ".
02 TWO PIC X(9) VALUE "TWO ".
02 THREE PIC X(9) VALUE "THREE ".
02 FOUR PIC X(9) VALUE "FOUR ".
02 FIVE PIC X(9) VALUE "FIVE ".
02 SIX PIC X(9) VALUE "SIX ".
02 SEVEN PIC X(9) VALUE "SEVEN ".
02 EIGHT PIC X(9) VALUE "EIGHT ".
02 NINE PIC X(9) VALUE "NINE ".
02 TEN PIC X(9) VALUE "TEN ".
02 ELEVEN PIC X(9) VALUE "ELEVEN ".
02 TWELVE PIC X(9) VALUE "TWELVE ".
02 THIRTEEN PIC X(9) VALUE "THIRTEEN ".
02 FOURTEEN PIC X(9) VALUE "FOURTEEN " .
02 FIFTEEN PIC X(9) VALUE "FIFTEEN ".
02 SIXTEEN PIC X(9) VALUE "SIXTEEN ".
02 SEVENTEEN PIC X(9) VALUE "SEVENTEEN".
02 EIGHTEEN PIC X(9) VALUE "EIGHTEEN ".
02 NINETEEN PIC X(9) VALUE "NINETEEN ".
01 TABLE1 REDEFINES NUM-TABLE1.
02 TAB11 PIC X(9) OCCURS 19 TIMES.
01 NUM-TABLE2.
02 TWENTY PIC X(9) VALUE "TWENTY ".
02 THIRTY PIC X(9) VALUE "THIRTY ".
02 FORTY PIC X(9) VALUE "FORTY ".
02 FIRTY PIC X(9) VALUE "FIFTY ".
02 SIXTY PIC X(9) VALUE "SIXTY ".
02 SEVENTY PIC X(9) VALUE "SEVENTY ".
02 EIGHTY PIC X(9) VALUE "EIGHTY ".
02 NINETY PIC X(9) VALUE "NINETY ".
01 TABLE2 REDEFINES NUM-TABLE2.
02 TAB22 PIC X(9) OCCURS 8 TIMES.
PROCEDURE DIVISION.
START-PARA.
DISPLAY (1 1) ERASE.
DISPLAY "ENTER ANY 9 DIGIT NUMBER : ".
ACCEPT NUM.
MOVE NUM TO NUM1.
IF ( NUM = 0) DISPLAY "ZERO ".
IF ( NUM = 1) DISPLAY TAB11 (NUM) .
IF ( NUM = 2) DISPLAY TAB11 (NUM) .
IF ( NUM = 3) DISPLAY TAB11 (NUM) .
IF ( NUM = 4) DISPLAY TAB11 (NUM) .
IF ( NUM = 5) DISPLAY TAB11 (NUM) .
IF ( NUM = 6) DISPLAY TAB11 (NUM) .
IF ( NUM = 7) DISPLAY TAB11 (NUM) .
IF ( NUM = 8) DISPLAY TAB11 (NUM) .
IF ( NUM = 9) DISPLAY TAB11 (NUM) .
IF ( NUM = 10) DISPLAY TAB11 (NUM) .
IF ( NUM = 11) DISPLAY TAB11 (NUM) .
IF ( NUM = 12) DISPLAY TAB11 (NUM) .
IF ( NUM = 13) DISPLAY TAB11 (NUM) .
IF ( NUM = 14) DISPLAY TAB11 (NUM) .
IF ( NUM = 15) DISPLAY TAB11 (NUM) .
IF ( NUM = 16) DISPLAY TAB11 (NUM) .
IF ( NUM = 17) DISPLAY TAB11 (NUM) .
IF ( NUM = 18) DISPLAY TAB11 (NUM) .
IF ( NUM = 19) DISPLAY TAB11 (NUM) .
IF (NUM1 NOT > 19) STOP RUN.
DIVIDE 10000000 INTO NUM GIVING Q REMAINDER NUM.
IF (Q > 0)
IF (Q NOT > 19)
DISPLAY TAB11 (Q), " CRORE "
ELSE
DIVIDE 10 INTO Q GIVING Q REMAINDER J
COMPUTE Q = Q - 1
DISPLAY TAB22 (Q) TAB11 (J), "CRORE ".
DIVIDE 100000 INTO NUM GIVING Q REMAINDER NUM.
IF (Q > 0)
IF (Q NOT > 19)
DISPLAY TAB11 (Q), " LAC "
ELSE
DIVIDE 10 INTO Q GIVING Q REMAINDER J
COMPUTE Q = Q - 1
DISPLAY TAB22 (Q) TAB11 (J), "LAC ".
DIVIDE 1000 INTO NUM GIVING Q REMAINDER NUM.
IF (Q > 0)
IF (Q NOT > 19)
DISPLAY TAB11 (Q), "THOUSAND "
ELSE
DIVIDE 10 INTO Q GIVING Q REMAINDER J
COMPUTE Q = Q - 1
DISPLAY TAB22 (Q) TAB11 (J), "THOUSAND ".
DIVIDE 100 INTO NUM GIVING Q REMAINDER NUM.
IF ( Q > 0)
DISPLAY TAB11 (Q), "HUNDRED " .
DIVIDE 10 INTO NUM GIVING Q REMAINDER NUM.
IF (Q > 0)
IF (Q NOT > 1) DISPLAY TAB11 (Q)
ELSE
COMPUTE Q = Q - 1
DISPLAY TAB22 (Q) TAB11 (NUM).
STOP RUN

Case Contol-Menu Control In Cobol

IDENTIFICATION DIVISION.
PROGRAM-ID. TESTPROGRAM.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
77 NUM1 PICTURE 9 VALUE ZEROS.
77 NUM2 PIC 9 VALUE ZERO.
77 ADDRES PIC 99 VALUE ZEROS.
77 MULRES PIC 99 VALUE ZEROS.
77 SUBRES PIC 9 VALUE ZEROS.
77 DIVRES PIC 9V99 VALUE ZEROS.
77 CH PIC 9.
PROCEDURE DIVISION.
MAINPARA.
DISPLAY " ENTER FIRST NUMBER : ".
ACCEPT NUM1.
DISPLAY " ENTER SECOND NUMBER : ".
ACCEPT NUM2.
DISPLAY "-----------------------".
DISPLAY " MENU ".
DISPLAY "-----------------------".
DISPLAY " 1 --> ADDITION ".
DISPLAY " 2 --> SUBTRACTION ".
DISPLAY " 3 --> MULTIPLICATION ".
DISPLAY " 4 --> DIVISION ".
DISPLAY " 0 --> EXIT ".
DISPLAY "-----------------------".
DISPLAY " ENTER YOUR CHOICE : ".
ACCEPT CH.
IF CH = 1 GO TO ADDPARA.
IF CH = 2 GO TO SUBPARA.
IF CH = 3 GO TO MULPARA.
IF CH = 4 GO TO DIVPARA.
IF CH = 0 GO TO EXIPARA.

ADDPARA.

COMPUTE ADDRES = NUM1 + NUM2.
DISPLAY " ADDITION RESULT :", ADDRES.
GO TO MAINPARA.
SUBPARA.
COMPUTE SUBRES = NUM1 - NUM2.
DISPLAY " SUBTRACTION RESULT : ", SUBRES.
GO TO MAINPARA.
MULPARA.
MULTIPLY NUM1 BY NUM2 GIVING MULRES.
DISPLAY " MULTIPLICATION RESULT : ", MULRES.
GO TO MAINPARA.
DIVPARA.
COMPUTE DIVRES = NUM1 / NUM2.
DISPLAY " DIVISION RESULT : ", DIVRES.
GO TO MAINPARA.

EXIPARA.
STOP RUN.