cardiovascular.frm

一个用VB写的人工智能看病程序源代码

    Case Is < 25
        HDLrisk = "Very High Risk"
End Select
Else
Select Case Val(Text1(12))
    Case Is > 70
        HDLrisk = "Very Low Risk"
    Case 40 To 70
        HDLriskV = (0.0008095 * (Val(Text1(12)) ^ 2)) - (0.136905 * Val(Text1(12))) + 6.1
        HDLrisk = Str(HDLriskV) & " times the Average Risk"
    Case Is < 40
        HDLrisk = "Very High Risk"
End Select
End If

If Text1(12) <> "" And Text1(11) <> "" Then

Interpret = Interpret & vbCr & vbLf & vbCr & vbLf & "Based upon the HDL, the following situation exists: " & HDLrisk
HDLrisk = ""

If Text1(0) = "M" Then
Select Case Val(Text1(11)) / Val(Text1(12))
    Case Is > 23.3
        HDLrisk = "Three Times Average Risk"
    Case 9.51 To 23.3
        HDLrisk = "Two Times Average Risk"
    Case 4.91 To 9.5
        HDLrisk = "Average Risk"
    Case Is <= 4.9
        HDLrisk = "50% Average Risk"
End Select
Else
Select Case Val(Text1(11)) / Val(Text1(12))
    Case Is > 10.9
        HDLrisk = "Three Times Average Risk"
    Case 6.91 To 10.9
        HDLrisk = "Two Times Average Risk"
    Case 4.31 To 6.9
        HDLrisk = "Average Risk"
    Case Is <= 4.3
        HDLrisk = "50% Average Risk"
End Select
End If
Interpret = Interpret & vbCr & vbLf & vbCr & vbLf & "The Total Cholesterol to HDL Ratio is: " & Str((Int((Val(Text1(11)) / Val(Text1(12))) * 100)) / 100) & " which indicates a " & HDLrisk
End If

If Val(LDL) <> 0 And Val(trigLygerides) <> 0 And Val(Text1(12)) <> 0 And Val(Text1(11)) <> 0 Then

If LDL <> "" Then
LDLriskV = (Int((Val(LDL) / Val(Text1(12))) * 100)) / 100
Else
LDLriskV = (Int(((Val(Text1(11)) - (Val(triglycerides) / 5) - Val(Text1(12))) / Val(Text1(12))) * 100)) / 100
End If
Select Case LDLriskV
Case Is < 3
    LDLrisk = "Low Risk"
Case 3 To 6
    LDLrisk = "Average Risk"
Case Is > 6
    LDLrisk = "High Risk"
End Select
Interpret = Interpret & vbCr & vbLf & vbCr & vbLf & "The LDL Cholesterol to HDL Cholesterol Ratio is " & LDLriskV & " this represents " & LDLrisk
End If
'M =IF(B7="F","NA",IF(AND(B8>=20,B8<=34,B22<2,B17>=220),"Yes",IF(AND(B8>=20,B8<=34,B22>=2,B17>=190),"Yes",
'IF(AND(B8>=35,B22<2,B17>=190),"Yes",IF(AND(B8>=35,B22>=2,B17>=160),"Yes","No")))))

'F=IF(B7="M","NA",IF(AND(B9="Y",B22<2,B17>=190),"Yes",IF(AND(B9="Y",B22>=2,B17>=160),"Yes",
'IF(AND(B8>=20,B9="N",B22<2,B17>=220),"Yes",IF(AND(B8>=20,B9="N",B22>=2,B17>=190),"Yes","No")))))
If Text1(0) = "M" Then
If Val(Text1(1)) >= 20 And Val(Text1(1)) <= 34 And NCEP < 2 And Val(LDL) >= 220 Then NCEPs = "Treatment is indicated"
If Val(Text1(1)) >= 20 And Val(Text1(1)) <= 34 And NCEP >= 2 And Val(LDL) >= 190 Then NCEPs = "Treatment is indicated"
If Val(Text1(1)) >= 35 And NCEP < 2 And Val(LDL) >= 190 Then NCEPs = "Treatment is indicated"
If Val(Text1(1)) >= 35 And NCEP >= 2 And Val(LDL) >= 160 Then NCEPs = "Treatment is indicated"
Else
If Text3 = "Y" And NCEP < 2 And Val(LDL) >= 190 Then NCEPs = "Treatment is indicated"
If Text3 = "Y" And NCEP >= 2 And Val(LDL) >= 160 Then NCEPs = "Treatment is indicated"
If Val(Text1(1)) >= 20 And Text3 = "N" And NCEP < 2 And Val(LDL) >= 220 Then NCEPs = "Treatment is indicated"
If Val(Text1(1)) >= 20 And Text3 = "N" And NCEP >= 2 And Val(LDL) >= 190 Then NCEPs = "Treatment is indicated"
End If
If NCEPs = "" Then NCEPs = "Treatment is not indicated"
Interpret = Interpret & vbCr & vbLf & vbCr & vbLf & "You have " & NCEP & " cardiac risk factors based upon the National Cholesterol Educational Program II (NCEPII) criteria.  " & NCEPs & " based upon your values."
If Val(LDL) >= 160 And NCEP1 >= 3 Then
    NCEPs1 = "Treatment is indicated"
Else
    NCEPs1 = "Treatment is not indicated"
End If
Interpret = Interpret & vbCr & vbLf & vbCr & vbLf & "You have " & NCEP1 & " cardiac risk factors based upon the National Cholesterol Educational Program II (NCEPII) Revised criteria.  " & NCEPs & " based upon your values."

If Val(Text1(11)) >= 240 Then
    ATPs = "The total cholesterol is HIGH.   "
Else
    If Val(Text1(11)) >= 200 Then
            ATPs = "The total cholesterol is BORDERLINE HIGH.   "
    Else
            ATPs = "The total cholesterol is DESIRABLE.   "
    End If
End If
If Val(Text1(12)) >= 60 Then
    ATPs = ATPs & "The HDL-Cholesterol is HIGH and (GOOD).   "
Else
    If Val(Text1(12)) >= 40 Then
        ATPs = ATPs & "The HDL-Cholesterol is INTERMEDIATE.   "
    Else
            ATPs = ATPs & "The HDL-Cholesterol is LOW and (NOT GOOD).   "
    End If
End If
'========================================================================
If Val(LDL) = 0 Then
    Interpret = Interpret & vbCr & vbLf & vbCr & vbLf & ATPs
Else
'IF(B11>=190,"very high",IF(B11>=160,"high",IF(B11>=130,"borderline high",IF(B11>=100,"above optimal","optimal")))))
If Val(LDL) >= 160 Then
    ATPs = ATPs & "The LDL-Cholesterol is HIGH.   "
Else
    If Val(LDL) >= 130 Then
        ATPs = ATPs & "The LDL-Cholesterol is BORDERLINE HIGH.   "
    Else
        If Val(LDL) >= 100 Then
            ATPs = ATPs & "The LDL-Cholesterol is ABOVE OPTIMAL.   "
        Else
                ATPs = ATPs & "The LDL-Cholesterol is OPTIMAL.   "
        End If
    End If
End If


ATPs = ATPs & "The Number of Coronary Risk Factors from the Adult Treatment Panel III criteria is/are: " & ATP & ".   "
'(B17="Y",B18="Y"),"< 100",IF(B28>=2,"< 130","< 160")))
If CAD = "Y" Or Text1(9) = "Y" Then
    ATPs = ATPs & "The LDL Cholesterol goal in mg/dl is less than 100.   "
    ATPx = 99
Else
    If ATP >= 2 Then
        ATPs = ATPs & "The LDL Cholesterol goal in mg/dl is less than 130.   "
        ATPx = 129
    Else
            ATPs = ATPs & "The LDL Cholesterol goal in mg/dl is less than 160.   "
            ATPx = 159
    End If
End If
If Val(LDL) < ATPx Then
        ATPs = ATPs & "The LDL Cholesterol does not require reduction.   "
Else
        ATPs = ATPs & "The LDL Cholesterol needs to be reduced by at least " & Val(LDL) - ATPx & "."
End If
If Syst1 <> "" Or diastolic <> "" Then
Interpret = Interpret & vbCr & vbLf & vbCr & vbLf & ATPs
End If
End If
'=======================================================================================================
Interpret = Interpret & vbCr & vbLf & vbCr & vbLf & "Your BMI is " & BmiValue & ". " & BMIcaption
End Sub

Private Sub FhxCAD_LostFocus()
If UCase(LTrim(RTrim(FhxCAD))) <> "Y" And UCase(LTrim(RTrim(FhxCAD))) <> "N" Then
    FhxCAD = ""
Else
FhxCAD = UCase((LTrim(RTrim(FhxCAD))))
End If
End Sub

Private Sub FhxCAD_KeyPress(KeyAscii As Integer)
If KeyAscii = 46 Then
KeyAscii = 0
Exit Sub
End If
If Chr(KeyAscii) Like "[a-zA-Z]" <> True And KeyAscii <> vbKeyBack And KeyAscii <> vbKeySpace And KeyAscii <> vbKeyDelete Then
KeyAscii = 0
End If

End Sub

Private Sub Fibrinogen_KeyPress(KeyAscii As Integer)
If KeyAscii = 46 Then
KeyAscii = 0
Exit Sub
End If
If Chr(KeyAscii) Like "#" <> True And KeyAscii <> vbKeyBack And KeyAscii <> vbKeyDelete And KeyAscii <> vbKeySpace Then
KeyAscii = 0
End If

End Sub

Private Sub Form_Load()
    Me.Top = (Screen.Height - Me.Height) / 2
    Me.Left = (Screen.Width - Me.Width) / 2
Combo1.AddItem "Kilograms to Pounds"
Combo1.AddItem "Pounds to Kilograms"
Combo1.AddItem "Centimeters to Inches"
Combo1.AddItem "Inches to Centimeters"
Combo1.AddItem "mmol/L to mg/dl"
Combo1.AddItem "mg/dl to mmol/L"
Combo1.AddItem "gm/L to mg/dl"
Combo1.AddItem "mg/dl to gm/L"
    Dim Msg, Style, Title, Help, Ctxt, Response, MyString
    Msg = "This Module is Intended as an Educational Device.   It is not warranteed for accuracy and is not designed to substitute for a clinical evaluation by your personal physician.   By clicking YES below, you agree with these terms."
    Style = vbYesNo + vbCritical + vbDefaultButton2
    Title = "Disclaimer"   ' Define title.
    Help = "DEMO.HLP"   ' Define Help file.
    Ctxt = 1000   ' Define topic
    Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbNo Then   ' User chose Yes.
   Unload Me   ' Perform some action.
   Exit Sub
End If
 
End Sub

Private Sub Hyperlipidemia_LostFocus()
If UCase(LTrim(RTrim(Hyperlipidemia))) <> "Y" And UCase(LTrim(RTrim(Hyperlipidemia))) <> "N" Then
    Hyperlipidemia = ""
Else
Hyperlipidemia = UCase((LTrim(RTrim(Hyperlipidemia))))
End If

End Sub

Private Sub Hyperlipidemia_KeyPress(KeyAscii As Integer)
If KeyAscii = 46 Then
KeyAscii = 0
Exit Sub
End If
If Chr(KeyAscii) Like "[a-zA-Z]" <> True And KeyAscii <> vbKeyBack And KeyAscii <> vbKeySpace And KeyAscii <> vbKeyDelete Then
KeyAscii = 0
End If

End Sub

Private Sub Hypertension_LostFocus()
If UCase(LTrim(RTrim(Hypertension))) <> "Y" And UCase(LTrim(RTrim(Hypertension))) <> "N" Then
    Hypertension = ""
Else
Hypertension = UCase((LTrim(RTrim(Hypertension))))
End If
End Sub

Private Sub Hypertension_KeyPress(KeyAscii As Integer)
If KeyAscii = 46 Then
KeyAscii = 0
Exit Sub
End If
If Chr(KeyAscii) Like "[a-zA-Z]" <> True And KeyAscii <> vbKeyBack And KeyAscii <> vbKeySpace And KeyAscii <> vbKeyDelete Then
KeyAscii = 0
End If

End Sub

Private Sub Obesity_LostFocus()
If UCase(LTrim(RTrim(Obesity))) <> "Y" And UCase(LTrim(RTrim(Obesity))) <> "N" Then
    Obesity = ""
Else
FhxCAD = UCase((LTrim(RTrim(Obesity))))
End If
End Sub

Private Sub Obesity_KeyPress(KeyAscii As Integer)
If KeyAscii = 46 Then
KeyAscii = 0
Exit Sub
End If
If Chr(KeyAscii) Like "[a-zA-Z]" <> True And KeyAscii <> vbKeyBack And KeyAscii <> vbKeySpace And KeyAscii <> vbKeyDelete Then
KeyAscii = 0
End If

End Sub

Private Sub text1_KeyPress(Index As Integer, KeyAscii As Integer)
Select Case Index
Case 0
If KeyAscii = 46 Then
KeyAscii = 0
Exit Sub
End If
If Chr(KeyAscii) Like "[a-zA-Z]" <> True And KeyAscii <> vbKeyBack And KeyAscii <> vbKeySpace And KeyAscii <> vbKeyDelete Then
KeyAscii = 0
End If

Case 1, 2
If KeyAscii = 46 Then
KeyAscii = 0
Exit Sub
End If
If Chr(KeyAscii) Like "#" <> True And KeyAscii <> vbKeyBack And KeyAscii <> vbKeyDelete And KeyAscii <> vbKeySpace Then
KeyAscii = 0
End If

