⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 patidata.pas

📁 某大型医院护士站
💻 PAS
字号:
unit PatiData;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls, DBCtrls, ToolWin, ComCtrls, DBTables,
  wwrcdvw, wwdblook, DB, qrprntr, wwDialog;

type
  TfrmPatiData = class(TForm)
    PageControl1 :TPageControl;
    TabSheet1: TTabSheet;
    Panel1: TPanel;
    Label1: TLabel;
    DBText1: TDBText;
    Label2: TLabel;
    Label17: TLabel;
    DBText3: TDBText;
    Label3: TLabel;
    Label4: TLabel;
    DBText4: TDBText;
    Label25: TLabel;
    DBText5: TDBText;
    txtCareerNm: TDBText;
    txtBirthAddr: TDBText;
    Label28: TLabel;
    Label9: TLabel;
    txtMarrStat: TDBText;
    Label23: TLabel;
    txtIcid: TDBText;
    txtBirthDay: TDBText;
    Label7: TLabel;
    Label24: TLabel;
    txtNationNm: TDBText;
    txtSexName: TDBText;
    Label6: TLabel;
    Label27: TLabel;
    txtCountryNm: TDBText;
    txtName: TDBText;
    Label5: TLabel;
    Label26: TLabel;
    Label8: TLabel;
    DBText15: TDBText;
    Label29: TLabel;
    DBText16: TDBText;
    txtRlphone: TDBText;
    Label13: TLabel;
    Label31: TLabel;
    DBText21: TDBText;
    txtRelationNm: TDBText;
    Label22: TLabel;
    txtRlname: TDBText;
    Label11: TLabel;
    Label30: TLabel;
    txtRlAddr: TDBText;
    Label32: TLabel;
    txtCorpName: TDBText;
    Label10: TLabel;
    txtCorpPhone: TDBText;
    txtCorpZipcode: TDBText;
    Label34: TLabel;
    txtCorpAddr: TDBText;
    Label33: TLabel;
    Label12: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    DBText30: TDBText;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Bevel3: TBevel;
    Bevel4: TBevel;
    DBText2: TDBText;
    PrepayAmt: TLabel;
    FeeAmt: TLabel;
    lcMarry: TwwDBLookupCombo;
    lcCountry: TwwDBLookupCombo;
    lcNation: TwwDBLookupCombo;
    lcSex: TwwDBLookupCombo;
    lcCondition: TwwDBLookupCombo;
    lcRelation: TwwDBLookupCombo;
    btnModiData: TBitBtn;
    btnModiInid: TBitBtn;
    btnPrintHead: TBitBtn;
    PayWarn: TLabel;
    DBNavigator1: TDBNavigator;
    btnFeeView: TBitBtn;
    btnExit: TBitBtn;
    rvPatientData: TwwRecordViewDialog;
    lcCareer: TwwDBLookupCombo;
    lcbal: TwwDBLookupCombo;
    procedure FormShow(Sender: TObject);
    procedure DBNavigator1Click(Sender: TObject; Button: TNavigateBtn);
    procedure btnFeeViewClick(Sender: TObject);
    procedure btnModiInidClick(Sender: TObject);
    procedure btnModiDataClick(Sender: TObject);
    procedure btnPrintHeadClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmPatiData: TfrmPatiData;

implementation

{$R *.DFM}
uses datamodule, FeeBrow, ModiInid;

procedure PaymentCal;
var
FeeVar, PrepayVar : double;
begin
{
try
  with DM do begin
    spPrePayTotal.Close;
    DM.ProjHisadt.StartTransaction;
    spPrePayTotal.Params[0].AsInteger  := PatiDataInid.AsInteger;
    spPrePayTotal.Params[1].AsSmallInt := PatiDataTimes.Value;
    spPrePayTotal.ExecProc;
    DM.ProjHisadt.Commit;
    PrepayVar := spPrePayTotal.Params[2].AsFloat;

    spFeeTotal.Close;
    DM.ProjHisadt.StartTransaction;
    spFeeTotal.Params[0].AsInteger  := PatiDataInid.AsInteger;
    spFeeTotal.Params[1].AsSmallInt := PatiDataTimes.Value;
    spFeeTotal.ExecProc;
    DM.ProjHisadt.Commit;
    FeeVar := spFeeTotal.params[2].AsFloat;

  end;

  frmPatiData.PrepayAmt.Caption := Format('%8.2f',[PrepayVar]);
  frmPatiData.FeeAmt.Caption := Format('%8.2f',[FeeVar]);

  if PrepayVar-FeeVar <= 500.00 then
    frmPatiData.PayWarn.Caption := '[ 按金不足!!! ]'
  else
    frmPatiData.PayWarn.Caption := '';
except
  if DM.ProjHisadt.InTransaction then
     DM.ProjHisadt.Rollback;
end;
}
end;

procedure TfrmPatiData.FormShow(Sender: TObject);
begin
 With DM do
  begin
   qryPatInfo.Close;
   qryPatInfo.Params[0].AsString := CurrWardID ;
   qryPatInfo.Open;   //Pruduce Current Used Beds
   if not qryPatInfo.Locate('Bed',CurrBedNo,[]) then
      qryPatInfo.First;       // Move to current beds number

  // calculate prepay amount and fee amount, and display them...
  // PaymentCal;
 end;
end;

procedure TfrmPatiData.DBNavigator1Click(Sender: TObject;
  Button: TNavigateBtn);
begin
  PaymentCal;
end;

procedure TfrmPatiData.btnFeeViewClick(Sender: TObject);
//var
  //bedfees,otherfees : Real;
begin
  {bedfees := 0.00;
  otherfees := 0.00;
  // following blocks produce feeclass table

  //this block calculate SurgenItem amount
  DM.FeeClass.Close;
  DM.FeeCalc.Close;
  DM.FeeCalc.SQL.Clear;
  DM.FeeCalc.SQL.Add ( 'Select IClass,Sum(Amt) amt From SurgenItem ');
  DM.FeeCalc.SQL.Add ( 'Where INID = :PInid And Times = :PTimes And Pay = 0 Group By 1 ');
  DM.FeeCalc.ParamByName('PInid').AsInteger := DM.PatiDataInid.AsInteger;
  DM.FeeCalc.ParamByName('PTimes').AsInteger := DM.PatiDatatimes.AsInteger;
  DM.FeeCalc.prepare;
  DM.FeeCalc.Open;

  DM.MoveFeeClass.Mode := batCopy;
  DM.MoveFeeClass.Execute;      //copy to FeeClass table

  //this block calculate Material amount;
  DM.FeeCalc.Close;
  DM.FeeCalc.SQL.Clear;
  DM.FeeCalc.SQL.Add ( 'Select IClass,Sum(Amt) amt From Material ');
  DM.FeeCalc.SQL.Add ( 'Where INID = :PInid And Times = :PTimes And Pay = 0 Group By 1 ');
  DM.FeeCalc.ParamByName('PInid').AsInteger := DM.PatiDataInid.AsInteger;
  DM.FeeCalc.ParamByName('PTimes').AsInteger := DM.PatiDatatimes.AsInteger;
  DM.FeeCalc.prepare;
  DM.FeeCalc.Open;

  DM.MoveFeeClass.Mode := batAppend;
  DM.MoveFeeClass.Execute;      // append to FeeClass table
  DM.FeeClass.Close;

  //this block calculate OutMedicine amount;
  DM.FeeCalc.Close;
  DM.FeeCalc.SQL.Clear;
  DM.FeeCalc.SQL.Add ( 'Select IClass,Sum(Amt) amt From OutMedicine ');
  DM.FeeCalc.SQL.Add ( 'Where INID = :PInid And Times = :PTimes And Pay = 0 Group By 1 ');
  DM.FeeCalc.ParamByName('PInid').AsInteger := DM.PatiDataInid.AsInteger;
  DM.FeeCalc.ParamByName('PTimes').AsInteger := DM.PatiDatatimes.AsInteger;
  DM.FeeCalc.prepare;
  DM.FeeCalc.Open;

  DM.MoveFeeClass.Execute;
  DM.FeeClass.Close;

  //this block calculate OrderItem amount;
  DM.FeeCalc.Close;
  DM.FeeCalc.SQL.Clear;
  DM.FeeCalc.SQL.Add ( 'Select IClass,Sum(Price*Qty) amt From CostItem ');
  DM.FeeCalc.SQL.Add ( 'Where INID = :PInid And Times = :PTimes And Pay = 0 Group By 1 ');
  DM.FeeCalc.ParamByName('PInid').AsInteger := DM.PatiDataInid.AsInteger;
  DM.FeeCalc.ParamByName('PTimes').AsInteger := DM.PatiDatatimes.AsInteger;
  DM.FeeCalc.prepare;
  DM.FeeCalc.Open;

  DM.MoveFeeClass.Execute;
  DM.FeeClass.Close;

  // following lines calculate bedFees and other fees
  DM.BedFee.close;      // BedFee is a query to fetch bed cost records
  DM.BedFee.ParamByName('PInid').AsInteger := DM.PatiDataInid.AsInteger;
  DM.BedFee.ParamByName('PTimes').AsInteger := DM.PatiDatatimes.AsInteger;
  DM.BedFee.prepare;
  DM.BedFee.Open;
  with DM,BedFee do begin
    First;
    While not Eof do begin
      if BedFeeOutDate.isnull then begin
        bedfees := bedfees + BedFeeRoomFee.Asfloat * (Trunc( Now - BedFeeindate.AsDateTime)+1);
        otherfees := otherfees + ( BedFeeCheckfee.AsFloat + BedFeeTvfee.AsFloat +
                     BedFeeAcfee.AsFloat + BedFeetelfee.AsFloat ) * (Trunc( Now - BedFeeindate.AsDateTime )+1);
        end
      else begin
        bedfees := bedfees + BedFeeRoomFee.Asfloat * (Trunc( BedFeeOutDate.AsDateTime - BedFeeindate.AsDateTime )+1);
        otherfees := otherfees + ( BedFeeCheckfee.AsFloat + BedFeeTvfee.AsFloat +
                     BedFeeAcfee.AsFloat + BedFeetelfee.AsFloat ) * (Trunc( BedFeeOutDate.AsDateTime - BedFeeindate.AsDatetime)+1);
        end;
      next;
    end;
  end;

  // append bedfee and other fees to FeeClass
  with DM, FeeClass do begin
    Open;
    Append;
    FeeClassIClass.AsString := csRoomFeeClass;   // roomfee has uniq class
    FeeClassAmt.AsFloat := Bedfees;
    Post;
    Append;
    FeeClassIClass.AsString := csOtherFeeClass;   //Modify this line if the other
                                                  //fees have different classes
    FeeClassAmt.AsFloat := OtherFees;
    Post;
  end;}
{ try
    if dm.ProjHisadt.InTransaction then
       dm.ProjHisadt.Commit;
    dm.ProjHisadt.StartTransaction;
    dm.spCheckcost.Params[0].asInteger := DM.PatiDataInid.AsInteger;
    dm.spCheckcost.params[1].asSmallInt := DM.PatiDatatimes.Value;
    dm.spCheckcost.Params[2].asString  := dm.currWardid;
//    dm.spCheckcost.Prepare;
    dm.spCheckcost.ExecProc;
    dm.ProjHisadt.Commit;
  except
  dm.ProjHisadt.Rollback;
  end;
 frmFeeBrow.Showmodal;}
end;

procedure TfrmPatiData.btnModiInidClick(Sender: TObject);
begin
{ frmModiInid.lblOldInid.Caption := inttostr(DM.PatiDataInid.AsInteger);
 frmModiInid.lblOldTimes.Caption := inttostr(DM.PatiDatatimes.AsInteger);
 frmModiInid.edtNewInid.Text := '';
 frmModiInid.edtNewTimes.Text := '';
 frmModiInid.showmodal;}
end;

procedure TfrmPatiData.btnModiDataClick(Sender: TObject);
var currec: TBookMark;
begin
{  DM.Nation.Open;
  DM.CareerTb.Open;
  DM.CountryTb.Open;
  DM.Sex.Open;
  DM.Marry.Open;
  dm.balmthd.open;
  DM.Relation.Open;
  DM.Condition.Open;
  DM.PatientData.Open;
  DM.PatientData.Locate('inid',DM.Patidatainid.asinteger,[]);
  rvPatientData.Execute;

  CURREC := DM.PatiData.Getbookmark;
  DM.PatiData.Close;
  DM.PatiData.Params[0].asstring := DM.CurrWardID ;
  DM.PatiData.Open;

  DM.PatiData.Gotobookmark(currec);
  DM.PatiData.FreeBookmark(currec);
  invalidate;}
end;

procedure TfrmPatiData.btnPrintHeadClick(Sender: TObject);
begin
  //frmPatientHead.Preview;
end;

procedure TfrmPatiData.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  DM.qryPatInfo.Close;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -