Due to some technical error All Project source code & Project report are now available on www.ignousupport.blogspot.com Download all project for free
Bills
Dim EditMode As Boolean
Dim ADDMode As Boolean
Dim VData As VoucherDataType
Dim rst As New ADODB.Recordset
Dim rst1 As New ADODB.Recordset
Dim RS As New ADODB.Recordset
Dim rst2 As New ADODB.Recordset
Public a As Variant
Public s As Integer
Private Sub SetSearchEngines()
On Error GoTo ErHand
'Populate all search list
'Called in Form_Load()
With BillSrch
.DBConnectString = ConnectString
.WithAlias = False
.SQLString = "SELECT BillNo,convert(nvarchar,BillNo) + ' Paid By : ' + PaidBy + ' Bill Date: ' + convert(nvarchar,billdate) FROM Bill"
.PopulateList
Set .BoundTextBox = Me.txtbl
End With
ErHand:
ErrHandler "Bills.SetSearchEngines()"
End Sub
Private Sub txtbl_GotFocus()
On Error Resume Next
If Not EditMode Then Exit Sub
BillSrch.SearchValue txtbl.Text
BillSrch.PopulateList
End Sub
Private Sub txtbl_LostFocus()
On Error GoTo ErHand
If Not EditMode Then Exit Sub
If txtbl.Text = "" Then Exit Sub
Set rst = New ADODB.Recordset
rst.Open "select * from bill where billno = " & Val(txtbl) & "", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = True Then MsgBox "Bill No. does not exist", vbInformation: Exit Sub
If Not rst!Status = "OK" Then MsgBox "This is Cancelled Bill ", vbExclamation + vbDefaultButton1 + vbMsgBoxRtlReading
'txtbl = Rst!billno
txtte = rst!estimate_amount
txtla = rst!Advance
Text3 = rst!DISCOUNT
txttp = rst!Amount_paid
Text2 = rst!Total_Due
txtbal = rst!BALANCE
DTPicker = rst!BillDate
txtRegNo = rst!registrationno
'==================================================================
'======================= Check If the Patient is Discharge==============
'==================================================================
Set rst = New Recordset
rst.Open "select * from addmission where refno = " & Me.txtRegNo & " Order By DoA Desc", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = False Then
TxtPatientName = rst!Name
TxtBedNo = rst!bedno
TxtDianosis = rst!Diagnosis
txtBedCategory.Text = rst!catname
TxtDoctor = rst!docincharge
TxtAddmissionDate = rst!doa
If IsNull(rst.Fields("dod")) = True Then
MsgBox "Patient is not discharged", vbInformation
Else
TxtDischargeDate = rst!dod
End If
End If
rst.Close
'==================================================================
MSFlexGrid1.Rows = 1
MSFlexGrid1.Cols = 3
MSFlexGrid1.ColWidth(0) = 0
Set rst = New Recordset
rst.Open "select * from billdetail where BillNo = " & Val(Me.txtbl) & " order by SerialNo", Conn, adOpenDynamic, adLockOptimistic
MSFlexGrid1.FormatString = "SR. No | Description | Amount"
If IsNull(rst!serialno) = False Then
Do While Not rst.EOF = True
Me.MSFlexGrid1.AddItem rst!serialno & "" & Chr(9) & rst!Discription & "" & Chr(9) & rst!amount & ""
rst.MoveNext
Loop
End If
rst.Close
Conn.Execute "delete from billAdd where billno = " & txtbl & ""
Conn.Execute "insert into billAdd select * from billdetail where billno = " & txtbl & ""
ErHand:
ErrHandler "Bills.TxtBl_LostFocus()"
End Sub
Private Sub CmdEdit_Click()
Call billEdit
End Sub
Public Sub billEdit()
On Error GoTo ErHand
If cmdedit.Caption = "&Update" Then
Conn.Execute "update bill set Estimate_Amount = " & txtte & " where BillNo = " & txtbl.Text & " "
Conn.Execute "update bill set Total_Due = " & Text2 & " where BillNo = " & txtbl.Text & ""
Conn.Execute "update bill set Balance = " & txtbal & " where BillNo = " & txtbl.Text & ""
Conn.Execute "update bill set discount = " & Text3 & " where BillNo = " & txtbl.Text & ""
Conn.Execute "update bill set Amount_Paid = " & txttp & " where BillNo = " & txtbl.Text & ""
Conn.Execute "update bill set Advance = " & txtla & " where BillNo = " & txtbl.Text & ""
Conn.Execute "delete from billdetail where billno = " & txtbl.Text & ""
Conn.Execute "insert into billdetail select * from billadd where billno = " & txtbl.Text & ""
VData = GetVoucherData("Bill No : " & txtbl.Text)
VData.AcCode = GetAccount(TxtPatientName.Text)
VData.ACContra = "000040"
VData.DrAmt = Val(txtbal.Text)
VData.CrAmt = 0
VData.Narration1 = "Bill No : " & txtbl.Text
VData.Narration2 = "Reg No : " & txtRegNo.Text
VData.vDate = Format(DTPicker, "dd-MMM-yyyy")
VData.VType = "PB"
Call InsertToAccount(ADDMode, VData)
MsgBox "RECORD! UPDATED", vbInformation
Call CmdNew_Click
Else
EditMode = True
Set BillSrch.BoundTextBox = txtbl
cmdedit.Caption = "&Update"
cmdsave.Enabled = False
Command5.Enabled = True
cmddelete.Enabled = True
cmdprint.Enabled = True
txtbl.SetFocus
End If
ErHand:
ErrHandler "Bills.CmdEdit_Click()"
End Sub
Private Sub CmdDelete_Click()
On Error GoTo ErHand
If txtbl.Text = "" Then MsgBox "Please Select The Bill Number", vbInformation: txtbl.SetFocus: Exit Sub
i = MsgBox("Are you Sure to delete the record", vbQuestion + vbYesNo)
If i = vbNo Then Exit Sub
Conn.Execute "delete from bill where billno = " & txtbl.Text & ""
Conn.Execute "delete from billDETAIL where billno = " & txtbl.Text & ""
Conn.Execute " Delete from Voucher Where VoucherType='Bill' And Narr='Bill No : " & txtbl.Text
Conn.Execute " Delete from Voucher Where VoucherType='Bill' And Narr='Reg No : " & txtRegNo.Text
Call CmdNew_Click
If i > 0 Then Exit Sub
MsgBox "No Record Found For Bill Number [ " & txtbl.Text & " ]", vbExclamation, App.Title
ErHand:
ErrHandler "Bills.CmdDelete_Click()"
End Sub
Private Sub CmdSave_Click()
Dim ADDMode As Boolean
Dim VData As VoucherDataType
ADDMode = False
On Error GoTo ErHand
If Text2 = "" Then Text2 = 0
If Text4 = "" Then Text4 = TxtPatientName
If txttp = "" Then txttp = 0
If txtbal = "" Then txtbal = 0
If txtRegNo.Text = "" Then Exit Sub
Dim RstSave As New ADODB.Recordset
RstSave.Open "Select * From Bill where BillNo=" & txtbl.Text & " ", Conn, adOpenDynamic, adLockBatchOptimistic
If RstSave.EOF Then
Dim RstCheck As New ADODB.Recordset
RstCheck.Open "Select * From Bill where RegistrationNo=" & txtRegNo.Text & " order by BillNo Desc ", Conn, adOpenDynamic, adLockBatchOptimistic
If Not RstCheck.EOF Then
i = MsgBox("You Are Going To Add New Bill Of Patient [ " & TxtPatientName.Text & " ]" & vbCrLf & " However You Have Prepared [ Bill Number - " & RstCheck!billno & " ] For This Patient " & vbCrLf & " Are You Sure To Add New Bill ", vbYesNo + vbQuestion + vbDefaultButton2, App.Title)
If i = vbNo Then Exit Sub
End If
ADDMode = True
RstSave.AddNew
Call incrementBillNo
Else
i = MsgBox("You Are Going To Modify Bill Number [ " & txtbl.Text & " ] Of Patient [ " & TxtPatientName.Text & " ] ,Are You Sure ", vbYesNo + vbExclamation, App.Title)
If i = vbNo Then Exit Sub
End If
VData = GetVoucherData("Bill No : " & txtbl.Text)
VData.AcCode = GetAccount(TxtPatientName.Text)
VData.ACContra = "000040"
VData.DrAmt = Val(txtbal.Text)
VData.CrAmt = 0
VData.Narration1 = "Bill No : " & txtbl.Text
VData.Narration2 = "Reg No : " & txtRegNo.Text
VData.vDate = Format(DTPicker, "dd-MMM-yyyy")
VData.VType = "PB"
Call InsertToAccount(ADDMode, VData)
RstSave.Fields("BillNo") = txtbl.Text
RstSave.Fields("BillDate") = Format(DTPicker, "dd-MMM-yyyy")
RstSave.Fields("SerialNo") = s
RstSave.Fields("Estimate_Amount") = Val(txtte.Text)
RstSave.Fields("Discount") = Val(Text3.Text)
RstSave.Fields("Advance") = Val(txtla.Text)
RstSave.Fields("Total_Due") = Val(Text2.Text)
RstSave.Fields("Amount_paid") = Val(txttp.Text)
RstSave.Fields("Balance") = Val(txtbal.Text)
RstSave.Fields("RegistrationNo") = txtRegNo.Text
RstSave.Fields("paidby") = Text4.Text
RstSave.Fields("status") = "OK"
RstSave.UpdateBatch
Set RstSave = Nothing
Conn.Execute "delete from billdetail where billno = " & txtbl & ""
Conn.Execute "insert into billdetail select * from billadd where billno = " & txtbl & ""
Call CmdNew_Click
ErHand:
ErrHandler "Bills.CmdSave_Click()"
End Sub
Private Sub Combo1_Click()
Call discriptionAmount
End Sub
Private Sub Command_Click()
Call DeleteDiscription
End Sub
Public Sub Command1_Click()
Call addInGrid
End Sub
Private Sub Command3_Click()
On Error GoTo ErHand
s = 1
TxtDischargeDate = Date
DTPicker = Date
TxtAddmissionDate = Date
If txtRegNo = "" Then MsgBox "Please Enter Registration No.", vbInformation: txtRegNo.SetFocus: Exit Sub
If EditMode = True Then If MsgBox("This will Create A New Bill For This Patient And Remove All The Changes Made By You After Creating Bill." & vbCrLf & "Are you Sure to Performed This Action ?", vbQuestion + vbYesNo + vbDefaultButton2, "Deletion Confirmation") = vbNo Then Exit Sub
Conn.Execute "delete from billadd"
'==================================================================
'======================= Check If the Patient is Discharge==============
'==================================================================
Set rst = New Recordset
rst.Open "select * from addmission where refno = " & Me.txtRegNo & " Order By DoA Desc", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = False Then
TxtPatientName = rst!Name
TxtBedNo = rst!bedno
TxtDianosis = rst!Diagnosis
txtBedCategory.Text = rst!catname
TxtDoctor = rst!docincharge
TxtAddmissionDate = rst!doa
If IsNull(rst.Fields("dod")) = True Then
MsgBox "Patient is not discharged", vbInformation
Exit Sub
Else
TxtDischargeDate = rst!dod
End If
End If
rst.Close
'==================================================================
'=========== Get Registration Fee From Patient Registration =======
'==================================================================
Set rst = New ADODB.Recordset
rst.Open "select RegistrationFees from Hospital where Registration= " & txtRegNo & " ", Conn, adOpenDynamic, adLockOptimistic
If IsNull(rst!registrationfees) = False And rst.EOF = False Then
Conn.Execute "insert into billadd values(" & txtbl & "," & s & ",'Registration Fees'," & rst.Fields(0) & "," & txtRegNo & ")"
End If
Call connect
Call incrementSerialNo
'==================================================================
'====================== Getting Bed Charge Of Patient=============
'==================================================================
Set rst = New Recordset
rst.Open "select catname,bedno,doa,dod,aot,dot from addmission1 where refno= " & txtRegNo & " And DoA='" & Format(TxtAddmissionDate, "dd-MMM-yyyy") & "' Order by DoA ", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = False Then
Dim a, b, c, d, e As Integer
Dim Cat As String
While Not rst.EOF
If IsNull(rst.Fields("dod")) = True Then
MsgBox "Patient is not discharged", vbInformation
Else
a = rst!dod - rst!doa
d = DateDiff("H", rst!dot, rst!aot)
e = Round(((a * 24) + d) / 24)
If e = 0 Then e = 1
End If
Cat = rst!catname
Set rst1 = New Recordset
rst1.Open "select rate from beddetail where detail= '" & Cat & "' ", Conn, adOpenDynamic, adLockOptimistic
If rst1.EOF = False Then b = Val(e) * Val(rst1.Fields(0)): c = Val(c) + Val(b)
rst.MoveNext
Wend
Set rst = Nothing
Conn.Execute "insert into billadd values(" & txtbl & "," & s & ",'To Bed Charges'," & c & "," & txtRegNo & ")"
End If
'==================================================================
'====================== Getting All Amount Of Work Done===========
'==================================================================
Call incrementSerialNo
Set rst = New Recordset
rst.Open "Select Sum(amount),WORKDONE from workdone where Regno = " & txtRegNo & " And VisitDate >='" & Format(TxtAddmissionDate, "dd-MMM-yyyy") & "' GROUP BY WORKDONE", Conn, adOpenDynamic, adLockOptimistic
If Not IsNull(rst.Fields(0)) Then
While Not rst.EOF = True
Call incrementSerialNo
Conn.Execute "insert into billadd values(" & txtbl & "," & s & ",'" & rst.Fields(1) & "'," & rst.Fields(0) & "," & txtRegNo & ")"
rst.MoveNext
Wend
End If
Call connect
'==================================================================
'====================== Get Amount Of Returning Medicine===========
'==================================================================
Dim MEd, TotMed As Long
Set rst = New ADODB.Recordset
rst.Open "Select Sum(Net_Payable) from Sale where ACCode='" & GetAccount(TxtPatientName) & "' And VType='SR' And VDate >='" & Format(TxtAddmissionDate, "dd-MMM-yyyy") & "'", Conn, adOpenDynamic, adLockOptimistic
If Not rst.EOF Then MEd = IIf(IsNull(rst.Fields(0)) = False, rst.Fields(0), 0)
Call incrementSerialNo
'==================================================================
'====================== Get Amount Of Issued Medicine===========
'==================================================================
Set rst = New ADODB.Recordset
rst.Open "Select Sum(Net_Payable) from Sale where ACCode='" & GetAccount(TxtPatientName) & "' And VType='SV' And VDate >='" & Format(TxtAddmissionDate, "dd-MMM-yyyy") & "'", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = False Then
TotMed = IIf(IsNull(rst.Fields(0)) = False, rst.Fields(0), 0) - MEd
Conn.Execute "insert into billadd values(" & txtbl & "," & s & ",'To Medicine Charges'," & TotMed & "," & txtRegNo & ")"
End If
Call connect
'==================================================================
'= Get All Amount From Receipt Table Which is Received From Patient=
'==================================================================
Set rst = New ADODB.Recordset
rst.Open "select sum(CrAmt) -sum(DrAmt) from Voucher where ACCode='" & GetAccount(TxtPatientName) & "' And VType='ST' And VDate >='" & Format(TxtAddmissionDate, "dd-MMM-yyyy") & "'", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = False Then txtla.Text = IIf(IsNull(rst.Fields(0)) = True, 0, rst.Fields(0))
Call incrementSerialNo
' '==================================================================
' '========================== Get Daily Charges =====================
' '==================================================================
' Set Rst = New Recordset
' Rst.Open "select Doa,Dod from addmission where refno= " & txtRegNo & " order by Doa Desc", Conn, adOpenDynamic, adLockOptimistic
'
' If Rst.EOF = False Then
' a = IIf(IsNull(Rst.Fields("dod")) = True, Date - Rst!doa + 1, Rst!dod - Rst!doa + 1)
' Set Rst = New ADODB.Recordset
' Rst.Open "select Discription,amount from dailymast ", Conn, adOpenDynamic, adLockOptimistic
' If IsNull(Rst.Fields(0)) = False Then
' While Not Rst.EOF = True
' Call incrementSerialNo
' Conn.Execute "insert into billadd values(" & txtbl & "," & s & ",'" & Rst.Fields(0) & "'," & Rst.Fields(1) & " * " & a & "," & txtRegNo & ")"
' Rst.MoveNext
' Wend
' End If
' End If
' '==================================================================
Call connect
Set rst = New ADODB.Recordset
rst.Open "select Sum(Amount) from BillAdd where id = " & txtRegNo & " ", Conn, adOpenDynamic, adLockOptimistic
txtte.Text = IIf(IsNull(rst.Fields(0)) = False, rst.Fields(0), 0)
Text2 = Val(txtte) - Val(txtla)
txtbal = Text2
ErHand:
ErrHandler "Bills.Command3(Bill)"
End Sub
Private Sub Command4_Click()
On Error GoTo ErHand
If txtbl = "" Then
MsgBox "Please Enter Bill No.", vbInformation
txtbl.SetFocus
Exit Sub
End If
MSFlexGrid1.Clear
MSFlexGrid1.ColWidth(0) = 0
MSFlexGrid1.Rows = 1
MSFlexGrid1.Cols = 3
MSFlexGrid1.FormatString = "SR. No | Description | Amount"
TxtDianosis.Text = ""
TxtDoctor.Text = ""
TxtBedNo = ""
Text2 = ""
txtbal = ""
txtBedCategory.Text = ""
txtla = ""
TxtPatientName = ""
txtte = ""
Text3 = ""
txttp = ""
Text4 = ""
Dim bl As Integer
Set rst = New Recordset
rst.Open "select registrationno from bill where billno = " & Me.txtbl & "", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = True Then
MsgBox "This Bill No. does not exist", vbInformation
Else
bl = rst.Fields(0)
End If
Set rst = New Recordset
rst.Open "select * from addmission where refno = " & bl & "", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = False Then
TxtPatientName = rst!Name
TxtBedNo = rst!bedno
TxtDianosis = rst!Diagnosis
If IsNull(rst.Fields("dod")) = True Then
MsgBox "Patient is not discharged", vbInformation
Else
TxtDischargeDate = rst!dod
End If
txtBedCategory.Text = rst!catname
TxtDoctor = rst!docincharge
TxtAddmissionDate = rst!doa
End If
'================================================================
Set rst = New ADODB.Recordset
rst.Open "select * from bill where billno = " & bl & " ", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = False Then
DTPicker = rst!BillDate
txtte = rst!estimate_amount
Text3 = rst!DISCOUNT
txtla = rst!Advance
Text2 = rst!Total_Due
txttp = rst!Amount_paid
txtbal = rst!BALANCE
Text4 = rst!paidby
txtRegNo = rst!registrationno
End If
Set rst = New ADODB.Recordset
rst.Open "select * from billdetail where billno = " & txtbl & " ", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = False Then
While Not rst.EOF = True
Me.MSFlexGrid1.AddItem rst!serialno & "" & Chr(9) & rst!Discription & "" & Chr(9) & rst!amount & ""
rst.MoveNext
Wend
End If
Set rst = Nothing
ErHand:
ErrHandler "Bills.Command4_Click()"
End Sub
Private Sub Command5_Click()
On Error GoTo ErHand
Dim i As String
If txtbl.Text = "" Then Exit Sub
rst.Open "select * from BILL where BILLNO = " & Val(txtbl.Text) & "", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = True Then MsgBox "Bill No. Not Found", vbInformation: rst.Close: Exit Sub
X = MsgBox("Are You Sure To Cancel The Bill", vbQuestion + vbYesNo, "Modify Record")
If X = vbNo Then Exit Sub
Conn.Execute "update bill set status = 'CANCEL' where billno = " & Val(txtbl.Text) & ""
Call CmdNew_Click
ErHand:
ErrHandler "Bills.Command5_Click() [Bill Cancellation]"
End Sub
Private Sub Form_Load()
On Error GoTo ErHand
Me.Top = (MDIForm1.ScaleHeight - Me.Height) / 2
Me.Left = 2540
Call SetSearchEngines
Call CmdNew_Click
DTPicker = Date
TxtDischargeDate = Date
TxtPatientName = registration.TxtTitle & " " & registration.txtfirst & " " & registration.txtmiddle & " " & registration.txtlast
TxtDoctor = registration.TxtDoctorIncharge.Text
txtRegNo.Text = registration.txtRegNo
'Call incrementBillNo
If txtRegNo.Text = "" Then Exit Sub
Set rst = New ADODB.Recordset
rst.Open "select doa,catname,bedno,diagnosis,dod from addmission where refno=" & registration.txtRegNo & " order by doa desc", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = False Then
'Rst.MoveLast
Me.txtBedCategory.Text = rst!catname & ""
Me.TxtAddmissionDate = rst!doa & ""
Me.TxtBedNo = rst!bedno & ""
Me.TxtDianosis = rst!Diagnosis & ""
If Not IsNull(rst!dod) Then TxtDischargeDate = rst!dod & ""
Else
rst.Close
End If
MSFlexGrid1.Rows = 1
txtbal.Locked = True
txtBedCategory.Locked = True
TxtPatientName.Locked = True
txtte.Locked = True
Text2.Locked = True
TxtDianosis.Locked = True
TxtDoctor.Locked = True
Set rst = New Recordset
rst.Open "select * from billmast", Conn, adOpenDynamic, adLockOptimistic
While Not rst.EOF
Combo1.AddItem rst!Discription
rst.MoveNext
Wend
Set rst = Nothing
ErHand:
ErrHandler "Bills.Form_Load()"
End Sub
Public Sub display()
On Error GoTo ErHand
txtRegNo.Text = a
TxtPatientName.Text = rst!Name
TxtAddmissionDate = rst!doa
TxtDoctor = rst!docincharge
TxtDianosis = rst!Diagnosis
txtBedCategory.Text = rst!catname
ErHand:
ErrHandler "Bills.Display()"
End Sub
Public Sub connect()
On Error Resume Next
MSFlexGrid1.Rows = 1
MSFlexGrid1.Cols = 3
Set rst = New Recordset
rst.Open "select * from billadd where billno =" & Val(txtbl.Text) & " order by serialno", Conn, adOpenDynamic, adLockOptimistic
MSFlexGrid1.FormatString = "SR. No | Description | Amount"
If IsNull(rst!serialno) = False Then
Do While Not rst.EOF = True
Me.MSFlexGrid1.AddItem rst!serialno & "" & Chr(9) & rst!Discription & "" & Chr(9) & rst!amount & ""
rst.MoveNext
Loop
End If
rst.Close
End Sub
Public Sub totalcharges()
If txtRegNo = "" Then MsgBox "Please Enter Registration No. of Patient", vbInformation: Exit Sub
End Sub
Private Sub Form_Unload(Cancel As Integer)
registration.Enabled = True
End Sub
Public Sub addInGrid()
On Error GoTo ErHand
If txtRegNo = "" Then MsgBox "Enter Patient Registration Number", vbInformation: Exit Sub
If txtpa = "" Then Call connect: Exit Sub
Call incrementSerialNo
Dim RstCheck As New ADODB.Recordset
RstCheck.Open "Select * from BillAdd Where ID=" & txtRegNo.Text & " And Discription='" & Combo1.Text & "'", Conn, adOpenDynamic, adLockBatchOptimistic
If Not RstCheck.EOF = True Then
Dim i As Integer
i = MsgBox("You Are Going To Add Duplicate Charge [ " & Combo1.Text & " ] " & vbCrLf & "To Patient [" & TxtPatientName.Text & " ] " & vbCrLf & " Do You Want To Continue........ ", vbYesNo + vbExclamation, App.Title)
If i = vbNo Then Exit Sub
Set RstCheck = Nothing
End If
Dim SQL As String
Dim rst As New ADODB.Recordset
rst.CursorLocation = adUseClient
SQL = "SELECT * FROM BillAdd "
rst.Open SQL, Conn, adOpenKeyset, adLockOptimistic, adCmdText
With Me
rst.AddNew
rst("BillNo") = txtbl.Text
rst("SerialNo") = s
rst("Discription") = .Combo1.Text & ""
rst("Amount") = Val(.txtpa) & ""
rst("ID") = Trim(.txtRegNo) & ""
rst.UpdateBatch
End With
Call connect
Set rst = New Recordset
rst.Open "select Sum(Amount) from BillAdd where id = " & Val(txtRegNo) & " ", Conn, adOpenDynamic, adLockOptimistic
If Not rst.EOF Then txtte.Text = rst.Fields(0)
Set rst = Nothing
ErHand:
ErrHandler "Bills.AddInGrid()"
End Sub
Public Sub DeleteDiscription()
On Error GoTo ErHand
Dim Cancelled As Boolean
Dim SQL As String
Dim rst As New ADODB.Recordset
rst.CursorLocation = adUseClient
If Me.txtbl = "" Then MsgBox "Please Enter Bill Number To Delete.", vbCritical, "Bill Number Not Found": Exit Sub
If MSFlexGrid1.RowSel = 0 Then Exit Sub
If MsgBox("This will Delete Selected Item [" & MSFlexGrid1.TextMatrix(MSFlexGrid1.RowSel, 1) & "]. Are you sure to delete it ?", vbQuestion + vbYesNo + vbDefaultButton2, "Deletion Confirmation") = vbNo Then Cancelled = True: GoTo ExitLable
'Delete Item
SQL = "Delete From BillAdd where SerialNo = " & MSFlexGrid1.TextMatrix(MSFlexGrid1.RowSel, 0) & " and BillNo=" & txtbl & ""
Conn.Execute SQL, , adCmdText
Call connect
Set rst = New Recordset
rst.Open "select Sum(Amount) from BillAdd where id = " & txtRegNo & " ", Conn, adOpenDynamic, adLockOptimistic
If IsNull(rst.Fields(0)) = True Then Exit Sub
txtte.Text = rst.Fields(0)
Set rst = Nothing
ExitLable:
ErHand:
ErrHandler "Bills.DeleteDiscription()"
End Sub
Public Sub incrementSerialNo()
On Error Resume Next
Set rst2 = New ADODB.Recordset
rst2.Open "select max(serialno) from Billadd ", Conn, adOpenDynamic, adLockOptimistic
s = IIf(IsNull(rst2.Fields(0)) = False, rst2.Fields(0) + 1, 1)
Set rst2 = Nothing
End Sub
Public Sub incrementBillNo()
On Error Resume Next
Set rst = New Recordset
rst.Open "select max(BillNo) from Bill", Conn, adOpenDynamic, adLockOptimistic
txtbl.Text = IIf(IsNull(rst.Fields(0)) = False, rst.Fields(0) + 1, 1)
Set rst = Nothing
End Sub
Private Sub Text3_Change()
Text2 = Val(txtte) - Val(txtla) - Val(Text3)
txtbal = Text2
End Sub
Public Sub discriptionAmount()
On Error Resume Next
Set rst = New Recordset
rst.Open "select * from billmast where discription = '" & Combo1 & "'", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF Or rst.BOF = True Then Exit Sub
txtpa = rst!amount
Set rst = Nothing
End Sub
Public Sub blank()
txtRegNo = ""
TxtDianosis.Text = ""
TxtDoctor.Text = ""
TxtBedNo = ""
Text2 = ""
txtbal = ""
txtBedCategory.Text = ""
txtbl = ""
txtla = ""
TxtPatientName = ""
txtte = ""
Text3 = ""
txttp = ""
Text4 = ""
End Sub
Private Sub CmdNew_Click()
On Error GoTo ErHand
Call blank
Call incrementBillNo
cmdedit.Caption = "&Edit"
EditMode = False
cmddelete.Enabled = False
cmdprint.Enabled = False
cmdsave.Enabled = True
Command5.Enabled = False
Set BillSrch.BoundTextBox = Nothing
MSFlexGrid1.Clear
MSFlexGrid1.ColWidth(0) = 0
MSFlexGrid1.Rows = 1
MSFlexGrid1.Cols = 3
MSFlexGrid1.FormatString = "SR. No | Description | Amount"
cmdsave.Enabled = True
ErHand:
ErrHandler "Bills.CmdNew_Click()"
End Sub
Private Sub CmdClose_Click()
Unload Me
End Sub
Private Sub CmdPrint_Click()
On Error Resume Next
DataEnvironment1.Recordsets.Item("command9").Close
DataEnvironment1.Recordsets.Item("command9").Open "select id,discription,amount from billadd where id=" & Val(txtRegNo) & "", Conn, adOpenDynamic, adLockOptimistic
BillReport.Sections(1).Controls("label2").Caption = txtbl
BillReport.Sections(1).Controls("label12").Caption = DTPicker
BillReport.Sections(1).Controls("label6").Caption = txtRegNo
BillReport.Sections(1).Controls("label8").Caption = TxtPatientName
BillReport.Sections(1).Controls("label10").Caption = TxtBedNo
BillReport.Sections(1).Controls("label20").Caption = txtBedCategory.Text
BillReport.Sections(1).Controls("label18").Caption = TxtDianosis
BillReport.Sections(1).Controls("label14").Caption = TxtAddmissionDate
BillReport.Sections(1).Controls("label16").Caption = TxtDischargeDate
BillReport.Sections(5).Controls("label25").Caption = Text3
BillReport.Sections(5).Controls("label26").Caption = Val(txtte) - Val(Text3)
BillReport.Sections(1).Controls.Item("label57").Caption = hos_name
BillReport.Sections(1).Controls.Item("label58").Caption = hos_add
BillReport.Sections(5).Controls("label28").Caption = txtbal
BillReport.Sections(5).Controls("label30").Caption = txtla
If Val(Text3) > 0 Then
BillReport.Sections(5).Controls("label23").Visible = True
BillReport.Sections(5).Controls("label25").Visible = True
End If
BillReport.Show
End Sub
Sponsored Links