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 Patient
Dim rst As New ADODB.Recordset
Public s As String
Dim a As String
Private Sub CmdClose_Click()
Unload Me
End Sub
Private Sub CmdNew_Click()
On Error GoTo ErHand
Me.txtRegNo = ""
Me.TxtRegFee.Text = "0"
Me.TxtSex = ""
Me.txtAddress = ""
Me.TxtAge.Text = ""
Me.TxtDoctor = ""
TxtDepartmentName = ""
txtfirst = ""
txtmiddle = ""
txtlast = ""
TxtDepartmentName.Text = ""
CmdSave.Enabled = True
cmdedit.Caption = "&Edit"
Set rst = New ADODB.Recordset
rst.Open "select max(regno) from Opd", Conn, adOpenDynamic, adLockOptimistic
If IsNull(rst.Fields(0)) = True Then
txtRegNo = "1"
rst.Close
Exit Sub
Else
txtRegNo = rst.Fields(0) + 1
End If
rst.Close
ErHand:
ErrHandler "OPD.CmdNew_Click()"
End Sub
Private Sub CmdDel_Click()
On Error GoTo ErHand
Dim a As String
a = InputBox("Enter the Registration No. to Delete")
If a = "" Then MsgBox "Enter the Registration No": Exit Sub
Set rst = New ADODB.Recordset
rst.Open "select * from Opd where regno = " & Val(a) & "", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = True Then
MsgBox "No Record Matched with Registration No", vbInformation
Set rst = Nothing
Exit Sub
End If
Conn.Execute "delete from Opd where regno = " & Val(a) & ""
Conn.Execute "delete from opdpres where refno = " & Val(a) & ""
Conn.Execute "delete from opdbill where registrationno = " & Val(a) & ""
Call CmdNew_Click
Set rst = Nothing
ErHand:
ErrHandler "OPD.CmdDel_Click()"
End Sub
Private Sub CmdEdit_Click()
On Error GoTo ErHand
If cmdedit.Caption = "&Edit" Then
s = InputBox("Enter the Reg. no. to update.")
If s = "" Or Not IsNumeric(s) Then Exit Sub
Set rst = New Recordset
rst.Open "select * from Opd where regno =" & s & "", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = True Then
MsgBox "No Record Found", vbInformation
rst.Close
Exit Sub
End If
txtRegNo = s
DTPicker2 = rst!dor
TxtRegFee.Text = rst!regfee
DTPicker1 = rst!tim
TxtSex = rst!sex
TxtAge.Text = rst!Age
TxtDoctor.Text = rst!docincharge
txtAddress = rst!Address
TxtDepartmentName = rst!Company & ""
TxtTitle = rst!Title & ""
txtfirst = rst!FName & ""
txtmiddle = rst!MName & ""
txtlast = rst!LName & ""
End If
If cmdedit.Caption = "&Update" Then
If TxtRegFee.Text = "" Then TxtRegFee.Text = 0
Conn.Execute "update Opd set dor ='" & DTPicker2 & "' where regno=" & s & ""
Conn.Execute "update Opd set regfee =" & TxtRegFee.Text & " where regno=" & s & ""
Conn.Execute "update Opd set tim ='" & DTPicker1 & "' where regno=" & s & ""
Conn.Execute "update Opd set sex ='" & TxtSex & "' where regno=" & s & ""
Conn.Execute "update Opd set age =" & TxtAge.Text & " where regno=" & s & ""
Conn.Execute "update Opd set docincharge ='" & TxtDoctor & "' where regno= " & s & ""
Conn.Execute "update Opd set address ='" & txtAddress & "' where regno= " & s & ""
Conn.Execute "update opd set company = '" & TxtDepartmentName.Text & "' where regno= " & s & ""
Conn.Execute "update Opd set TITLE ='" & TxtTitle & "' where regno=" & s & ""
Conn.Execute "update Opd set Fname ='" & txtfirst & "' where regno=" & s & ""
Conn.Execute "update Opd set Mname ='" & txtmiddle & "' where regno=" & s & ""
Conn.Execute "update Opd set Lname ='" & txtlast & "' where regno=" & s & ""
End If
If cmdedit.Caption = "&Edit" Then
CmdSave.Enabled = False
cmdedit.Caption = "&Update"
Else
If cmdedit.Caption = "&Update" Then
cmdedit.Caption = "&Edit"
CmdSave.Enabled = True
Call CmdNew_Click
End If
End If
ErHand:
ErrHandler "OPD.CmdEdit_Click()"
End Sub
Private Sub CmdSave_Click()
On Error GoTo ErHand
Dim temp As Double
Dim acc As Double
Set rst = New ADODB.Recordset
rst.Open "select * from opd where regno = " & txtRegNo & "", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = False Then
MsgBox "This Registration No. Already exist !", vbInformation
rst.Close
Exit Sub
End If
If txtRegNo.Text = "" Then
MsgBox ("Please Enter The Registration No."), vbInformation
txtRegNo.SetFocus
Exit Sub
End If
If TxtRegFee.Text = "" Then TxtRegFee.Text = 0
If txtfirst = "" Then
MsgBox ("Please Enter The Patient Name."), vbInformation
txtfirst.SetFocus
Exit Sub
End If
If TxtAge.Text = "" Then
MsgBox ("Please Enter the Age "), vbInformation
TxtAge.SetFocus
Exit Sub
End If
If TxtSex = "" Then
MsgBox ("Please Enter Sex."), vbInformation
TxtSex.SetFocus
Exit Sub
End If
If TxtDoctor = "" Then
MsgBox ("Please Enter The Doctor Incharge"), vbInformation
TxtDoctor.SetFocus
Exit Sub
End If
Set rst = New ADODB.Recordset
rst.Open "select * from OPD", Conn, adOpenDynamic, adLockBatchOptimistic
If Not rst.EOF Then rst.MoveLast
rst.AddNew
rst.Fields("RegNo") = txtRegNo
rst.Fields("DoR") = DTPicker2
rst.Fields("RegFee") = TxtRegFee.Text
rst.Fields("tim") = DTPicker2
rst.Fields("Sex") = TxtSex
rst.Fields("Age") = TxtAge.Text
rst.Fields("docincharge") = TxtDoctor.Text
rst.Fields("Address") = txtAddress
rst.Fields("company") = TxtDepartmentName
rst.Fields("Title") = TxtTitle
rst.Fields("FName") = txtfirst
rst.Fields("MName") = txtmiddle
rst.Fields("LName") = txtlast
rst.UpdateBatch
Set rst = Nothing
Call CmdNew_Click
ErHand:
ErrHandler "OPD.CmdSave_Click()"
End Sub
Private Sub CmdPrint_Click()
If txtRegNo = "" Then
MsgBox "Please enter Reg. No.", vbInformation
txtRegNo.SetFocus
Exit Sub
End If
On Error Resume Next
DataEnvironment1.Recordsets.Item("Opd").Close
DataEnvironment1.Recordsets.Item("Opd").Open "select * from Opd where regno =" & txtRegNo & "", Conn, adOpenDynamic, adLockOptimistic
DataReportOpd.Sections(1).Controls.Item("label57").Caption = hos_name
DataReportOpd.Sections(1).Controls.Item("label58").Caption = hos_add
DataReportOpd.Show
End Sub
Private Sub Cmdsearch_Click()
searchopd.Show
End Sub
Private Sub CmdICard_Click()
On Error Resume Next
Set rst = New ADODB.Recordset
rst.Open "select regno from opd where regno=" & Val(txtRegNo) & "", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = True Then
MsgBox "record not found !", vbInformation
Exit Sub
End If
Picardopd.Show
End Sub
Private Sub Command9_Click()
On Error GoTo ErHand
If Me.txtRegNo = "" Then
MsgBox "Please Select A Patient To Transfer", vbInformation, App.Title
txtRegNo.SetFocus
Exit Sub
End If
registration.Show
Call registration.Transfer
registration.TxtTitle = TxtTitle
registration.txtfirst = txtfirst
registration.txtmiddle = txtmiddle
registration.txtlast = txtlast
registration.TxtSex = TxtSex
registration.TxtAge = TxtAge.Text
registration.TxtDoctorIncharge = Me.TxtDoctor
registration.TxtDept = Me.TxtDepartmentName
registration.TxtOPDID.Text = Me.txtRegNo
registration.txtAddress = Me.txtAddress
Unload Me
ErHand:
ErrHandler "OPD.Command9_Click() [Transfer Patient]"
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyF1 Or KeyCode = vbKeyF2 Or KeyCode = vbKeyF3 Or KeyCode = vbKeyF4 Then
If txtRegNo = "" Then
MsgBox "First Enter the Registration NO.!", vbExclamation
Exit Sub
End If
End If
If KeyCode = vbKeyF1 Then
Load OPDPrescription
ElseIf KeyCode = vbKeyF2 Then
Load opdbill
' ElseIf KeyCode = vbKeyF3 Then
' Load Opdreceipt
ElseIf KeyCode = vbKeyF3 Then
Load OPDUltraSound
ElseIf KeyCode = vbKeyF4 Then
End If
End Sub
Private Sub Form_Load()
On Error GoTo ErHand
Me.Top = 0
Me.Left = 0
DTPicker2 = Date
MSFlexGrid1(0).AddItem "OPD Prescription (F1)"
MSFlexGrid1(0).AddItem "OPD Bill (F2)"
' MSFlexGrid1(0).AddItem "OPD Receipt (F3)"
MSFlexGrid1(0).AddItem "Ultra Sound (F3)"
MSFlexGrid1(0).AddItem "Lab Report (F4)"
Call SetSearchEngines
Set rst = New ADODB.Recordset
rst.Open "select max(regno) from Opd", Conn, adOpenDynamic, adLockOptimistic
If IsNull(rst.Fields(0)) = True Then
txtRegNo = "1"
Else
txtRegNo = rst.Fields(0) + 1
End If
rst.Close
Set rst = New ADODB.Recordset
rst.Open " select title,Fname,Mname,Lname from DocMast ", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = True Then
rst.Close
Exit Sub
Else
Do While Not rst.EOF = True
TxtDoctor.AddItem rst!Title & " " & rst!FName & " " & rst!MName & " " & rst!LName & ""
rst.MoveNext
Loop
End If
rst.Close
ErHand:
ErrHandler "OPD.Form_Load()"
End Sub
Private Sub TxtRegNo_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
Set rst = New Recordset
rst.Open "select * from Opd where regno = " & Val(txtRegNo) & " ", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = True Then MsgBox "No Record Found", vbInformation: rst.Close: Call CmdNew_Click: Exit Sub
DTPicker2 = rst!dor
TxtRegFee.Text = rst!regfee
DTPicker1 = rst!tim
TxtTitle = rst!Title & ""
txtfirst = rst!FName & ""
txtmiddle = rst!MName & ""
txtlast = rst!LName & ""
TxtSex = rst!sex
TxtAge.Text = rst!Age
TxtDoctor = rst!docincharge
txtAddress = rst!Address
TxtDepartmentName = rst!Company
End If
End Sub
Private Sub Timer1_Timer()
DTPicker1 = Time
End Sub
Private Sub SetSearchEngines()
On Error Resume Next
'Populate all search list
'Called in Form_Load()
With Me.DeptSrch
.DBConnectString = ConnectString
.SQLString = "SELECT DCode, DepartmentName FROM Department"
.PopulateList
Set .BoundTextBox = Me.TxtDepartmentName
End With
End Sub
Private Sub TxtDepartmentName_GotFocus()
DeptSrch.SearchValue TxtDepartmentName
End Sub
Private Sub TxtDepartmentName_Validate(Cancel As Boolean)
TxtDepartmentName = StrConv(TxtDepartmentName, vbProperCase)
End Sub
Private Sub MSFlexGrid1_DblClick(Index As Integer)
If txtRegNo = "" Then
MsgBox "First Enter the Registration NO.!", vbExclamation
Exit Sub
Else
If MSFlexGrid1(0).Text = "OPD Prescription (F1)" Then
Load OPDPrescription
ElseIf MSFlexGrid1(0).Text = "OPD Bill (F2)" Then
Load opdbill
' ElseIf MSFlexGrid1(0).text = "OPD Receipt (F3)" Then
' Load Opdreceipt
ElseIf MSFlexGrid1(0).Text = "Ultra Sound (F3)" Then
Load OPDUltraSound
ElseIf MSFlexGrid1(0).Text = "Lab Report (F4)" Then
MsgBox "Not Implemented...........", vbInformation
End If
End If
End Sub
Sponsored Links