modorgandescribe.bas

VB6.0编写的医院影像系统

    AdnexaDescribe = AdnexaDescribe & strTemp
        
End Function

Public Function FoetusDescribe(frmTemplet As Form) As String                                    '胎儿

    Dim strTemp As String
    
    With frmTemplet
    
        strTemp = "胎儿:" & vbCrLf
    
        If .txtF_HP.Text <> "" Then strTemp = strTemp & "头臀长" & .txtF_HP.Text & "mm,"
        If .txtF_Top.Text <> "" Then strTemp = strTemp & "双顶径" & .txtF_Top.Text & "mm,"
        If .txtF_Chest.Text <> "" Then strTemp = strTemp & "胸径" & .txtF_Chest.Text & "mm,"
        If .txtF_RightLeft.Text <> "" Then strTemp = strTemp & "腹径" & .txtF_RightLeft.Text & "mm,"
        If .txtF_Foreandaft.Text <> "" Then strTemp = strTemp & "前后径" & .txtF_Foreandaft.Text & "mm,"
        If .txtF_Thighbone.Text <> "" Then strTemp = strTemp & "股骨长" & .txtF_Thighbone.Text & "mm,"
        strTemp = Change_End(strTemp)
        If .cboF_Position.Text <> "" Then strTemp = strTemp & "胎位" & .cboF_Position.Text & ","
        If .cboF_Placenta.Text <> "" Then strTemp = strTemp & "胎盘位置" & .cboF_Placenta.Text & ","
        If .cboF_Ripeness.Text <> "" Then strTemp = strTemp & "胎盘成熟度" & .cboF_Ripeness.Text & ","
        If .txtF_Thick.Text <> "" Then strTemp = strTemp & "胎盘厚度" & .txtF_Thick.Text & "mm,"
        strTemp = Change_End(strTemp)
        If .cboF_Cover <> "" Then strTemp = strTemp & "胎盘边缘" & .cboF_Cover & "遮盖子宫内口,"
        If .TxtF_L.Text <> "" Then strTemp = strTemp & "胎盘下缘距宫颈内口" & .TxtF_L.Text & "mm,"
        strTemp = Change_End(strTemp)
        If .cboF_See.Text <> "" Then strTemp = strTemp & .cboF_See.Text & "胎心搏动及胎动,"
        If .txtF_H.Text <> "" Then strTemp = strTemp & "心率" & .txtF_H.Text & "B/Min。"
        strTemp = Change_End(strTemp)
        If .cboF_other.Text <> "" Then strTemp = strTemp & "其它: " & .cboF_other.Text & "。" & vbCrLf
        
        If .txtF_W_1.Text <> "" Or .txtF_W_2.Text <> "" Or .txtF_W_3.Text <> "" Or .txtF_W_4.Text <> "" Then
            strTemp = strTemp & "羊水范围: " & .txtF_W_1.Text & "mm, " & .txtF_W_2.Text & "mm, " & _
                .txtF_W_3.Text & "mm, " & .txtF_W_4.Text & "mm。" & vbCrLf
        End If
        
        If .txtF_B_SD1.Text <> "" Then strTemp = strTemp & "脐动脉S/D " & .txtF_B_SD1.Text & ","
        If .txtF_B_SD2.Text <> "" Then strTemp = strTemp & "大脑中动脉S/D " & .txtF_B_SD2.Text & ","
        If .txtF_B_PI1.Text <> "" Then strTemp = strTemp & "脐动脉PI " & .txtF_B_PI1.Text & ","
        If .txtF_B_PI2.Text <> "" Then strTemp = strTemp & "大脑中动脉PI " & .txtF_B_PI2.Text & ","
        If .txtF_B_RI1.Text <> "" Then strTemp = strTemp & "脐动脉RI " & .txtF_B_RI1.Text & ","
        If .txtF_B_RI2.Text <> "" Then strTemp = strTemp & "大脑中动脉RI " & .txtF_B_RI2.Text & ","
        strTemp = Change_End(strTemp)
        
        '处理空值、结束符,并回车换行
        If strTemp = ("胎儿:" & vbCrLf) Then
            strTemp = strTemp & "未见异常。" & vbCrLf
        Else
            If Right$(strTemp, 1) = "," Then Mid$(strTemp, Len(strTemp)) = "。"
            strTemp = strTemp & vbCrLf
        End If
        
    End With
    
    FoetusDescribe = strTemp
    
End Function

Public Function ThoraxDescribe(frmTemplet As Form) As String
    
    '---------------------
    '生成胸腔探测的描述
    '---------------------
    
    Dim strTemp As String, i As Integer
    
    With frmTemplet
            
        strTemp = "胸腔探测:"
        
        For i = 0 To 1
            If .cboThorax_Side(i).Text <> vbNullString Then strTemp = strTemp & .cboThorax_Side(i).Text & "胸腔探测,"
            If .cboThorax_Liq(i).Text <> vbNullString Then strTemp = strTemp & .cboThorax_Liq(i).Text & "积液,"
            If .txtThorax_Rib_1(i).Text <> vbNullString Then strTemp = strTemp & "范围" & .txtThorax_Rib_1(i).Text & "肋"
            If .txtThorax_Rib_2(i).Text <> vbNullString Then strTemp = strTemp & "到" & .txtThorax_Rib_2(i).Text & "肋,"
            If .txtThorax_ID(i).Text <> vbNullString Then strTemp = strTemp & "内径" & .txtThorax_ID(i).Text & "mm,"
            If .cboThorax_Echo(i).Text <> vbNullString Then strTemp = strTemp & "内见" & .cboThorax_Echo(i).Text & ","
            If .cboThorax_Locate(i).Text <> vbNullString Then strTemp = strTemp & .cboThorax_Locate(i).Text & "定位,"
            strTemp = Change_End(strTemp)
        Next
    End With
    
    '处理空值、结束符,并回车换行
    If strTemp = "胸腔探测:" Then
            strTemp = strTemp & "未见异常。" & vbCrLf
    Else
        If Right$(strTemp, 1) = "," Then Mid$(strTemp, Len(strTemp)) = "。"
        strTemp = strTemp & vbCrLf
    End If
    
    ThoraxDescribe = strTemp

End Function

