Turbo Pascal İle Hastane Otomasyonu

Tahribat.com Forumları
line

Delphi - Pascal
line

07/May/03 14:10 Kısayol Şikayet Özel Mesaj

MaCHo

Kayıt Tarihi: 07/Mayıs/2003

{****************** Coder MaCHo
- HASTANE OTOMASYONU -
Not : Ufak Bir hastane otomasyon programı Gerçi Veri yapılarına giriyor ama olsun programda sorgulama,kayıt listeleme,
ve kayıt silme ve kayıt ekleme mevcut Küçük hatalar olabilir affola
Bilgi Paylaştıkca cogalir *******************}

uses crt;
var
Adi,Soyadi,Nu,Cins:string[10];
T:CHAR;
x,b1,b2,b3,b4:byte;
D:text;
PROCEDURE CINSSORGU;
var
e,k,d:text;{e(erkek) k (kadin)}
x,c,anu,nu,ad,soy,cins:string[10];
Begin
Assign(E,"C:\erkek.txt");
Assign(K,"C:\kadin.txt");
Assign(D,"C:\hasta.txt");
{$I-} Reset(D);
if Ioresult<>0 then
Begin
Writeln("Veri Dosyasi Yok");
exit;
end;
Append(E);
if IORESULT <> 0 then Rewrite(E);
Append(K);
if IORESULT <> 0 then Rewrite(K);
{$I+}
While(Not Eof(D)) do
Begin
Readln(D,Nu,ad,soy,cins);

if(copy(cins,1,5)="ERKEK") then
writeln (E,Nu,Ad,Soy,Cins)
Else
Writeln(K,Nu,Ad,Soy,Cins);
End;
close(D);
Close(E);
Close(K);
Textbackground(3);Clrscr;
textcolor(15);
textbackground(1);
Gotoxy(20,10);Write("ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»");
Gotoxy(20,11);write("º º");
Gotoxy(20,12);Write("º º");
Gotoxy(20,13);Write("º SORGU YAPILDI ! º");
Gotoxy(20,14);Write("º º");
Gotoxy(20,14);Write("º º");
Gotoxy(20,15);Write("ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼");
REPEAT UNTIL KEYPRESSED;
END;

procedure Kayit;
Begin
Assign(D,"C:\Hastane.txt");
{$I-}Append(D);
If IOResult<>0 then Rewrite(D);
{$I+}

Repeat
Clrscr;
GotoXy(10,10);Write("ADI=");ReadLn(Adi);b1:=10-length(Adi);
GotoXy(10,11);Write("SOYADI=");ReadLn(SOyAdi);b2:=10-length(SoyAdi);
GotoXy(10,12);Write("NUMARASI=");ReadLn(NU); b3:=10-length(NU);
GotoXy(10,13);Write("CINSIYETI=");ReadLn(CINS);b4:=10-length(CINS);

WRITELN(D,Nu,"":b1,Adi,"":b2,Soyadi,"":b3,Cins,"":b4);

WriteLN("Devam m?");
T:=Upcase(Readkey);
Until(T="H");
Close(D);

end;
Procedure Liste;
begin

Assign(D,"C:\Hastane.txt");
{$I-}Reset(D);
If IOResult<>0 then
begin
writeln("Veri dosyas yok !");exit;
end;
{$I+}

clrscr;
Gotoxy(20,5);WRITELN("Numaras Adi Soyadi Cins");
Gotoxy(20,6);WRITELN("------------------------------------");
x:=7;
While(Not Eof(D))do
begin
Readln(D,Nu,Adi,Soyadi,Cins);
GotoXy(20,x);Write(NU);
GotoXy(31,x);Write(ADI);
GotoXy(40,x);Write(SOYADI);
GotoXy(51,x);Write(CINS);
x:=x+1;
End;
Textcolor(128+14);
Gotoxy(10,20);WRITELN("Dosya Sonu!");
Repeat Until Keypressed;
Close(d);
end;

BEGIN
Repeat
Textbackground(3);Clrscr;
textcolor(15);
textbackground(1);
Gotoxy(20,10);Write("ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»");
Gotoxy(20,11);write("º 1- KAYIT º");
Gotoxy(20,12);Write("º 2- LISTE º");
Gotoxy(20,13);Write("º 3- SORGULAMA º");
Gotoxy(20,14);Write("º 4- €IKIS º");
Gotoxy(20,15);Write("º SE€ ¨ º");
Gotoxy(20,16);Write("ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼");
T:=Readkey;
if(T="1") Then KAYIT;
if(T="2") Then LISTE;
if(T="3") Then CINSSORGU;

UNTIL (T="4");

END.

Choose Your Destiny

Alıntı yap
07/May/03 14:38 Kısayol Şikayet Özel Mesaj

MaCHo

Kayıt Tarihi: 07/Mayıs/2003

Gotoxy(20,10);Write("ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»");
Gotoxy(20,11);write("º 1- KAYIT º");
Gotoxy(20,12);Write("º 2- LISTE º");
Gotoxy(20,13);Write("º 3- SORGULAMA º");
Gotoxy(20,14);Write("º 4- €IKIS º");
Gotoxy(20,15);Write("º SE€ ¨ º");
Gotoxy(20,16);Write("ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼");
_________________________________
direk Derleyiciden kopyaladıgım için Ascii Kodlar cıkmamıs burada gördügünüz kısımları Alt+201,Alt+205,Alt+186,Alt+187,Alt+188,Alt+200,Alt+205 Ascii karekterlerini kullanarak yapıyoruz..

Choose Your Destiny

Alıntı yap

Toplam Hit: 3232 Toplam Mesaj: 2

Cevapla