Next Chapter 62 Ultra Sound
PROJECT SOURCE CODE
SPONSORED LINKS
Ultra Sound
Dim rst As New ADODB.Recordset
Private Sub chameleonButton1_Click()
If Combo1 = "" Then
MsgBox "Please select Date", vbInformation
Combo1.SetFocus
Exit Sub
End If
On Error Resume Next
DataEnvironment1.Recordsets.Item("command8").Close
DataEnvironment1.Recordsets.Item("command8").Open "select * from ultrasound1 where id=" & Val(TxtUltra) & "and ultradate= '" & Format(Combo1, "dd-mm-yyyy") & "'", Conn, adOpenDynamic, adLockOptimistic
DataReport8.Sections(1).Controls.Item("label57").Caption = hos_name
DataReport8.Sections(1).Controls.Item("label58").Caption = hos_add
DataReport8.Show
End Sub
Private Sub chameleonButton2_Click()
DTPicker1 = Date
TxtUltraDate = Date
TxtUltraSex = "M"
TxtAC = "0"
TxtACd = "0"
TxtACw = "0"
TxtBPD = "0"
TxtBPDd = "0"
TxtBPDw = "0"
TxtDGAd = "0"
TxtDGAw = "0"
TxtEDD = "0"
TxtFetal = "0"
TxtFL = "0"
TxtFLd = "0"
TxtFLw = "0"
TxtFoetus = "Single"
TxtImpressGA = "0"
TxtImpressW = "0"
TxtLinguor = "Adequate"
TxtLMP = "0"
TxtPlacenta = "Upper"
End Sub
Private Sub chameleonButton3_Click()
On Error GoTo ErHand
Dim a As String
If TxtUltra.Text = "" Then MsgBox " Patient Registration Should Not Be Empty": Exit Sub
If Combo1.Text = "" Then MsgBox " UltraSound Date Should Not Be Empty": Exit Sub
a = MsgBox("Do You Want To Delete " & vbCrLf & "UltraSound Report Of [ " & Me.txtultraname & " ]" & vbCrLf & " Date [ " & Combo1.Text & " ]", vbYesNo + vbExclamation, "Need Your Responce")
If a = vbNo Then Exit Sub
a = 0
Conn.Execute "delete from ultrasound1 where id = " & Val(TxtUltra.Text) & "and ultradate = '" & Format(Combo1, "dd-mm-yyyy") & "'", a
If a <= 0 Then MsgBox "No Record Found For Delete", vbExclamation, "Confirmation"
ErHand:
ErrHandler "UtraSound.chameleonButton3_Click"
On Error Resume Next
Combo1.RemoveItem (Combo1.ListIndex)
Call chameleonButton2_Click
End Sub
Private Sub chameleonButton5_Click()
On Error GoTo ErHand
If TxtUltra.Text = "" Then MsgBox "please enter regNo.", vbInformation: Exit Sub
Set rst = New ADODB.Recordset
rst.Open "select * from Ultrasound1 where Id=" & TxtUltra.Text & " And ultradate='" & Format(DTPicker1, "dd-MMM-yyyy") & "'", Conn, adOpenDynamic, adLockBatchOptimistic
If rst.EOF Then
rst.AddNew
Combo1.AddItem Format(DTPicker1, "dd-MMM-yyyy")
Else
i = MsgBox("You Are Going To Update UltraSound Of [ " & Me.txtultraname & " ]" & vbCrLf & " For Date [" & Format(DTPicker1, "dd-MMM-yyyy") & "]" & vbCrLf & " Do You Want To Continue", vbExclamation + vbYesNo)
If i = vbNo Then Exit Sub
End If
rst.Fields("ultraDate") = Format(DTPicker1, "dd-MMM-yyyy")
rst.Fields("Id") = TxtUltra & ""
rst.Fields("name") = txtultraname & ""
rst.Fields("LMP") = Me.TxtLMP & ""
rst.Fields("edd") = Me.TxtEDD & ""
rst.Fields("dgaweek") = Me.TxtDGAw & ""
rst.Fields("dgadays") = Me.TxtDGAd & ""
rst.Fields("Foetus") = Me.TxtFoetus & ""
rst.Fields("bpd") = Me.TxtBPD & ""
rst.Fields("bpdweek") = Me.TxtBPDw & ""
rst.Fields("bpddays") = Me.TxtBPDd & ""
rst.Fields("fl") = Me.TxtFL & ""
rst.Fields("flweek") = Me.TxtFLw & ""
rst.Fields("fldays") = Me.TxtFLd & ""
rst.Fields("AC") = Me.TxtAC & ""
rst.Fields("ACweek") = Me.TxtACw & ""
rst.Fields("ACdays") = Me.TxtACd & ""
rst.Fields("fweight") = Me.TxtFetal & ""
rst.Fields("ImpressGA") = Me.TxtImpressGA & ""
rst.Fields("liquor") = Me.TxtLinguor & ""
rst.Fields("ImpressW") = Me.TxtImpressW & ""
rst.Fields("Placenta") = Me.TxtPlacenta & ""
rst.UpdateBatch
rst.Close
Set rst = Nothing
Call chameleonButton2_Click
ErHand:
ErrHandler "UtraSound.chameleonButton5_Click"
End Sub
Private Sub chameleonButton7_Click()
Unload Me
Unload SearchFrm
registration.Enabled = True
End Sub
Private Sub Combo1_Click()
On Error GoTo ErHand
Set rst = New ADODB.Recordset
rst.Open "select * from ultrasound1 where id =" & Val(TxtUltra) & " and ultradate ='" & Format(Trim(Combo1), "dd-MMM-yyyy") & "'", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = True Then Call chameleonButton2_Click: Exit Sub
DTPicker1 = Format(Combo1.Text, "dd-MMM-yyyy")
TxtLMP = rst!lmp & ""
TxtEDD = rst!EDD & ""
TxtDGAw = rst!dgaweek & ""
TxtDGAd = rst!dgadays & ""
TxtBPD = rst!bpd & ""
TxtBPDw = rst!bpdweek & ""
TxtBPDd = rst!bpddays & ""
TxtFL = rst!fl & ""
TxtFLw = rst!flweek & ""
TxtFLd = rst!fldays & ""
TxtFetal = rst!fweight & ""
TxtFoetus = rst!Foetus & ""
TxtAC = rst!ac & ""
TxtACw = rst!acweek & ""
TxtACd = rst!ACdays & ""
TxtPlacenta = rst!placenta & ""
TxtLinguor = rst!liquor & ""
TxtImpressW = rst!impressw & ""
TxtImpressGA = rst!ImpressGA & ""
rst.Close
ErHand:
ErrHandler "UtraSound.Combo1_Click"
End Sub
Private Sub Form_Load()
On Error GoTo ErHand
Me.Top = 0
Me.Left = 0
Me.DTPicker1 = Date
Me.Combo1.Clear
TxtUltra = registration.txtRegNo
Set rst = New ADODB.Recordset
rst.Open "select * from Hospital where Registration=" & registration.txtRegNo & "", Conn, adOpenDynamic, adLockOptimistic
If Not rst.EOF = True Then
txtultraage = rst!Age
txtultraname = rst!Title & " " & rst!first_name & " " & rst!middle_name & " " & rst!last_name & " "
rst.Close
End If
Dim RstLoad As New ADODB.Recordset
RstLoad.Open "select ultradate from ultrasound1 where id = " & Val(registration.txtRegNo) & " order by ultradate", Conn, adOpenDynamic, adLockOptimistic
If RstLoad.EOF = True Then Exit Sub
While Not RstLoad.EOF
Combo1.AddItem Format(RstLoad!ultradate, "dd-MMM-yyyy")
Combo1.Text = Format(RstLoad!ultradate, "dd-MMM-yyyy")
RstLoad.MoveNext
Wend
ErHand:
ErrHandler "UtraSound.Form_Load"
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unload SearchFrm
registration.Enabled = True
End Sub
Private Sub TxtUltra_KeyPress(KeyAscii As Integer)
If (KeyAscii >= vbKey0 And KeyAscii <= vbKey9) Or KeyAscii = vbKeyBack Or (KeyAscii = 46) Then
Exit Sub
Else
Beep
End If
End Sub