Public Function ScrotumDescribe(frmTemplet As Form) As String
    
    '---------------------
    '生成阴囊的描述
    '---------------------
    
    Dim strTemp As String, Temp_Str As String, i As Integer
    
    With frmTemplet
            
        strTemp = "阴囊:"
        
        For i = 0 To 1
            If .txtSC_L(i).Text <> "" Or .txtSC_W(i).Text <> "" Or .txtSC_H(i).Text <> "" Then
                Temp_Str = Temp_Str & "睾丸大小 " & LengthWideThick(.txtSC_L(i).Text, .txtSC_W(i).Text, .txtSC_H(i).Text) & "mm,"
                ' .txtSC_L(i).Text & "×" & .txtSC_W(i).Text & "×" & _
                    .txtSC_H(i).Text & "mm,"
            End If
            If .cboSC_Shape(i).Text <> vbNullString Then Temp_Str = Temp_Str & "形态" & .cboSC_Shape(i).Text & ", "
            If .cboSC_Dot(i).Text <> vbNullString Then Temp_Str = Temp_Str & "光点" & .cboSC_Dot(i).Text & ", "
            If .cboSC_Echo(i).Text <> vbNullString Then Temp_Str = Temp_Str & "回声分布" & .cboSC_Echo(i).Text & ", "
            If .cboSC_Blood(i).Text <> vbNullString Then Temp_Str = Temp_Str & "血流分布" & .cboSC_Blood(i).Text & ","
            If i = 0 Then
                strTemp = strTemp & "右侧" & Temp_Str
            Else
                strTemp = strTemp & "左侧" & Temp_Str
            End If
            Temp_Str = ""
        Next
        
        For i = 0 To 1
            If .txtSC_Head_L(i).Text <> vbNullString Or .txtSC_Head_W(i).Text <> vbNullString Or .txtSC_Head_Z(i).Text <> vbNullString Then
                Temp_Str = Temp_Str & "附睾头大小" & LengthWideThick(.txtSC_Head_L(i).Text, .txtSC_Head_W(i).Text, .txtSC_Head_Z(i).Text) & "mm, "
                ' .txtSC_Head_L(i).Text & "×" & .txtSC_Head_W(i).Text & "×" & .txtSC_Head_Z(i).Text & "mm, "
            End If
            If .txtSC_Tail_L(i).Text <> vbNullString Or .txtSC_Tail_W(i).Text <> vbNullString Or .txtSC_Tail_Z(i).Text <> vbNullString Then
                Temp_Str = Temp_Str & "附睾尾大小" & LengthWideThick(.txtSC_Tail_L(i).Text, .txtSC_Tail_W(i).Text, .txtSC_Tail_Z(i).Text) & "mm, "
                ' .txtSC_Tail_L(i).Text & "×" & .txtSC_Tail_W(i).Text & "×" & .txtSC_Tail_Z(i).Text & "mm, "
            End If
            If .cboSC_Tail_Echo(i).Text <> vbNullString Then
                Temp_Str = Temp_Str & " 回声分布 " & .cboSC_Tail_Echo(i).Text & ","
            End If
            If .cboSC_Tail_Blood(i).Text <> "" Then Temp_Str = Temp_Str & "血流分布" & .cboSC_Tail_Blood(i).Text & ","
            Temp_Str = Change_End(Temp_Str)
            If i = 0 Then
                strTemp = strTemp & "右侧" & Temp_Str
            Else
                strTemp = strTemp & "左侧" & Temp_Str
            End If
            Temp_Str = ""
        Next
        
        For i = 0 To 1
            If .cboSC_Mem_Side(i).Text <> vbNullString And .cboSC_Mem_Liq(i).Text <> vbNullString Then
                strTemp = strTemp & .cboSC_Mem_Side(i).Text & "睾丸鞘膜腔" & .cboSC_Mem_Liq(i).Text & "积液,"
            End If
            If .txtSC_GY(i).Text <> "" Then strTemp = strTemp & .txtSC_GY(i).Text & "mm,"
            strTemp = Change_End(strTemp)
        Next
        
        If .cboSC_Renal.Text <> vbNullString And .cboSC_LymphNode.Text <> vbNullString Then
            strTemp = strTemp & .cboSC_Renal.Text & "肾门" & .cboSC_LymphNode.Text & ", "
        End If
        If .txtSC_LN_Length.Text <> vbNullString Or .txtSC_LN_Width.Text <> vbNullString Or .txtSC_LN_Z.Text <> vbNullString Then
            strTemp = strTemp & .cboSC_LymphNode_Bigger.Text & LengthWideThick(.txtSC_LN_Length.Text, .txtSC_LN_Width.Text, .txtSC_LN_Z.Text) & "mm。" & vbCrLf
            ' .txtSC_LN_Length.Text & "×" & .txtSC_LN_Width.Text & "×" & _
            .txtSC_LN_Z.Text & "mm。" & vbCrLf
        End If
        
    End With
    
    '处理空值、结束符,并回车换行
    If strTemp = "阴囊:" Then
            strTemp = strTemp & "未见异常。" & vbCrLf
    Else
        If Right$(strTemp, 1) = "," Then Mid$(strTemp, Len(strTemp)) = "。"
        strTemp = strTemp & vbCrLf
    End If
    
    ScrotumDescribe = strTemp

End Function

