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