Hastane Takip Programı

B

BiRkan2

Uzman üye
1 Tem 2007
1,670
49
119
Prison Break
Buyrun Arkadaşlar Kodlarıda burda....
İçeriğide şöyle
Hasta giris -- Hasta listeleme ----- Hastalık sebebi
-------------------------------------------------------------------
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.

pAScalcılar için..
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst

Turkhackteam.org internet sitesi 5651 sayılı kanun’un 2. maddesinin 1. fıkrasının m) bendi ile aynı kanunun 5. maddesi kapsamında "Yer Sağlayıcı" konumundadır. İçerikler ön onay olmaksızın tamamen kullanıcılar tarafından oluşturulmaktadır. Turkhackteam.org; Yer sağlayıcı olarak, kullanıcılar tarafından oluşturulan içeriği ya da hukuka aykırı paylaşımı kontrol etmekle ya da araştırmakla yükümlü değildir. Türkhackteam saldırı timleri Türk sitelerine hiçbir zararlı faaliyette bulunmaz. Türkhackteam üyelerinin yaptığı bireysel hack faaliyetlerinden Türkhackteam sorumlu değildir. Sitelerinize Türkhackteam ismi kullanılarak hack faaliyetinde bulunulursa, site-sunucu erişim loglarından bu faaliyeti gerçekleştiren ip adresini tespit edip diğer kanıtlarla birlikte savcılığa suç duyurusunda bulununuz.