patientout.pas

某大型医院护士站

unit PatientOut;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, DBCtrls, wwdblook, ComCtrls, Buttons, ExtCtrls ,DB;

type
  TfrmPatientOut = class(TForm)
    Panel2: TPanel;
    btnOK: TBitBtn;
    btnCancel: TBitBtn;
    btnApply: TBitBtn;
    Bevel1: TBevel;
    Panel1: TPanel;
    Label1: TLabel;
    Bevel2: TBevel;
    Panel3: TPanel;
    txtInid: TDBText;
    txtTimes: TDBText;
    txtSexName: TDBText;
    txtAge: TDBText;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label10: TLabel;
    gb_EndTime: TGroupBox;
    dtp_EndDate: TDateTimePicker;
    dtp_EndTime: TDateTimePicker;
    rb_TodayOut: TRadioButton;
    rb_TomrrowOut: TRadioButton;
    Label2: TLabel;
    Label11: TLabel;
    dtp_LeftDate: TDateTimePicker;
    dtp_LeftTime: TDateTimePicker;
    rg_LeftType : TRadioGroup;
    dbcb_BedID: TwwDBLookupCombo;
    LookPatientDesc: TwwDBLookupCombo;
    DBCheckBox1: TDBCheckBox;
    btnPrnLeftNote: TBitBtn;
    txtFeeTotal: TLabel;
    txtPrepayTotal: TLabel;
    procedure FormShow(Sender: TObject);
    procedure rb_TodayOutClick(Sender: TObject);
    procedure rb_TomrrowOutClick(Sender: TObject);
    procedure dbcb_BedIDCloseUp(Sender: TObject; LookupTable,
      FillTable: TDataSet; modified: Boolean);
    procedure btnPrnLeftNoteClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure btnApplyClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    function PatientOut : Boolean;
  public
    { Public declarations }
  end;

var
  frmPatientOut: TfrmPatientOut;

implementation

uses DataModule, HisUtilitis, LeftNote;

{$R *.DFM}

function TfrmPatientOut.PatientOut : boolean;  //病人出院
var
  EndTime  : TDateTime;
  LeftTime : TDateTime;
  LeftType : SmallInt;
  spResult : Integer;
begin
  if ( (dbcb_BedID.Text = '') or (Length(dbcb_BedID.Text) = 0) ) then
  begin
    HisErrorprompt('没有输入床号！');
    SysUtils.Abort;
  end;

  if (not rb_TodayOut.Checked) and (not rb_TomrrowOut.Checked) then
  begin
    HisErrorprompt('没有输入出院时间！');
    SysUtils.Abort;
  end;

  EndTime  := Int(dtp_EndDate.Date)  + frac(dtp_EndTime.Time);
  LeftTime := Int(dtp_LeftDate.Date) + frac(dtp_LeftTime.Time);
  LeftType := rg_LeftType.ItemIndex + 1;  // 1 正常 2 死亡 3 逃离

  if ( Int(dtp_LeftDate.Date) < Date - 1 ) or
     ( Int(dtp_LeftDate.Date) > Date + 1 ) then
  begin
    HisErrorPrompt('出院时间必须是昨天、今天或明天！');
    Result := False;
    Exit;
  end;

  if Endtime > Lefttime then
  begin
   HisErrorprompt('停医嘱时间必须早于出院时间.');
   Result := False;
   Exit;
  end;

  try
    if DM.ProjHisadt.InTransaction then
      DM.ProjHisadt.Commit;

    DM.ProjHisadt.StartTransaction;
    with DM.spPatientOut do
    begin
      Close;
      Params[0].AsInteger  := DM.tblDtlPatSubInid.Value;
      Params[1].AsSmallInt := DM.tblDtlPatSubTimes.Value;
      Params[2].AsSmallInt := DM.tblDtlPatSubSqid.Value;
      Params[3].AsDateTime := EndTime;
      Params[4].AsDateTime := LeftTime;
      Params[5].AsSmallInt := LeftType;
      Params[6].AsString   := DM.currOperatorno;
      Params[7].AsString   := DM.currWardid;
      Params[8].AsString   := DM.qryCanOutBedNoBed.Value;
      Params[9].AsInteger  := DM.SEndTimeCnstn;

      ExecProc;
      spResult := params[10].AsInteger;
      Close;
    end;
    DM.ProjHisadt.Commit;

    Result := True;

    if spResult = -2 then
    begin
      HisErrorPrompt('当前病人医嘱没有全部确认，不能办理出院。');
      Result := False;
    end else
    if spResult = 2 then begin  // the bed not blanked
      // modify the bed icon here
    end;

    if spresult = -1 then
    begin
      HisErrorprompt('停医嘱时间不能早于开医嘱时间！');
      Result := False;
    end;

    if spresult = -3 then
    begin
      HisErrorprompt(PChar(' 停医嘱时间或出院时间不能超过前后'
                            + InttoStr(DM.SEndTimeCnstn) + '小时！'));
      Result := False;
    end;

    if spresult = -100 then
    begin
      HisErrorprompt('存在不可预测的错误，请与系统管理员联系！');
      Result := False;
    end;

    if spresult >= 0 then   //生成床位费
    begin
      with DM.spBedfeecrt do
      begin
        Close;
        Params[0].AsInteger := DM.tblDtlPatSubInid.Value;
        Params[1].AsDate    := Trunc(dtp_LeftDate.Date) - 1;
        ExecProc;
      end;
    end;

  //生成最后一天的费用清单
{
    with DM.spPatDayfee do
     begin
       Close;
       ParambyName('PINID').AsInteger   := DM.tblDtlPatSubInid.Value;
       ParambyName('PTIMES').AsSmallInt := DM.tblDtlPatSubTimes.Value;
       ParambyName('PSQID').AsSmallInt  := DM.tblDtlPatSubSqid.Value;
       ParambyName('PDATE').AsDate      := Trunc(LeftTime);
       Execproc;
     end;
}
  except
    if DM.ProjHisadt.InTransaction then DM.ProjHisadt.Rollback;
    Result := False;
  end;
