Курсовые работы / ПРИС П _18

Label3: TLabel; e1: TEdit;

e2: TEdit; Button1: TButton; Button2: TButton; Button4: TButton;

PopupMenu1: TPopupMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

DBGrid1: TDBGrid;

N4: TMenuItem;

N5: TMenuItem;

Label4: TLabel;

Button3: TButton;

Button5: TButton;

procedure N1Click(Sender: TObject); procedure N2Click(Sender: TObject); procedure N3Click(Sender: TObject); procedure e1Change(Sender: TObject); procedure e2Change(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject);

procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure N5Click(Sender: TObject);

procedure Button3Click(Sender: TObject); procedure Button5Click(Sender: TObject);

private

{Private declarations } public

{Public declarations } end;

var

FPacient: TFPacient;

implementation

uses datm, aPacient, main, DgPac, aBolList; {$R *.dfm}

procedure TFPacient.N1Click(Sender: TObject); begin

faPacient.Caption:=Caption+' :: '+n1.Caption; tm:=0; faPacient.cb1.clear;faPacient.cb2.clear; dm.temp.Active:=false;

dm.temp.CommandText:='Select nazv_ot from otdel'; dm.temp.Active:=true;

While not dm.temp.Eof do begin

faPacient.cb1.items.add(dm.temp.fields[0].AsString);

dm.temp.Next;

end;

faPacient.dtp1.date:=date;faPacient.dtp2.date:=date;

faPacient.ShowModal;

end;

procedure TFPacient.N2Click(Sender: TObject); begin

if dm.pac.Fields[0].AsString='' then begin

showmessage('Запись для редактирования отсутствует'); exit;

end;

tmp:=dm.pac.Fields[0].AsString;tm:=1;

ind:=dm.pac.recno;

//******************************

if fmain.Update('pac','Pacient')=false then

62

begin

showmessage('Данная запись используется другим пользователем'); exit;

end;

//******************************

faPacient.cb1.clear;faPacient.cb2.clear;

dm.temp.Active:=false; dm.temp.CommandText:='Select nazv_ot from otdel'; dm.temp.Active:=true;

While not dm.temp.Eof do begin

faPacient.cb1.items.add(dm.temp.fields[0].AsString);

dm.temp.Next;

end;

faPacient.e1.Text:=dm.pac.fieldbyname('fio_pac').AsString; faPacient.e2.Text:=dm.pac.fieldbyname('adr_pac').AsString; faPacient.e3.Text:=dm.pac.fieldbyname('kem_pac').AsString; faPacient.e4.Text:=dm.pac.fieldbyname('sp_pac').AsString; faPacient.e5.Text:=dm.pac.fieldbyname('np_pac').AsString;

faPacient.cb1.Text:=dm.pac.fieldbyname('nazv_ot').AsString; faPacient.cb3.Text:=dm.pac.fieldbyname('pol_pac').AsString;

faPacient.cb1change(sender); faPacient.cb2.Text:=dm.pac.fieldbyname('nom_pal').AsString; faPacient.cb2change(sender);

faPacient.dtp1.date:=dm.pac.fieldbyname('kogda_pac').asdatetime;

faPacient.dtp2.date:=dm.pac.fieldbyname('dataN_pac').asdatetime;

faPacient.Caption:=Caption+' :: '+n2.Caption; faPacient.ShowModal;

end;

procedure TFPacient.N3Click(Sender: TObject);

begin

if dm.pac.Fields[0].AsString='' then

begin

showmessage('Запись для редактирования отсутствует');

exit;

end;

tmp:=dm.pac.Fields[0].AsString;tm:=1;

if fmain.Delete('pac','Pacient',tmp)=false then

begin

showmessage('Данная запись используется другим пользователем');

exit;

end

else dm.pac.Requery();

end;

procedure TFPacient.e1Change(Sender: TObject);

begin

dm.pac.Active:=false;

dm.pac.CommandText:='Select id_pac,fio_pac,pol_pac,adr_pac,sp_pac,np_pac,kem_pac,kogda_pac,([naz v_ot]&", №: "&[nom_pal]) as pal,nazv_ot,nom_pal,id_pal,datan_pac,datak_pac from pacient,palata,otdel where (id_pal=id_pal_pac) and (id_ot=id_ot_pal) and

(fio_pac like "%'+e1.Text+'%") and (([nazv_ot]&", №: "&[nom_pal]) like "%'+e2.Text+'%")';

dm.pac.Active:=true;

end;

procedure TFPacient.e2Change(Sender: TObject);

begin

dm.pac.Active:=false;

dm.pac.CommandText:='Select id_pac,fio_pac,pol_pac,adr_pac,sp_pac,np_pac,kem_pac,kogda_pac,([naz v_ot]&", №: "&[nom_pal]) as pal,nazv_ot,nom_pal,id_pal,datan_pac,datak_pac from pacient,palata,otdel where (id_pal=id_pal_pac) and (id_ot=id_ot_pal) and

(fio_pac like "%'+e1.Text+'%") and (([nazv_ot]&", №: "&[nom_pal]) like "%'+e2.Text+'%")';

dm.pac.Active:=true;

end;

63

procedure TFPacient.Button4Click(Sender: TObject);

begin

dm.pac.Active:=false;

dm.pac.CommandText:='Select id_pac,fio_pac,pol_pac,adr_pac,sp_pac,np_pac,kem_pac,kogda_pac,([naz v_ot]&", №: "&[nom_pal]) as pal,nazv_ot,nom_pal,id_pal,datan_pac,datak_pac from pacient,palata,otdel where (id_pal=id_pal_pac) and (id_ot=id_ot_pal) ORDER BY pol_pac';

dm.pac.Active:=true;

end;

procedure TFPacient.Button1Click(Sender: TObject);

begin

dm.pac.Active:=false;

dm.pac.CommandText:='Select id_pac,fio_pac,pol_pac,adr_pac,sp_pac,np_pac,kem_pac,kogda_pac,([naz v_ot]&", №: "&[nom_pal]) as pal,nazv_ot,nom_pal,id_pal,datan_pac,datak_pac from pacient,palata,otdel where (id_pal=id_pal_pac) and (id_ot=id_ot_pal) ORDER BY dataN_pac';

dm.pac.Active:=true;

end;

procedure TFPacient.Button2Click(Sender: TObject);

begin

dm.pac.Active:=false;

dm.pac.CommandText:='Select id_pac,fio_pac,pol_pac,adr_pac,sp_pac,np_pac,kem_pac,kogda_pac,([naz v_ot]&", №: "&[nom_pal]) as pal,nazv_ot,nom_pal,id_pal,datan_pac,datak_pac from pacient,palata,otdel where (id_pal=id_pal_pac) and (id_ot=id_ot_pal) ORDER BY dataK_pac';

dm.pac.Active:=true;

end;

procedure TFPacient.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

e1.Clear;e2.Clear;

dm.pac.Active:=false;

end;

procedure TFPacient.N5Click(Sender: TObject); begin

if dm.pac.Fields[0].AsString='' then begin

showmessage('Запись для редактирования отсутствует');

exit;

end;

id_pac:=dm.pac.Fields[0].AsString;

fdgpac.Caption:=dm.pac.fieldbyname('fio_pac').AsString+' :: '+n5.Caption;

fdgpac.DBGrid1.PopupMenu:=fdgpac.PopupMenu1;

fdgpac.DBGrid1.DataSource:=dm.dps;

dm.dp.Active:=false;

dm.dp.CommandText:='Select id_dp,nazv_dg from diagnoz,dgpac WHERE (id_dg=id_dg_dp) and (id_pac_dp='+id_pac+')';

dm.dp.Active:=true;

fdgpac.ShowModal;

end;

procedure TFPacient.Button3Click(Sender: TObject);

begin

if dm.pac.Fields[0].AsString='' then

begin

showmessage('Запись для редактирования отсутствует');

exit;

end;

if dm.pac.Fieldbyname('datak_pac').AsString<>'' then

begin

showmessage('Лечение уже завершено');

exit;

end;

id_pac:=dm.pac.Fields[0].AsString;

64

faBolList.Caption:=Caption+' :: '+n1.Caption;

dm.temp.Active:=false;

dm.temp.CommandText:='select fio_vr from vrach';

dm.temp.Active:=true;

