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
Visit Form
Dim rst As New ADODB.Recordset
Public st As String
Private Sub Update()
On Error GoTo ErHand
If Text1 = "" Then
MsgBox "Please enter the Registration No.", vbInformation
Text1.SetFocus
Exit Sub
End If
If Text3 = "" Then Text3 = 0
If Text4 = "" Then Text4 = 0
If Text16 = "" Then Text16 = 0
If Text7 = "" Then Text7 = 0
If Text6 = "" Then Text6 = 0
Conn.Execute "update visit set compl = '" & Text2 & "' where regno = " & Trim(Text1) & " and sno = " & st & ""
Conn.Execute "update visit set [Temp]= " & Text3 & " where regno = " & Text1 & " and sno = " & st & ""
Conn.Execute "update visit set BP = " & Text4 & " where regno = " & Text1 & " and sno = " & st & ""
Conn.Execute "update visit set BP2 = " & Text16 & " where regno = " & Text1 & " and sno = " & st & ""
Conn.Execute "update visit set weight = '" & Text11 & "' where regno = " & Text1 & " and sno = " & st & ""
Conn.Execute "update visit set gencond = '" & Text5 & "' where regno = " & Text1 & " and sno = " & st & ""
Conn.Execute "update visit set pulse = " & Text7 & " where regno = " & Text1 & " and sno = " & st & ""
Conn.Execute "update visit set rr = " & Text6 & " where regno = " & Text1 & " and sno = " & st & ""
Conn.Execute "update visit set pa = '" & Text8 & "' where regno = " & Text1 & " and sno = " & st & ""
Conn.Execute "update visit set neuropupil = '" & Text9 & "' where regno = " & Text1 & " and sno = " & st & ""
Conn.Execute "update visit set neuroplanter = '" & Text10 & "' where regno = " & Text1 & " and sno = " & st & ""
Conn.Execute "update visit set vtime = '" & DTPicker2 & "' where regno = " & Text1 & " and sno = " & st & ""
Conn.Execute "update visit set neuropupil1 = '" & Text12 & "' where regno = " & Text1 & " and sno = " & st & ""
Conn.Execute "update visit set neuropupil2 = '" & Text13 & "' where regno = " & Text1 & " and sno = " & st & ""
Conn.Execute "update visit set neuropupil3 = '" & Text14 & "' where regno = " & Text1 & " and sno = " & st & ""
Conn.Execute "update visit set neuroplanter1 = '" & Text15 & "' where regno = " & Text1 & " and sno = " & st & ""
Conn.Execute "update visit set dat = '" & DTPicker1 & "' where regno = " & Text1 & " and sno = " & st & ""
Timer1.Enabled = True
MsgBox "Record Modified!", vbInformation
Command3.Caption = "Edit"
Set rst = New ADODB.Recordset
rst.Open "select * from visit where regno=" & Val(registration.txtRegNo) & "", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = True Then
Me.MSFlexGrid1.Clear
MSFlexGrid1.FormatString = "S.No. |Date |Time |Complaints |Temp. |B.P. Sys. |B.P. Dia. |Weight |Pulse |R/R |P/A |Neuro Pupil Size - Lt.|Neuro Pupil Size - Rt.|Neuro Pupil Reaction - Lt.|Neuro Pupil Reaction - Rt.|Neuro Plantar - Lt.|Neuro Plantar - Rt.|General Condition "
Exit Sub
Else
Call Me.visitflex
End If
ErHand:
ErrHandler "Visit.Update"
End Sub
Private Sub chameleonButton1_Click()
On Error Resume Next
graph.Show
End Sub
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Command2_Click()
DTPicker1 = Date
DTPicker2 = Time
Command3.Caption = "Edit"
Command4.Enabled = True
Command5.Enabled = True
Command6.Enabled = False
Me.Text10 = ""
Me.Text11 = ""
Me.Text12 = ""
Me.Text2 = ""
Me.Text3 = ""
Me.Text4 = ""
Me.Text5 = ""
Me.Text6 = ""
Me.Text7 = ""
Me.Text8 = ""
Me.Text9 = ""
Me.Text13 = ""
Me.Text14 = ""
Me.Text15 = ""
Me.Text16 = ""
Text2.SetFocus
End Sub
Private Sub Command3_Click()
On Error GoTo ErHand
If Command3.Caption = "Update" Then
Call Update
Call Command2_Click
Exit Sub
End If
st = InputBox("Please enter Serial No. to Edit")
If st = "" Then Exit Sub
If IsNumeric(st) = False Then Exit Sub
Set rst = New ADODB.Recordset
rst.Open "select * from visit where regno=" & Val(registration.txtRegNo) & " and sno = " & st & "", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = True Then
MsgBox "This Serial No. does not exist", vbInformation
rst.Close
Exit Sub
End If
DTPicker1 = rst!Dat
Text2 = rst!compl
Text3 = rst!temp
Text4 = rst!bp
Text16 = rst!bp2
Text11 = rst!Weight
Text5 = rst!gencond
Text7 = rst!pulse
Text6 = rst!rr
Text8 = rst!pa
Text9 = rst!neuropupil
Text10 = rst!neuroplanter
DTPicker2 = rst!vtime
Text12 = rst!neuropupil1
Text13 = rst!neuropupil2
Text14 = rst!neuropupil3
Text15 = rst!neuroplanter1
Timer1.Enabled = False
Command3.Caption = "Update"
Command4.Enabled = True
Command5.Enabled = False
Command6.Enabled = True
rst.Close
ErHand:
ErrHandler "Visit.Command3_Click"
End Sub
Private Sub Command4_Click()
On Error GoTo ErHand
Dim st As String
st = InputBox("Please enter Serial No. to delete")
If st = "" Then Exit Sub
If IsNumeric(st) = False Then Exit Sub
Set rst = New ADODB.Recordset
rst.Open "select * from visit where RegNo= " & registration.txtRegNo & " and sno=" & st & "", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = True Then
MsgBox "This Serial No. does not exist", vbInformation
rst.Close
Exit Sub
End If
rst.Close
i = MsgBox("Are you Sure To Delete the Record.?", vbYesNo + vbQuestion)
If i = vbNo Then Exit Sub
Conn.Execute "delete from visit where regno = " & Trim(Text1) & " and sno =" & st
MsgBox "Record Deleted! ", vbInformation
Set rst = New ADODB.Recordset
rst.Open "select * from visit where regno=" & Val(registration.txtRegNo) & "", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = True Then
Me.MSFlexGrid1.Clear
MSFlexGrid1.FormatString = "S.No. |Date |Time |Complaints |Temp. |B.P. Sys. |B.P. Dia. |Weight |Pulse |R/R |P/A |Neuro Pupil Size - Lt.|Neuro Pupil Size - Rt.|Neuro Pupil Reaction - Lt.|Neuro Pupil Reaction - Rt.|Neuro Plantar - Lt.|Neuro Plantar - Rt.|General Condition "
Exit Sub
Else
Call Me.visitflex
End If
ErHand:
ErrHandler "Visit.Command4_Click"
End Sub
Private Sub Command5_Click()
On Error GoTo ErHand
If Text1 = "" Then MsgBox "Please enter the Registration No.", vbInformation: Text1.SetFocus: Exit Sub
If Text3 = "" Then Text3 = 0
If Text4 = "" Then Text4 = 0
If Text16 = "" Then Text16 = 0
If Text7 = "" Then Text7 = 0
If Text6 = "" Then Text6 = 0
Set rst = New ADODB.Recordset
rst.Open "select * from Visit where Regno=" & Text1.Text & " And dat='" & Format(DTPicker1, "dd-MMM-yyyy") & "' And Vtime='" & Format(DTPicker2, "hh:mm:ss") & "'", Conn, adOpenDynamic, adLockBatchOptimistic
If rst.EOF Then
rst.AddNew
Dim i As Integer
Dim RstID As New ADODB.Recordset
RstID.Open "select max(sno) from visit where Regno = " & Text1.Text & "", Conn, adOpenDynamic, adLockOptimistic
i = IIf(IsNull(RstID.Fields(0)) = True, 1, RstID.Fields(0) + 1)
Set RstID = Nothing
Else
j = MsgBox("You Are Going To Update Visit Of [ " & Text1.Text & " ]" & vbCrLf & " For Date [" & Format(DTPicker1, "dd-MMM-yyyy") & "] And Time [" & Format(DTPicker2, "hh:mm:ss") & "]" & vbCrLf & " Do You Want To Continue", vbExclamation + vbYesNo)
If j = vbNo Then Exit Sub
End If
rst!regno = Text1.Text & ""
rst!sno = i
rst!Dat = Format(DTPicker1, "dd-MMM-yyyy")
rst!compl = Text2 & ""
rst!temp = Val(Text3)
rst!bp = Val(Text4)
rst!bp2 = Val(Text16)
rst!Weight = Text11 & ""
rst!gencond = Text5 & ""
rst!pulse = Val(Text7)
rst!rr = Val(Text6)
rst!pa = Text8 & ""
rst!neuropupil = Text9 & ""
rst!neuroplanter = Text10 & ""
rst!vtime = Format(DTPicker2, "hh:mm:ss")
rst!neuropupil1 = Text12 & ""
rst!neuropupil2 = Text13 & ""
rst!neuropupil3 = Text14 & ""
rst!neuroplanter1 = Text15 & ""
rst.UpdateBatch
Call Command2_Click
Command5.Enabled = False
Set rst = New ADODB.Recordset
rst.Open "select * from visit where regno=" & Val(registration.txtRegNo) & "", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = True Then
Me.MSFlexGrid1.Clear
MSFlexGrid1.FormatString = "S.No. |Date |Time |Complaints |Temp. |B.P. Sys. |B.P. Dia. |Weight |Pulse |R/R |P/A |Neuro Pupil Size - Lt.|Neuro Pupil Size - Rt.|Neuro Pupil Reaction - Lt.|Neuro Pupil Reaction - Rt.|Neuro Plantar - Lt.|Neuro Plantar - Rt.|General Condition "
Exit Sub
End If
Call Me.visitflex
ErHand:
ErrHandler "Visit.Command3_Click"
End Sub
Private Sub Command6_Click()
MsgBox "Please set the Printer setting to Landscape", vbInformation
Set rst = New ADODB.Recordset
rst.Open "SELECT * FROM hospital WHERE REGistration =" & Val(Text1) & "", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = True Then
MsgBox "This Reg. No. does not exist", vbInformation
rst.Close
Exit Sub
End If
On Error Resume Next
DataEnvironment1.Recordsets.Item("command6").Close
DataEnvironment1.Recordsets.Item("command6").Open "select * from visit where regno =" & Val(Text1) & " ", Conn, adOpenDynamic, adLockOptimistic
VisitReport.Sections(1).Controls("label18").Caption = rst!registration & ""
VisitReport.Sections(1).Controls("label19").Caption = rst!first_name & "" + " " + rst!middle_name & "" + " " + rst!last_name & ""
VisitReport.Sections(1).Controls("label33").Caption = rst!Age & ""
VisitReport.Sections(1).Controls("label41").Caption = rst!FATHER_NAME & ""
VisitReport.Sections(1).Controls("label12").Caption = rst!sex & ""
VisitReport.Sections(1).Controls("label49").Caption = rst!street & "" + " " + rst!City & "" + " " + rst!State & "" + " " + rst!COUNTRY & " "
VisitReport.Sections(1).Controls.Item("label57").Caption = hos_name
VisitReport.Sections(1).Controls.Item("label58").Caption = hos_add
VisitReport.Show
Set rst = Nothing
End Sub
Private Sub Form_Load()
On Error GoTo ErHand
Me.Top = 200
Me.Left = 500
DTPicker1 = Date
DTPicker2 = Time
Text1 = registration.txtRegNo
Set rst = New ADODB.Recordset
rst.Open "select compname from compmast", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = False Then
Text2.Text = rst.Fields(0) & ""
Do While Not rst.EOF = True
Text2.AddItem rst.Fields(0)
rst.MoveNext
Loop
End If
Set rst = New ADODB.Recordset
rst.Open "select * from visit where regno=" & Val(registration.txtRegNo) & "", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = True Then
Me.MSFlexGrid1.Clear
MSFlexGrid1.FormatString = "S.No. |Date |Time |Complaints |Temp. |B.P. Sys. |B.P. Dia. |Weight |Pulse |R/R |P/A |Neuro Pupil Size - Lt.|Neuro Pupil Size - Rt.|Neuro Pupil Reaction - Lt.|Neuro Pupil Reaction - Rt.|Neuro Plantar - Lt.|Neuro Plantar - Rt.|General Condition "
Exit Sub
Else
Call Me.visitflex
End If
Me.Text1.Locked = True
ErHand:
ErrHandler "Visit.Form_Load"
End Sub
Private Sub Form_Unload(Cancel As Integer)
registration.Enabled = True
End Sub
Public Function visitflex()
On Error GoTo ErHand
visit.MSFlexGrid1.Rows = 1
MSFlexGrid1.FormatString = "S.No. |Date |Time |Complaints |Temp. |B.P. Sys. |B.P. Dia. |Weight |Pulse |R/R |P/A |Neuro Pupil Size - Lt.|Neuro Pupil Size - Rt.|Neuro Pupil Reaction - Lt.|Neuro Pupil Reaction - Rt.|Neuro Plantar - Lt.|Neuro Plantar - Rt.|General Condition "
Do While Not rst.EOF = True
visit.MSFlexGrid1.AddItem rst!sno & Chr(9) & rst!Dat & "" & Chr(9) & _
rst!vtime & " " & Chr(9) & rst!compl & " " & Chr(9) & rst!temp & " " & Chr(9) & _
rst!bp & " " & Chr(9) & rst!bp2 & " " & Chr(9) & rst!Weight & " " & Chr(9) & _
rst!pulse & " " & Chr(9) & rst!rr & " " & Chr(9) & rst!pa & " " & Chr(9) & _
rst!neuropupil & " " & Chr(9) & rst!neuropupil1 & " " & Chr(9) & rst!neuropupil2 & " " & Chr(9) & rst!neuropupil3 & " " & Chr(9) & rst!neuroplanter & " " & Chr(9) & rst!neuroplanter1 & " " & Chr(9) & rst!gencond & " "
rst.MoveNext
Loop
ErHand:
ErrHandler "Visit.VisitFlex"
End Function
Public Sub display()
On Error Resume Next
Text2.Text = rst!compl & ""
Text3.Text = rst!temp & ""
Text4.Text = rst!bp & ""
Text11.Text = rst!Weight & ""
Text5.Text = rst!gencond & ""
Text7.Text = rst!pulse & ""
Text6.Text = rst!rr & ""
Text8.Text = rst!pa & ""
Text9.Text = rst!neuropupil & ""
Text10.Text = rst!neuroplanter & ""
End Sub
Private Sub Text16_KeyPress(KeyAscii As Integer)
If (KeyAscii >= vbKey0 And KeyAscii <= vbKey9) Or KeyAscii = vbKeyBack Or (KeyAscii = 46) Then
Exit Sub
Else
KeyAscii = 0
Beep
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If (KeyAscii >= vbKey0 And KeyAscii <= vbKey9) Or KeyAscii = vbKeyBack Or (KeyAscii = 46) Then
Exit Sub
Else
KeyAscii = 0
Beep
End If
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
If (KeyAscii >= vbKey0 And KeyAscii <= vbKey9) Or KeyAscii = vbKeyBack Or (KeyAscii = 46) Then
Exit Sub
Else
KeyAscii = 0
Beep
End If
End Sub
Private Sub Text6_KeyPress(KeyAscii As Integer)
If (KeyAscii >= vbKey0 And KeyAscii <= vbKey9) Or KeyAscii = vbKeyBack Or (KeyAscii = 46) Then
Exit Sub
Else
KeyAscii = 0
Beep
End If
End Sub
Private Sub Text7_KeyPress(KeyAscii As Integer)
If (KeyAscii >= vbKey0 And KeyAscii <= vbKey9) Or KeyAscii = vbKeyBack Or (KeyAscii = 46) Then
Exit Sub
Else
KeyAscii = 0
Beep
End If
End Sub
Private Sub Timer1_Timer()
DTPicker2 = Time
End Sub