frmorganilllist.frm

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

        cmdDeleteDetail.Enabled = True
        cmdEditDetail.Enabled = True
    End If

End Sub


Private Sub cmdEditDetail_Click()
'加入一个列表值
Dim strDetail As String
Dim strSQL As String
Dim rsTemp As String
Dim Detail_Index As Integer
    
    If lstDetail.ListIndex = -1 Then
        MsgBox "请先选择一个语句,再对其进行编辑!", vbOKOnly + vbInformation, "提示"
        Exit Sub
    End If
    
    strDetail = Trim(InputBox("请输入新语句内容:", "新语句", lstDetail.Text))
    If strDetail = vbNullString Then Exit Sub
    If ExistRecord("US_CASE_ILL_DETAIL", "ILL_DETAIL", strDetail, "AND ORGAN_ILL = '" & lstIll.Text & "'") Then
        MsgBox "已经存在该记录,请重新输入!", vbExclamation + vbOKOnly, "输入错误"
        Exit Sub
    ElseIf MsgBox("这将修改当前的描述语句，确定吗？", vbQuestion + vbYesNo, "编辑描述语句") = vbNo Then
        Exit Sub
    End If
    
   Detail_Index = lstDetail.ListIndex
    '编辑记录
    strSQL = "UPDATE US_CASE_ILL_DETAIL SET ILL_DETAIL = '" & strDetail & "' WHERE ILL_DETAIL = '" & lstDetail.Text & "' AND ORGAN_ILL = '" & lstIll.Text & "'"
    GDB.Execute strSQL
    
    lstIll_Click
    lstDetail.SetFocus
    lstDetail.ListIndex = Detail_Index

End Sub

Private Sub cmdEditIll_Click()
'加入一个列表值
Dim strIll As String
Dim strSQL As String
Dim rsTemp As String
Dim Ill_Index As Integer
    
    If lstIll.ListIndex = -1 Then
        MsgBox "请先选择一个语句,再对其进行编辑!", vbOKOnly + vbInformation, "提示"
        Exit Sub
    End If
    
    strIll = Trim(InputBox("请输入新疾病内容:", "新疾病", lstIll.Text))
    If strIll = vbNullString Then Exit Sub
    If ExistRecord("US_CASE_ILL", "ORGAN_ILL", strIll, "AND ORGAN_NAME = '" & lstOrgan.Text & "'") Then
        MsgBox "已经存在该记录,请重新输入!", vbExclamation + vbOKOnly, "输入错误"
        Exit Sub
    ElseIf MsgBox("这将修改当前的疾病，确定吗？", vbQuestion + vbYesNo, "编辑疾病") = vbNo Then
        Exit Sub
    End If
    
    Ill_Index = lstIll.ListIndex
    
    '编辑记录, 注意需要手工级联更新
    strSQL = "UPDATE US_CASE_ILL SET ORGAN_ILL = '" & strIll & "' WHERE ORGAN_ILL = '" & lstIll.Text & "' AND ORGAN_NAME = '" & lstOrgan.Text & "'"
    GDB.Execute strSQL
    strSQL = "UPDATE US_CASE_ILL_DETAIL SET ORGAN_ILL = '" & strIll & "' WHERE ORGAN_ILL = '" & lstIll.Text & "'" '& "AND ORGAN_NAME = '" & lstOrgan.Text & "'"
    GDB.Execute strSQL
    
    lstOrgan_Click
    lstIll.SetFocus
    lstIll.ListIndex = Ill_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", "ORGAN_NAME", strOrgan, "") Then
        MsgBox "已经存在该记录,请重新输入!", vbExclamation + vbOKOnly, "输入错误"
        Exit Sub
    ElseIf MsgBox("这将修改当前的部位内容，确定吗？", vbQuestion + vbYesNo, "编辑部位") = vbNo Then
        Exit Sub
    End If
    
    '编辑记录
    strSQL = "UPDATE US_CASE_ORGAN SET ORGAN_NAME = '" & strOrgan & "' WHERE ORGAN_NAME = '" & lstOrgan.Text & "'"
    GDB.Execute strSQL
    strSQL = "UPDATE US_CASE_ILL SET ORGAN_NAME = '" & strOrgan & "' WHERE ORGAN_NAME = '" & lstOrgan.Text & "'"
    GDB.Execute strSQL
    
    FillOrgan
    lstOrgan.SetFocus
    lstOrgan.ListIndex = Organ_Index

