ufrmcellmarrowquery.pas

来自「一个简单得医院图像管理系统」· PAS 代码 · 共 250 行

unit ufrmCellMarrowQuery;

interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ComCtrls, StdCtrls,uPubFun,uPublicConnection,ADODB,DB,DateUtils,
 uDictionary;

type
  TQueryReturn=record
     Succeed:Boolean;
     SQL:string;
  end;
  TfrmCellMarrowQuery = class(TForm)
    Label4: TLabel;
    dtpStart: TDateTimePicker;
    Label1: TLabel;
    dtpEnd: TDateTimePicker;
    GroupBox4: TGroupBox;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label19: TLabel;
    edtCaseCode: TEdit;
    edtName: TEdit;
    edtSicknessBed: TEdit;
    cboDepartment: TComboBox;
    cboSex: TComboBox;
    cboDiagnosis: TComboBox;
    cboSicknessSection: TComboBox;
    cboOutOrIn: TComboBox;
    GroupBox5: TGroupBox;
    Label14: TLabel;
    Label16: TLabel;
    Label18: TLabel;
    Label23: TLabel;
    Label24: TLabel;
    Label13: TLabel;
    cboSampleSource: TComboBox;
    cboSendDoctor: TComboBox;
    cboTestDoctor: TComboBox;
    edtTestNo: TEdit;
    btnQuery: TButton;
    btnReset: TButton;
    btnClose: TButton;
    memReport: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure btnQueryClick(Sender: TObject);
    procedure btnResetClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure cboDepartmentExit(Sender: TObject);
    procedure cboSicknessSectionExit(Sender: TObject);
    procedure cboDiagnosisExit(Sender: TObject);
    procedure cboSendDoctorExit(Sender: TObject);
    procedure cboTestDoctorExit(Sender: TObject);
  private
     FQueryReturn:TQueryReturn;
     FADOQuery:TADOQuery;
     //产生SQL语句
     procedure ProductSQL;
     procedure InitialQuery;
     procedure LookUpByName(cobItem: TComboBox;Dictionary: TDictionary);

  public
     //以下为字典对象
     TestDoctor:TDictionary;
     SicknessSection:TDictionary;
     Diagnostic:TDictionary;
     Department:TDictionary;
     SendDoctor:TDictionary;
     procedure LoadDictionary;
     property QueryReturn:TQueryReturn read FQueryReturn;
     
  end;

var
  frmCellMarrowQuery: TfrmCellMarrowQuery;

implementation

{$R *.dfm}

{ TfrmCellMarrowQuery }

procedure TfrmCellMarrowQuery.InitialQuery;
var
  i:Integer;
begin
  for i:=0 to Self.ComponentCount-1 do
  begin
    if Self.Components[i] is TComboBox then
    begin
      TComboBox(Self.Components[i]).Text:='';
    end;
    if Self.Components[i] is TEdit then
    begin
      TEdit(Self.Components[i]).Text:='';
    end;
    if Self.Components[i] is TMemo then
    begin
      TMemo(Self.Components[i]).Text:='';
    end;
  end;
  //默认为住院
  cboOutOrIn.ItemIndex:=1;
  dtpEnd.Date:=Today;
  dtpStart.Date:=IncMonth(Today,-5);

end;

procedure TfrmCellMarrowQuery.LoadDictionary;
begin
  Department.LoadAllDictionNames(cboDepartment.Items);
  SicknessSection.LoadAllDictionNames(cboSicknessSection.Items);
  Diagnostic.LoadAllDictionNames(cboDiagnosis.Items);
  TestDoctor.LoadAllDictionNames(cboTestDoctor.Items);
  SendDoctor.LoadAllDictionNames(cboSendDoctor.Items);
end;

procedure TfrmCellMarrowQuery.LookUpByName(cobItem: TComboBox;
  Dictionary: TDictionary);
var
  tem:string;
begin
  if cobItem.Items.IndexOf(Trim(cobItem.Text))>-1 then Exit;
  tem:=Trim(Dictionary.FindNameByCode(Trim(cobItem.Text)));
  if tem='' then Exit;
  cobItem.Text:=tem;
