Due to some technical error All Project source code & Project report are now available on www.ignousupport.blogspot.com Download all project for free
PROJECT SOURCE CODE
SPONSORED LINKS
OPD BILL
Dim EditMode As Boolean
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()
'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 OPDBill"
.PopulateList
Set .BoundTextBox = Me.txtbl
End With
End Sub
Private Sub Text2_GotFocus()
If Text3 = "" Then
If txtla = "" Then
txtla = 0
Text2 = Val(txtte) - Val(txtla)
Exit Sub
Else
Text2 = Val(txtte) - Val(txtla)
End If
Else
If txtla = "" Then
txtla = 0
Text2 = Val(txtte) - Val(txtla) - Val(Text3)
Exit Sub
Else
Text2 = Val(txtte) - Val(txtla) - Val(Text3)
End If
End If
End Sub
Private Sub txtbal_GotFocus()
If txttp = "" Then
txttp = 0
txtbal = Val(Text2) - Val(txttp)
Exit Sub
Else
txtbal = Val(Text2) - Val(txttp)
End If
End Sub
Private Sub txtbl_GotFocus()
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 opdbill 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
TxtPatientName = rst!paidby & ""
Text3 = rst!DISCOUNT
txttp = rst!Amount_paid
Text2 = rst!Total_Due
txtbal = rst!BALANCE
DTPicker = rst!BillDate
txtRegNo = rst!registrationno
'==================================================================
MSFlexGrid1.Rows = 1
MSFlexGrid1.Cols = 3
MSFlexGrid1.ColWidth(0) = 0
Set rst = New Recordset
rst.Open "select * from opdbilldetail 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 opdbilldetail where billno = " & txtbl & ""
ErHand:
ErrHandler "OPDBill.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 opdbill set Estimate_Amount = " & txtte & " where BillNo = " & txtbl.Text & " "
Conn.Execute "update opdbill set Total_Due = " & Text2 & " where BillNo = " & txtbl.Text & ""
Conn.Execute "update opdbill set Balance = " & txtbal & " where BillNo = " & txtbl.Text & ""
Conn.Execute "update opdbill set discount = " & Text3 & " where BillNo = " & txtbl.Text & ""
Conn.Execute "update opdbill set Amount_Paid = " & txttp & " where BillNo = " & txtbl.Text & ""
Conn.Execute "delete from opdbilldetail where billno = " & txtbl.Text & ""
Conn.Execute "insert into opdbilldetail select * from billadd where billno = " & txtbl.Text & ""
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 "OPDBill.BillEdit()"
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 OPDbill where billno = " & txtbl.Text & ""
Conn.Execute "delete from OPDbillDETAIL where billno = " & txtbl.Text & ""
Call CmdNew_Click
If i > 0 Then Exit Sub
MsgBox "No Record Found For Bill Number [ " & txtbl.Text & " ]", vbExclamation, App.Title
ErHand:
ErrHandler "OPDBill.CmdDelete_Click()"
End Sub
Private Sub CmdSave_Click()
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 OPDBill where BillNo=" & txtbl.Text & " ", Conn, adOpenDynamic, adLockBatchOptimistic
If RstSave.EOF Then
Dim RstCheck As New ADODB.Recordset
RstCheck.Open "Select * From OPDBill 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
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
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
Conn.Execute "delete from opdbilldetail where billno = " & txtbl & ""
Conn.Execute "insert into opdbilldetail select * from billadd where billno = " & txtbl & ""
Conn.Execute "Delete from BillAdd"
Call CmdNew_Click
ErHand:
ErrHandler "OPDBill.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 Command5_Click()
On Error GoTo ErHand
Dim i As String
If txtbl.Text = "" Then Exit Sub
rst.Open "select * from OPDBILL 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 opdbill set status = 'CANCEL' where billno = " & Val(txtbl.Text) & ""
Call CmdNew_Click
ErHand:
ErrHandler "OPDBill.Command5_Click()"
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
MSFlexGrid1.Rows = 1
txtbal.Locked = True
txtte.Locked = True
Text2.Locked = True
TxtPatientName.Locked = True
TxtDoctor.Locked = True
DTPicker = Date
' TxtDischargeDate = Date
' TxtPatientName = registration.TxtTitle & " " & registration.TxtFirst.text & " " & registration.Txtmiddle.text & " " & registration.TxtLast.text
' TxtDoctor = registration.TxtDoctorIncharge.text
' txtRegNo.text = registration.txtRegNo
'Call incrementBillNo
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 "OPDBill.Form_Load()"
End Sub
Public Sub display()
On Error Resume Next
txtRegNo.Text = a
TxtPatientName.Text = rst!Name
TxtDoctor = rst!docincharge
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
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 "OPDBill.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 "OPDBill.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 OPDBill", 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 = ""
TxtBedNo = ""
Text2 = ""
txtbal = ""
txtbl = ""
txtla = ""
TxtPatientName = ""
txtte = ""
Text3 = ""
txttp = ""
Text4 = ""
End Sub
Private Sub CmdNew_Click()
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
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 opdbilldetail where id=" & Val(txtRegNo) & "", Conn, adOpenDynamic, adLockOptimistic
OpdBillReport.Sections(1).Controls("label2").Caption = txtbl
OpdBillReport.Sections(1).Controls("label12").Caption = DTPicker
OpdBillReport.Sections(1).Controls("label6").Caption = txtRegNo
OpdBillReport.Sections(1).Controls("label8").Caption = TxtPatientName
OpdBillReport.Sections(1).Controls.Item("label57").Caption = hos_name
OpdBillReport.Sections(1).Controls.Item("label58").Caption = hos_add
OpdBillReport.Sections(5).Controls("label25").Caption = Text3
OpdBillReport.Sections(5).Controls("label26").Caption = Val(txtte) - Val(Text3)
OpdBillReport.Sections(5).Controls("label28").Caption = txtbal
OpdBillReport.Sections(5).Controls("label30").Caption = txtla
If Val(Text3) > 0 Then
OpdBillReport.Sections(5).Controls("label23").Visible = True
OpdBillReport.Sections(5).Controls("label25").Visible = True
End If
OpdBillReport.Show
End Sub
Private Sub TxtRegNo_KeyPress(KeyAscii As Integer)
On Error Resume Next
If KeyAscii = 13 Then
If txtRegNo = "" Then Exit Sub
Set rst = New Recordset
rst.Open "select * from OPD where RegNo = " & Me.txtRegNo & "", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = False Then
Me.TxtPatientName = rst!Title & " " & rst!FName & " " & rst!MName & " " & rst!LName
TxtDoctor = rst!docincharge
End If
rst.Close
Conn.Execute "DELETE FROM BILLADD"
End If
End Sub
Private Sub TxtRegNo_LostFocus()
Call TxtRegNo_KeyPress(13)
End Sub
Private Sub txttp_Change()
If txttp = "" Then
txttp = 0
txtbal = Val(Text2) - Val(txttp)
Exit Sub
Else
txtbal = Val(Text2) - Val(txttp)
End If
End Sub
Sponsored Links