frmorganitemlist.frm

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

    '----------------
    rsOrganItemDetail.Delete
    rsOrganItemDetail.UpdateBatch adAffectAllChapters
    Exit Sub

ErrHandle:

    If Err.Number = 3021 Then
        MsgBox "当前已经没有记录可以删除！", vbInformation, "提示"
        Exit Sub
    End If
    
    ShowError

End Sub

Private Sub cmdDeleteItem_Click()
On Error GoTo ErrHandle
Dim strSQL As String
        
    '-------------
    '删除字段
    '-------------
    If lstItem.ListIndex = -1 Then
        MsgBox "请先选择一个项目,再进行删除操作!", vbOKOnly + vbInformation, "提示"
        Exit Sub
    End If
    
    strSQL = "DELETE FROM US_ORGAN_ITEM WHERE ORGAN_NAME = '" & lstOrgan.Text & "' AND ORGAN_ITEM = '" & lstItem.Text & "'"
    GDB.Execute strSQL
    
    FillOrganItem lstOrgan.Text
    Exit Sub

ErrHandle:
    If Err.Number = 3021 Then
        MsgBox "当前已经没有记录可以删除！", vbInformation, "提示"
        Exit Sub
    End If

End Sub

Private Sub cmdDeleteOrgan_Click()
On Error GoTo ErrHandle
Dim strSQL As String
    
    '删除字段
    If lstOrgan.ListIndex = -1 Then
        MsgBox "请先选择一个项目,再进行删除操作!", vbOKOnly + vbInformation, "提示"
        Exit Sub
    End If
    
    strSQL = "DELETE FROM US_ORGAN WHERE ORGAN_NAME = '" & lstOrgan.Text & "'"
    GDB.Execute strSQL
    
    FillOrgan
    Exit Sub

ErrHandle:

    If Err.Number = 3021 Then
        MsgBox "当前已经没有记录可以删除！", vbInformation, "提示"
        Exit Sub
    End If
    
End Sub

Private Sub cmdEditItem_Click()
'加入一个列表值
Dim strItem As String
Dim strSQL As String
Dim rsTemp As String
Dim Item_Index As Integer
    
    If lstItem.ListIndex = -1 Then
        MsgBox "请先选择一个小类,再对其进行编辑!", vbOKOnly + vbInformation, "提示"
        Exit Sub
    End If
    
    strItem = Trim(InputBox("请输入新小类内容:", "编辑小类", lstItem.Text))
    If strItem = vbNullString Then Exit Sub
    If ExistRecord("US_ORGAN_ITEM", "ORGAN_ITEM", strItem, "AND ORGAN_NAME = '" & lstOrgan.Text & "'") Then
        MsgBox "已经存在该小类,请重新输入!", vbExclamation + vbOKOnly, "输入错误"
        Exit Sub
    ElseIf MsgBox("这将修改当前的小类，确定吗？", vbQuestion + vbYesNo, "编辑小类") = vbNo Then
        Exit Sub
    End If
    
   Item_Index = lstItem.ListIndex
    '编辑记录
    strSQL = "UPDATE US_ORGAN_ITEM SET ORGAN_ITEM = '" & strItem & "' WHERE ORGAN_ITEM = '" & lstItem.Text & "' AND ORGAN_NAME = '" & lstOrgan.Text & "'"
    GDB.Execute strSQL
    
    FillOrganItem (lstOrgan.Text)
    lstItem.SetFocus
    lstItem.ListIndex = Item_Index

End Sub

