chgcharge.pas

某大型医院护士站

unit ChgCharge;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls, wwdblook, Wwdbdlg, DBCtrls, ComCtrls, Db,
  DBTables, Wwquery;

type
  TfrmChgCharge = class(TForm)
    Bevel1: TBevel;
    gbEndTime: TGroupBox;
    pickEndDate: TDateTimePicker;
    pickEndTime: TDateTimePicker;
    gbLeftTime: TGroupBox;
    pickLeftDate: TDateTimePicker;
    pickLeftTime: TDateTimePicker;
    GroupBox3: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    lbInid: TDBText;
    Label4: TLabel;
    lbTimes: TDBText;
    Label5: TLabel;
    Label6: TLabel;
    lbSexName: TDBText;
    Label7: TLabel;
    lbAge: TDBText;
    Label11: TLabel;
    lbPrePay: TLabel;
    Label12: TLabel;
    lbCost: TLabel;
    Panel1: TPanel;
    btnOK: TBitBtn;
    btnCancel: TBitBtn;
    btnApply: TBitBtn;
    gbChangeDept: TGroupBox;
    qryWardRDept: TwwQuery;
    lookPatSub: TwwDBLookupCombo;
    cbAutoStopOrder: TCheckBox;
    lookupPatientBed: TwwDBLookupCombo;
    LookupChgDept: TwwDBLookupCombo;
    qryWardRDeptWARDID: TStringField;
    qryWardRDeptDEPTNUM: TStringField;
    qryWardRDeptISDEF: TSmallintField;
    qryWardRDeptDEF_REDNUM: TFloatField;
    qryWardRDeptWARDNAME: TStringField;
    qryWardRDeptDEPTNAME: TStringField;
    procedure FormShow(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure btnApplyClick(Sender: TObject);
    procedure lookupPatientBedCloseUp(Sender: TObject; LookupTable,
      FillTable: TDataSet; modified: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure cbAutoStopOrderClick(Sender: TObject);
  private
    { Private declarations }
    function ChgCharge : Boolean;
  public
    { Public declarations }
  end;

var
  frmChgCharge: TfrmChgCharge;

implementation

uses Datamodule, HisUtilitis;

{$R *.DFM}

function TfrmChgCharge.ChgCharge : Boolean;
var
  EndTime    : TDateTime;
  StdEndTime : TDateTime;
  LeftTime   : TDateTime;
  spResult  : Integer;
begin
  EndTime  := Int(pickEndDate.Date)  + frac(pickEndTime.Time);
  LeftTime := Int(pickLeftDate.Date) + frac(pickLeftTime.Time);

  if ( lookupPatientBed.Text = '' ) or
     ( length( lookupPatientBed.Text ) = 0 ) then
  begin
    HisErrorPrompt('无效的病床号！');
    lookupPatientBed.SetFocus;
    Result := False;
    Exit;
  end;

  with DM.qryChkConfirm do
  begin
    Active := False;
    SQL.Clear;
    SQL.ADD('SELECT COUNT(*) AS NO_CONFIRMNUM FROM ORDERITEM ');
    SQL.ADD('WHERE INID  = :P_INID ');
    SQL.ADD('AND TIMES   = :P_TIMES ');
    SQL.ADD('AND SQID    = :P_SQID ');
    SQL.ADD('AND WARDID  = :P_WARDID ');
    SQL.ADD('AND ( CONFIRM = 0  OR STOPTYPE < 0 )');
    Params[0].AsInteger := DM.tblDtlPatSubInid.Value;
    Params[1].AsInteger := DM.tblDtlPatSubTimes.Value;
    Params[2].AsInteger := DM.tblDtlPatSubSqid.Value;
    Params[3].AsString  := DM.currWardid;
    Active := True;

    if DM.qryChkConfirmNO_CONFIRMNUM.Value > 0 then
    begin
       Hiserrorprompt('该病人还有医嘱没有确认，不能作紧急发送！');
       Active := False;
       Result := False;
       Exit;
    end else
    Active := False;
  end;

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

  if Endtime > Lefttime then
  begin
       HisErrorprompt('停医嘱时间不能晚于转出时间！');
       result := false;
       exit;
  end;

  if  ( (lookupChgDept.Text = '') or
        ( length(lookupChgDept.Text ) = 0 ) ) then
  begin
    HisErrorPrompt('必须输入转入病区！');
    Result := False;
    Exit;
  end;

  if not HisIsYesQuery('是否将病人从本病区转出？') then
  begin
    Result := False;
    Exit;
  end;

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

    DM.spSdTime.Close;
    DM.spSdTime.Params[0].AsDateTime := EndTime;
    DM.spSdTime.ExecProc;
    StdEndTime := DM.spSdTime.Params[1].AsDateTime;
    DM.ProjHisadt.StartTransaction;

    DM.spChgCharge.Close;
    DM.spChgCharge.Params[0].AsInteger   := DM.tblDtlPatSubInid.Value;
    DM.spChgCharge.Params[1].AsSmallInt  := DM.tblDtlPatSubTimes.Value;
    DM.spChgCharge.Params[2].AsSmallInt  := DM.tblDtlPatSubSqid.Value;
    DM.spChgCharge.Params[3].AsDateTime  := EndTime;
    DM.spChgCharge.Params[4].AsDateTime  := LeftTime;
    DM.spChgCharge.Params[5].AsString    := qryWardRDeptDeptNum.Value;
    DM.spChgCharge.Params[6].AsString    := DM.currOperatorno;
    DM.spChgCharge.Params[7].AsDateTime  := StdEndTime;
    DM.spChgCharge.Params[8].AsString    := qryWardRDeptWardID.Value;

    if cbAutoStopOrder.Checked then
       DM.spChgCharge.Params[9].AsSmallint  := 1
    else
       DM.spChgcharge.Params[9].AsSmallint  := 0;

    DM.spChgCharge.ExecProc;
    DM.ProjHisadt.Commit;

    spResult := DM.spChgCharge.Params[10].AsInteger;
    if spResult > 0 then
       Result := True
    else begin
       case spResult of
        -1 : HisErrorPrompt('选择科室的资料有错误，请联系系统管理员查明原因！');
        -2 : HisErrorPrompt('该病人有医嘱没有确认或停医嘱时间早于开医嘱时间！');
        -100 : HisErrorPrompt('转科过程中出错，请联系系统管理员查明原因！');
       end;
       
       Result := False;
    end;

  except
    DM.ProjHisadt.Rollback;
    Result := False;
  end;
end;

procedure TfrmChgCharge.FormShow(Sender: TObject);
var
  tmpDate : TDate;
  tmpTime : TTime;
begin
  if DM.Ward.Active then
    DM.Ward.refresh
  else
    DM.Ward.Open;
  DM.ExorderItem.close;
  DM.OrderItem.close;

  with DM do
  begin
    qryCanOutBedNo.Close;
    qryCanOutBedNo.ParamByName('wardid').AsString := currWardid;
    qryCanOutBedNo.open;

    tblDtlPatSub.Close;
    tblDtlPatSub.Active := True;
  end;

  tmpDate := Date;
  tmpTime := Time;
  pickEndDate.Date  := tmpDate;
  pickEndTime.Time  := tmpTime;
  pickLeftDate.Date := tmpDate;
  pickLeftTime.Time := tmpTime;
  qryWardRDept.Close;
  qryWardRDept.Open;
  cbAutoStopOrder.Checked := ( DM.RIsAutoStopOrder = 1 );
  if not cbAutoStopOrder.Checked then
  begin
    pickEndDate.Enabled := False;
    pickEndDate.Color   := clGray;
    pickEndTime.Enabled := False;
    pickEndTime.Color   := clGray;
  end;
end;

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

procedure TfrmChgCharge.btnApplyClick(Sender: TObject);
begin
  if ChgCharge then
  begin
    lookupPatientBed.Text := '';
    lookPatSub.Text := '';

    with DM do
    begin
      qryCanOutBedNo.Close;
      qryCanOutBedNo.ParamByName('wardid').AsString := currWardid;
      qryCanOutBedNo.open;

      tblDtlPatSub.Close;
      tblDtlPatSub.Active := True;
    end;
  end;
end;

procedure TfrmChgCharge.lookupPatientBedCloseUp(Sender: TObject;
  LookupTable, FillTable: TDataSet; modified: Boolean);
begin
  lookPatSub.Text := DM.tblDtlPatSubPatDesc.Value;

  with DM.qryPreTotal do
  begin
    close;
    Params[0].AsInteger  := DM.qryCanOutBedNoInid.AsInteger;
    Params[1].AsSmallInt := DM.qryCanOutBedNoTimes.Value;
    Open;
    lbPrePay.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;
    lbCost.Caption := format('%.2f',[DM.qryFeeTotalFeeTotal.Value]);
    Close;
  end;

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

end;

procedure TfrmChgCharge.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  DM.qryCanOutBedNo.Close;
  DM.tblDtlPatSub.Close;
  qryWardRDept.Close;
end;

procedure TfrmChgCharge.cbAutoStopOrderClick(Sender: TObject);
begin
  if not cbAutoStopOrder.Checked then
  begin
    pickEndDate.Enabled := False;
    pickEndDate.Color   := clGray;
    pickEndTime.Enabled := False;
    pickEndTime.Color   := clGray;
  end else
  begin
    pickEndDate.Enabled := True;
    pickEndDate.Color   := clWhite;
    pickEndTime.Enabled := True;
    pickEndTime.Color   := clWhite;
  end;
end;

end.