Public Function KidneysTransplantDescribe(frmTemplet As Form) As String                                    '肾移植

    Dim strTemp As String
    Dim i As Integer

    With frmTemplet

        KidneysTransplantDescribe = "移植肾:" & vbCrLf

        If .cboKT_P.Text <> "" Or .cboKT_PL.Text <> "" Then KidneysTransplantDescribe = _
            KidneysTransplantDescribe & .cboKT_P.Text & "移植肾位于" & .cboKT_PL.Text & "。"
        If .txtKT_L.Text <> "" Or .txtKT_W.Text <> "" Or .txtKT_T.Text <> "" Then strTemp = strTemp & _
            "移植肾大小: " & LengthWideThick(.txtKT_L.Text, .txtKT_W.Text, .txtKT_T.Text) & "mm,"
            ' .txtKT_L.Text & "×" & .txtKT_W.Text & "×" & .txtKT_T.Text & "mm,"
        If .cboKT_Shape.Text <> "" Then
            strTemp = strTemp & "形态" & .cboKT_Shape.Text & ","
        End If
        If Right$(strTemp, 1) = "," Then
            Mid$(strTemp, Len(strTemp)) = "。"
            KidneysTransplantDescribe = KidneysTransplantDescribe & "    " & strTemp & vbCrLf
            strTemp = ""
        End If

        If .cboKT_A.Text <> "" Then strTemp = strTemp & "肾周" & .cboKT_A.Text & "积液,"
        If .cboKT_Place.Text <> "" Then strTemp = strTemp & "肾内" & .cboKT_Place.Text
        If .cboKT_I.Text <> "" And .cboKT_Place.Text <> "" Then
            strTemp = strTemp & "见" & .cboKT_I.Text & ","
        ElseIf .cboKT_I.Text <> "" Then
            strTemp = strTemp & "肾内见" & .cboKT_I.Text & ","
        End If
        If .txtKT_BL.Text <> "" Or .txtKT_BW.Text <> "" Or .txtKT_BZ.Text <> "" Then
            strTemp = strTemp & .cboKT_D.Text & LengthWideThick(.txtKT_BL.Text, .txtKT_BW.Text, .txtKT_BZ.Text) & "mm,"
            ' .txtKT_BL.Text & "×" & .txtKT_BW.Text & "×" & .txtKT_BZ.Text & "mm,"
        End If
        If Right$(strTemp, 1) = "," Then
            Mid$(strTemp, Len(strTemp)) = "。"
            KidneysTransplantDescribe = KidneysTransplantDescribe & "    " & strTemp & vbCrLf
            strTemp = ""
        End If

        If .cboKT_B.Text <> "" Then strTemp = strTemp & "集合系统结构" & .cboKT_B.Text & ","
        If .CboMT_B.Text <> "" Then strTemp = strTemp & "血液信号" & .CboMT_B.Text & ","
        If .cboMT_BD.Text <> "" Then strTemp = strTemp & "血流信号分布呈" & .cboMT_BD.Text & ","
        If Right$(strTemp, 1) = "," Then
            Mid$(strTemp, Len(strTemp)) = "。"
            KidneysTransplantDescribe = KidneysTransplantDescribe & "    " & strTemp & vbCrLf
            strTemp = ""
        End If
        For i = 0 To 3
            If .txtKT_Max(i).Text <> "" Then strTemp = strTemp & " Vmax " & .txtKT_Max(i).Text & "m/s,"
            If .txtKT_Min(i).Text <> "" Then strTemp = strTemp & " Vmin " & .txtKT_Min(i).Text & "m/s,"
            If .txtKT_RI(i).Text <> "" Then strTemp = strTemp & " RI " & .txtKT_RI(i).Text & ","
            If .txtKT_PI(i).Text <> "" Then strTemp = strTemp & " PI " & .txtKT_PI(i).Text & ","
            If .txtKT_MM(i).Text <> "" Then strTemp = strTemp & " Vmin/Vmax " & .txtKT_MM(i).Text & ","
            If Right$(strTemp, 1) = "," Then
                Mid$(strTemp, Len(strTemp)) = ";"
                Select Case i
                    Case 0
                        strTemp = "肾主动脉血流 " & strTemp & vbCrLf
                    Case 1
                        strTemp = "段 动 脉血流 " & strTemp & vbCrLf
                    Case 2
                        strTemp = "叶间动脉血流 " & strTemp & vbCrLf
                    Case 3
                        strTemp = "弓形动脉血流 " & strTemp & vbCrLf
                    Case Else
                End Select
                KidneysTransplantDescribe = KidneysTransplantDescribe & strTemp
                strTemp = ""
            End If