end;

procedure TfrmPatientOut.FormShow(Sender: TObject);
begin
  with DM do
  begin
    qryCanOutBedNo.Close;
    qryCanOutBedNo.ParamByName('wardid').AsString := currWardid;
    qryCanOutBedNo.open;

    tblDtlPatSub.Active := True;
  end;
  dtp_EndTime.Time := Time;
  dtp_LeftTime.Time := Time;
  Screen.Cursor := crDefault;
end;

procedure TfrmPatientOut.rb_TodayOutClick(Sender: TObject);
begin
  if  rb_TodayOut.Checked then
  begin
    dtp_EndDate.Enabled  := True;
    dtp_EndDate.Color    := clWhite;
    dtp_EndDate.DateTime := Date;
    dtp_EndTime.Enabled  := True;
    dtp_EndTime.Color    := clWhite;
    dtp_LeftDate.Enabled := True;
    dtp_LeftDate.Color   := clWhite;
    dtp_LeftDate.DateTime:= Date;
    dtp_LeftTime.Enabled := True;
    dtp_LeftTime.Color   := clWhite;
  end;
end;

procedure TfrmPatientOut.rb_TomrrowOutClick(Sender: TObject);
begin
  if  rb_TomrrowOut.Checked then
  begin
    dtp_EndDate.Enabled  := True;
    dtp_EndDate.Color    := clWhite;
    dtp_EndDate.DateTime := Date + 1;
    dtp_EndTime.Enabled  := True;
    dtp_EndTime.Color    := clWhite;
    dtp_LeftDate.Enabled := True;
    dtp_LeftDate.Color   := clWhite;
    dtp_LeftDate.DateTime:= Date + 1;
    dtp_LeftTime.Enabled := True;
    dtp_LeftTime.Color   := clWhite;
  end;
end;

procedure TfrmPatientOut.dbcb_BedIDCloseUp(Sender: TObject; LookupTable,
  FillTable: TDataSet; modified: Boolean);
begin
  LookPatientDesc.Text := DM.tblDtlPatSubPatDesc.Value;

  with DM.qryPreTotal do
  begin
    close;
    Params[0].AsInteger  := DM.qryCanOutBedNoInid.AsInteger;
    Params[1].AsSmallInt := DM.qryCanOutBedNoTimes.Value;
    Open;
    txtPrepayTotal.Caption := format('%.2f',[DM.qryPreTotalPrepayTotal.Value]);
    Close;
  end;

  with DM.qryFeeTotal do
  begin
    close;
    Params[0].AsInteger  := DM.qryCanOutBedNoInid.AsInteger;
    Params[1].AsSmallInt := DM.qryCanOutBedNoTimes.Value;
    Open;
    txtFeeTotal.Caption := format('%.2f',[DM.qryFeeTotalFeeTotal.Value]);
    Close;
  end;

  if (StrtoFloat(txtFeeTotal.Caption) >= StrtoFloat(txtPrepayTotal.Caption) ) then
  begin
      txtFeeTotal.Font.Color    := clRed;
      txtPrepayTotal.Font.Color := clRed;
  end else
  begin
      txtFeeTotal.Font.Color    := clBlack;
      txtPrepayTotal.Font.Color := clBlack;
  end;
end;

procedure TfrmPatientOut.btnPrnLeftNoteClick(Sender: TObject);
var
  LeftTime : TDateTime;
begin
  LeftTime := Int(dtp_LeftDate.Date) + frac(dtp_LeftTime.Time);
  try
    frmLeftNote := TfrmLeftNote.Create(Self);
    frmLeftNote.PatientName := DM.tblDtlPatSubPatDesc.Value;
    frmLeftNote.Inid        := DM.tblDtlPatSubInid.Value;
    frmLeftNote.InDate      := TDate(DM.qryCanOutBedNoInDate.Value );
    frmLeftNote.OutDate     := TDate(LeftTime);
    frmLeftNote.WardName    := DM.currWardName;
    frmLeftNote.WardId      := DM.currWardId;
    frmLeftNote.Print;
  finally
    frmLeftNote.free;
  end;
end;

procedure TfrmPatientOut.btnOKClick(Sender: TObject);
begin
  if PatientOut then ModalResult := mrOK;
end;

procedure TfrmPatientOut.btnApplyClick(Sender: TObject);
begin
  if PatientOut then
  begin
    rb_TodayOut.Checked := False;
    rb_TomrrowOut.Checked := False;

    dtp_EndDate.Enabled  := False;
    dtp_EndDate.Color    := $00B2B2B2;
    dtp_EndTime.Enabled  := False;
    dtp_EndTime.Color    := $00B2B2B2;

    dtp_LeftDate.Enabled := False;
    dtp_LeftDate.Color   := $00B2B2B2;
    dtp_LeftTime.Enabled := False;
    dtp_LeftTime.Color   := $00B2B2B2;

    DM.tblDtlPatSub.Active   := False;
    DM.qryCanOutBedNo.Active := False;
    DM.qryCanOutBedNo.Active := True;
    DM.tblDtlPatSub.Active   := True;

    dbcb_BedID.Text := '';
    dbcb_BedID.SetFocus;
  end;
end;

procedure TfrmPatientOut.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  with DM do
  begin
    tblDtlPatSub.Close;
    qryCanOutBedNo.Close;
  end;
end;

end.