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

begin

if not (Key in [#8, 'а'..'я','А'..'Я',' ']) then begin

Key := #0; end;

end;

procedure TFaPacient.e5KeyPress(Sender: TObject; var Key: Char); begin

if not (Key in [#8, '0'..'9']) then begin

Key := #0; end

else if (trim(e5.Text)='') and (key='0') then key:=#0; end;

procedure TFaPacient.e4KeyPress(Sender: TObject; var Key: Char);

begin

if not (Key in [#8, '0'..'9']) then

begin

Key := #0;

end

else if (trim(e4.Text)='') and (key='0') then key:=#0;

end;

procedure TFaPacient.cb1Change(Sender: TObject);

begin

if id_ot<>'' then

begin

dm.com.CommandText:='Update otdel set log_ot=false WHERE (id_ot='+id_ot+')';

dm.com.Execute;

id_ot:='';

end;

dm.temp.Active:=false;

dm.temp.CommandText:='select id_ot from otdel where (nazv_ot="'+cb1.Text+'") and (log_ot=false)';

dm.temp.Active:=true;

if dm.temp.RecordCount=0 then begin

showmessage('Запись используется другим пользователем'); id_ot:='';

cb1.Text:=''; end

else begin

id_ot:=dm.temp.fields[0].asstring; cb2.Clear;

if id_pal<>'' then begin

dm.com.CommandText:='Update palata set log_pal=false WHERE (id_pal='+id_pal+')';

dm.com.Execute;

id_pal:='';

end;

if cb3.Text<>'' then

begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select nom_pal from palata WHERE (id_ot_pal='+id_ot+') and (pol_pal="'+cb3.text+'")';

dm.temp.Active:=true; While not dm.temp.Eof do

begin

cb2.Items.Add(dm.temp.Fields[0].AsString);

dm.temp.Next;

end;

end;

dm.com.CommandText:='Update otdel set log_ot=true WHERE (id_ot='+id_ot+')';

dm.com.Execute;

end;

42

end;

procedure TFaPacient.cb3Change(Sender: TObject);

begin

cb2.Clear;

if cb1.Text<>'' then

begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select nom_pal from palata WHERE (id_ot_pal='+id_ot+') and (pol_pal="'+cb3.text+'")';

dm.temp.Active:=true;

While not dm.temp.Eof do

begin

cb2.Items.Add(dm.temp.Fields[0].AsString);

dm.temp.Next;

end;

end;

end;

procedure TFaPacient.cb2Change(Sender: TObject);

begin

if id_pal<>'' then

begin

dm.com.CommandText:='Update palata set log_pal=false WHERE (id_pal='+id_pal+')';

dm.com.Execute;

id_pal:='';

end;

dm.temp.Active:=false;

dm.temp.CommandText:='select id_pal from palata where (nom_pal = "'+cb2.text+'") and (id_ot_pal='+id_ot+') and (log_pal=false)';

dm.temp.Active:=true;

if dm.temp.RecordCount=0 then

begin

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

id_pal:='';

cb2.Text:='';

end

else

begin

id_pal:=dm.temp.fields[0].asstring;

dm.com.CommandText:='Update palata set log_pal=true WHERE (id_pal='+id_pal+')';

dm.com.Execute;

end;

end;

procedure TFaPacient.BitBtn1Click(Sender: TObject);

begin

if (e1.Text='') or (e2.Text='') or (e3.Text='') or (e4.Text='') or (e5.Text='') or (id_pal='') or (cb3.Text='') then showmessage('Вы не заполнили одно или несколько полей')

else

begin

if length(e4.Text)<>4 then

begin

showmessage('Серия паспорта состоит из 4х символов');

exit;

end;

if length(e5.Text)<>6 then

begin

showmessage('Серия паспорта состоит из 6 символов');

exit;

end;

if dtp2.Date<date then

begin

showmessage('Дата начала лечения не может быть меньше текущей');

exit;

end;

if tm=0 then

begin

dm.temp.Active:=false;

43

dm.temp.CommandText:='Select id_pac from pacient where (sp_pac='+e4.Text+') and (np_pac='+e5.Text+')';

dm.temp.Active:=true;

if dm.temp.RecordCount>0 then showmessage('Подобная запись уже существует')

else

begin

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;

dm.com.CommandText:='Insert into pacient (fio_pac,adr_pac,kem_pac,kogda_pac,sp_pac,np_pac,pol_pac,id_pal_pac, datan_pac) values ("'+e1.Text+'","'+e2.Text+'","'+e3.Text+'","'+datetostr(dtp1.date)+'",'+e4. Text+','+e5.Text+',"'+cb3.Text+'",'+id_pal+',"'+datetostr(dtp2.Date)+'")';

dm.com.Execute;

showmessage('Запись успешно добавлена');

dm.pac.Requery();

closequery;

end;

end

else

begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select id_pac from pacient where (sp_pac='+e4.Text+') and (np_pac='+e5.Text+')';

dm.temp.Active:=true;

if (dm.temp.RecordCount>0) and (tmp<>dm.temp.Fields[0].asstring) then showmessage('Подобная запись уже существует')

else

begin

if id_pal<>dm.pac.FieldByName('id_pal').AsString then

begin

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;

end;

dm.com.CommandText:='Update pacient SET fio_pac="'+e1.Text+'",adr_pac="'+e2.Text+'",kem_pac="'+e3.Text+'",ko gda_pac="'+datetostr(dtp2.Date)+'",sp_pac="'+e4.Text+'",np_pac="'+e5. Text+'",pol_pac="'+cb3.Text+'",id_pal_pac="'+id_pal+'",dataN_pac="'+d atetostr(dtp1.Date)+'" WHERE (id_pac='+tmp+')';

dm.com.Execute;

showmessage('Запись успешно изменена');

dm.pac.Requery();

//dm.pac.recno:=ind;

closequery;

end;

end;

end;

end;

procedure TFaPacient.FormCloseQuery(Sender: TObject;

var CanClose: Boolean);

begin

e1.Clear;e2.Clear;e3.Clear;e4.Clear;e5.Clear;

dtp1.Date:=date;dtp2.Date:=date;

cb1.Clear;cb2.Clear;cb3.Text:='';

if tm=1 then

begin

dm.com.CommandText:='Update pacient set log_pac=FALSE WHERE (id_pac='+tmp+')';

dm.com.Execute;

end;

44

if id_pal<>'' then begin

dm.com.CommandText:='Update palata set log_pal=false WHERE (id_pal='+id_pal+')';

dm.com.Execute; id_pal:='';

end;

if id_ot<>'' then begin

dm.com.CommandText:='Update otdel set log_ot=false WHERE (id_ot='+id_ot+')';

dm.com.Execute;

id_ot:='';

end;

close;

end;

procedure TFaPacient.BitBtn2Click(Sender: TObject);

begin

closequery;

end;

end.

unit apalata;

interface

uses

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

Forms,

Dialogs, Spin, StdCtrls, Buttons, ExtCtrls;

type

TFaPalata = class(TForm)

Panel1: TPanel;

Label1: TLabel;

Panel2: TPanel;

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

e1: TEdit;

cb1: TComboBox; Label2: TLabel; Label3: TLabel; cb2: TComboBox; Label4: TLabel; se1: TSpinEdit;

Label5: TLabel;

cb3: TComboBox;

procedure BitBtn2Click(Sender: TObject);

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

procedure cb3Change(Sender: TObject);

procedure BitBtn1Click(Sender: TObject);

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

procedure cb2KeyPress(Sender: TObject; var Key: Char); private

{Private declarations } public

{Public declarations } end;

var

FaPalata: TFaPalata;

implementation

uses datm;

{$R *.dfm}

procedure TFaPalata.BitBtn2Click(Sender: TObject);

45

begin closequery; end;

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

begin

e1.Clear; cb1.Clear;cb3.Clear;se1.Value:=1;cb2.Text:=''; if tm=1 then

begin

dm.com.CommandText:='Update palata set log_pal=FALSE WHERE (id_pal='+tmp+')';

dm.com.Execute;

end;

if id_ot<>'' then begin

dm.com.CommandText:='Update otdel set log_ot=false WHERE (id_ot='+id_ot+')';

dm.com.Execute; id_ot:='';

end;

if id_vr<>'' then begin

dm.com.CommandText:='Update vrach set log_vr=false WHERE (id_vr='+id_vr+')';

dm.com.Execute;

id_vr:='';

end;

close;

end;

procedure TFaPalata.cb1Change(Sender: TObject); begin

if id_ot<>'' then begin

dm.com.CommandText:='Update otdel set log_ot=false WHERE (id_ot='+id_ot+')';

dm.com.Execute; id_ot:='';

end;

dm.temp.Active:=false;

dm.temp.CommandText:='select id_ot from otdel where (nazv_ot="'+cb1.Text+'") and (log_ot=false)';

dm.temp.Active:=true;

if dm.temp.RecordCount=0 then begin

showmessage('Запись используется другим пользователем'); id_ot:='';

cb1.Text:=''; end

else begin

id_ot:=dm.temp.fields[0].asstring;

dm.com.CommandText:='Update otdel set log_ot=true WHERE (id_ot='+id_ot+')';

dm.com.Execute;

end;

end;

procedure TFaPalata.cb3Change(Sender: TObject); begin

if id_vr<>'' then

begin

dm.com.CommandText:='Update vrach set log_vr=false WHERE (id_vr='+id_vr+')';

dm.com.Execute; id_vr:='';

end;

dm.temp.Active:=false;

dm.temp.CommandText:='select id_vr from vrach where (fio_vr = "'+cb3.text+'") and (log_vr=false)';

dm.temp.Active:=true;

if dm.temp.RecordCount=0 then begin

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

id_vr:='';

cb1.Text:='';

end

else

begin

id_vr:=dm.temp.fields[0].asstring;

dm.com.CommandText:='Update vrach set log_vr=true WHERE (id_vr='+id_vr+')';

dm.com.Execute;

end;

end;

procedure TFaPalata.BitBtn1Click(Sender: TObject);

begin

if (e1.Text='') or (id_ot='') or (cb2.Text='') or (id_vr='') then showmessage('Вы не заполнили одно или несколько полей')

else

begin

if tm=0 then

begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select id_pal from palata where (nom_pal="'+e1.Text+'") and (id_ot_pal='+id_ot+')';

dm.temp.Active:=true;

if dm.temp.RecordCount>0 then showmessage('Подобная запись уже существует')

else

begin

dm.com.CommandText:='Insert into palata (nom_pal,id_ot_pal,km_pal,pol_pal,id_vr_pal) values ("'+e1.Text+'",'+id_ot+','+se1.Text+',"'+cb2.Text+'",'+id_vr+')';

dm.com.Execute;

showmessage('Запись успешно добавлена');

dm.pal.Requery();

closequery;

end;

end

else

begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select id_pal from palata where (nom_pal="'+e1.Text+'") and (id_ot_pal='+id_ot+')';

dm.temp.Active:=true;

if (dm.temp.RecordCount>0) and (tmp<>dm.temp.Fields[0].asstring) then showmessage('Подобная запись уже существует')

else

begin

dm.com.CommandText:='Update palata SET nom_pal="'+e1.Text+'",id_ot_pal="'+id_ot+'",id_vr_pal="'+id_vr+'",km_ pal="'+se1.Text+'",pol_pal="'+cb2.Text+'" WHERE (id_pal='+tmp+')';

dm.com.Execute;

showmessage('Запись успешно изменена');

dm.pal.Requery();

//dm.pal.recno:=ind;

closequery;

end;

end;

end;

end;

procedure TFaPalata.cb1KeyPress(Sender: TObject; var Key: Char);

begin

key:=#0;

end;

procedure TFaPalata.cb2KeyPress(Sender: TObject; var Key: Char);

begin

key:=#0;

end;

end.

unit aVrach;

47

interface

uses

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

Forms,

Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls,

Spin,ueasypath,jpeg,dateutils;

type

TFaVrach = class(TForm)

Panel1: TPanel;

Label1: TLabel;

Label2: TLabel;

Panel2: TPanel;

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

e1: TEdit;

Image1: TImage;

Label3: TLabel;

se1: TSpinEdit;

dtp1: TDateTimePicker;

od: TOpenDialog;

procedure Image1Click(Sender: TObject); procedure BitBtn2Click(Sender: TObject);

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

procedure e1KeyPress(Sender: TObject; var Key: Char); private

{Private declarations } public

{Public declarations } end;

var

FaVrach: TFaVrach;

implementation

uses datm, main;

{$R *.dfm}

procedure TFaVrach.Image1Click(Sender: TObject); begin

if od.Execute then

begin

foto:=NameFile(od.filename,true);

image1.Picture.LoadFromFile(od.filename);

end;

end;

procedure TFaVrach.BitBtn2Click(Sender: TObject);

begin

closequery;

end;

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

begin e1.Clear; se1.value:=1;

dtp1.Date:=date;

image1.Picture:=nil; foto:=''; if tm=1 then

begin

dm.com.CommandText:='Update vrach set log_vr=FALSE WHERE (id_vr='+tmp+')';

dm.com.Execute;

end;

close;

end;

48

procedure TFaVrach.BitBtn1Click(Sender: TObject);

begin

if (e1.Text='') then showmessage('Вы не заполнили одно или несколько полей')

else

begin

if yearsbetween(date,dtp1.Date)<22 then

begin

showmessage('Врач не может быть моложе 22 лет');

exit;

end;

if yearsbetween(date,dtp1.Date)>80 then

begin

showmessage('Врач не может быть старше 80 лет');

exit;

end;

if tm=0 then

begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select id_vr from vrach where (fio_vr="'+e1.Text+'") and (dr_vr=#'+fmain.data(dtp1.date)+'#)';

dm.temp.Active:=true;

if dm.temp.RecordCount>0 then showmessage('Подобная запись уже существует')

else

begin

dm.com.CommandText:='Insert into vrach (fio_vr,dr_vr,kat_vr,photo_vr) values ("'+e1.Text+'","'+datetostr(dtp1.Date)+'",'+se1.text+',"'+foto+'")';

dm.com.Execute;

showmessage('Запись успешно добавлена');

dm.vr.Requery();

closequery;

end;

end

else

begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select id_vr from vrach where (fio_vr="'+e1.Text+'") and (dr_vr=#'+fmain.data(dtp1.date)+'#)';

dm.temp.Active:=true;

if (dm.temp.RecordCount>0) and (tmp<>dm.temp.Fields[0].asstring) then showmessage('Подобная запись уже существует')

else

begin

dm.com.CommandText:='Update vrach SET fio_vr="'+e1.Text+'",dr_vr="'+datetostr(dtp1.Date)+'",kat_vr="'+se1.text +'",photo_vr="'+foto+'" WHERE (id_vr='+tmp+')';

dm.com.Execute;

showmessage('Запись успешно изменена');

dm.vr.Requery();

//dm.vr.recno:=ind;

closequery;

end;

end;

end;

end;

procedure TFaVrach.e1KeyPress(Sender: TObject; var Key: Char);

begin

if not (Key in [#8, 'а'..'я','А'..'Я',' ']) then

begin

Key := #0;

end;

end;

end.

unit BolList;

interface

uses

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

Forms,

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

49

type

TFBolList = class(TForm)

Panel1: TPanel;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel; e1: TEdit;

e2: TEdit; Button4: TButton;

PopupMenu1: TPopupMenu;

N5: TMenuItem;

DBGrid1: TDBGrid;

procedure N5Click(Sender: TObject); procedure e1Change(Sender: TObject); procedure Button4Click(Sender: TObject);

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

private

{Private declarations } public

{Public declarations } end;

var

FBolList: TFBolList;

implementation

uses datm, DgPac;

{$R *.dfm}

procedure TFBolList.N5Click(Sender: TObject);

begin

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

begin

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

exit;

end;

id_pac:=dm.bl.Fieldbyname('id_pac_bl').AsString;

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

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 TFBolList.e1Change(Sender: TObject);

begin

dm.bl.Active:=false;

dm.bl.CommandText:='Select id_bl,fio_pac,fio_vr,datav_bl,id_pac_bl from bollist,pacient,vrach where (id_pac=id_pac_bl) and (id_vr=id_vr_bl) and (fio_pac like "%'+e1.Text+'%") and (fio_vr like "%'+e2.Text+'%")';

dm.bl.Active:=true;

end;

procedure TFBolList.Button4Click(Sender: TObject);

begin

dm.bl.Active:=false;

dm.bl.CommandText:='Select id_bl,fio_pac,fio_vr,datav_bl,id_pac_bl from bollist,pacient,vrach where (id_pac=id_pac_bl) and (id_vr=id_vr_bl) and (fio_pac like "%'+e1.Text+'%") and (fio_vr like "%'+e2.Text+'%") ORDER BY datav_bl';

dm.bl.Active:=true;

end;

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

begin

e1.Clear;e2.Clear;

dm.bl.Active:=false;

50

end;

procedure TFBolList.e2Change(Sender: TObject);

begin

dm.bl.Active:=false;

dm.bl.CommandText:='Select id_bl,fio_pac,fio_vr,datav_bl,id_pac_bl from bollist,pacient,vrach where (id_pac=id_pac_bl) and (id_vr=id_vr_bl) and (fio_pac like "%'+e1.Text+'%") and (fio_vr like "%'+e2.Text+'%")';

dm.bl.Active:=true;

end;

end.

unit chPass;

interface

uses

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

Forms,

Dialogs, StdCtrls, Buttons, ExtCtrls;

type

TFchPass = class(TForm)

Panel1: TPanel;

Label1: TLabel;

Panel2: TPanel;

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

e1: TEdit;

Label2: TLabel;

e2: TEdit;

Label3: TLabel;

Label4: TLabel;

cb1: TComboBox;

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

procedure BitBtn2Click(Sender: TObject);

procedure BitBtn1Click(Sender: TObject);

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

private

{Private declarations } public

{Public declarations } end;

var

FchPass: TFchPass;

implementation

uses datm;

{$R *.dfm}

procedure TFchPass.cb1KeyPress(Sender: TObject; var Key: Char);

begin key:=#0;

end;

procedure TFchPass.BitBtn2Click(Sender: TObject);

begin

closequery;

end;

procedure TFchPass.BitBtn1Click(Sender: TObject);

begin

if cb1.Text='' then showmessage('Вы не выбрали имя пользователя')

else if e1.Text='' then showmessage('Вы не ввели новый пароль')

else if e2.Text='' then showmessage('Вы не ввели подтверждение пароля')

else if e1.Text<>e2.Text then showmessage('Пароль и подтверждение пароля не совпадают')

51