⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 modorgantip.bas

📁 VB6.0编写的医院影像系统
💻 BAS
📖 第 1 页 / 共 3 页
字号:

Public Function RingTip(frmTemplet As Form) As String
'透环
    Dim strTemp As String
    
    With frmTemplet
    
        If .cboR_Ring.Text <> "" Then strTemp = strTemp & "宫内节育环" & .cboR_Ring.Text & ","
        
    End With
    
    If Right$(strTemp, 1) = "," Then Mid$(strTemp, Len(strTemp)) = "。"
    RingTip = strTemp
    
End Function

Public Function KidneysPunctureTip(frmTemplet As Form) As String
'双肾穿刺定位
    Dim strTemp As String
    
    With frmTemplet
    
        If .cboKP_Part.Text <> "" Then strTemp = strTemp & .cboKP_Part.Text & "肾穿刺已定位,"
        
    End With
    
    If Right$(strTemp, 1) = "," Then Mid$(strTemp, Len(strTemp)) = "。"
    KidneysPunctureTip = strTemp
    
End Function

Public Function EyesTip(frmTemplet As Form) As String
'双眼
    Dim strTemp As String
    
    With frmTemplet
    
        If .cboE_R_VitreousBody.Text = "见少量絮状回声" Then strTemp = strTemp & "右眼玻璃体浑浊,"
        
        Select Case .cboE_R_Eyeground.Text
            Case "见有分离光带,呈V字形分布"
                strTemp = strTemp & "右眼视网膜脱离,"
            Case "见有分离光带,呈半球形隆起"
                strTemp = strTemp & "右眼脉络膜脱离,"
            Case Else
        End Select
        
        If .cboE_L_VitreousBody.Text = "见少量絮状回声" Then strTemp = strTemp & "左眼玻璃体浑浊,"
        
        Select Case .cboE_L_Eyeground.Text
            Case "见有分离光带,呈V字形分布"
                strTemp = strTemp & "左眼视网膜脱离,"
            Case "见有分离光带,呈半球形隆起"
                strTemp = strTemp & "左眼脉络膜脱离,"
            Case Else
        End Select
        
    End With
    
    If Right$(strTemp, 1) = "," Then
        Mid$(strTemp, Len(strTemp)) = "。"
    Else
        strTemp = "双眼未见异常。"
    End If
    EyesTip = strTemp
    
End Function

Public Function AdrensTip(frmTemplet As Form) As String                             '双肾上腺

    Dim strTemp As String
    Dim i As Integer
    
    With frmTemplet
    
        For i = 0 To 1
        
            If .cboA_Part1(i).Text <> "" And .cboA_Echo(i).Text <> "" Then
                strTemp = strTemp & .cboA_Part1(i).Text & "侧肾上腺内部回声" & .cboA_Echo(i).Text & ","
            End If
            
            Select Case .cboA_Probe(i).Text
            
                Case "见液性暗区"
                    strTemp = strTemp & .cboA_Part1(i).Text & "侧肾上腺液性占位(囊肿),"
                    
                Case "见低回声光团", "见中等回声光团"
                    strTemp = strTemp & .cboA_Part1(i).Text & "侧肾上腺实质性占位,"
                    
                Case Else
            End Select
        
            If .cboA_Echo(i).Text = "细密明亮" And .cboA_Probe(i).Text = "见高回声光团" Then
                strTemp = strTemp & .cboA_Part1(i).Text & "侧肾上腺髓性脂肪瘤,"
            End If
        Next
        
    End With
    
    If Right$(strTemp, 1) = "," Then
        Mid$(strTemp, Len(strTemp)) = "。"
    Else
        strTemp = "双肾上腺未见异常。"
    End If
    AdrensTip = strTemp
    
End Function

