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 + -
显示快捷键?