End Sub

Private Sub cmdAddDetail_Click()
'加入一个列表值
Dim strDetail As String
Dim strSQL As String
Dim rsTemp As String
    
    '加入新字段
    strDetail = Trim(InputBox("请输入新语句内容:", "新语句"))
    If strDetail = vbNullString Then Exit Sub
    If ExistRecord("US_CASE_ILL_DETAIL", "ILL_DETAIL", strDetail, "AND ORGAN_ILL = '" & lstIll.Text & "'") Then
        MsgBox "已经存在该记录,请重新输入!", vbExclamation + vbOKOnly, "输入错误"
        Exit Sub
    End If
    
    '加入新记录
    strSQL = "INSERT INTO US_CASE_ILL_DETAIL (ORGAN_ILL,ILL_DETAIL) VALUES ('" & lstIll.Text & "', '" & strDetail & "')"
    GDB.Execute strSQL
    
    '加入列表框
    lstDetail.AddItem strDetail
    lstDetail.ListIndex = lstDetail.ListCount - 1
     
End Sub

Private Sub cmdAddIll_Click()
Dim strIll As String
Dim strSQL As String
Dim rsTemp As String

    '加入新字段
    strIll = Trim(InputBox("请输入新疾病名称:", "新疾病"))
    If strIll = vbNullString Then Exit Sub
    If ExistRecord("US_CASE_ILL", "ORGAN_ILL", strIll, "AND ORGAN_NAME = '" & lstOrgan.Text & "'") Then
        MsgBox "已经存在该记录,请重新输入!", vbExclamation + vbOKOnly, "输入错误"
        Exit Sub
    End If
    
    '加入新记录
    strSQL = "INSERT INTO US_CASE_ILL (ORGAN_NAME,ORGAN_ILL) VALUES ('" & lstOrgan.Text & "', '" & strIll & "')"
    GDB.Execute strSQL
    
    '加入列表框
    lstIll.AddItem strIll
    lstIll.ListIndex = lstIll.ListCount - 1
    
End Sub

Private Sub cmdAddOrgan_Click()
Dim strOrgan As String
Dim strSQL As String
Dim rsTemp As String
    
    '----------------
    '加入新脏器
    '----------------
    strOrgan = Trim(InputBox("请输入新部位名称:", "新部位"))
    If strOrgan = vbNullString Then Exit Sub
    If ExistRecord("US_CASE_ORGAN", "ORGAN_NAME", strOrgan) Then
        MsgBox "已经存在该记录,请重新输入!", vbExclamation + vbOKOnly, "输入错误"
        Exit Sub
    End If
    
    '加入新记录
    strSQL = "INSERT INTO US_CASE_ORGAN (ORGAN_NAME) VALUES ('" & strOrgan & "')"
    GDB.Execute strSQL
    
    '加入列表框
    lstOrgan.AddItem strOrgan
    lstOrgan.ListIndex = lstOrgan.ListCount - 1
    
End Sub