Public Function ThyroidGlandTip(frmTemplet As Form) As String                             '甲状腺

    Dim strTemp As String
    
    With frmTemplet
        
        If .cboTG_R_Leaf.Text = "已切除,未显示" Then strTemp = strTemp & "右叶已切除,"
        If .cboTG_R_Shape.Text = "饱满" And .cboTG_R_BloodStream.Text = "增强" Then
            strTemp = strTemp & "右叶符合甲亢声像图,建议查T3、T4,"
        End If
        
        If .cboTG_L_Leaf.Text = "已切除,未显示" Then strTemp = strTemp & "左叶已切除,"
        If .cboTG_L_Shape.Text = "饱满" And .cboTG_L_BloodStream.Text = "增强" Then
            strTemp = strTemp & "左叶符合甲亢声像图,建议查T3、T4,"
        End If
        
        Select Case .cboTG_See.Text
        
            Case "液性暗区"
                strTemp = strTemp & "甲状腺" & .cboTG_Place.Text & "见液性占位,"
                
            Case "低回声肿块", "中等回声肿块", "高回声肿块"
                strTemp = strTemp & "甲状腺" & .cboTG_Place.Text & "见实质性占位,"
                
            Case Else
        End Select
        
    End With
    
    If Right$(strTemp, 1) = "," Then
        Mid$(strTemp, Len(strTemp)) = "。"
    Else
        strTemp = "甲状腺未见异常。"
    End If
    ThyroidGlandTip = strTemp
    
End Function

Public Function MammaryGlandTip(frmTemplet As Form) As String                             '乳腺

    Dim strTemp As String
    Dim i As Integer
    
    With frmTemplet
        
        For i = 0 To 3
            Select Case .cboMG_See(i).Text
                Case "液性暗区"
                    strTemp = strTemp & .cboMG_Part1(i).Text & "乳腺" & .cboMG_Quadrant(i).Text & "象限" & "液性占位,"
                Case "多个液性暗区"
                    strTemp = strTemp & .cboMG_Part1(i).Text & "乳腺" & .cboMG_Quadrant(i).Text & "象限" & "多发液性占位,"
                Case "低回声肿块", "中等回声肿块"
                    strTemp = strTemp & .cboMG_Part1(i).Text & "乳腺" & .cboMG_Quadrant(i).Text & "象限" & "实质性占位,"
                Case "多个低回声肿块", "多个中等回声肿块"
                    strTemp = strTemp & .cboMG_Part1(i).Text & "乳腺" & .cboMG_Quadrant(i).Text & "象限" & "多发实质性占位,"
                Case Else
            End Select
        Next
        
    End With
    
    If Right$(strTemp, 1) = "," Then
        Mid$(strTemp, Len(strTemp)) = "。"
    Else
        strTemp = "乳腺未见异常。"
    End If
    MammaryGlandTip = strTemp
    
End Function

Public Function WombTip(frmTemplet As Form) As String                             '子宫

    Dim strTemp As String
    Dim i As Integer, j As Integer
    
    With frmTemplet
    
        '子宫
        Select Case .cboW_In_See.Text
            Case "孕囊回声"
                strTemp = strTemp & "早孕,"
            Case "孕囊,孕囊旁见节育环"
                strTemp = strTemp & "早孕(带环),"
            Case "孕囊回声,内见胎芽及心管搏动", "孕囊回声,内见胎芽及心管搏动,见卵黄囊"
                strTemp = strTemp & "早孕,目前见心管搏动,"
            Case "中等回声光团"
                strTemp = strTemp & "宫腔内中等回声光团,"
            Case "低回声光团"
                strTemp = strTemp & "宫腔内低回声光团,"
            Case "混合光团"
                strTemp = strTemp & "宫内PRT,"
            Case Else
        End Select
        If Val(.txtW_Thick.Text) > 10 Then strTemp = strTemp & "内膜增厚,"
        
        For i = 0 To 3
        Select Case .cboW_See(i).Text
            Case "低回声光团"       ', "中等回声光团", "强回声光团"
               If .cboW_Envelope(i).Text = "有" Then
                    j = InStr(1, strTemp, "子宫肌瘤")
                    If j = 0 And InStr(1, strTemp, "子宫多发肌瘤") = 0 Then
                        strTemp = strTemp & "子宫肌瘤,"
                    ElseIf j > 0 Then
                        strTemp = Left(strTemp, j + 1) & "多发" & Right(strTemp, Len(strTemp) - j - 1)
                    End If
                Else
                    strTemp = strTemp & "子宫肌腺症,"
                End If
            Case "多个低回声光团"         ', "多个中等回声光团"
                If .cboW_Envelope(i).Text = "有" Then
                    j = InStr(1, strTemp, "子宫肌瘤")
                    If j = 0 And InStr(1, strTemp, "子宫多发肌瘤") = 0 Then
                        strTemp = strTemp & "子宫多发肌瘤,"
                    ElseIf InStr(1, strTemp, "子宫多发肌瘤") = 0 Then
                        strTemp = Left(strTemp, j + 1) & "多发" & Right(strTemp, Len(strTemp) - j - 1)
                    End If
                End If
            Case "液性暗区"
                strTemp = strTemp & "子宫液性占位,"
            Case Else
        End Select
        Next
        Select Case .cboW_WN_See.Text
            Case "低回声光团"
                strTemp = strTemp & "宫颈肌瘤,"
            Case "无回声区"
                strTemp = strTemp & "宫颈囊肿,"
            Case Else
        End Select
    End With
    If strTemp <> "" Then
        WombTip = Change_End(strTemp)
    Else
        WombTip = "子宫未见异常。"
    End If
