sendmsg.pas

某大型医院护士站

unit Sendmsg;

interface

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

type
  TfrmSendmsg = class(TForm)
    Panel2: TPanel;
    btnSend: TBitBtn;
    btnClose: TBitBtn;
    Panel1: TPanel;
    Label1: TLabel;
    Bevel1: TBevel;
    Bevel2: TBevel;
    rb_SelDept: TRadioButton;
    rb_SelPat: TRadioButton;
    dbcb_DeptSub: TwwDBLookupCombo;
    Label2: TLabel;
    SendmsgDate: TDateTimePicker;
    feeStartTime: TDateTimePicker;
    SendProgress: TProgressBar;
    gdSendPat: TwwDBGrid;
    procedure FormShow(Sender: TObject);
    procedure gdSendPatCalcCellColors(Sender: TObject; Field: TField;
      State: TGridDrawState; Highlight: Boolean; AFont: TFont;
      ABrush: TBrush);
    procedure btnSendClick(Sender: TObject);
    procedure rb_SelPatClick(Sender: TObject);
    procedure rb_SelDeptClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmSendmsg: TfrmSendmsg;

implementation

uses HisUtilitis, DataModule;

{$R *.DFM}

procedure TfrmSendmsg.FormShow(Sender: TObject);
begin
  SendMsgDate.Date  := Date + 1;
  feeStartTime.Time := DM.SStartPoint;

  with DM.qrySendPat do
  begin
    Close;
    Params[0].AsString := DM.currWardid;
    Params[1].AsDate   := Trunc(SendMsgDate.Date);
    Open;
  end;
  if DM.qrySendPat.RecordCount = 0 then
     btnSend.Enabled := False;

  with DM.qryDeptSub do
  begin
    Close;
    SQL.Clear;
    SQL.Add('SELECT A.WARDID  , B.NAME AS WARDNAME , ');
    SQL.Add('A.DEPTNUM , C.NAME AS DEPTNAME , 0 AS ISALL ');
    SQL.Add('FROM WARDRDEPT A ,WARD B ,DEPT C ');
    SQL.Add('WHERE A.WARDID = B.WARDID ');
    SQL.Add('AND A.DEPTNUM = C.NUM ');
    SQL.Add('AND A.WARDID = :WARDID ');
    SQL.Add('UNION  ALL ');
    SQL.Add('SELECT ''0'' AS WARDID , ''全病区'' AS WARDNAME , ');
    SQL.Add('''0'' AS DEPTNUM ,''全病区'' AS DEPTNAME ,1 AS ISALL ');
    SQL.Add('FROM TESTTIME ');
    Params[0].AsString := DM.currWardid;
    Open;
  end;
  dbcb_DeptSub.Text := Trim(DM.qryDeptSubDeptName.Value);

end;

procedure TfrmSendmsg.gdSendPatCalcCellColors(Sender: TObject;
  Field: TField; State: TGridDrawState; Highlight: Boolean; AFont: TFont;
  ABrush: TBrush);
begin
  if DM.qrySendPatConfirm.AsInteger = 1 then  //已确认医嘱用蓝字
     AFont.Color := clBlue
  else
     AFont.Color := clBlack;

  if Highlight then
  begin
    AFont.Color := clWhite;
    ABrush.Color := clHighlight;
  end;
end;

procedure TfrmSendmsg.btnSendClick(Sender: TObject);
var
  spResult ,i  ,SelectCount:integer;
  Curr ,i_SendPoint :TDateTime;
begin
  Curr := Now;

  if (SendmsgDate.Date < Date + 1) then
  begin
    HisErrorPrompt('系统规定发送日期不能早于明天！');
    SendmsgDate.Date := Date + 1;
    SysUtils.Abort;
  end;

  if (Trunc(SendmsgDate.Date) > Trunc(Date + DM.SSendMaxSnap)) then
  begin
    HisErrorPrompt(PChar('系统规定只能发送' + InttoStr(DM.SSendMaxSnap) + '天'));
    SendmsgDate.Date := Date + 1;
    SysUtils.Abort;
  end;
  //计算发送时间
  i_SendPoint := Trunc(SendmsgDate.Date) + Frac(feeStartTime.Time);

  try

  with DM.Ins_Aomsg do
  begin
    Close;
    SQL.Clear;
    SQL.Add('INSERT INTO CONFIRMLOG (DEPTNUM ,MSGTIME ,EXCUPLACE ,MSGTYPE , ');
    SQL.Add('WARDID ,ISPRN_PO ,ISPRN_NPO ,ISPCNFM_PO ,ISPCNFM_NPO) ');
    SQL.Add('SELECT ''0000'' ,A.MSGTIME ,A.EXCUPLACE ,''01'' ,');
    SQL.Add('A.WARDID ,0 ,0 ,0 ,0 ');
    SQL.Add('FROM MSGDETAIL A ,EXCUTEPOS B  ');
    SQL.Add('WHERE A.WARDID = :P_WARDID AND A.MSGTIME = :P_AOMSG ');
    SQL.Add('AND A.EXCUPLACE = B.EXCUPLACE AND B.ISRNWRITE = 0 ');
    SQL.Add('GROUP BY A.WARDID ,A.MSGTIME ,A.EXCUPLACE ');
  end;

  if ( rb_SelDept.Checked ) then
  begin
     if ( DM.qrySendPat.RecordCount = 0 ) then SysUtils.Abort;

     i := 0;
     SendProgress.Position := 0;

     DM.qrySendPat.DisableControls;
     DM.qrySendPat.First;
     while not DM.qrySendPat.Eof do
     begin
       if DM.PROJHISADT.InTransaction then DM.PROJHISADT.Commit;

       if ( DM.qrySendPatConfirm.Value = 0 ) then
       begin
         i := i + 1;
         SendProgress.Position := Trunc( (i / DM.qrySendPat.RecordCount ) * 100);
         DM.qrySendPat.Next;
         Continue;
       end;

        DM.PROJHISADT.StartTransaction;
        with DM.spSendMsg do
        begin
          Close;
          Params[0].AsInteger  := DM.qrySendPatInid.Value;
          Params[1].AsSmallInt := DM.qrySendPatTimes.Value;
          Params[2].AsSmallInt := DM.qrySendPatSqid.Value;
          Params[3].AsString   := DM.currWardid;
          Params[4].AsString   := DM.currOperatorno;
          Params[5].AsDateTime := Curr;
          Params[6].AsDateTime := i_SendPoint;
          ExecProc;
          spResult := Params[7].AsInteger;
        end;
        DM.PROJHISADT.Commit;

        if ( spResult < 0 ) then
           HisErrorPrompt('发送过程出错，请认真查对医嘱数据是否有错！！');

        i := i + 1;
        SendProgress.Position := Trunc( (i / DM.qrySendPat.RecordCount) * 100 ) ;
        DM.qrySendPat.Next;
     end;

     with DM.Ins_Aomsg do
      begin
        Close;
        ParamByName('P_WARDID').AsString  := DM.currWardid;
        ParamByName('P_AOMSG').AsDateTime := Curr;
        ExecSQL;
      end;

     with DM.qrySendPat do
     begin
       Close;
       Params[0].AsString := DM.currWardid;
       Params[1].AsDate   := Trunc(SendMsgDate.Date);
       Open;
     end;

     HisInfoPrompt('指示发送完毕，请按[关闭]退出！');

     DM.qrySendPat.EnableControls;
     btnSend.Enabled := not (DM.qrySendPat.RecordCount = 0);
  end;

  if ( rb_SelPat.Checked ) then
  begin
    SelectCount := gdSendPat.SelectedList.Count;
    if (SelectCount = 0) or (DM.qrySendPat.RecordCount = 0) then
        Raise Exception.Create('没有选中医嘱!');

   SendProgress.Position := 0;
   DM.qrySendPat.DisableControls;

   for i := 1 to SelectCount do
   begin
     DM.qrySendPat.GotoBookmark(gdSendPat.SelectedList.items[i - 1]);
     DM.qrySendPat.Freebookmark(gdSendPat.SelectedList.items[i - 1]);

     if DM.PROJHISADT.InTransaction then DM.PROJHISADT.Commit;

     if ( DM.qrySendPatConfirm.Value = 0 ) then
     begin
       SendProgress.Position := Trunc( (i / SelectCount ) * 100);
       Continue;
     end;

     DM.PROJHISADT.StartTransaction;
     with DM.spSendMsg do
     begin
        Close;
        Params[0].AsInteger  := DM.qrySendPatInid.Value;
        Params[1].AsSmallInt := DM.qrySendPatTimes.Value;
        Params[2].AsSmallInt := DM.qrySendPatSqid.Value;
        Params[3].AsString   := DM.currWardid;
        Params[4].AsString   := DM.currOperatorno;
        Params[5].AsDateTime := Curr;
        Params[6].AsDateTime := i_SendPoint;
        ExecProc;
        spResult := Params[7].AsInteger;
     end;
     DM.PROJHISADT.Commit;

      if ( spResult < 0 ) then
         HisErrorPrompt('发送过程出错，请认真查对医嘱数据是否有错！！');

      SendProgress.Position := Trunc( (i / SelectCount ) * 100);

   end;

   with DM.Ins_Aomsg do
    begin
      Close;
      ParamByName('P_WARDID').AsString  := DM.currWardid;
      ParamByName('P_AOMSG').AsDateTime := Curr;
      ExecSQL;
    end;

   with DM.qrySendPat do
   begin
     Close;
     Params[0].AsString := DM.currWardid;
     Params[1].AsDate   := Trunc(SendMsgDate.Date);
     Open;
   end;

   gdSendPat.SelectedList.Clear;
   DM.qrySendPat.EnableControls;

   HisInfoPrompt('指示发送完毕，请按[关闭]退出！');

   btnSend.Enabled := not (DM.qrySendPat.RecordCount = 0);
  end;

  except
    if DM.PROJHISADT.InTransaction then DM.PROJHISADT.Rollback;

    SendProgress.Position := 0;
    DM.qrySendPat.EnableControls;

    with DM.Ins_Aomsg do
    begin
      Close;
      ParamByName('P_WARDID').AsString  := DM.currWardid;
      ParamByName('P_AOMSG').AsDateTime := Curr;
      ExecSQL;
    end;

    gdSendPat.SelectedList.Clear;
    HisErrorPrompt('发送过程出错，请认真查对医嘱数据是否有错！！');
    SysUtils.Abort;
  end;
end;

procedure TfrmSendmsg.rb_SelPatClick(Sender: TObject);
begin
  gdSendPat.Enabled := rb_SelPat.Checked;
end;

procedure TfrmSendmsg.rb_SelDeptClick(Sender: TObject);
begin
  gdSendPat.SelectedList.Clear;
  gdSendPat.Enabled := not rb_SelDept.Checked;
end;

end.