Private Sub cmdEditOrgan_Click()
'加入一个列表值
Dim strOrgan As String
Dim strSQL As String
Dim rsTemp As String
Dim Organ_Index As Integer
    
    Organ_Index = lstOrgan.ListIndex
    If lstOrgan.ListIndex = -1 Then
        MsgBox "请先选择一个大类,再对其进行编辑!", vbOKOnly + vbInformation, "提示"
        Exit Sub
    End If
    
    strOrgan = Trim(InputBox("请输入新大类内容:", "编辑位", lstOrgan.Text))
    If strOrgan = vbNullString Then Exit Sub
    If ExistRecord("US_CASE", "ORGAN_NAME", strOrgan, "") Then
        MsgBox "已经存在该记录,请重新输入!", vbExclamation + vbOKOnly, "输入错误"
        Exit Sub
    ElseIf MsgBox("这将修改当前的大类内容，确定吗？", vbQuestion + vbYesNo, "编辑大类") = vbNo Then
        Exit Sub
    End If
    
    '编辑记录
    strSQL = "UPDATE US_ORGAN SET ORGAN_NAME = '" & strOrgan & "' WHERE ORGAN_NAME = '" & lstOrgan.Text & "'"
    ConnUS.Execute strSQL
    strSQL = "UPDATE US_ORGAN_ITEM SET ORGAN_NAME = '" & strOrgan & "' WHERE ORGAN_NAME = '" & lstOrgan.Text & "'"
    GDB.Execute strSQL
    
    FillOrgan
    lstOrgan.SetFocus
    lstOrgan.ListIndex = Organ_Index

End Sub

Private Sub cmdHelp_Click()

End Sub

Private Sub cmdSaveDetail_Click()
    
    '-----------------------------
    '更新记录集
    '-----------------------------
On Error GoTo ErrHandle
    
    With rsOrganItemDetail
        .UpdateBatch adAffectAllChapters
        .Requery
        Exit Sub

ErrHandle:
    
        '这里处理因为不能更新而造成的错误
        ShowEditConflictError
        .CancelBatch adAffectAllChapters
        .Requery
    
    End With
    
End Sub


Private Sub dtgDetail_Error(ByVal DataError As Integer, response As Integer)
    
    MsgBox "ErrFromCode:" & DataError
    
End Sub

Private Sub Form_Load()

    '--------------------------------------
    '初始化及设置绑定
    '--------------------------------------

'    Set rsOrganItemDetail = OpenRSBatch("SELECT * FROM US_ORGAN_ITEM_DETAIL ORDER BY ITEM_DETAIL_INDEX ASC")
'    Set dtgDetail.DataSource = rsOrganItemDetail
'    rsOrganItemDetail.Filter = "ORGAN_ITEM_ID = -1"
'
'    '载入时自动填充列表
'    FillOrgan

    Call iniListView
    Call SetItemTree

    '检查用户权限
'    SetUserRight
    
End Sub

'Private Sub Form_Load()
''设置报告项目树及内容列表框
'
'    Call iniListView
'    Call SetItemTree
'
'End Sub
'
Private Sub iniListView()

    lsvdetail.View = lvwReport
    lsvdetail.LabelEdit = lvwManual
    lsvdetail.FullRowSelect = True

    lsvdetail.ListItems.Clear
    lsvdetail.ColumnHeaders.Add 1, "K1", "序号", 1600, lvwColumnLeft
    lsvdetail.ColumnHeaders.Add 2, "K2", "列表内容", 3200, lvwColumnLeft

End Sub

Private Sub SetItemTree()
Dim sSQL As String
Dim Nodx As MSComctlLib.Node

    With trvItem
        .Nodes.Clear
        .Nodes.Add , , "*-1", "器官", 1
    End With

    sSQL = "select * from us_organ order by serial_id"
    Set rsItem = OpenRSClient(sSQL)
    With rsItem
    Do While Not .EOF
        Set Nodx = trvItem.Nodes.Add("*-1", tvwChild, "K" & rsItem!Organ_Name, rsItem!Organ_Name, 1)
        Call SetDetailNode(rsItem!Organ_Name)
        .MoveNext
    Loop
    End With

    trvItem.Nodes(1).Selected = True

    rsItem.Close
    Set rsItem = Nothing