Private Sub cmdDeleteDetail_Click()
On Error GoTo ErrHandle
Dim strSQL As String
Dim Detail_Index As Integer

    '----------------
    '删除选择的记录
    '----------------
    If lstDetail.ListIndex = -1 Then
        MsgBox "请先选择一个描述语句,再进行删除操作!", vbOKOnly + vbInformation, "提示"
        Exit Sub
    End If
    
    If MsgBox("这将删除当前的描述语句，确定吗？", vbQuestion + vbYesNo, "删除描述语句") = vbNo Then
        Exit Sub
    End If
    Detail_Index = lstDetail.ListIndex
    strSQL = "DELETE FROM US_CASE_ILL_DETAIL WHERE ILL_DETAIL='" & lstDetail.Text & "' AND ORGAN_ILL = '" & lstIll.Text & "'"
    GDB.Execute strSQL
    
    FillOrganIllDetail lstIll.Text
    lstDetail.SetFocus
    If lstDetail.ListCount <> 0 Then lstDetail.ListIndex = Detail_Index - 1
    Exit Sub

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

End Sub

Private Sub cmdDeleteIll_Click()
On Error GoTo ErrHandle
Dim strSQL As String
Dim Ill_Index As Integer
        
    '-------------
    '删除字段
    '-------------
    If lstIll.ListIndex = -1 Then
        MsgBox "请先选择一个疾病,再进行删除操作!", vbOKOnly + vbInformation, "提示"
        Exit Sub
    End If
    
    If MsgBox("这将删除当前的疾病，确定吗？", vbQuestion + vbYesNo, "删除疾病") = vbNo Then
        Exit Sub
    End If
    Ill_Index = lstIll.ListIndex
    strSQL = "DELETE FROM US_CASE_ILL WHERE ORGAN_NAME = '" & lstOrgan.Text & "' AND ORGAN_ILL = '" & lstIll.Text & "'"
    GDB.Execute strSQL
    
    FillOrganIll lstOrgan.Text
    lstIll.SetFocus
    If lstIll.ListCount <> 0 Then lstIll.ListIndex = Ill_Index - 1
    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
    
    If MsgBox("这将删除当前的部位，确定吗？", vbQuestion + vbYesNo, "删除部位") = vbNo Then
        Exit Sub
    End If
    strSQL = "DELETE FROM US_CASE_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 cmdOK_Click()
    
    '-------------------------------------------------
    '如果报告窗体已经加载，则加入报告，否则编辑此项目
    '-------------------------------------------------
    
    If frmReport.Loaded Then
        If Organ_Name <> lstOrgan.Text Then
            Organ_Name = lstOrgan.Text
            If Code_Tip <> "" Then
                Mid(Code_Tip, Len(Code_Tip)) = "。"
                Add_Tip (Code_Tip)
                Code_Tip = ""
            End If
            If frmReport.txtDescribe.Text = "" Then
                frmReport.txtDescribe.Text = frmReport.txtDescribe & Organ_Name & ":" & vbCrLf
            Else
                frmReport.txtDescribe.Text = frmReport.txtDescribe & vbCrLf & Organ_Name & ":" & vbCrLf
            End If
        End If
        If Ill_Name <> lstIll.Text Then
            Ill_Name = lstIll.Text
            If InStr(Code_Tip, Ill_Name) = 0 Then Code_Tip = Code_Tip & Ill_Name & ","
        End If
        frmReport.txtDescribe.Text = frmReport.txtDescribe.Text & lstDetail.Text
        If lstDetail.ListIndex < lstDetail.ListCount - 1 Then lstDetail.ListIndex = lstDetail.ListIndex + 1
    Else
        cmdEditDetail_Click
    End If
    
End Sub

Private Sub lstDetail_DblClick()
    
    '----------------------
    '双击相当于点击“确认”
    '----------------------
    
    cmdOK_Click
    
End Sub

Private Sub Form_Load()
    
    '设置窗体位置
    IniUS.LoadFormPlace Me
    
    Loaded = True
    Code_Tip = ""
   '载入时自动填充列表
    FillOrgan
    
    '检查用户权限
'    SetUserRight
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    '----------------
    '释放对象
    '----------------
    On Error Resume Next
    If Code_Tip <> "" Then
        Mid(Code_Tip, Len(Code_Tip)) = "。"
        Add_Tip (Code_Tip)
        Code_Tip = ""
    End If
    Loaded = False
    Unload Me
    
    '保存窗体位置
    IniUS.SaveFormPlace Me
    If frmReport.Loaded Then frmReport.txtDescribe.SetFocus
    