End Select
End Sub

Private Sub Text1_LostFocus(Index As Integer)
If UCase(LTrim(RTrim(Text1(0)))) <> "F" And UCase(LTrim(RTrim(Text1(0)))) <> "M" Then
    Text1(0) = ""
    Text1(0).SetFocus
Else
Text1(0) = UCase((LTrim(RTrim(Text1(0)))))
If Text1(0) = "M" Then
    Text3.Text = "N"
    Text4.Text = "N"
End If
End If

If Text1(2) <> "" And Text1(3) <> "" Then
    Bmi
    Text1(19) = Str(BmiValue)
End If

If UCase(LTrim(RTrim(Text1(6)))) <> "Y" And UCase(LTrim(RTrim(Text1(6)))) <> "N" Then
    Text1(6) = ""
Else
Text1(6) = UCase((LTrim(RTrim(Text1(6)))))
End If

If UCase(LTrim(RTrim(Text1(7)))) <> "Y" And UCase(LTrim(RTrim(Text1(7)))) <> "N" Then
    Text1(7) = ""
Else
Text1(7) = UCase((LTrim(RTrim(Text1(7)))))
End If

If UCase(LTrim(RTrim(Text1(8)))) <> "Y" And UCase(LTrim(RTrim(Text1(8)))) <> "N" Then
    Text1(8) = ""
Else
Text1(8) = UCase((LTrim(RTrim(Text1(8)))))
End If

If UCase(LTrim(RTrim(Text1(9)))) <> "Y" And UCase(LTrim(RTrim(Text1(9)))) <> "N" Then
    Text1(9) = ""
Else
Text1(9) = UCase((LTrim(RTrim(Text1(9)))))
End If

If UCase(LTrim(RTrim(Text1(10)))) <> "Y" And UCase(LTrim(RTrim(Text1(10)))) <> "N" Then
    Text1(10) = ""
Else
Text1(10) = UCase((LTrim(RTrim(Text1(10)))))
Hypertension.Text = "Y"
End If

If UCase(LTrim(RTrim(Text1(13)))) <> "Y" And UCase(LTrim(RTrim(Text1(13)))) <> "N" Then
    Text1(13) = ""
Else
Text1(13) = UCase((LTrim(RTrim(Text1(13)))))
End If

'If UCase(LTrim(RTrim(Text1(14)))) <> "Y" And UCase(LTrim(RTrim(Text1(14)))) <> "N" Then
'    Text1(15) = ""
'Else
'Text1(15) = UCase((LTrim(RTrim(Text1(14)))))
'End If

'If UCase(LTrim(RTrim(Text1(15)))) <> "Y" And UCase(LTrim(RTrim(Text1(15)))) <> "N" Then
'    Text1(15) = ""
'Else
'Text1(15) = UCase((LTrim(RTrim(Text1(15)))))
'End If

'If UCase(LTrim(RTrim(Text1(16)))) <> "Y" And UCase(LTrim(RTrim(Text1(16)))) <> "N" Then
'    Text1(16) = ""
'Else
'Text1(16) = UCase((LTrim(RTrim(Text1(16)))))
'End If


'If UCase(LTrim(RTrim(Text1(17)))) <> "Y" And UCase(LTrim(RTrim(Text1(17)))) <> "N" Then
'    Text1(17) = ""
'Else
'Text1(17) = UCase((LTrim(RTrim(Text1(17)))))
'End If

End Sub

Private Sub Text10_LostFocus()
If UCase(LTrim(RTrim(Text10))) <> "Y" And UCase(LTrim(RTrim(Text10))) <> "N" Then
    Text10 = ""
Else
Text10 = UCase((LTrim(RTrim(Text10))))
Text8 = "Y"
End If
End Sub

Private Sub Text10_KeyPress(KeyAscii As Integer)
If KeyAscii = 46 Then
KeyAscii = 0
Exit Sub
End If
If Chr(KeyAscii) Like "[a-zA-Z]" <> True And KeyAscii <> vbKeyBack And KeyAscii <> vbKeySpace And KeyAscii <> vbKeyDelete Then
KeyAscii = 0
End If

End Sub

Private Sub Text11_LostFocus()
If UCase(LTrim(RTrim(Text11))) <> "Y" And UCase(LTrim(RTrim(Text11))) <> "N" Then
    Text11 = ""
Else
Text11 = UCase((LTrim(RTrim(Text11))))
Text6 = "Y"
End If