End Sub

Private Sub SetDetailNode(ByVal sKey As String)
Dim sSQL As String
Dim tNodex As MSComctlLib.Node
Dim rsNode As ADODB.Recordset

'    sDate = Mid(sKey, 1)
    sSQL = "select * from us_organ_item where organ_name='" & sKey & "' "

    Set rsNode = OpenRSClient(sSQL)
    With rsNode
    Do While Not .EOF
        Set tNodex = trvItem.Nodes.Add("K" & sKey, tvwChild, "T" & CStr(rsNode!organ_item_id), rsNode!organ_item, 2)
        'tNodex.Tag = rsSick!sick_id
        .MoveNext
    Loop
    End With

    rsNode.Close
    Set rsNode = Nothing
    
    'If Not trvItem.Nodes(1).Expanded Then trvSickInfo.Nodes(1).Expanded = True
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    '----------------
    '释放对象
    '----------------
    On Error Resume Next
    
    rsOrganItemDetail.Close
    Set rsOrganItemDetail = Nothing
    
End Sub

Private Sub lstItem_Click()
    
    '更新"DETAIL"表格
    Dim strSQL As String
    
    ItemId = FindValue("SELECT ORGAN_ITEM_ID FROM US_ORGAN_ITEM WHERE ORGAN_NAME = '" & lstOrgan.Text & "' AND ORGAN_ITEM = '" & lstItem.Text & "'")
    
    With rsOrganItemDetail
        .Filter = "ORGAN_ITEM_ID  = " & ItemId
        .Requery
        If Not .EOF And Not .BOF Then
            .MoveFirst
        End If
    End With
    
    '设置状态
    cmdAddDetail.Enabled = True
    cmdDeleteDetail.Enabled = True
    
End Sub

Private Sub lstOrgan_Click()
    
    '--------------
    '填充字段列表
    '--------------
    FillOrganItem lstOrgan.Text
    rsOrganItemDetail.Filter = "ORGAN_ITEM_ID = -1"

End Sub

Public Sub SetUserRight()
    
    '-------------------
    '检查用户权限
    '-------------------
    Select Case UserType
        Case "超级管理员"
        
        Case "系统管理员", "一般用户"
            cmdAddOrgan.Visible = False
            cmdDeleteOrgan.Visible = False
            cmdEditOrgan.Visible = False
            cmdAddItem.Visible = False
            cmdDeleteItem.Visible = False
            cmdEditItem.Visible = False
    End Select
    
End Sub

Private Sub trvItem_Click()
Dim Nodex As MSComctlLib.Node
Dim rsDetail As ADODB.Recordset
Dim lsvItem As MSComctlLib.ListItem
Dim lOrganItemID As Long
Dim iCount As Long
Dim sSQL As String
Dim lRow As Long

    Set Nodex = trvItem.SelectedItem
    trvItem.DropHighlight = trvItem.SelectedItem
    If Mid(Nodex.Key, 1, 1) = "T" Then
        lOrganItemID = Mid(Nodex.Key, 2)
    Else
        Exit Sub
    End If

    sSQL = "select * from us_organ_item_detail where organ_item_id= '" & lOrganItemID & "' order by item_detail_index"
    Set rsDetail = GDB.Execute(sSQL)
    
    lsvdetail.ListItems.Clear
    
    iCount = 1
    With rsDetail
    Do While Not .EOF
       Set lsvItem = lsvdetail.ListItems.Add(iCount, "U" & iCount)
       lsvItem.Text = rsDetail!Item_detail_Index
       lsvItem.SubItems(1) = rsDetail!Item_detail
       iCount = iCount + 1
       .MoveNext
    Loop
    End With
        
    rsDetail.Close
    Set rsDetail = Nothing

End Sub

Private Sub trvItem_NodeClick(ByVal Node As MSComctlLib.Node)
    
    Call trvItem_Click
    
End Sub