orderitem.pas

某大型医院护士站

unit OrderItem;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, wwdblook, DBCtrls, ComCtrls, ExtCtrls, ActnList, Buttons,
  fcButton, fcImgBtn, fcShapeBtn, fcClearPanel, fcButtonGroup, ImgList,
  Menus, fcStatusBar, Wwdbigrd, Grids, Wwdbgrid ,DB, Mask, wwdbedit,
  Wwdbspin, wwDialog, wwidlg, fcLabel, wwdbdatetimepicker;

type
  TfrmOrderItem = class(TForm)
    OrderStatusBar: TfcStatusBar;
    MainMenu1: TMainMenu;
    mmView: TMenuItem;
    N2: TMenuItem;
    N1: TMenuItem;
    sh1: TMenuItem;
    N6: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N7: TMenuItem;
    E1: TMenuItem;
    MultiSele: TMenuItem;
    N11: TMenuItem;
    Emagency: TMenuItem;
    StopOrder: TMenuItem;
    OrderCheck: TMenuItem;
    E2: TMenuItem;
    FuncImageList: TImageList;
    ControlBar1: TControlBar;
    ToolPannel: TPanel;
    btnRowSelect: TSpeedButton;
    btnStopOrder: TSpeedButton;
    btnAtonce: TSpeedButton;
    Bevel2: TBevel;
    btnConfirm: TSpeedButton;
    btnRecall: TSpeedButton;
    FunctionActionList: TActionList;
    NSLongOrder: TAction;
    AllLongOrder: TAction;
    NSTempOrder: TAction;
    AllTempOrder: TAction;
    pcFeeSelected: TPageControl;
    Panel1: TPanel;
    pn_InputCase: TPanel;
    ts_OrdreItem: TTabSheet;
    ts_PayBill: TTabSheet;
    fcButtonGroup1: TfcButtonGroup;
    btnPartLong: TfcShapeBtn;
    btnAllLong: TfcShapeBtn;
    btnPartShort: TfcShapeBtn;
    btnAllShort: TfcShapeBtn;
    Bevel3: TBevel;
    Bevel4: TBevel;
    btnCheckOrder: TSpeedButton;
    Bevel1: TBevel;
    btnPayBill: TSpeedButton;
    ConfirmAction: TAction;
    gridOrderItem: TwwDBGrid;
    Bevel5: TBevel;
    pn_PatInfo: TPanel;
    gridExOrderItem: TwwDBGrid;
    gridExOrderItemIButton: TwwIButton;
    ScrollBox2: TScrollBox;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label15: TLabel;
    DBText1: TDBText;
    DBText3: TDBText;
    DBText5: TDBText;
    DBText6: TDBText;
    DBText7: TDBText;
    DBText2: TDBText;
    Label1: TLabel;
    lookupBedNo: TwwDBLookupCombo;
    dbvn_BedNO: TDBNavigator;
    Bevel6: TBevel;
    lbInid: TDBText;
    lbTimes: TDBText;
    Label10: TLabel;
    lbAge: TDBText;
    Label3: TLabel;
    Bevel7: TBevel;
    lbprepay: TLabel;
    Label14: TLabel;
    lbcost: TLabel;
    Label2: TLabel;
    Label13: TLabel;
    lbSexName: TDBText;
    LookupSubName: TwwDBLookupCombo;
    edStartTime: TwwDBSpinEdit;
    edEndTime: TwwDBSpinEdit;
    lookupUsageID: TwwDBLookupCombo;
    lookupUseTimes: TwwDBLookupCombo;
    LookupExcutePos: TwwDBLookupCombo;
    lookupItemID: TwwDBLookupCombo;
    LookUpOpenDoc: TwwDBLookupCombo;
    Label4: TLabel;
    Label11: TLabel;
    ppMenuOrderItem: TPopupMenu;
    miStartTimeSort: TMenuItem;
    miKindIdSort: TMenuItem;
    miDisplayIdSort: TMenuItem;
    N10: TMenuItem;
    miOrderItemRowSelect: TMenuItem;
    miOrderItemSelectAll: TMenuItem;
    miNumInput: TMenuItem;
    miPYExcodeInput: TMenuItem;
    N9: TMenuItem;
    DBCheckReuse: TDBCheckBox;
    DBCheckExCost: TDBCheckBox;
    DBCheckSelfPay: TDBCheckBox;
    DBCheckBox1: TDBCheckBox;
    DBCheckBox2: TDBCheckBox;
    DBCheckBox3: TDBCheckBox;
    Label12: TLabel;
    Label16: TLabel;
    DBText4: TDBText;
    N3: TMenuItem;
    mmOrderConfirm: TMenuItem;
    mmOrderStop: TMenuItem;
    mmEmergency: TMenuItem;
    StopOrderActive: TAction;
    EmergencyAction: TAction;
    Label17: TLabel;
    fcLabel1: TfcLabel;
    lb_Patmsg: TfcLabel;
    Panel2: TPanel;
    gdPayBill: TwwDBGrid;
    Label18: TLabel;
    dtp_CostDate: TDateTimePicker;
    spCostDate: TwwDBSpinEdit;
    mmOrderCancel: TMenuItem;
    Label19: TLabel;
    Label20: TLabel;
    CancelOrderAction: TAction;
    btnOrderCancel: TSpeedButton;
    tsRecipe: TTabSheet;
    Panel3: TPanel;
    Splitter1: TSplitter;
    Panel4: TPanel;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    wwDBGrid1: TwwDBGrid;
    Panel5: TPanel;
    wwDBGrid2: TwwDBGrid;
    Label21: TLabel;
    Label22: TLabel;
    Label23: TLabel;
    Label24: TLabel;
    btnRecipe: TSpeedButton;
    Panel6: TPanel;
    BitBtn1: TBitBtn;
    btnSave: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    wwDBDateTimePicker1: TwwDBDateTimePicker;
    lcbDoctor: TwwDBLookupCombo;
    lcbRecipeType: TwwDBLookupCombo;
    lcbExcuplace: TwwDBLookupCombo;
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    Shape4: TShape;
    BitBtn2: TBitBtn;
    mmFeeqrymodi: TMenuItem;
    DBText8: TDBText;
    DBText9: TDBText;
    N8: TMenuItem;
    DBText10: TDBText;
    procedure NSLongOrderExecute(Sender: TObject);
    procedure AllLongOrderExecute(Sender: TObject);
    procedure NSTempOrderExecute(Sender: TObject);
    procedure AllTempOrderExecute(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure E2Click(Sender: TObject);
    procedure lookupItemIDNotInList(Sender: TObject; LookupTable: TDataSet;
      NewValue: String; var Accept: Boolean);
    procedure gridOrderItemKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure lookupBedNoCloseUp(Sender: TObject; LookupTable,
      FillTable: TDataSet; modified: Boolean);
    procedure miPYExcodeInputClick(Sender: TObject);
    procedure miStartTimeSortClick(Sender: TObject);
    procedure miKindIdSortClick(Sender: TObject);
    procedure miDisplayIdSortClick(Sender: TObject);
    procedure miNumInputClick(Sender: TObject);
    procedure ConfirmActionExecute(Sender: TObject);
    procedure dbvn_BedNOClick(Sender: TObject; Button: TNavigateBtn);
    procedure btnRowSelectClick(Sender: TObject);
    procedure miOrderItemRowSelectClick(Sender: TObject);
    procedure miOrderItemSelectAllClick(Sender: TObject);
    procedure StopOrderActiveExecute(Sender: TObject);
    procedure EmergencyActionExecute(Sender: TObject);
    procedure gridOrderItemCalcCellColors(Sender: TObject; Field: TField;
      State: TGridDrawState; Highlight: Boolean; AFont: TFont;
      ABrush: TBrush);
    procedure btnRecallClick(Sender: TObject);
    procedure gridOrderItemColEnter(Sender: TObject);
    procedure gridOrderItemExit(Sender: TObject);
    procedure LookupSubNameCloseUp(Sender: TObject; LookupTable,
      FillTable: TDataSet; modified: Boolean);
    procedure btnPayBillClick(Sender: TObject);
    procedure dtp_CostDateChange(Sender: TObject);
    procedure ppMenuOrderItemPopup(Sender: TObject);
    procedure gdPayBillCalcCellColors(Sender: TObject; Field: TField;
      State: TGridDrawState; Highlight: Boolean; AFont: TFont;
      ABrush: TBrush);
    procedure btnRecipeClick(Sender: TObject);
    procedure lcbRecipeTypeNotInList(Sender: TObject;
      LookupTable: TDataSet; NewValue: String; var Accept: Boolean);
    procedure mmFeeqrymodiClick(Sender: TObject);
    procedure gdPayBillKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure CancelOrderActionExecute(Sender: TObject);
  private
    procedure ChangeOrderItemFilter( FilterNo : Integer );
    procedure AltBedNo;
  public

  end;

var
  frmOrderItem: TfrmOrderItem;
  procedure OpenOrder; // 打开医嘱

implementation

uses DataModule, HisUtilitis, SelectOrder, PatientAO, find, ItemfeeDtl;

{$R *.DFM}

procedure OpenOrder; //打开医嘱
var
  strPrepay : string;
  strCost   : string;
  WarningStr: string;
begin
{  dm.maxamt := 0.0; }
  Screen.Cursor := crHourGlass;
  //查出病床列表
  DM.ExorderItem.close;
  DM.OrderItem.close;
  DM.tblPatientSub.Close;
  DM.qryPatientBedNo.Close;   // Produce current ward beds list
  DM.qryPatientBedNo.ParamByName('wardid').AsString := DM.currWardid;
  DM.qryPatientBedNo.Open;

  DM.qrybed.Close;
  DM.qrybed.ParamByName('wardid').AsString := DM.currWardid;
  DM.qrybed.ParamByName('bed').AsString := DM.currBedNo;
  DM.qrybed.Open;
  if (DM.qrybedInid.AsString = '') or (DM.qrybedInid.IsNull) then
  begin
    HisErrorprompt('本病床没有病人,不能打开医嘱.');
    Exit;
  end;

  // get current beds information
  DM.qryPatientBedNo.Locate('bed',DM.currBedNo, []);

  //To improve the response performance, disable following two segements
  with DM.qryPreTotal do
  begin
    close;
    Params[0].AsInteger  := DM.qryPatientBedNoInid.AsInteger;
    Params[1].AsSmallInt := DM.qryPatientBedNoTimes.Value;
    Open;
    strPrepay := format('%.2f',[DM.qryPreTotalPrepayTotal.Value]);
    Close;
  end;

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

  {
  if (dm.qryPatientBedNonmnt.Value=0) and (dm.QRYPATIENTBEDNOPATIENTDATA.Value = 1) then
  begin
   frmorderitem.spgreenpassend.close;
   frmorderitem.spgreenpassend.params[0].asinteger := dm.qryPatientBedNoinid.AsInteger;
   frmorderitem.spgreenpassend.params[1].assmallint := dm.qryPatientBedNotimes.Value;
   frmorderitem.spgreenpassend.execproc;
   with DM do
    begin
      try
        if ProjHisadt.InTransaction then
          ProjHisadt.Commit;
        ProjHisadt.StartTransaction;
        spConfirm.Params[0].AsInteger  := qryPatientBedNoInid.AsInteger;
        spConfirm.Params[1].AsSmallint := qryPatientBedNoTimes.Value;
        spConfirm.ExecProc;
        ProjHisadt.Commit;
      except
        ProjHisadt.Rollback;
      end;
    end;
   cwlinfoprompt('病人不是自费，恢复正常医疗状态。');
  end; //end if

  if (dm.spPrepayTotal.Params[2].asfloat > dm.spFeeTotal.Params[2].asfloat) and (dm.QRYPATIENTBEDNOPATIENTDATA.Value = 1) then
  begin
   frmorderitem.spgreenpassend.close;
   frmorderitem.spgreenpassend.params[0].asinteger := dm.qryPatientBedNoinid.AsInteger;
   frmorderitem.spgreenpassend.params[1].assmallint := dm.qryPatientBedNotimes.Value;
   frmorderitem.spgreenpassend.execproc;
   with DM do
    begin
      try
        if ProjHisadt.InTransaction then
          ProjHisadt.Commit;
        ProjHisadt.StartTransaction;
        spConfirm.Params[0].AsInteger  := qryPatientBedNoInid.AsInteger;
        spConfirm.Params[1].AsSmallint := qryPatientBedNoTimes.Value;
        spConfirm.ExecProc;
        ProjHisadt.Commit;
        //OrderItem.Refresh;
      except
        ProjHisadt.Rollback;
      end;
    end;
   cwlinfoprompt('已交足押金，恢复正常医疗状态。');
  end; //end if

  if (dm.spPrepayTotal.Params[2].asfloat <= dm.spFeeTotal.Params[2].asfloat) and (dm.qryPatientBedNoNMNT.value = 1) then
    begin
    if cwlisyesquery('该病人剩余押金少于0，要继续录入医嘱吗？') then
    begin

    try
    if dm.ProjHisadt.InTransaction then
    dm.ProjHisadt.Commit;
    dm.ProjHisadt.StartTransaction;

    with frmorderitem do
    begin
    spgreenpass.close;
    spgreenpass.Params[0].asinteger := dm.qryPatientBedNoinid.AsInteger;
    spgreenpass.Params[1].asstring := dm.currWardid;
    spgreenpass.Params[2].asstring := dm.currBedNo;
    spgreenpass.Params[3].asstring := dm.currOperatorno;
    qryexectime.close;
    qryexectime.ParamByName('inid').asinteger := dm.qryPatientBedNoinid.AsInteger;
    qryexectime.ParamByName('times').assmallint := dm.qryPatientBedNotimes.Value;
    qryexectime.OPEN;

    if qryexectimeetime.AsDateTime < strtodate('1910-1-1') then
       endtime := now
    else
       endtime := qryexectimeetime.AsDateTime;

    spgreenpass.Params[4].asdatetime := endtime;
    spgreenpass.Params[5].assmallint := dm.qryPatientBedNotimes.Value;
    spgreenpass.ExecProc;
    dm.maxamt := spgreenpass.Params[6].asfloat;
    dm.maxendtime := spgreenpass.Params[7].asdatetime;
    end; //end with
    dm.ProjHisadt.Commit;

    except
    dm.ProjHisadt.Rollback;
    sysutils.Abort;
    end; //end except
    end
    else
    sysutils.Abort;
    end;
             }
  DM.tblPatientSub.Open;
  frmOrderitem.gridOrderItem.ReadOnly :=
                 (DM.tblPatientSubInState.Value > 1)
              OR (DM.tblPatientSubEnabled.Value = 0);

  if ( (strtofloat(strPrepay)- strtofloat(strCost))
      < DM.tblPatientSubFEELOWLEVEL.Value ) then
  begin
    WarningStr :=   Trim(DM.tblPatientSubPatDesc.Value)
                  + '(' + DM.tblPatientSubBedID.Value + ')'
                  + '剩余的押金已经低于'
                  +  floattostr(DM.tblPatientSubFEELOWLEVEL.Value) + '元' + #13
                  + '请提醒医生或护士长做好催款工作！';
    hisWarningPrompt(Pchar(WarningStr));
  end;

  frmOrderItem.gdPayBill.ReadOnly := frmOrderitem.gridOrderItem.ReadOnly;

  DM.OrderItem.Filtered := True;
  frmOrderItem.ChangeOrderItemFilter(0); //缺省过滤使用户只看到有效长嘱
  DM.OrderItem.Open;                     //打开医嘱明细表

  DM.ExOrderItem.Open;                   //打开附医嘱加项目表
  frmorderitem.miNumInputClick(Nil);     //打开医嘱项目表(收费项目)
  DM.Frequency.Open;                     //use times table
  DM.Usage.Open;                         //usage table
  DM.tblDoctor.Open;