while not dm.temp.Eof do

begin

faBolList.cb1.items.add(dm.temp.Fields[0].AsString);

dm.temp.Next;

end;

faBolList.ShowModal;

end;

procedure TFPacient.Button5Click(Sender: TObject);

begin

if dm.pac.Fields[0].AsString='' then

begin

showmessage('Запись для редактирования отсутствует');

exit;

end;

if dm.pac.Fieldbyname('datak_pac').AsString='' then

begin

showmessage('Лечение еще не завершено');

exit;

end;

id_pac:=dm.pac.Fields[0].AsString;

dm.temp.Active:=false;

dm.temp.CommandText:='Select id_pal_pac from pacient WHERE (id_pac='+id_pac+')';

dm.temp.Active:=true;

id_pal:=dm.temp.Fields[0].AsString;

dm.temp.Active:=false;

dm.temp.CommandText:='Select km_pal-(select count(id_pac) from pacient where (id_pal_pac='+id_pal+')and (datak_pac is null)) from palata where (id_pal='+id_pal+')';

dm.temp.Active:=true;

if dm.temp.Fields[0].AsInteger=0 then begin

showmessage('Мест в палате больше нет'); exit;

end;

if application.MessageBox('Вы хотите возобновить лечение?','Лечение',mb_yesno+mb_iconquestion)=idyes then

begin

dm.com.CommandText:='Update pacient SET dataN_pac=Date(),dataK_pac=Null where (id_pac='+id_pac+')';

dm.com.Execute;

dm.pac.Requery();

showmessage('Лечение возобновлено');

end;

end;

end.

unit Palata;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,

Forms,

Dialogs, Menus, Grids, DBGrids, StdCtrls, ExtCtrls;

type

TFPalata = class(TForm)

Panel1: TPanel;

Label1: TLabel; e1: TEdit;

PopupMenu1: TPopupMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

Label2: TLabel;

65

faPalata.cb1.clear;faPalata.cb3.clear;

dm.temp.Active:=false; dm.temp.CommandText:='Select nazv_ot from otdel'; dm.temp.Active:=true;

While not dm.temp.Eof do begin

faPalata.cb1.items.add(dm.temp.fields[0].AsString);

dm.temp.Next;

end;

dm.temp.Active:=false; dm.temp.CommandText:='Select fio_vr from vrach'; dm.temp.Active:=true;

While not dm.temp.Eof do begin

faPalata.cb3.items.add(dm.temp.fields[0].AsString);

dm.temp.Next;

end;

faPalata.e1.Text:=dm.pal.fieldbyname('nom_pal').AsString; faPalata.cb1.Text:=dm.pal.fieldbyname('nazv_ot').AsString; faPalata.cb2.Text:=dm.pal.fieldbyname('pol_pal').AsString; faPalata.cb3.Text:=dm.pal.fieldbyname('fio_vr').AsString; faPalata.se1.Text:=dm.pal.fieldbyname('km_pal').AsString;

faPalata.cb1change(sender);faPalata.cb3change(sender); faPalata.Caption:=Caption+' :: '+n2.Caption;

faPalata.ShowModal;

end;

procedure TFPalata.N3Click(Sender: TObject); begin

if dm.pal.Fields[0].AsString='' then

begin

showmessage('Запись для редактирования отсутствует'); exit;

end;

tmp:=dm.pal.Fields[0].AsString;tm:=1;

if fmain.Delete('pal','palata',tmp)=false then

begin

showmessage('Данная запись используется другим пользователем');

exit;

end

else dm.pal.Requery();

end;

procedure TFPalata.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

e1.Clear;e2.Clear;

dm.pal.Active:=false;

end;

procedure TFPalata.e1Change(Sender: TObject);

begin

dm.pal.Active:=false;

dm.pal.CommandText:='Select id_pal,nom_pal,nazv_ot,km_pal,km_pal- (select count(id_pac) from pacient where (id_pal_pac=id_pal) and (datak_pac is null)) as sm, pol_pal,fio_vr from vrach,otdel,palata WHERE (id_vr=id_vr_pal) and (id_ot=id_ot_pal) and (nazv_ot like "%'+e1.Text+'%") and (fio_vr like "%'+e2.Text+'%")';

dm.pal.Active:=true;

end;

procedure TFPalata.Button4Click(Sender: TObject);

begin

dm.pal.Active:=false;

dm.pal.CommandText:='Select id_pal,nom_pal,nazv_ot,km_pal,km_pal- (select count(id_pac) from pacient where (id_pal_pac=id_pal) and (datak_pac is null)) as sm, pol_pal,fio_vr from vrach,otdel,palata WHERE (id_vr=id_vr_pal) and (id_ot=id_ot_pal) and (nazv_ot like "%'+e1.Text+'%") and (fio_vr like "%'+e2.Text+'%") order by nom_pal';

dm.pal.Active:=true;

end;

procedure TFPalata.Button1Click(Sender: TObject);

67

begin

dm.pal.Active:=false;

dm.pal.CommandText:='Select id_pal,nom_pal,nazv_ot,km_pal,km_pal- (select count(id_pac) from pacient where (id_pal_pac=id_pal) and (datak_pac is null)) as sm, pol_pal,fio_vr from vrach,otdel,palata WHERE (id_vr=id_vr_pal) and (id_ot=id_ot_pal) and (nazv_ot like "%'+e1.Text+'%") and (fio_vr like "%'+e2.Text+'%") order by pol_pal';

dm.pal.Active:=true;

end;

procedure TFPalata.Button2Click(Sender: TObject);

begin

dm.pal.Active:=false;

dm.pal.CommandText:='Select id_pal,nom_pal,nazv_ot,km_pal,km_pal- (select count(id_pac) from pacient where (id_pal_pac=id_pal) and (datak_pac is null)) as sm, pol_pal,fio_vr from vrach,otdel,palata WHERE (id_vr=id_vr_pal) and (id_ot=id_ot_pal) and (nazv_ot like "%'+e1.Text+'%") and (fio_vr like "%'+e2.Text+'%") order by km_pal';

dm.pal.Active:=true;

end;

procedure TFPalata.e2Change(Sender: TObject);

begin

dm.pal.Active:=false;

dm.pal.CommandText:='Select id_pal,nom_pal,nazv_ot,km_pal,km_pal- (select count(id_pac) from pacient where (id_pal_pac=id_pal) and (datak_pac is null)) as sm, pol_pal,fio_vr from vrach,otdel,palata WHERE (id_vr=id_vr_pal) and (id_ot=id_ot_pal) and (nazv_ot like "%'+e1.Text+'%") and (fio_vr like "%'+e2.Text+'%")';

dm.pal.Active:=true;

end;

end.

unit Pass;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,

Forms,

Dialogs,inifiles, StdCtrls, Buttons, ExtCtrls;

type

TFpass = class(TForm)

Panel1: TPanel;

Panel2: TPanel;

Label1: TLabel;

Label2: TLabel;

cb: TComboBox; e1: TEdit;

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

procedure cbKeyPress(Sender: TObject; var Key: Char);

procedure BitBtn2Click(Sender: TObject);

procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

procedure FormShow(Sender: TObject);

procedure BitBtn1Click(Sender: TObject);

private

{Private declarations } public

{Public declarations } end;

var

Fpass: TFpass;

implementation

uses datm, main, otdel, Palata, Vrach, Pacient, Diagnoz;

{$R *.dfm}

procedure TFpass.cbKeyPress(Sender: TObject; var Key: Char);

begin

key:=#0;

end;

68

procedure TFpass.BitBtn2Click(Sender: TObject);

begin

closequery;

end;

procedure TFpass.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

if application.MessageBox('Вы уверены?','Выход из программы!',mb_yesno+mb_iconquestion)=idyes then

begin

dm.ado.Connected:=false;

application.Terminate;

end

else canclose:=false;

end;

begin

if dm.od.Execute then

begin

IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName)+'Data\options.ini' );

inifile.WriteString('base','path',dm.od.FileName);

IniFile.Free;

dbp:=dm.od.FileName;

dm.ADO.Connected:=false;

dm.ADO.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+dbp+';Persist Security Info=False';

dm.ADO.Connected:=true;

end

else

begin

dm.ado.Connected:=false; showmessage('Вы вышли из программы');