End Sub

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

Public Sub Add_Tip(strAdd As String)
    
    '--------------------------------------
    '加入提示
    '--------------------------------------
    
    If IniUS.GetString("Report", "CodeTip") = 0 Then Exit Sub
    With frmReport
        If .txtUSTip(0).Text = "" Or .txtUSTip(0).Text = "未见异常。" Then
            .txtUSTip(0).Text = strAdd
        ElseIf .txtUSTip(1).Text = "" Then
            .txtUSTip(1).Text = strAdd
        ElseIf .txtUSTip(2).Text = "" Then
            .txtUSTip(2).Text = strAdd
        ElseIf .txtUSTip(3).Text = "" Then
            .txtUSTip(3).Text = strAdd
        ElseIf .txtUSTip(4).Text = "" Then
            .txtUSTip(4).Text = strAdd
        ElseIf .txtUSTip(5).Text = "" Then
            .txtUSTip(5).Text = strAdd
        ElseIf .txtUSTip(6).Text = "" Then
            .txtUSTip(6).Text = strAdd
        Else
            .txtUSTip(7).Text = .txtUSTip(7).Text & strAdd
        End If
    End With
    
End Sub

Public Sub lstOrgan_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo ErrHandle
    Select Case KeyCode
        Case vbKeyEscape
            Form_Unload (True)
        Case vbKeyReturn
            lstOrgan_Click
            lstIll.SetFocus
            cmdAddOrgan.Enabled = False
            cmdDeleteOrgan.Enabled = False
            cmdEditOrgan.Enabled = False
            cmdAddIll.Enabled = True
            cmdDeleteIll.Enabled = True
            cmdEditIll.Enabled = True
            lstIll.ListIndex = 0
        Case vbKeyE
            cmdEditOrgan_Click
        Case vbKeyInsert
            If cmdAddOrgan.Visible = True And cmdAddOrgan.Enabled = True Then cmdAddOrgan_Click
        Case vbKeyDelete
            If cmdDeleteOrgan.Visible = True And cmdDeleteOrgan.Enabled = True Then cmdDeleteOrgan_Click
        Case Else
    End Select
ErrHandle:
End Sub

Public Sub lstIll_KeyDown(KeyCode As Integer, Shift As Integer)
    On Error GoTo ErrHandle
    Select Case KeyCode
        Case vbKeyEscape
            lstOrgan_Click
            lstOrgan.SetFocus
        Case vbKeyReturn
            lstIll_Click
            lstDetail.SetFocus
            cmdAddIll.Enabled = False
            cmdDeleteIll.Enabled = False
            cmdEditIll.Enabled = False
            cmdAddDetail.Enabled = True
            cmdDeleteDetail.Enabled = True
            cmdEditDetail.Enabled = True
            lstDetail.ListIndex = 0
        Case vbKeyE
            cmdEditIll_Click
        Case vbKeyInsert
            If cmdAddIll.Visible = True And cmdAddIll.Enabled = True Then cmdAddIll_Click
        Case vbKeyDelete
            If cmdDeleteIll.Visible = True And cmdDeleteIll.Enabled = True Then cmdDeleteIll_Click
        Case Else
    End Select
ErrHandle:
End Sub

Public Sub lstDetail_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo ErrHandle
    Select Case KeyCode
        Case vbKeyEscape
            lstIll_Click
            lstIll.SetFocus
        Case vbKeyReturn
            cmdOK_Click
        Case vbKeyE
            cmdEditDetail_Click
        Case vbKeyInsert
            If cmdAddDetail.Visible = True And cmdAddDetail.Enabled = True Then cmdAddDetail_Click
        Case vbKeyDelete
            If cmdDeleteDetail.Visible = True And cmdDeleteDetail.Enabled = True Then cmdDeleteDetail_Click
        Case Else
    End Select
ErrHandle:
End Sub