main.pas

某大型医院护士站

    frmChgCharge.Free;
  end;
end;

procedure TfrmMain.BabyBornActionExecute(Sender: TObject);
begin
  if ( ListViewWard.Selected = Nil ) then SysUtils.Abort;

  try
    frmBabyBorn := TfrmBabyBorn.Create(Self);
    if ( ListViewWard.Selected <> Nil ) then
    begin
      frmBabyBorn.qryMotherInfo.Close;
      frmBabyBorn.qryMotherInfo.Params[0].AsInteger
                  := StrtoInt(ListViewWard.Selected.SubItems[2]);
      frmBabyBorn.qryMotherInfo.Open;
    end;
    frmBabyBorn.dtpBabyDate.Date := Date;
    frmBabyBorn.ShowModal;
  finally
    frmBabyBorn.Free;
  end;
end;

procedure TfrmMain.PatientPropertyExecute(Sender: TObject);
begin
  try
    frmPatiData := TfrmPatiData.Create(Self);
    frmPatiData.ShowModal;
  finally
    frmPatiData.Free;
  end;
end;

procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if MessageDlg('是否要退出病区管理系统?',
    mtConfirmation, [mbYes, mbNo], 0) = mrYes then
    CanClose := True
  else
    CanClose := False;
end;

procedure TfrmMain.ListViewWardDblClick(Sender: TObject);
begin
  if (ListViewWard.SelCount > 0) and OpenOrderAction.Enabled then
  begin
    OpenOrderActionExecute(Sender);
  end;
end;

procedure TfrmMain.ListViewWardDragDrop(Sender, Source: TObject; X,
  Y: Integer);
begin
  with (Sender As TListView) do
  begin
    if (Selected = nil) then Exit;
      DropTarget := GetItemAt(X,Y);
  end;
end;

procedure TfrmMain.ListViewWardDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  with (Sender as TListView) do
  begin
    if ( Selected.SubItems[2] = NULL) or //SubItems[2] 表示住院号
       (Selected.SubItems[2] = '') then  //如果是空床,则不能拖放到其他的图标
      Accept := False
    else
      Accept := True;
  end;
end;

procedure TfrmMain.ListViewWardEndDrag(Sender, Target: TObject; X,
  Y: Integer);
var
  inid,
  PatientName,
  sex,
  nurclass : string;
  ImageIndex : Integer;
  PromptStr : String;
begin
  with (Sender as TListView) do
  begin
    if ((Selected <> nil) and (DropTarget <> nil) and
        (Selected <> DropTarget) ) then
    begin
      PromptStr := '是否将病人 '+ Selected.SubItems[3] +
                       ' 换到 ' + DropTarget.SubItems[1] +
                       ' 号床？';
      if HisIsYesQuery(PChar(PromptStr)) then
      begin

        if ChangeBed( Selected.SubItems[1], DropTarget.SubItems[1] ) then
        begin
          OnChange := nil;
          inid        := Selected.SubItems[2];
          PatientName := Selected.SubItems[3];
          sex         := Selected.SubItems[4];
          nurclass    := Selected.SubItems[5];
          ImageIndex  := Selected.ImageIndex;

          Selected.Caption := Selected.SubItems[1] + DropTarget.SubItems[3];
          Selected.SubItems[2] := DropTarget.SubItems[2];
          Selected.SubItems[3] := DropTarget.SubItems[3];
          Selected.SubItems[4] := DropTarget.SubItems[4];
          Selected.SubItems[5] := DropTarget.SubItems[5];
          Selected.ImageIndex := DropTarget.ImageIndex;

          DropTarget.Caption := DropTarget.SubItems[1] + PatientName;
          DropTarget.SubItems[2] := inid;
          DropTarget.SubItems[3] := PatientName;
          DropTarget.SubItems[4] := sex;
          DropTarget.SubItems[5] := nurclass;
          DropTarget.ImageIndex := ImageIndex;

          Selected   := DropTarget;
          ItemFocused := DropTarget;
          DropTarget := nil;
          OnChange := ListViewWardChange;

          BedRefreshActionExecute(Sender);
        end
        else
          DropTarget := nil;
      end
      else
        DropTarget := nil;
    end;
  end;
end;

procedure TfrmMain.N31Click(Sender: TObject);
begin
  DM.ReadRunParams;
  DM.DownLoadData;
  DM.LoadSysParams;
  hisInfoPrompt('更新数据完毕！');
end;

procedure TfrmMain.ppEmergencyClick(Sender: TObject);
var
  tmpInid :integer;
  tmpTimes:SmallInt;
  tmpSqid :SmallInt;
begin
  tmpInid  := 0;
  tmpTimes := 0;
  tmpSqid  := 0;

  if ListViewWard.Selected <> Nil then
  begin
    tmpInid := StrtoInt(ListViewWard.Selected.SubItems[2]);
    tmpTimes:= StrtoInt(ListViewWard.Selected.SubItems[6]);
    tmpSqid := 1;
  end
  else
    SysUtils.Abort;

  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 WARDID  = :P_WARDID ');
    SQL.ADD('AND CONFIRM = 0 ');
    Params[0].AsInteger := tmpInid;
    Params[1].AsInteger := tmpTimes;
    Params[2].AsString  := DM.currWardid;
    Active := True;

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

  Screen.Cursor := crSQLWait;
  with DM.qryPatientAtOnce do
  begin
    Active := False;
    Params[0].AsInteger := tmpInid;
    Params[1].AsInteger := tmpTimes;
    Params[2].AsInteger := tmpSqid;
    Params[3].AsString  := DM.currWardid;
    Active := True;
  end;
  Screen.Cursor := crDefault;

  try
    frmpatientAtOnce := TfrmpatientAtOnce.Create(self);
    frmpatientAtOnce.Caption :=  '选择 '
                                  + ListViewWard.Selected.SubItems[3] +
                                 ' (' + DM.currBedNo + ') 紧急发送的医嘱';
    frmpatientAtOnce.ShowModal;
  finally
    frmpatientAtOnce.free;
  end;
end;

procedure TfrmMain.PrnOrderActionExecute(Sender: TObject);
begin
  try
    frmQryPrn := TfrmQryPrn.Create(Self);
    frmQryPrn.ShowModal;
  finally
    Screen.Cursor := crDefault;
    frmQryPrn.Free;
  end;
end;

procedure TfrmMain.SendMsgActionExecute(Sender: TObject);
begin
  DM.SetSystemTime;    //下载服务器时间，以防用户修改本地时间

  if (Time < DM.SSendStrTime) or (Time > DM.SSendEndTime) then
  begin
    HisErrorprompt(PChar('指示发送应该在' + TimetoStr(DM.SSendStrTime) +
                                     '至' + TimetoStr(DM.SSendEndTime) + '之间'
                         + #13 + '现在请使用紧急发送功能发送医嘱！') );
    SysUtils.Abort;
  end;

  try
    frmSendmsg := TfrmSendmsg.Create(Self);
    if frmSendmsg.ShowModal = mrOK then
       BedRefreshActionExecute(Sender);
  finally
    Screen.Cursor := crDefault;
    frmSendmsg.Free;
  end;
end;

procedure TfrmMain.PopupBedPopup(Sender: TObject);
var
  tmpListItem :TListItem;
begin
  if (ListViewWard.Selected <> Nil) then
  begin
     tmpListItem := ListViewWard.Selected;
     if ( Length(Trim(tmpListItem.SubItems[2])) = 0 ) then //如果是空床
     begin
       ppPatientIn.Enabled     := True;
       ppPatientOut.Enabled    := False;
       ppBedChange.Enabled     := False;
       ppBlankBed.Enabled      := False;
       ppBedChangeDept.Enabled := False;
       ppPatBorn.Enabled       := False;
       ppEmergency.Enabled     := False;
       ppPrnOutNote.Enabled    := False;
       ppOutRecall.Enabled     := False;

       ppBedOrderIn.Enabled    := False;
       ppBedOrderPrint.Enabled := False;
       ppFeeCheck.Enabled      := False;

       ppPatientData.Enabled   := False;

       ppOpenGreenpass.Enabled := False;
     end else
     begin
       if (StrtoInt(tmpListItem.SubItems[7]) = 1) then //如果已经定义出院
       begin
         ppPatientIn.Enabled     := False;
         ppPatientOut.Enabled    := False;
         ppBedChange.Enabled     := False;
         ppBlankBed.Enabled      := True;
         ppBedChangeDept.Enabled := False;
         ppPatBorn.Enabled       := False;
         ppEmergency.Enabled     := False;
         ppPrnOutNote.Enabled    := True;
         ppOutRecall.Enabled     := True;

         ppBedOrderIn.Enabled    := True;
         ppBedOrderPrint.Enabled := True;
         ppFeeCheck.Enabled      := True;

         ppPatientData.Enabled   := True;

         ppOpenGreenpass.Enabled := False;
       end else    //正常状态病人
       begin
         ppPatientIn.Enabled     := False;
         ppPatientOut.Enabled    := True;
         ppBedChange.Enabled     := True;
         ppBlankBed.Enabled      := False;
         ppBedChangeDept.Enabled := True;
         ppPatBorn.Enabled       := True;
         ppEmergency.Enabled     := False;
         ppPrnOutNote.Enabled    := False;
         ppOutRecall.Enabled     := False;

         ppBedOrderIn.Enabled    := True;
         ppBedOrderPrint.Enabled := True;
         ppFeeCheck.Enabled      := True;

         ppPatientData.Enabled   := True;

         ppOpenGreenpass.Enabled := False;
       end;
     end;
  end;
end;

procedure TfrmMain.BlankBedActionExecute(Sender: TObject);
begin
  if ((ListViewWard.Selected <> Nil) and
      (StrtoInt(ListViewWard.Selected.SubItems[7]) = 1) ) AND
      (Length(ListViewWard.Selected.SubItems[2])   <> 0 ) then
  begin
    if HisIsYesQuery('是否要空出床位！') then
    begin
      //程序简单，故不作事务处理
      with DM.spBlankBed do
      begin
        Close;
        Params[0].AsString := DM.currWardid;
        Params[1].AsString := Trim(ListViewWard.Selected.SubItems[1]);
        Params[2].AsInteger:= StrtoInt(ListViewWard.Selected.SubItems[2]);
        ExecProc;
        BedRefreshActionExecute(Sender);
      end;
    end;
  end;
end;

procedure TfrmMain.mmSysChangePasswdClick(Sender: TObject);
begin
  try
    frmPassWord := TfrmPassWord.Create(Self);
    frmPassWord.ShowModal;
  finally
    frmPassWord.Free;
  end;
end;

procedure TfrmMain.mmBedPropertyClick(Sender: TObject);
begin
  try
    frmBedProperty := TfrmBedProperty.Create(Self);

    with frmBedProperty do
    begin
      cbUseall.OnClick := Nil;

      qryCurrWardBed.Close;
      qryCurrWardBed.Params[0].AsString := DM.CurrWardid;
      qryCurrWardBed.Open;
      if ListViewWard.Selected <> Nil then
         qryCurrWardbed.Locate('Bed',
                          Trim(ListViewWard.Selected.SubItems[1]),[]);

      tblWardSub.Open;
      ShowModal;
    end;
  finally
    frmBedProperty.Free;
  end;
end;

procedure TfrmMain.mmWardMedClick(Sender: TObject);
begin
  try
    frmWardMed := TfrmWardMed.Create(Self);
    frmWardMed.ShowModal;
  finally
    Screen.Cursor := crDefault;
    frmWardMed.Free;
  end;
end;

procedure TfrmMain.ppIncludeRecpClick(Sender: TObject);
begin
  with PRN_DM.qryDayfeeDtl do
  begin
    Close;
    SQL.Clear;
    SQL.Add('SELECT INID ,TIMES ,SQID ,ICLASS ,ITEMID,SUM(QTY) AS TOTALQTY, ');
    SQL.Add('SUM(QTY * PRICE) AS TOTALFEE ');
    SQL.Add('FROM COSTITEM ');
    SQL.Add('WHERE INID = :I_INID ');
    SQL.Add('  AND TIMES= :I_TIMES ');
    SQL.Add('  AND ORDERKIND in (0 ,1 ,4 ,5) ');
    SQL.Add('GROUP BY INID ,TIMES ,SQID ,ICLASS ,ITEMID ');
    SQL.Add('ORDER BY ICLASS ,ITEMID');
  end;

  PatCheckfee(0);
end;

procedure TfrmMain.ppExcludeRecpClick(Sender: TObject);
begin
  with PRN_DM.qryDayfeeDtl do
  begin
    Close;
    SQL.Clear;
    SQL.Add('SELECT INID ,TIMES ,SQID ,ICLASS ,ITEMID,SUM(QTY) AS TOTALQTY, ');
    SQL.Add('SUM(QTY * PRICE) AS TOTALFEE ');
    SQL.Add('FROM COSTITEM ');
    SQL.Add('WHERE INID = :I_INID ');
    SQL.Add('  AND TIMES= :I_TIMES ');
    SQL.Add('GROUP BY INID ,TIMES ,SQID ,ICLASS ,ITEMID ');
    SQL.Add('ORDER BY ICLASS ,ITEMID');
  end;

  PatCheckfee(0);
end;

procedure TfrmMain.mmInfoQryClick(Sender: TObject);
begin
  try
    frmBaseInfo := TfrmBaseInfo.Create(Self);
    frmBaseInfo.ShowModal;
  finally
    frmBaseInfo.Free;
  end;
end;

procedure TfrmMain.dbcb_mDeptSubCloseUp(Sender: TObject; LookupTable,
  FillTable: TDataSet; modified: Boolean);
begin
  dbcb_mDeptSub.Text := Trim(DM.qryDeptSubDeptName.Value);
end;

procedure TfrmMain.ppPrnOutNoteClick(Sender: TObject);
begin
  if ListViewWard.Selected <> Nil then
  begin
    try
      frmLeftNote := TfrmLeftNote.Create(Self);
      frmLeftNote.PatientName := ListViewWard.Selected.SubItems[3];
      frmLeftNote.Inid        := StrtoInt(ListViewWard.Selected.SubItems[2]);

      frmLeftNote.InDate      :=
              Trunc(StrtoDateTime(Trim(ListViewWard.Selected.SubItems[10])));
      frmLeftNote.OutDate     :=
              Trunc(StrtoDateTime(Trim(ListViewWard.Selected.SubItems[11])));

      frmLeftNote.WardName    := DM.currWardName;
      frmLeftNote.WardId      := DM.currWardId;
      frmLeftNote.Print;
    finally
      frmLeftNote.free;
    end;
  end;
end;

procedure TfrmMain.OutRecallActionExecute(Sender: TObject);
begin
  try
    frmOutRecall := TfrmOutRecall.Create(Self);
    if    ( ListViewWard.Selected <> Nil )
      and ( ListViewWard.Selected.SubItems[7] <> '0') then
    begin
      frmOutRecall.edInid.Text  :=
                Trim(ListViewWard.Selected.SubItems[2]);
      frmOutRecall.edBedID.Text :=
                Trim(ListViewWard.Selected.SubItems[1]);
      frmOutRecall.lbPatName.Caption :=
                Trim(ListViewWard.Selected.SubItems[3]);
    end;
    frmOutRecall.ShowModal;
    BedRefreshActionExecute(Sender);
  finally
    frmOutRecall.Free;
  end;
end;

procedure TfrmMain.ppLocalWardClick(Sender: TObject);
begin
  with PRN_DM.qryDayfeeDtl do
  begin
    Close;
    SQL.Clear;
    SQL.Add('SELECT INID ,TIMES ,SQID ,ICLASS ,ITEMID,SUM(QTY) AS TOTALQTY, ');
    SQL.Add('SUM(QTY * PRICE) AS TOTALFEE ');
    SQL.Add('FROM COSTITEM ');
    SQL.Add('WHERE INID  = :I_INID ');
    SQL.Add('  AND TIMES = :I_TIMES ');
    SQL.Add('  AND Wardid= :I_WardID ');
    SQL.Add('GROUP BY INID ,TIMES ,SQID ,ICLASS ,ITEMID ');
    SQL.Add('ORDER BY ICLASS ,ITEMID');
  end;

  PatCheckfee(1);
end;

end.