End Function

Public Function AdnexaTip(frmTemplet As Form) As String                             '附件

    Dim strTemp As String
    
    With frmTemplet
        '卵巢
        If .cboW_R_Ovary.Text = "已切除,未显示" Then strTemp = strTemp & "右卵巢已切除,"
        
        Select Case .cboW_RSI.Text
            Case "无回声区"
                strTemp = strTemp & "右卵巢囊肿,"
            Case "液性暗区,内见强光团,后方伴声影"
                strTemp = strTemp & "右卵巢畸胎瘤,"
            Case "细密光点"
                strTemp = strTemp & "右卵巢内膜囊肿,"
            Case "分隔光带"
                strTemp = strTemp & "右卵巢多房性囊,"
            Case "实质性强光团"
                strTemp = strTemp & "右卵巢实质性肿瘤,"
            Case Else
        End Select
        If .cboW_RSO.Text = "无回声区" Then strTemp = strTemp & "右卵巢旁囊肿,"
        
        If .cboW_L_Ovary.Text = "已切除,未显示" Then strTemp = strTemp & "左卵巢已切除,"
        Select Case .cboW_LSI.Text
            Case "无回声区"
                strTemp = strTemp & "左卵巢囊肿,"
            Case "液性暗区,内见强光团,后方伴声影"
                strTemp = strTemp & "左卵巢畸胎瘤,"
            Case "细密光点"
                strTemp = strTemp & "左卵巢内膜囊肿,"
            Case "分隔光带"
                strTemp = strTemp & "左卵巢多房性囊,"
            Case "实质性强光团"
                strTemp = strTemp & "左卵巢实质性肿瘤,"
            Case Else
        End Select
        If .cboW_LSO.Text = "无回声区" Then strTemp = strTemp & "左卵巢旁囊肿,"
        If strTemp = "" Then strTemp = "双侧附件未见异常,"
        
        '盆腔
        Select Case .cboW_PelvicCavity.Text
            Case "见少量"
                strTemp = strTemp & "盆腔少量积液,"
            Case "见中量"
                strTemp = strTemp & "盆腔中量积液,"
            Case "见大量"
                strTemp = strTemp & "盆腔大量积液,"
            Case Else
        End Select
        Select Case .cboW_A_See.Text
            Case "液性肿块"
                strTemp = strTemp & .cboW_Adnexa.Text & "液性占位,"
            Case "低回声肿块", "中等回声肿块"
                strTemp = strTemp & .cboW_Adnexa.Text & "实质性占位,"
            Case Else
        End Select
        If .cboW_A_See.Text = "混合性肿块" And .cboW_InA_See.Text = "液性暗区及心管搏动" Then
            strTemp = strTemp & .cboW_Adnexa.Text & "混合性占位(异位妊娠),"
        ElseIf .cboW_A_See.Text = "混合性肿块" Then
            strTemp = strTemp & .cboW_Adnexa.Text & "混合性占位,"
        End If
        
    End With
    
    If strTemp <> "" Then
        strTemp = Change_End(strTemp)
    Else
        strTemp = "双侧附件未见异常。"
    End If
    AdnexaTip = strTemp
    
End Function

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

    Dim strTemp As String
    Dim i As Integer
    
    With frmTemplet
        If .cboF_Position.Text <> "" Then
            If InStr(.cboF_Position.Text, "Sc") <> 0 Then
                strTemp = strTemp & "横位,"
            ElseIf InStr(.cboF_Position.Text, "O") <> 0 Then
                strTemp = strTemp & "头位,"
            ElseIf InStr(.cboF_Position.Text, "S") <> 0 Then
                strTemp = strTemp & "臀位,"
            End If
       End If

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -