⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 patientin.pas

📁 某大型医院护士站
💻 PAS
字号:
unit PatientIn;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
  Buttons, ComCtrls, ExtCtrls, wwdblook, Wwdbdlg, Grids, Wwdbigrd, Wwdbgrid,
  DBCtrls, Wwlocate, wwDialog;

type
  TfrmPatientIn = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    gridInWard: TwwDBGrid;
    gridEmptyBed: TwwDBGrid;
    Label1: TLabel;
    Bevel1: TBevel;
    btnOK: TBitBtn;
    btnCancel: TBitBtn;
    Panel3: TPanel;
    txtInid: TDBText;
    txtTimes: TDBText;
    txtname: TDBText;
    txtSexName: TDBText;
    txtAge: TDBText;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    btnFindInWard: TwwIButton;
    btnFindEmptyBed: TwwIButton;
    LocateDlgInWard: TwwLocateDialog;
    btnApply: TBitBtn;
    Label10: TLabel;
    txtIndept: TDBText;
    txtChgDept: TDBText;
    cbRange: TComboBox;
    Label11: TLabel;
    Bevel2: TBevel;
    Label2: TLabel;
    dbckb_IsBaby: TDBCheckBox;
    InWardDate: TDateTimePicker;
    InWardTime: TDateTimePicker;
    procedure cbRangeChange(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure btnApplyClick(Sender: TObject);
    procedure btnFindEmptyBedClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    function PatientInWard : Boolean;
  public
    { Public declarations }
    DefaultBed : String;
  end;

var
  frmPatientIn: TfrmPatientIn;

implementation

uses Datamodule, HisUtilitis;

{$R *.DFM}
function TfrmPatientIn.PatientInWard : Boolean;
var
  spResult : Integer;
  InWardDateTime :TDateTime;
begin
  Result := False;
  InWardDateTime := Int(InWardDate.Date) + frac(InWardTime.Time);
  try
    if DM.ProjHisadt.InTransaction then
      DM.ProjHisadt.Commit;
    DM.ProjHisadt.StartTransaction;
    DM.spInward.Params[0].AsInteger := DM.qryInWardInid.AsInteger;
    DM.spInWard.Params[1].AsSmallInt:= DM.qryInWardTimes.Value;
    DM.spInWard.Params[2].AsSmallInt:= DM.qryInWardSQID.Value;
    DM.spInWard.Params[3].AsDateTime:= InWardDateTime;
    DM.spInward.Params[4].AsString  := DM.currWardid;
    DM.spInward.Params[5].AsString  := DM.qryEmptyBedBed.AsString;
    DM.spInward.Params[6].AsString  := DM.currOperatorno;

    DM.spInward.ExecProc;
    spResult := DM.spInward.Params[7].AsInteger;
    DM.spInward.Close;
    DM.ProjHisadt.Commit;

    case spResult of
      -1 : begin
             hisErrorPrompt('病人列表中无此住院号!');
             Result := False;
           end;
      -2 : begin
             hisErrorPrompt('病床列表中无此空病床!');
             Result := False;
           end;
      -4 : begin
             hisErrorPrompt('病床已经分配给其他病人!');
             Result := False;
           end;
       1 : begin
              Result := True;
           end;
    end;
  except
    DM.ProjHisadt.Rollback;
  end;
end;

procedure TfrmPatientIn.cbRangeChange(Sender: TObject);
begin
  with DM.qryInWard do
  begin
    Close;
    //选本病区 0,  选全院 1
    ParamByName('IsAll').AsSmallInt := cbRange.ItemIndex;
    ParamByName('InDept').AsString := DM.currWardid;
    Open;
  end;
end;

procedure TfrmPatientIn.FormShow(Sender: TObject);
begin
  cbRange.ItemIndex := 0;
  cbRange.OnChange(Sender);
  InWardDate.Date := Date;
  InWardTime.Time := Time;
  with DM.qryEmptyBed do
  begin
    Close;
    ParamByName('wardid').AsString := DM.currWardid;
    ParamByName('IsAll').AsInteger := 0;
    Open;
    Locate('bed', DefaultBed, []);
  end;
end;

procedure TfrmPatientIn.btnOKClick(Sender: TObject);
var
  PromptStr :string;
begin
  if ( DM.qryInWard.RecordCount = 0 ) then
  begin
    hisErrorPrompt('没有待入病区的病人!!');
    SysUtils.Abort;
  end;

  if (not DM.isSysAdm) and
     ( (Trunc(InWardDate.Date) > (Trunc(Date) + 1)) or
         (Trunc(InWardDate.Date) < (Trunc(Date) - 1)) ) then
  begin
    hisErrorPrompt('入院日期不能超过一天!');
    SysUtils.Abort;
  end;

  if (not DM.qryEmptyBedInID.IsNull) and (not DM.qryInWardInid.IsNull)
  and (DM.qryEmptyBedInID.Value <> DM.qryInWardInid.Value) then
  begin
    hisErrorPrompt('本床位已经有其他病人!');
    SysUtils.Abort;
  end;

  if (DM.qryEmptyBedDeptnum.Value <> DM.qryInWardDeptnum.Value) then
  begin
    PromptStr := '本床位所属科室与当前病人的入住科室不相同' + #13 +
                 '请认真核对病人资料或床位所属科室后确认是否要分配床位?';

    if not HisIsYesQuery(PChar(PromptStr)) then
       SysUtils.Abort;
  end;

  if PatientInWard then ModalResult := mrOK;
end;

procedure TfrmPatientIn.btnApplyClick(Sender: TObject);
var
  PromptStr :string;
begin
  if ( DM.qryInWard.RecordCount = 0 ) then
  begin
    hisErrorPrompt('没有待入病区的病人!!');
    SysUtils.Abort;
  end;

  if (not DM.isSysAdm) and
     ( (Trunc(InWardDate.Date) > (Trunc(Date) + 1)) or
         (Trunc(InWardDate.Date) < (Trunc(Date) - 1)) ) then
  begin
    hisErrorPrompt('入院日期不能超过一天!');
    SysUtils.Abort;
  end;

  if (not DM.qryEmptyBedInID.IsNull) and (not DM.qryInWardInid.IsNull)
  and (DM.qryEmptyBedInID.Value <> DM.qryInWardInid.Value) then
  begin
    hisErrorPrompt('本床位已经有其他病人!');
    SysUtils.Abort;
  end;

  if (DM.qryEmptyBedDeptnum.Value <> DM.qryInWardDeptnum.Value) then
  begin
    PromptStr := '本床位所属科室与当前病人的入住科室不相同' + #13 +
                 '请认真核对病人资料或床位所属科室后确认是否要分配床位?';

    if not HisIsYesQuery(PChar(PromptStr)) then
       SysUtils.Abort;
  end;
  
  if  PatientInWard then OnShow(Sender);
end;

procedure TfrmPatientIn.btnFindEmptyBedClick(Sender: TObject);
begin
  with DM.qryEmptyBed do
  begin
    DisableControls;
    Close;
    ParamByName('WardID').AsString := DM.currWardid;
    if btnFindEmptyBed.Down then
       ParamByName('IsAll').AsInteger := 1
    else
       ParamByName('IsAll').AsInteger := 0;
    Open;
    EnableControls;
  end;
end;

procedure TfrmPatientIn.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  with DM do
  begin
    qryInWard.Active := False;
    qryEmptyBed.Active := False;
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -