frmsetorgantemp.frm

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

         Caption         =   "确定 [ENTER]"
         Default         =   -1  'True
         BeginProperty Font 
            Name            =   "楷体_GB2312"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   3825
         TabIndex        =   2
         Top             =   180
         Width           =   1275
      End
   End
   Begin VB.Frame Frame1 
      Height          =   75
      Left            =   120
      TabIndex        =   0
      Top             =   4530
      Width           =   6435
   End
   Begin VB.Label Label14 
      BackStyle       =   0  'Transparent
      Caption         =   "频率："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   3720
      TabIndex        =   34
      Top             =   5280
      Width           =   900
   End
   Begin VB.Label Label13 
      BackStyle       =   0  'Transparent
      Caption         =   "序号："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   180
      TabIndex        =   32
      Top             =   5280
      Width           =   900
   End
   Begin VB.Label Label12 
      BackStyle       =   0  'Transparent
      Caption         =   "性别："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   3720
      TabIndex        =   30
      Top             =   4800
      Width           =   780
   End
   Begin VB.Label Label11 
      BackStyle       =   0  'Transparent
      Caption         =   "报告类型："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   180
      TabIndex        =   28
      Top             =   4800
      Width           =   900
   End
   Begin VB.Label Label10 
      BackStyle       =   0  'Transparent
      Caption         =   "脏器数目："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   3720
      TabIndex        =   26
      Top             =   4140
      Width           =   900
   End
   Begin VB.Label Label9 
      BackStyle       =   0  'Transparent
      Caption         =   "心超价格："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   180
      TabIndex        =   24
      Top             =   4140
      Width           =   900
   End
   Begin VB.Label Label8 
      BackStyle       =   0  'Transparent
      Caption         =   "彩超价格："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   3720
      TabIndex        =   22
      Top             =   3660
      Width           =   900
   End
   Begin VB.Label Label7 
      BackStyle       =   0  'Transparent
      Caption         =   "黑白价格："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   180
      TabIndex        =   20
      Top             =   3660
      Width           =   900
   End
   Begin VB.Label Label3 
      BackStyle       =   0  'Transparent
      Caption         =   "部位大类："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   3660
      TabIndex        =   16
      Top             =   240
      Width           =   1005
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "部位名称："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   180
      TabIndex        =   9
      Top             =   255
      Width           =   1500
   End
End
Attribute VB_Name = "frmSetOrganTemp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public WorkType As String               '工作类型(添加/编辑)
Public CombName As String               '器官组合名称
Public CombString As String             '组合字串

Private OriginCombName As String

Private Sub cboTemp_Click()
    
    '点击时填充器官列表
    
    Dim rsTemp As ADODB.Recordset
    Dim CombList() As String
    
    On Error Resume Next
    
    Set rsTemp = OpenRSClient("SELECT TEMP_COMB_STRING FROM US_ORGAN_TEMP WHERE TEMP_NAME = '" & cboTemp.Text & "'")
    CombList = Split(rsTemp!TEMP_COMB_STRING, US_STR_COMBSPLIT)
    ListComb CombList

End Sub

Private Sub cmdAdd_Click()
    
    Dim strComb As String
    Dim i As Integer
    
    '找出对应的器官字串
    With lstOrganString
        strComb = vbNullString
        For i = 0 To .ListCount - 1
            If .Selected(i) Then strComb = strComb & .List(i) & US_STR_COMBSPLIT
        Next i
        If Right(strComb, 1) = US_STR_COMBSPLIT Then strComb = Left(strComb, Len(strComb) - 1)
    End With
    
    '检查
    If strComb = vbNullString Or cboTemp.Text = vbNullString Then
        MsgBox "请选择有效的内容!", vbOKOnly + vbInformation, "提示"
        Exit Sub
    End If
    
    '预先校验工作(检查原先是否为空)
    If Trim(txtTemp.Text) = vbNullString Then
        txtTemp.Text = cboTemp.Text
    Else
        txtTemp.Text = txtTemp.Text & US_STR_TEMPSPLIT & cboTemp.Text
    End If
    
    If Trim(txtCombString.Text) = vbNullString Then
        txtCombString.Text = strComb
    Else
        txtCombString.Text = txtCombString.Text & US_STR_TEMPSPLIT & strComb
    End If
    
    frmOrganVSTemp.rsOrganVSTemp!TEMP_NAME = txtTemp.Text
    frmOrganVSTemp.rsOrganVSTemp!COMB_STRING = txtCombString.Text
    
End Sub

Private Sub cmdCancel_Click()
    frmOrganVSTemp.rsOrganVSTemp.Cancel
    Unload Me
End Sub

Private Sub cmdClear_Click()
    txtTemp.Text = vbNullString
    txtCombString.Text = vbNullString
End Sub


Private Sub cmdOK_Click()
    Dim i As Integer
    
    '必须要求部位大类的输入
    
'    If Trim(cboRegion.Text) = vbNullString Then
'        MsgBox "请选择所属的部位大类!", vbInformation + vbOKOnly, "提示"
'        Exit Sub
'    End If
        
    
    On Error Resume Next
    
    '检查必要的输入
    If Trim(txtCombName.Text) = vbNullString Then
        MsgBox "对不起, 您必须输入此部位的名称!", vbInformation + vbOKOnly, "提示"
        txtCombName.Text = OriginCombName
        frmOrganVSTemp.rsOrganVSTemp(txtCombName.DataField).Value = OriginCombName
        Exit Sub
    End If
            
    frmOrganVSTemp.rsOrganVSTemp.Update
    Unload Me

    

    '释放对象
    
End Sub


Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    
    '处理键盘事件
    Select Case KeyCode
        Case vbKeyReturn
            cmdOK_Click
            
        Case US_KEY_CANCEL
            cmdCancel_Click
            
        Case vbKeyF1
            
    End Select
    
End Sub

Private Sub Form_Load()
    
    On Error Resume Next
    
    Dim rsTemp As ADODB.Recordset
    
    '填充"器官部位"列表
    Set rsTemp = OpenRSClient("SELECT * FROM US_ORGAN_REGION")
    With rsTemp
        cboRegion.Clear
        Do While Not .EOF
            cboRegion.AddItem !REGION_NAME
            .MoveNext
        Loop
        cboRegion.Text = frmOrganVSTemp.rsOrganVSTemp!REGION_NAME & vbNullString
    End With
    
    '填充"器官模板"列表
    Set rsTemp = OpenRSClient("SELECT * FROM US_ORGAN_TEMP")
    With rsTemp
        cboTemp.Clear
        Do While Not .EOF
            cboTemp.AddItem !TEMP_NAME
            .MoveNext
        Loop
    End With
    
    Set rsTemp = Nothing
    
    '设置绑定
    Set txtCombName.DataSource = frmOrganVSTemp.rsOrganVSTemp
    Set cboRegion.DataSource = frmOrganVSTemp.rsOrganVSTemp
    Set txtTemp.DataSource = frmOrganVSTemp.rsOrganVSTemp
    Set txtCombString.DataSource = frmOrganVSTemp.rsOrganVSTemp
    Set txtBWPrice.DataSource = frmOrganVSTemp.rsOrganVSTemp
    Set txtColorPrice.DataSource = frmOrganVSTemp.rsOrganVSTemp
    Set txtHeartPrice.DataSource = frmOrganVSTemp.rsOrganVSTemp
    Set txtOrganNum.DataSource = frmOrganVSTemp.rsOrganVSTemp
    Set txtUSType.DataSource = frmOrganVSTemp.rsOrganVSTemp
    Set txtSex.DataSource = frmOrganVSTemp.rsOrganVSTemp
    Set txtIndex.DataSource = frmOrganVSTemp.rsOrganVSTemp
    Set txtFrequency.DataSource = frmOrganVSTemp.rsOrganVSTemp
    
    OriginCombName = txtCombName.Text

    
End Sub



Private Sub ListComb(CombList() As String)

    '填充模板器官列表
    Dim i As Integer
    lstOrganString.Clear
    For i = 0 To UBound(CombList)
        lstOrganString.AddItem CombList(i)
    Next i
    lstOrganString.Refresh
    
End Sub


Private Sub ShowComb(CombString As String)
    
    On Error Resume Next
    
    '显示已经有Comb_String的列表
    Dim CombList() As String
    Dim i As Integer
    
    CombList = Split(CombString, US_STR_COMBSPLIT)
    For i = 0 To UBound(CombList)
        lstOrganString.Text = CombList(i)
        lstOrganString.Selected(LstTextToIndex(lstOrganString, CombList(i))) = True
    Next i
    
End Sub