qryprn.pas

某大型医院护士站

     qryPrnSumData.SQL.ADD('AND MsgType LIKE :i_msgtype ');
     qryPrnSumData.SQL.ADD('AND CANSENT   = 1 ');

     if ( PrnType = 0 ) then
       qryPrnSumData.SQL.ADD('AND ITEMTYPE = 0 ')
     else
       qryPrnSumData.SQL.ADD('AND ITEMTYPE <> 0 ');

     qryPrnSumData.SQL.ADD('ORDER BY WARDID ,DEPTNUM ');
     qryPrnSumData.Params[0].AsString   := DM.currWardid;
     qryPrnSumData.Params[1].AsSmallint := Excuplace;
     qryPrnSumData.Params[2].AsString   := MsgType;

     qryPrnSumData.Open;

     if ( qryPrnSumData.RecordCount = 0 ) then
     begin
         HisErrorPrompt('没有药品统领！！');
         SysUtils.Abort;
     end;

     qryPrnSumBill.Close;
     bmPrnSumMed.Execute;
     qryPrnSumData.Close;
     qryPrnSumBill.Open;

     try
       Application.CreateForm(TfrmPrnSumBill,frmPrnSumBill);
       with frmPrnSumBill do
       begin
         qrlbTitle.Caption := '';

         if MsgType = '02' then
            qrlbTitle.Caption := '紧急发药';

         qrlbOpName.Caption := DM.currOperatorName;
         if PrnType = 0 then
            qrlbTitle.Caption :=  qrlbTitle.Caption + '口服药统领单';
         if PrnType = 1 then
            qrlbTitle.Caption :=  qrlbTitle.Caption + '非口服药统领单';

         qrSUMBill.Prepare;   
         qrSUMBill.Preview;
       end;
     finally
       qryPrnSumBill.Close;
       frmPrnSumBill.Free;
     end;
  end;//end with
end;

procedure TfrmQryPrn.PrnWardDtlBill(PrnType ,Excuplace:Smallint ;
                                    MsgType :String);
begin
  with PRN_DM do
  begin
     qryPrnDtlBill.Close;
     qryPrnDtlBill.SQL.Clear;
     qryPrnDtlBill.SQL.ADD('SELECT Inid ,Times ,Sqid ,ItemID , ');
     qryPrnDtlBill.SQL.ADD('Sum(TotalQty) AS TotalQty ');
     qryPrnDtlBill.SQL.ADD('From MsgDetail ');
     qryPrnDtlBill.SQL.ADD('WHERE Wardid  = :i_wardid ');
     qryPrnDtlBill.SQL.ADD('AND Excuplace = :i_excuplace');
     qryPrnDtlBill.SQL.ADD('AND MsgType LIKE :i_msgtype ');
     qryPrnDtlBill.SQL.ADD('AND CANSENT   = 1 ');


     if ( PrnType = 0 ) then
       qryPrnDtlBill.SQL.ADD('AND ITEMTYPE = 0 ')
     else
       qryPrnDtlBill.SQL.ADD('AND ITEMTYPE <> 0 ');

     qryPrnDtlBill.SQL.ADD('GROUP BY Inid ,Times ,Sqid ,ItemID  ');
     qryPrnDtlBill.SQL.ADD('ORDER BY Inid ,ItemID ');

     qryPrnDtlBill.Params[0].AsString   := DM.currWardid;
     qryPrnDtlBill.Params[1].AsSmallint := Excuplace;
     qryPrnDtlBill.Params[2].AsString   := MsgType;

     qryPrnDtlBill.Open;

     if ( qryPrnDtlBill.RecordCount = 0 ) then
     begin
         HisErrorPrompt('没有药品统领！！');
         SysUtils.Abort;
     end;

     with frmWardDtlBill do
     begin
       qrlbTitle.Caption := '';

       if MsgType = '02' then
          qrlbTitle.Caption := DM.currWardName + '紧急发药'
       else
          qrlbTitle.Caption := DM.currWardName;

       if PrnType = 0 then
          qrlbTitle.Caption :=  qrlbTitle.Caption + '口服药明细单';
       if PrnType = 1 then
          qrlbTitle.Caption :=  qrlbTitle.Caption + '非口服药明细单';

       qrlbOpName.Caption := DM.currOperatorName;
       
       Prepare;
       Preview;

       qryPrnDtlBill.Close;
     end;
  end;//end with
end;

procedure TfrmQryPrn.PrnPatDayfeeDtl;
var
  i ,j:Integer;
begin
  //下载本病区病人基础数据
 PRN_DM.qryPRN_Patientsub.Close;
 PRN_DM.qryPRN_Patientsub.Params[0].AsString := DM.currWardid;
 PRN_DM.qryPRN_Patientsub.Open;
 PRN_DM.bmPatientSub.Execute;

 PRN_DM.bmInvitem.Execute;

 PRN_DM.clr_DayfeeDtl.ExecSQL;

 try

   j := gdCurbeds.SelectedList.Count;
   for i := 0 to j - 1 do
   begin
     PRN_DM.qryCurrBeds.GotoBookmark(gdCurBeds.SelectedList.Items[i]);

     PRN_DM.qryDayfeeDtl.Close;

     PRN_DM.qryDayfeeDtl.Params[0].AsInteger
                   := PRN_DM.qryCurrBedsInid.AsInteger;

     PRN_DM.qryDayfeeDtl.Params[1].AsSmallInt
                   := PRN_DM.qryCurrBedsTimes.AsInteger;

     PRN_DM.qryDayfeeDtl.Params[2].AsSmallInt
                   := PRN_DM.qryCurrBedsSqid.AsInteger;

     PRN_DM.qryDayfeeDtl.Params[3].AsDate
                   := Trunc(dtp_FeeDate.Date);

     PRN_DM.qryDayfeeDtl.Open;

     PRN_DM.bmDayfeeDtl.Execute;

   end;
    PRN_DM.qryDayfeeDtl.Close;

 except
   PRN_DM.qryDayfeeDtl.Close;
 end;

 try
    frmPatDayfeeDtl := TfrmPatDayfeeDtl.Create(Self);
    with frmPatDayfeeDtl do
    begin
      qrlbBillDate.Caption := '清单日期：' +
                      DatetoStr(dtp_FeeDate.Date - 1) + '-' +
                                            TimetoStr(DM.SStartPoint) + '到' +
                      DatetoStr(dtp_FeeDate.Date) + '-' +
                                            TimetoStr(DM.SStartPoint);

      qryPatDayfeeDtl.Open;
      if qryPatDayfeeDtl.RecordCount > 0 then
         QuickRep1.Preview
      else
         HisInfoPrompt('没有清单明细数据！！');
    end;
  finally
    Screen.Cursor := crDefault;
    frmPatDayfeeDtl.qryPatDayfeeDtl.Close;
    frmPatDayfeeDtl.Free;
  end;

end;

procedure TfrmQryPrn.rgBedRangeClick(Sender: TObject);
begin
  case rgBedRange.ItemIndex of
    0 : begin
          gdCurBeds.UnselectAll;
          gdCurBeds.Enabled := False;
        end;
    1 : begin
          gdCurBeds.UnselectAll;
          gdCurBeds.SelectRecord;
          gdCurBeds.Enabled := True;
        end;
    2 : begin
          gdCurBeds.SelectAll;
          gdCurBeds.Enabled := False;
        end;
  end;
end;

procedure TfrmQryPrn.btnOralClick(Sender: TObject);
begin
  PrintProcBill(0); //打印口服执行单
end;

procedure TfrmQryPrn.btnInjClick(Sender: TObject);
begin
  PrintProcBill(1); //打印注射执行单
end;

procedure TfrmQryPrn.btnMealClick(Sender: TObject);
begin
  PrintProcBill(2); //打印饮食执行单
end;

procedure TfrmQryPrn.btnTestClick(Sender: TObject);
begin
  PrintProcBill(5); //打印检验执行单
end;

procedure TfrmQryPrn.btnCheckClick(Sender: TObject);
begin
  PrintProcBill(6); //打印检查执行单
end;

procedure TfrmQryPrn.btnCareClick(Sender: TObject);
begin
  PrintProcBill(4); //打印护理执行单
end;

procedure TfrmQryPrn.btnCureClick(Sender: TObject);
begin
  PrintProcBill(3); //打印治疗执行单
end;

procedure TfrmQryPrn.btnBobyPropertyClick(Sender: TObject);
begin
  PrintProcBill(7); //打印测体征执行单
end;


{ Following Procedure process drop injection label}
procedure TfrmQryPrn.btnInjPreviewClick(Sender: TObject);
begin
  InjectionLabelPrn(0);
end;

procedure TfrmQryPrn.btnInjOtherClick(Sender: TObject);
begin
  InjectionLabelPrn(1);
end;

procedure TfrmQryPrn.btnPatDayfeeDtlClick(Sender: TObject);
begin
 pmPatDayfeeDtl.Popup(frmQryPrn.Left + Panel1.Left
                                     + btnPatDayfeeDtl.Left + 5 ,
                      frmQryPrn.Top  + Panel1.Top
                                     + btnPatDayfeeDtl.Top
                                     + btnPatDayfeeDtl.Height);
end;

procedure TfrmQryPrn.btnPatDayfeeClick(Sender: TObject);
var
 i ,j,finid :integer;
 ftimes ,fsqid  :smallint;
 PLastRemain  :Double;
 PPrepaytotal :Double;
begin
  if ( Trunc(dtp_FeeDate.Date) >= Trunc(Date) ) then
  begin
    HisErrorPrompt('只能打印昨天或以前的费用！！');
    SysUtils.Abort;
  end;

//  只能打印昨天以前的费用清单
{
  if ( Trunc(dtp_FeeDate.Date) = Trunc(Date) ) and
     ( Time < StrtoTime('12:00:00') )then
  begin
    HisErrorPrompt('当天费用清单只能在12:00:00后查询！！');
    SysUtils.Abort;
  end;
}
  j := gdcurbeds.SelectedList.Count;
  if j > 0 then
  begin
    pbar2.Max := j;
    label2.Visible := True;
  end;

  try
   PRN_DM.clr_PatDayfees.ExecSQL;
   PRN_DM.clr_PatSumfee.ExecSQL;

   if DM.ProjHisadt.InTransaction then
      DM.ProjHisadt.Commit;
   for I := 0 to j - 1 do
   begin
     PRN_DM.qryCurrBeds.GotoBookmark(gdCurBeds.SelectedList.Items[i]);

     finid := PRN_DM.qryCurrBedsInid.AsInteger;
     ftimes:= PRN_DM.qryCurrBedsTimes.Value;
     fsqid := PRN_DM.qryCurrBedsSqid.Value;

     frmDayFeeView.DayFeeRec[i].Inid := finid;
     frmDayFeeView.DayFeeRec[i].Times:= ftimes;
     frmDayFeeView.DayFeeRec[i].Sqid := fsqid;
     frmDayFeeView.DayFeeRec[i].PntDate := Trunc(dtp_FeeDate.Date);

   //首先生成清单日期以前的床位费
     with DM.spBedfeecrt do
     begin
       close;
       Params[0].AsInteger := PRN_DM.qryCurrBedsInid.AsInteger;
       params[1].AsDate := Trunc(dtp_FeeDate.Date);
       ExecProc;
     end;

   //生成一日清单数据，即作日结
     with DM.spPatDayfee do
     begin
       Close;
       ParambyName('PINID').AsInteger   := finid;
       ParambyName('PTIMES').AsSmallInt := ftimes;
       ParambyName('PSQID').AsSmallInt  := fsqid;
       ParambyName('PDATE').AsDate      := Trunc(dtp_FeeDate.Date);
       Execproc;
       PPrepaytotal := ParambyName('PPREPAYTOTAL').AsFloat;
       PLastRemain  := ParambyName('PLASTREMAIN').AsFloat;
     end;

     //下载清单数据到本地打印
     with PRN_DM.qryDayfeePrn do
     begin
       Close;
       ParambyName('PINID').AsInteger   := finid;
       ParambyName('PTIMES').AsSmallInt := ftimes;
       ParambyName('PSQID').AsSmallInt  := fsqid;
       ParambyName('PPNTBLDATE').AsDate := Trunc(dtp_FeeDate.Date);
       Open;

       if RecordCount > 0 then
       begin
         PRN_DM.tblPatDayFees.Close;
         PRN_DM.bmDayfeePrn.Execute;

         with PRN_DM.InsPatSumFee do
         begin
           Parambyname ('PINID').AsInteger      := finid;
           Parambyname ('PTIMES').AsSmallint    := ftimes;
           Parambyname ('PSQID').AsSmallint     := fsqid;
           Parambyname ('PPNTBLDATE').AsDate    := Trunc(dtp_FeeDate.Date);
           Parambyname ('PLASTREMAIN').AsFloat  := PLastRemain;
           Parambyname ('PPREPAYTOTAL').AsFloat := PPrepaytotal;
           ExecSQL;
         end;
       end;
       close;
     end;


     pbar2.Position := i + 1;
     label2.Caption := format('%3.0f',[((i + 1)/ j )*100])+'%';
     label2.Refresh;
   end;

   frmDayFeeView.Show;
   frmDayFeeView.Display (j);

   pbar2.Position := 0;
   label2.Visible := False;

   if DM.ProjHisadt.InTransaction then
      DM.ProjHisadt.Commit;
 except
   HisErrorPrompt('打印清单出现错误，请认真核对数据！');
   if DM.ProjHisadt.InTransaction then
      DM.ProjHisadt.Rollback;

   gdCurBeds.SelectedList.Clear;
 end;
end;

procedure TfrmQryPrn.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  gdCurBeds.SelectedList.Clear;
  Prn_DM.qryCurrBeds.Close;
end;

procedure TfrmQryPrn.btnIvdripClick(Sender: TObject);
begin
  IvdripPopMenu.Popup(frmQryPrn.Left + Panel1.Left
                                     + gbUseage.Left + btnIvdrip.Left + 5 ,
                      frmQryPrn.Top  + Panel1.Top
                                     + gbUseage.Top  + btnivdrip.Top
                                     + btnivdrip.Height);
end;

procedure TfrmQryPrn.iv1Click(Sender: TObject);
begin
  PrnIvdripCard(1 ,1);
end;

procedure TfrmQryPrn.iv2Click(Sender: TObject);
begin
  PrnIvdripCard(1 ,0);
end;

procedure TfrmQryPrn.iv3Click(Sender: TObject);
begin
  PrnIvdripCard(0 ,1);
end;

procedure TfrmQryPrn.iv4Click(Sender: TObject);
begin
  PrnIvdripCard(0 ,0);
end;

procedure TfrmQryPrn.btnWardSumMedClick(Sender: TObject);
begin
pmPrnSumMed.Popup(frmQryPrn.Left + Panel1.Left
                                     + btnWardSumMed.Left + 5 ,
                      frmQryPrn.Top  + Panel1.Top
                                     + btnWardSumMed.Top
                                     + btnWardSumMed.Height);
end;

procedure TfrmQryPrn.mmSendOPClick(Sender: TObject);
begin
  PrnWardSumBill(0 ,1 ,'01');
end;

procedure TfrmQryPrn.mmSendNPOClick(Sender: TObject);
begin
   PrnWardSumBill(1 ,1 ,'01');
end;

procedure TfrmQryPrn.mmAtoncePOClick(Sender: TObject);
begin
  PrnWardSumBill(0 ,1 ,'02')
end;

procedure TfrmQryPrn.mmAtonceNPOClick(Sender: TObject);
begin
  PrnWardSumBill(1 ,1 ,'02')
end;

procedure TfrmQryPrn.mmChineseMedClick(Sender: TObject);
begin
  PrnWardSumBill(0 ,3,'%')
end;

procedure TfrmQryPrn.pmPntblDateClick(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 SQID = :I_SQID ');
    SQL.Add('  AND PNTBLDATE = :I_PRNDATE ');
    SQL.Add('  AND PRICE <> 0 ');
    SQL.Add('GROUP BY INID ,TIMES ,SQID ,ICLASS ,ITEMID ');
    SQL.Add('ORDER BY ICLASS ,ITEMID');
  end;

  PrnPatDayfeeDtl;
end;

procedure TfrmQryPrn.pmCostDateClick(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 SQID = :I_SQID ');
    SQL.Add('   AND COSTDATE = :I_PRNDATE ');
    SQL.Add('   AND PRICE <> 0 ');
    SQL.Add('GROUP BY INID ,TIMES ,SQID ,ICLASS ,ITEMID ');
    SQL.Add('ORDER BY ICLASS ,ITEMID');
  end;

  PrnPatDayfeeDtl;
end;

procedure TfrmQryPrn.mmSendDtlPOClick(Sender: TObject);
begin
  PrnWardDtlBill(0 ,1 ,'%');
end;

procedure TfrmQryPrn.mmSendDtlNPOClick(Sender: TObject);
begin
  PrnWardDtlBill(1 ,1 ,'%');
end;

procedure TfrmQryPrn.mmAtonceDtlPOClick(Sender: TObject);
begin
  PrnWardDtlBill(0 ,1 ,'02');
end;

procedure TfrmQryPrn.mmAtonceDtlNPOClick(Sender: TObject);
begin
  PrnWardDtlBill(1 ,1 ,'02');
end;

end.