checkitem.pas

来自「某疗养院动脉硬化管理系统」· PAS 代码 · 共 401 行

unit CheckItem;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, BaseUnit, StdCtrls, OleCtrls, ExtCtrls, Buttons, RzTabs,
  AcroPDFLib_TLB, ADODB, IniFiles, CheckLst, ActiveX;

type
  TFrmCheckItem = class(TForm1)
    Panel1: TPanel;
    GroupBox1: TGroupBox;
    ChkCF: TCheckBox;
    ChkCD: TCheckBox;
    ChkCR: TCheckBox;
    Splitter1: TSplitter;
    Panel2: TPanel;
    BitBtn2: TBitBtn;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    EdtID: TEdit;
    Label2: TLabel;
    EdtName: TEdit;
    Label3: TLabel;
    EdtSex: TEdit;
    Label4: TLabel;
    EdtBornDate: TEdit;
    Label5: TLabel;
    EdtSysBP: TEdit;
    Label6: TLabel;
    EdtDiaBP: TEdit;
    Label7: TLabel;
    EdtCF: TEdit;
    Label8: TLabel;
    EdtCD: TEdit;
    Label9: TLabel;
    EdtCR: TEdit;
    Label10: TLabel;
    EdtHeart: TEdit;
    Label11: TLabel;
    EdtCentralBP: TEdit;
    BitBtn4: TBitBtn;
    BtnGetInfo: TBitBtn;
    OpenDlg: TOpenDialog;
    RzPageControl1: TRzPageControl;
    TabSheet1: TRzTabSheet;
    Memo1: TMemo;
    PDF: TAcroPDF;
    LstPDF: TCheckListBox;
    BitBtn3: TBitBtn;
    procedure BitBtn4Click(Sender: TObject);
    procedure BtnGetInfoClick(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure LstPDFClick(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
  private
    PDFPath,DICOMPath,BakPDFPath,JPGFile:string;
    //生成DICOM图
    //procedure CreateDICOM(FileName:string);
    //扫描文件
    procedure ScanFile(AStrings:TStrings;ASourFile:string);
    //初始化
    procedure IniForm;
    //读ini
    procedure ReadIni;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmCheckItem: TFrmCheckItem;

implementation

uses PubFunction, DataModule, ExamResult, Select;

{$R *.dfm}

//分离字符串
function SplitText(Memo:TMemo;Text1,Text2:string):string;
var str:string;
    strpos1,strpos2:integer;
begin
  //Memo.Lines.LoadFromFile(FileName);
  str:=Trim(Memo.Lines.Text);
  //ShowMessage(str);
  Memo.Lines.Text :=Trim(str);
  strpos1:=pos(Text1,str);
  //ShowMessage(IntToStr(strpos1));
  Delete(str,1,strpos1-1+Length(Text1));
  Memo.Lines.Text :=str;
  str:=Trim(str);
  //ShowMessage(str);
  strpos2:=pos(Text2,str);
  //ShowMessage(IntToStr(strpos2));
  Result:=Trim(Copy(str,1,strpos2-1));
end;
//分离PWV
function SplitPWV(Memo:TMemo;Text1,Text2:string):string;
var PWV:string;
begin
  PWV:='';
  PWV:=SplitText(Memo,Text1,Text2);
  Result:=PWV;
end;
//初始化
procedure TFrmCheckItem.IniForm;
var i:integer;
begin
  for i:=0 to GroupBox1.ControlCount-1 do
  begin
    if GroupBox1.Controls[i] is TCheckBox then
      TCheckBox(GroupBox1.Controls[i]).Checked:=True;
  end;
  for i:=0 to GroupBox2.ControlCount-1 do
  begin
    if GroupBox2.Controls[i] is TEdit then
      TEdit(GroupBox2.Controls[i]).Text:='';
  end;
end;

procedure TFrmCheckItem.BitBtn4Click(Sender: TObject);
begin
  inherited;
  close;
end;

procedure TFrmCheckItem.BtnGetInfoClick(Sender: TObject);
var sUserPassword,sOwnerPassword,PDFFile,CmdLine,OutFile:string;
    lHandle:LongInt;
    CR,CR_PWV,CF,CF_PWV,CD,CD_PWV:string;
    //CR_PWV,CF_PWV,CD_PWV:string;
    StrPos,i,Count:integer;
begin
  inherited;
  OutFile:=PDFPath;
  Count:=0;
  for i:=0 to LstPDF.Items.Count-1 do
  begin
    if LstPDF.Checked[i] then
      Count:=Count+1;
  end;
  if Count=0 then
  begin
    application.MessageBox('请选择一个PDF文件！','提示',mb_ok+mb_iconinformation);
    exit;
  end;
  if LstPDF.Items.Count=0 then
  begin
    application.MessageBox('无病人检查数据文件!','提示',mb_ok+mb_iconinformation);
    exit;
  end;
  for i:=0 to LstPDF.Items.Count-1 do
  begin
    if LstPDF.Checked[i] then
      PDFFile:=LstPDF.Items.Strings[i];
  end;
  //生成JPG*************************************************
  CmdLine:='PDFToJPG -i '+PDFFile+' -o '+OutFile+' -r 150 -q 70';
  WinExec(PChar(CmdLine),sw_hide);
  JPGFile:=BakPDFPath+'\'+GenFileID+'.jpg';
  MoveFile(PChar(Copy(PDFFile,1,Length(PDFFile)-4)+'-001.jpg'),PChar(JPGFile));
  //********************************************************
  if (not(ChkCF.Checked))and(not(ChkCD.Checked))and(not(ChkCR.Checked)) then
  begin
    application.MessageBox('至少选择一个检查项目！','提示',mb_ok+mb_iconinformation);
    exit;
  end;
  pdfOpenPDF(PChar(PDFFile),True,PChar(sUserPassword),PChar(sOwnerPassword),lHandle);
  pdfConvertPDFToTextFile(1,1,lHandle,PChar(PDFFile+'.txt'));
  pdfClose(lHandle);
  Memo1.Lines.LoadFromFile(PDFFile+'.txt');
  EdtName.Text:=Trim(SplitText(Memo1,'Last name:','Gender:'));
  EdtSex.Text:=Trim(SplitText(Memo1,'Gender:','Weight:'));
  EdtName.Text:=EdtName.Text+' '+Trim(SplitText(Memo1,'First name:','Date of Birth:'));
  EdtBornDate.Text:=Trim(SplitText(Memo1,'Date of Birth:','Height:'));
  EdtID.Text:=Trim(SplitText(Memo1,'ID:','BMI:'));
  PatientID:=EdtID.Text;
  //ShowMessage(PatientID);
  EdtSysBP.Text:=Trim(SplitText(Memo1,'Sys BP / Dia BP','/'));
  EdtDiaBP.Text:=Trim(SplitText(Memo1,'/','(mmHg)'));
  //CR_PWV
  if ChkCR.Checked then
  begin
    CR:=SplitPWV(Memo1,'Carotid-radial (C-R)','bpm');
    StrPos:=Pos(' ',CR);
    Delete(CR,1,StrPos-1);
    CR:=Trim(CR);
    StrPos:=Pos(' ',Trim(CR));
    CR_PWV:=Copy(CR,1,StrPos-1);
    EdtCR.Text:=CR_PWV;
    CR_V:='(C-R)上肢脉搏波速度:'+CR_PWV;
    //ShowMessage(CR);
  end;
  //HeartRate
  EdtHeart.Text:=Trim(Copy(CR,StrPos,Length(CR)));
  //CF_PWV
  if ChkCF.Checked then
  begin
    CF:=SplitPWV(Memo1,'Carotid-femoral (C-F)','Est. central pulsed BP:');
    StrPos:=Pos(' ',CF);
    Delete(CF,1,StrPos-1);
    CF_PWV:=Trim(CF);
    EdtCF.Text:=CF_PWV;
    CF_V:='(C-F)主动脉脉搏波速度:'+CF_PWV;
    //ShowMessage(CF);
  end;
  //CD_PWV
  if ChkCD.Checked then
  begin
    CD:=SplitPWV(Memo1,'Carotid-distal (C-D)','(mmHg)');
    StrPos:=Pos(' ',CD);
    Delete(CD,1,StrPos-1);
    CD:=Trim(CD);
    StrPos:=Pos(' ',Trim(CD));
    CD_PWV:=Copy(CD,1,StrPos-1);
    EdtCD.Text:=CD_PWV;
    CD_V:='(C-D)下肢脉搏波速度:'+CD_PWV;
    //ShowMessage(CD);
  end;
  EdtCentralBP.Text:=Trim(Copy(CD,StrPos,Length(CD)));
end;
//生成DICOM图
{procedure TFrmCheckItem.CreateDICOM(FileName:string);
var OutFile,CmdLine:string;
begin
  OutFile:=PDFPath;
  //OutFile:='c:\CompliorPDF';
  //如果文件不存在,则直接退出函数
  if not FileExists(FileName) then
    exit;
  //参数-i输入文件,-o输出文件,-r分辨率,-q质量
  CmdLine:='PDFToJPG -i '+FileName+' -o '+OutFile+' -r 200 -q 100';
  //showmessage(cmdline);
  WinExec(PChar(CmdLine),sw_hide);
  DICOMX.DCMfilename:=Copy(FileName,1,Length(FileName)-4)+'-001.jpg';
  //DICOMX.DCMSaveToDCM:=GenFileName+'.dcm';
  DICOMX.DCMSaveToDCM:='111.dcm';
end;         }

procedure TFrmCheckItem.ScanFile(AStrings:TStrings;ASourFile:string);
var sour_path,sour_file:string;
    TmpList:TStringList;
    FileRec:TSearchrec;
begin
  sour_path:=ExtractFilePath(ASourFile);
  sour_file:=ExtractFileName(ASourFile);
  //判断文件夹是否存在
  if not DirectoryExists(sour_path) then
  begin
    AStrings.Clear;
    exit;
  end;
  //创建StringList
  TmpList:=TStringList.Create;
  TmpList.Clear;
  //查找文件
  if FindFirst(sour_path+sour_file,faAnyfile,FileRec)=0 then
    repeat
      if((FileRec.Attr and faDirectory)=0)then
        begin
          TmpList.Add(sour_path+FileRec.Name)
        end;
    until FindNext(FileRec)<>0;
  //关闭Rec
  SysUtils.FindClose(FileRec);
  AStrings.Assign(TmpList);
  TmpList.Free;  
end;

procedure TFrmCheckItem.BitBtn2Click(Sender: TObject);
var tmp:TADOQuery;
    i:integer;
    PDFFile:string;
begin
  inherited;
  //ShowMessage(GenFileID);
  if Trim(EdtID.Text)='' then
  begin
    application.MessageBox('请先获取该病人的数据信息！','提示',mb_ok+mb_iconinformation);
    exit;
  end;
  tmp:=tadoquery.Create(nil);
  tmp.Connection :=DM.ADOCn;
  //if not DM.ADOCn.InTransaction then
  DM.ADOCn.BeginTrans;
  try
    with tmp do
    begin
      sql.Clear;
      sql.Add('INSERT INTO CompliorResult (PatientID,PatientName,Gender,DateOfBirth,SysBP,DiaBP,PulsedBP,R_CR_PWV,R_CF_PWV,R_CD_PWV,HeartRate,EstCenteralPulsedBP,FileName)');
      sql.Add(' VALUES (:v1,:v2,:v3,:v4,:v5,:v6,:v7,:v8,:v9,:v10,:v11,:v12,:v13)');
      Parameters.ParamByName('v1').Value :=EdtID.Text;
      Parameters.ParamByName('v2').Value :=EdtName.Text;
      Parameters.ParamByName('v3').Value :=EdtSex.Text;
      Parameters.ParamByName('v4').Value :=EdtBornDate.Text;
      Parameters.ParamByName('v5').Value :=EdtSysBP.Text;
      Parameters.ParamByName('v6').Value :=EdtDiaBP.Text;
      Parameters.ParamByName('v7').Value :=' '; //PulsedBP
      Parameters.ParamByName('v8').Value :=EdtCR.Text;
      Parameters.ParamByName('v9').Value :=EdtCF.Text;
      Parameters.ParamByName('v10').Value :=EdtCD.Text;
      Parameters.ParamByName('v11').Value :=EdtHeart.Text;
      Parameters.ParamByName('v12').Value :=EdtCentralBP.Text;
      Parameters.ParamByName('v13').Value :=JPGFile;
      ExecSql;
    end;
    DM.ADOCn.CommitTrans;
    for i:=0 to LstPDF.Items.Count-1 do
      if LstPDF.Checked[i] then
      begin
        PDFFile:=LstPDF.Items.Strings[i];
        //LstPDF.DeleteSelected;
      end;
    //CreateDICOM(PDFFile);
  except
    DM.ADOCn.RollbackTrans;
    raise;
    application.MessageBox('保存失败！','警告',mb_ok+mb_iconinformation);
  end;
  PatientID:=EdtID.Text;
  {ShowMessage('PatientID:'+PatientID);
  ShowMessage(DEP);
  ShowMessage(UserID);
  ShowMessage(UserName);
  ShowMessage(Desc);
  ShowMessage(Conclusion);
  ShowMessage(Advice);  }
  try
    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);
  except
    application.MessageBox('数据保存至HIS数据库失败！','警告',mb_ok+mb_iconwarning);
    exit;
  end;
  IniForm;
end;

procedure TFrmCheckItem.ReadIni;
var IniFile:TIniFile;
begin
  IniFile:=TIniFile.Create(ExtractFilePath(paramstr(0))+'Config.ini');
  try
    with IniFile do
    begin
      PDFPath:=ReadString('SourcePDFPath','SourcePDFPath','C:\CompliorPDF');
      BakPDFPath:=ReadString('BackupPDFPath','BackupPDFPath','C:\CompliorPDF_Backup');
      DICOMPath:=ReadString('TargetDICOMPath','TargetDICOMPath','C:\CompliorPDF_Backup');
    end;
  finally
    IniFile.Free;
  end;
end;

procedure TFrmCheckItem.FormCreate(Sender: TObject);
begin
  inherited;
  ReadIni;
  ScanFile(LstPDF.Items,PDFPath+'\*.pdf');
end;

procedure TFrmCheckItem.LstPDFClick(Sender: TObject);
var i:integer;
begin
  inherited;
  for i:=0 to LstPDF.Items.Count -1 do
  begin
    LstPDF.Checked[i]:=false; //取消选择
    LstPDF.Checked[LstPDF.ItemIndex]:=true;//选择点击项目
  end;
  for i:=0 to LstPDF.Items.Count-1 do
    if LstPDF.Checked[i] then
    begin
      if FileExists(LstPDF.Items.Strings[i]) then
        PDF.LoadFile(LstPDF.Items.Strings[i])
      else
      begin
        application.MessageBox('该病人信息已保存!','提示',mb_ok+mb_iconinformation);
        exit;
      end;
    end;
  BtnGetInfo.OnClick(Sender);
end;

procedure TFrmCheckItem.BitBtn3Click(Sender: TObject);
begin
  inherited;
  if Trim(EdtID.Text)='' then
  begin
    application.MessageBox('请先获取该病人的数据信息！','提示',mb_ok+mb_iconinformation);
    exit;
  end;
  PatientID:=EdtID.Text;
  PatientName:=EdtName.Text;
  TFrmExamResult.Create(application).ShowModal;
end;

end.