end;

procedure TfrmCellMarrowQuery.ProductSQL;
var
 sql:string;
 procedure GetSQL(sText:string;sFieldName:string);
 begin
  if Trim(sText)<>'' then
  begin
    sql:=sql+' and ('+sFieldName+'='+QuotedStr(Trim(sText))+')';
  end;
 end;
begin
  FQueryReturn.SQL:='';
  FQueryReturn.Succeed:=False;

  //日期
  SQL:='(TestDate>=#%s#) and (TestDate<=#%s#)';
  SQL:=Format(SQL,[DateToStr(dtpStart.Date),DateToStr(dtpEnd.Date)]);
  GetSQL(edtCaseCode.Text,'PatientCode');
  GetSQL(cboOutOrIn.Text,'OutOrIn');
  if Trim(edtName.Text)<>'' then
  begin
    sql:=sql+' and (PatientName like '+QuotedStr(Trim(edtName.Text))+')';
  end;
  GetSQL(cboSex.Text,'Sex');
  GetSQL(cboSicknessSection.Text,'SickSection');
  GetSQL(cboDepartment.Text,'Department');
  GetSQL(edtSicknessBed.Text,'BedCode');
  GetSQL(cboDiagnosis.Text,'Diagnositic');
  GetSQL(edtTestNo.Text,'TestNumber');
  GetSQL(cboSampleSource.Text,'SampleSource');
  GetSQL(cboSendDoctor.Text,'SendDoctor');
  GetSQL(cboTestDoctor.Text,'TestDoctor');
  GetSQL(memReport.Text,'ReportMemo');
  FQueryReturn.SQL:=sql;

try
  if FADOQuery.Active then FADOQuery.Active:=False;
  FADOQuery.SQL.Text:='select count(*) as QueryCount from CELL_MARROW_PATIENT where '+sql;
  FADOQuery.Active:=True;
  FQueryReturn.Succeed:=TBasoUtils.GetDataFromField(FADOQuery,'QueryCount',0)>=1;
finally
  if FADOQuery.Active then FADOQuery.Active:=False;
end;

end;

procedure TfrmCellMarrowQuery.FormCreate(Sender: TObject);
begin
  FADOQuery:=TADOQuery.Create(Self);
  FADOQuery.Connection:=GlobalConnection.Connection;
  FQueryReturn.SQL:='';
  FQueryReturn.Succeed:=False;
  InitialQuery;

end;

procedure TfrmCellMarrowQuery.btnQueryClick(Sender: TObject);
begin
  Screen.Cursor:=crHourGlass;
try
  ProductSQL;
finally
  Screen.Cursor:=crDefault;
end;
  if FQueryReturn.Succeed then
  begin
   Close;
  end else
  begin
   if TBasoUtils.SysMessage('未查询到符合条件的检验报告，是否重新查询？',YESNO+QUST)=NO then
   begin
     Close;
   end else
   begin
     edtCaseCode.SetFocus;
   end;
  end;
end;

procedure TfrmCellMarrowQuery.btnResetClick(Sender: TObject);
begin
  InitialQuery;
  edtCaseCode.SetFocus;
end;

procedure TfrmCellMarrowQuery.btnCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmCellMarrowQuery.cboDepartmentExit(Sender: TObject);
begin
  LookUpByName(cboDepartment,Department);
end;

procedure TfrmCellMarrowQuery.cboSicknessSectionExit(Sender: TObject);
begin
  LookUpByName(cboSicknessSection,SicknessSection);
end;

procedure TfrmCellMarrowQuery.cboDiagnosisExit(Sender: TObject);
begin
  LookUpByName(cboDiagnosis,Diagnostic);
end;

procedure TfrmCellMarrowQuery.cboSendDoctorExit(Sender: TObject);
begin
  LookUpByName(cboSendDoctor,SendDoctor);
end;

procedure TfrmCellMarrowQuery.cboTestDoctorExit(Sender: TObject);
begin
  LookUpByName(cboTestDoctor,TestDoctor);
end;

end.