Hastane takip

uses crt;

type

kayit=record

isim:string;

soyad:string;

sinif:string;

no:string;

y1,y2,y3:integer;

evno:longint;

f:char;

end;

var

dosya:file of kayit;

kay:kayit;

tus,t:char;

i,kod:integer;

Procedure kayityap;

begin

assign(dosya,'ogr.dat');

{$i-} Reset (dosya);kod:=ioresult;{$i+}

if kod<>0 then rewrite(dosya);

repeat

clrscr;

gotoxy(15,5); write('Hastann;');

gotoxy(15,7); write('Adi Girin...'); Readln(kay.isim);

if kay.isim='' then

begin

close(dosya);exit;end;

gotoxy(15,9);write('Soyadi Girin...');readln(kay.soyad);

gotoxy(15,11);write('Gelis Nedeni Girin...'); readln(kay.sinif);

gotoxy(15,13);write('Hangi B”l�me G”nderildi Girin... ');readln(kay.no);

gotoxy(15,15);write('Teshis Girin...');readln(kay.evno);

gotoxy(15,17);write('Yatirilacak Mi? [e/h]');readln(kay.y1);

gotoxy(15,19);write('Kat No Girin ');readln(kay.y2);

gotoxy(15,21);write('Oda No Girin');readln(kay.y3);

gotoxy(16,23);write('Bilgiler Dosyaya yazilsin mi?  [E / H ]');

repeat

tus:=upcase(readkey);

until tus in ['E','H'];

if tus='E' then

begin

kay.f:='*';

seek(dosya,filesize(dosya));

write(dosya,kay);

end;

until 1=2;

end;

Procedure listeleme;

var

s:integer;

begin

assign(dosya,'ogr.dat');

{$i-} reset (dosya); i:=ioresult; {$i+}

if i<>0 then

begin

gotoxy(33,40); writeln('... Kayit yok ...');

tus:=readkey; halt;

end;

clrscr;

gotoxy(3,3);

writeln('                            KAYITLI HASTALARIN LISTESI');

writeln('                           ****************************');

s:=0;

for i:=0 to filesize(dosya)-1 do

begin

seek(dosya,i); read(dosya,kay);

if kay.f='*' then

begin

s:=s+7;

writeln;

writeln('* Adi          :',kay.isim);

writeln('* Soyadi       :',kay.soyad);

writeln('* Sinifi       :',kay.sinif);

writeln('* Numarasi     :',kay.no);

end;

if s>18 then

begin

gotoxy(25,60);

write('... Diger kayitlar i‡in bir tusa bas ...');

tus:=readkey;

s:=0;

clrscr;

end;

end;

gotoxy(25,40);

write('... Listelenecek Kayitlar Bitti ...');

tus:=readkey;

close(dosya);

end;

procedure arama;

var

ara:string;

begin

assign(dosya,'ogr.dat');

{$i-} reset(dosya); kod:=ioresult; {$i+}

if kod<>0 then

begin

gotoxy(33,40); writeln('... kayit yok ...');

tus:=readkey; exit;

end;

repeat

clrscr;

gotoxy(22,4); write('Aradiginiz isim...:'); readln(ara);

if ara='' then

begin

close(dosya); exit;

end;

for i:=0 to filesize(dosya)-1 do

begin

seek(dosya,i); read(dosya,kay);

if (kay.f='*') and (kay.isim=ara) then

begin

clrscr;

gotoxy(15,7); write('Adi...:',kay.isim);

gotoxy(15,9); write('Soyadi...:',kay.soyad);

gotoxy(15,11); write('Sinifi...:',kay.sinif);

gotoxy(15,13); write('Numarasi...:',kay.no);

gotoxy(15,15); write('Ev Numarasi...:',kay.evno);

gotoxy(15,17); write('1.Yazili...:',kay.y1);

gotoxy(15,19); write('2.Yazili...:',kay.y2);

gotoxy(15,21); write('3.Yazili...:',kay.y3);

gotoxy(25,23); write('Aradiginiz Kayit Bu Mu? [E/H]...:');

repeat

tus:=upcase(readkey);

until tus in ['E','H'];

if tus='E' then

begin

close(dosya); exit;

end;

end;

end;

writeln;

gotoxy(15,25);

write('Aradiginiz Kayit Yok. Devam etmek i‡in bir tusa bas');

tus:=readkey;

until 1=2;

end;

procedure duzeltme;

var

ara:string;

begin

assign(dosya,'ogr.dat');

{$i-} reset (dosya); kod:=ioresult; {$i+}

if kod<>0 then

begin

gotoxy(33,40); write('... Kayit yok ...');

tus:=readkey; exit;

end;

clrscr;

gotoxy(15,4); write('D�zeltilecek isim...:'); readln(ara);

if ara='' then

begin

close(dosya); exit;

end;

for i:=0 to filesize(dosya)-1 do

begin

seek(dosya,i); read(dosya,kay);

if (ara=kay.isim) and (kay.f='*') then

begin

clrscr;

gotoxy(15,7); write('Adi...:',kay.isim);

gotoxy(15,9); write('Soyadi...:',kay.soyad);

gotoxy(15,11); write('Sinifi...:',kay.sinif);

gotoxy(15,13); write('Numarasi...:',kay.no);

gotoxy(15,15); write('Ev Numarasi...:',kay.evno);

gotoxy(15,17); write('1.Yazili...:',kay.y1);

gotoxy(15,19); write('2.Yazili...:',kay.y2);

