utestresult.pas

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

unit uTestResult;

interface
uses Windows, Messages, SysUtils, Variants, Classes,uPublicConnection,uPubFun,
     DB,ADODB,OleCtrls, CELL50Lib_TLB;
type
  TTestResult=class(TObject)
  private
    FCell:TCell;
    FQuery:TADOQuery;

  public
    constructor Create(Cell:TCell);reintroduce;
    destructor Destroy;override;
    //根据病人ID号查询
    function QueryByPatientIDS(PatientIDS:TStrings):Boolean;
    //显示当前检验结果到Cell中
    procedure DisplayTestResultInCell;
    //删除检验检验结果
    function DeleteCurrentTestResult:Boolean;
    //添加默认的检验结果
    function AddDefaultTestResult(iPatientID:Integer):Boolean;
    //修改检验结果
    function SaveTestResult(iPatientID:Integer):Boolean;

    //根据病人编号选择检验结果
    procedure SelectTestResultByPatientID(iPatientID:Integer);

    property Query:TADOQuery read FQuery;

  end;

implementation

function TTestResult.AddDefaultTestResult(iPatientID:Integer): Boolean;
var
 i:integer;
begin
  Result:=False;
  if FQuery.Active=False then Exit;
try
  FQuery.Append;
  FQuery.FieldByName('PatienID').AsInteger:=iPatientID;
  for i:=1 to 43 do
  begin
    FQuery.FieldByName('R'+IntToStr(i)).AsString:=' ';
    if i in [1..39] then
    begin
    FQuery.FieldByName('B'+IntToStr(i)).AsString:=' ';
    end;
  end;
  FQuery.Post;
  Result:=True;
except
  on e:Exception do
  begin
    TBasoUtils.SysMessage(e.Message,OK+STOP);
  end;
end;

end;

constructor TTestResult.Create(Cell: TCell);
begin
  inherited Create;
  FCell:=Cell;
  FQuery:=TADOQuery.Create(nil);
  FQuery.Connection:=GlobalConnection.Connection;

end;

function TTestResult.DeleteCurrentTestResult: Boolean;
var
  i:integer;
begin
  Result:=False;
  if FQuery.Active=False then Exit;
  if FQuery.RecordCount<1 then Exit;
try
  FQuery.First;
  for i:=1 to FQuery.RecordCount do
  begin
  FQuery.Delete;
  end;
  Result:=True;
except
  on e:Exception do
  begin
    TBasoUtils.SysMessage(e.Message,OK+STOP);
  end;
end;
end;

destructor TTestResult.Destroy;
begin
  FCell:=nil;
  if FQuery.Active then FQuery.Active:=False;
  FQuery.Free;
  inherited;
end;

procedure TTestResult.DisplayTestResultInCell;
var
  i:integer;
  tem:string;
begin
  if FQuery.Active=False then Exit;
  if FQuery.RecordCount<1 then Exit;
  if Assigned(FCell)=False then Exit;
  for i:=1 to 43 do
  begin
  //显示髓片结果
  if i in [1..40] then
  begin
    tem:=Trim(TBasoUtils.GetDataFromField(FQuery,'R'+IntToStr(i),''));
    FCell.SetCellString(7,i+2,0,tem);
  end;
  //显示血片结果
  if i in [1..39] then
  begin
    tem:=Trim(TBasoUtils.GetDataFromField(FQuery,'B'+IntToStr(i),''));
    FCell.SetCellString(4,i+2,0,tem);
  end;
  //显示综合结果
  if i in [41..43] then
  begin
    tem:=Trim(TBasoUtils.GetDataFromField(FQuery,'R'+IntToStr(i),''));
    FCell.SetCellString(4,i+2,0,tem);
  end;
 end;
end;

function TTestResult.QueryByPatientIDS(PatientIDS: TStrings):Boolean;
var
  sSQL:string;
  sInSQL:string;
  function GetInSQL:string;
  var
    i:integer;
    tem:string;
  begin
    Result:='';
    if PatientIDS.Count<1 then Exit;
    for i:=0 to PatientIDS.Count-1 do
    begin
      tem:=Trim(PatientIDS[i]);
      if tem<>'' then
      begin
        if i=0 then
        begin
          result:=tem;
        end else
        begin
          Result:=Result+','+tem;
        end;
      end;
    end;
  end;
begin
  sInSQL:=GetInSQL;
  sSQL:='select*from MARROW_TEST_RESULT';
  if sInSQL='' then
  begin
    sSQL:=sSQL+' where 1=2';//若为空则取数据结构
  end else
  begin
    sSQL:=sSQL+' where PatienID in ('+sInSQL+')';
  end;
  if FQuery.Active then FQuery.Active:=False;
  FQuery.SQL.Text:=sSQL;
try
  FQuery.Active:=True;
finally
  Result:=FQuery.Active;
end;
end;

function TTestResult.SaveTestResult(iPatientID:Integer): Boolean;
var
  i:integer;
  tem:string;
begin
  Result:=False;
  if FQuery.Active=False then Exit;
  if FQuery.RecordCount<1 then Exit;

  if Assigned(FCell)=False then Exit;
  if FQuery.State=dsbrowse then FQuery.Edit;
try
  for i:=1 to 43 do
  begin
    if i in [1..40] then
    begin
      tem:=FCell.GetCellString(7,i+2,0);//髓片结果
    end else if i in [41..43] then
    begin
      tem:=FCell.GetCellString(4,i+2,0);//综合分析结果
    end;
    if Trim(tem)='' then tem:=' ';
    FQuery.FieldByName('R'+IntToStr(i)).AsString:=tem;

    if i in [1..39] then
    begin
    tem:=FCell.GetCellString(4,i+2,0);//血片结果
    if Trim(tem)='' then tem:=' ';
    FQuery.FieldByName('B'+IntToStr(i)).AsString:=tem;
    end;
  end;
  //TBasoUtils.SysMessage(IntToStr(iPatientID),ok);
  FQuery.FieldByName('PatienID').AsInteger:=iPatientID;
  FQuery.Post; //保存结果
  Result:=True;
except
  on e:Exception do
  begin
    TBasoUtils.SysMessage(e.Message,OK+STOP);
  end;
end;
end;

procedure TTestResult.SelectTestResultByPatientID(iPatientID: Integer);
var
  sFilter:string;
begin
  if FQuery.Active=False then Exit;
  sFilter:='PatienID='+IntToStr(iPatientID);
  if FQuery.Filtered then FQuery.Filtered:=False;
  FQuery.Filter:=sFilter;
  FQuery.Filtered:=True;
end;

end.