patientresult.pas
来自「某疗养院动脉硬化管理系统」· PAS 代码 · 共 219 行
PAS
219 行
unit PatientResult;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, BaseUnit, ExtCtrls, StdCtrls, Buttons, OleCtrls, AcroPDFLib_TLB, ADODB, IniFiles;
type
TFrmPatientResult = class(TForm1)
Panel2: TPanel;
GroupBox1: TGroupBox;
Label2: TLabel;
Label3: TLabel;
EdtID: TEdit;
EdtName: TEdit;
GroupBox2: TGroupBox;
EdtPicDesc: TMemo;
GroupBox3: TGroupBox;
EdtExamDesc: TMemo;
GroupBox4: TGroupBox;
EdtAdvice: TMemo;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
pdf: TAcroPDF;
Splitter1: TSplitter;
CheckBox1: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure EdtPicDescKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure EdtExamDescKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure EdtAdviceKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
private
RecID:integer;
{ Private declarations }
public
{ Public declarations }
end;
var
FrmPatientResult: TFrmPatientResult;
implementation
uses PubFunction, Select, DataModule, PatientDataM;
{$R *.dfm}
procedure TFrmPatientResult.FormCreate(Sender: TObject);
var tmp:tadoquery;
IniFile:TIniFile;
begin
inherited;
EdtID.Text:=PatientID;
EdtName.Text:=PatientName;
//////////////////////////////////////////////////////////////
//读取dep
IniFile:=TIniFile.Create(ExtractFilePath(paramstr(0))+'Room.ini');
try
with IniFile do
begin
Dep:=ReadString('Room','Room','301002');
end;
finally
IniFile.Free;
end;
/////////////////////////////////////////////////////////////
tmp:=tadoquery.Create(nil);
tmp.Connection :=DM.ADOCn;
if ReportSender='已完成' then
begin
ShowRecord(tmp,'*','ExamReport Where ResultID='+''''+No+'''','id');
EdtPicDesc.Text:=tmp.FieldByName('PicDesc').AsString;
//ShowMessage(tmp.FieldByName('PicDesc').AsString);
EdtExamDesc.Text:=tmp.FieldByName('ExamDesc').AsString;
EdtAdvice.Text:=tmp.FieldByName('Advice').AsString;
RecID:=tmp.FieldByName('ID').AsInteger;
tmp.Close;
tmp.Free;
end;
if ReportSender='未完成' then
EdtPicDesc.Lines.Text:=CR_V+','+CF_V+','+CD_V;
if not FileExists(PicPath) then
exit
else
PDF.LoadFile(PicPath);
end;
procedure TFrmPatientResult.EdtPicDescKeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
begin
inherited;
if key=vk_Return then
begin
Item:='Desc';
TFrmSelect.Create(application).ShowModal;
EdtPicDesc.Text:=EdtPicDesc.Text+PicDesc;
end;
end;
procedure TFrmPatientResult.EdtExamDescKeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
begin
inherited;
if key=vk_Return then
begin
item:='Conclusion';
TFrmSelect.Create(application).ShowModal;
EdtExamDesc.Text:=ExamDesc+EdtExamDesc.Text;
end;
end;
procedure TFrmPatientResult.EdtAdviceKeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
begin
inherited;
if key=vk_Return then
begin
Item:='Advice';
TFrmSelect.Create(application).ShowModal;
EdtAdvice.Text:=Trim(EdtAdvice.Text)+Advice;
end;
end;
procedure TFrmPatientResult.BitBtn1Click(Sender: TObject);
var tmp:tadoquery;
suc:integer; //写入HIS标志,1成功0失败
begin
inherited;
if CheckBox1.Checked then
begin
IsHealthy:=True;
Yangxing:=Conclusion;
end
else
IsHealthy:=False;
Desc:=Trim(EdtPicDesc.Text);
Advice:=Trim(EdtAdvice.Text);
Conclusion:=Trim(EdtExamDesc.Text);
if SaveReport(PChar(PatientID),PChar(DEP),PChar(UserID),PChar(UserName),now(),PChar(UserID),PChar(UserName),now(),PChar(Desc),PChar(Advice),PChar(Conclusion),PChar(Yangxing),PChar(DiagNoseCode),IsHealthy) then
begin
suc:=1; //成功
application.MessageBox('数据保存至HIS数据库成功!','提示',mb_ok+mb_iconinformation);
end
else
begin
suc:=0; //失败
application.MessageBox('数据保存至HIS数据库失败!','警告',mb_ok+mb_iconwarning);
end;
tmp:=tadoquery.Create(nil);
tmp.Connection :=DM.ADOCn;
DM.ADOCn.BeginTrans;
try
//修改诊断报告
if ReportSender='已完成' then
begin
with tmp do
begin
sql.Clear;
sql.Add('UPDATE ExamReport SET PicDesc=:v1,ExamDesc=:v2,Advice=:v3,Status=:v5 WHERE ID=:v4');
Parameters.ParamByName('v1').Value :=Desc;
Parameters.ParamByName('v2').Value :=Conclusion;
Parameters.ParamByName('v3').Value :=Advice;
Parameters.ParamByName('v4').Value :=RecID;
Parameters.ParamByName('v5').Value :=suc;
ExecSql;
end;
end;
//写入诊断报告
if ReportSender='未完成' then
begin
with tmp do
begin
sql.Clear;
sql.Add('INSERT INTO ExamReport (PatientID,PatientName,PicDesc,ExamDesc,Advice,Status,ResultID) VALUES (:v1,:v2,:v3,:v4,:v5,:v6,:v7)');
Parameters.ParamByName('v1').Value :=EdtID.Text;
Parameters.ParamByName('v2').Value :=EdtName.Text;
Parameters.ParamByName('v3').Value :=Desc;
Parameters.ParamByName('v4').Value :=Conclusion;
Parameters.ParamByName('v5').Value :=Advice;
Parameters.ParamByName('v6').Value :=suc;
Parameters.ParamByName('v7').Value :=No;
ExecSql;
end;
end;
//更改诊断报告状态信息
with tmp do
begin
sql.Clear;
sql.Add('UPDATE CompliorResult SET Status=1 WHERE ID='+''''+No+'''');
//ShowMessage(sql.Text);
ExecSql;
end;
DM.ADOCn.CommitTrans;
except
DM.ADOCn.RollbackTrans;
raise;
application.MessageBox('保存失败!','警告',mb_ok+mb_iconinformation);
end;
//刷新
ShowRecord(PatientDM.ADQComplete,'*','CompliorResult WHERE Status=1','ID');
close;
end;
procedure TFrmPatientResult.BitBtn2Click(Sender: TObject);
begin
inherited;
Desc:='';
Advice:='';
Conclusion:='';
close;
end;
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?