gotoxy(15,21); write('3.Yazili...:',kay.y3);

gotoxy(20,23); write('D�zeltilecek Kayit Bu Mu? [E/H]...:');

repeat

tus:=upcase(readkey);

until tus in ['E','H'];

if tus='E' then

repeat

clrscr;

gotoxy(15,7); write('1) Adi...:',kay.isim);

gotoxy(15,9); write('2) Soyadi...:',kay.soyad);

gotoxy(15,11); write('3) Sinifi...:',kay.sinif);

gotoxy(15,13); write('4) Numarasi...:',kay.no);

gotoxy(15,15); write('5) Ev Numarasi...:',kay.evno);

gotoxy(15,17); write('6) 1.Yazili...:',kay.y1);

gotoxy(15,19); write('7) 2.Yazili...:',kay.y2);

gotoxy(15,21); write('8) 3.Yazili...:',kay.y3);

gotoxy(15,23); write('9) Islem Sonu');

gotoxy(20,25); write('Se‡iminiz (1 . . 9) ...:');

repeat

tus:=readkey;

until tus in ['1'..'9'];

case tus of

'1':begin

gotoxy(15,30);

write('Adi...:'); readln(kay.isim);

end;

'2':begin

gotoxy(15,30);

write('Soyadi...:'); readln(kay.soyad);

end;

'3':begin

gotoxy(15,30);

write('Sinifi...:'); readln(kay.sinif);

end;

'4':begin

gotoxy(15,30);

write('Numarasi...:'); readln(kay.no);

end;

'5':begin

gotoxy(15,30);

write('Ev Numarasi...:'); readln(kay.evno);

end;

'6':begin

gotoxy(15,30);

write('1.Yazili...:'); readln(kay.y1);

end;

'7':begin

gotoxy(15,30);

write('2.Yazili...:'); readln(kay.y2);

end;

'8':begin

gotoxy(15,30);

write('3.Yazili...:'); readln(kay.y3);

end;

'9':begin

seek(dosya,i);

write(dosya,kay);

gotoxy(30,28); write('... Islem Tamamlandi ...');

close (dosya);

tus:=readkey; exit;

end;

#27:exit;

end;

until 1=2;

end;

end;

gotoxy(33,40); write('... Kayit Yok ...');

close(dosya);

tus:=readkey;

end;

procedure silme;

var

ara:string;

begin

assign(dosya,'ogr.dat');

{$i-} reset(dosya); kod:=ioresult; {$i+}

if kod<>0 then

begin

gotoxy(33,40); writeln('... kayit yok ...');

tus:=readkey;

exit;

end;

clrscr;

gotoxy(15,4); write('Silinecek isim...:'); readln(ara);

if ara='' then

begin

close(dosya); exit;

end;

for i:=0 to filesize(dosya)-1 do

begin

seek(dosya,i);

read(dosya,kay);

if (ara=kay.isim) and (kay.f='*') then

begin

clrscr;

gotoxy(15,7); write('Adi...:',kay.isim);

gotoxy(15,9); write('Soyadi...:',kay.soyad);

gotoxy(15,11); write('Sinifi...:',kay.sinif);

gotoxy(15,13); write('Numarasi...:',kay.no);

gotoxy(15,15); write('Ev Numarasi...:',kay.evno);

gotoxy(15,17); write('1.Yazili...:',kay.y1);

gotoxy(15,19); write('2.Yazili...:',kay.y2);

gotoxy(15,21); write('3.Yazili...:',kay.y3);

gotoxy(25,23); write('Silinecek Kayit Bu Mu? [E/H]...:');

repeat

tus:=upcase(readkey);

until tus in ['E','H'];

if tus='E' then

begin

kay.f:='s';

seek(dosya,i); write(dosya,kay);

gotoxy(33,40); write('... Kayit Silindi ...');

close(dosya);

tus:=readkey;

exit;

end;

end;

end;

gotoxy(33,40); write('... kayit yok ...');

close(dosya);

tus:=readkey;

end;

procedure menu;

begin

repeat

clrscr;

writeln(''); writeln(''); writeln(''); writeln('');

writeln(''); writeln(''); writeln(''); writeln('');

writeln(''); writeln(''); writeln(''); writeln('');

writeln(''); writeln(''); writeln(''); writeln('');

textcolor(9);

writeln('                              OGRENCI KAYIT PROGRAMI');

writeln('');writeln(''); writeln('');

writeln('              ***************************************************');

writeln('              * *********************************************** *');

writeln('              * *                                             * *');

writeln('              * *               ****** MENU ******            * *');

writeln('              * *              1- KAYIT GIRISI                * *');

writeln('              * *              2- KAYIT LISTELEME             * *');

writeln('              * *              3- KAYIT ARAMA                 * *');

writeln('              * *              4- KAYIT DUZELTME              * *');

writeln('              * *              5- KAYIT SILME                 * *');

writeln('              * *              6- CIKIS=ESC                   * *');

writeln('              * *                                             * *');

writeln('              * *********************************************** *');

writeln('              ***************************************************');

textcolor(2); gotoxy(100,100);

writeln('');

writeln('');

writeln('');

writeln('');

write('                                             Se‡iminiz...:');

textcolor(15); gotoxy(100,100);

repeat

tus:=readkey;

until tus in ['1'..'6',#27];

if tus<>#27 then

case tus of

'1':kayityap;

'2':listeleme;

'3':arama;

'4':duzeltme;

'5':silme;

'6':exit;

end;

until tus=#27;

end;

begin

menu;

end.