frmmaintain.frm

1、以DLL形式提供医生工作站 2、 根据【检查项目】

    txtSubPart.Text = ""
    Exit Sub
ErrHandler:
    MsgBox "部位删除失败, 原因:" + Err.Description, vbExclamation, "提示"
End Sub

Private Sub btnDeleteMethod_Click(Shifit As Integer)
On Error GoTo ErrHandler
    If lstCheckMethod.ListCount <= 0 Or Trim(lstCheckMethod.Text) = "" Then
        MsgBox "请选择要删除的检查方式!", vbExclamation, "提示"
        Exit Sub
    End If

    If MsgBox("您确定要删除该检查方式吗?", vbYesNo Or vbQuestion, "") <> vbYes Then
        Exit Sub
    End If
    Dim strSql As String
    strSql = "DELETE FROM CheckMethod WHERE ID = '" + lstMethodNumber.Text + "'"
    If Not ExecuteNonQuery(strSql) Then
        MsgBox "删除失败, 请与系统管理员联系!", vbExclamation, "提示"
        Exit Sub
    Else
        MsgBox "删除成功!", vbExclamation, "提示"
    End If
        
    Call InitMethodMethods(cmbSubPartId.Text)
    txtMethod.Text = ""
    cmbCharge.Text = ""
    Exit Sub
ErrHandler:
    MsgBox "检查方式删除失败, 原因:" + Err.Description, vbExclamation, "提示"
End Sub

Private Sub btnDeletePatientStates_Click(Shifit As Integer)
On Error GoTo ErrHandler
    If lstPatientState.ListCount <= 0 Then
        MsgBox "请选择要删除的状态!", vbExclamation, "提示"
        Exit Sub
    End If
    If lstPatientState.ListIndex < 0 Then
        MsgBox "请选择要删除的状态!", vbExclamation, "提示"
        Exit Sub
    End If
    
    
    'If Trim(txtPatientState.Text) = "" Then
    '    MsgBox "请选择要删除的状态!", vbExclamation, "提示"
    '
    '    Exit Sub
    'End If


    If MsgBox("您确定要删除吗?", vbYesNo Or vbQuestion, "") <> vbYes Then
        Exit Sub
    End If
    Dim strSql As String
    strSql = "DELETE FROM State WHERE ID = '" + lstPatientStateId.Text + "'"
    If Not ExecuteNonQuery(strSql) Then
        MsgBox "状态删除失败, 请与系统管理员联系!", vbExclamation, "提示"
        Exit Sub
    Else
        MsgBox "状态删除成功!", vbExclamation, "提示"
    End If
        
    Call InitPatientStates
    txtPatientState.Text = ""
    Exit Sub
ErrHandler:
    MsgBox "状态删除失败, 原因:" + Err.Description, vbExclamation, "提示"
End Sub

Private Sub btnDeleteSubPart_Click(Shifit As Integer)
On Error GoTo ErrHandler
    If lstSubNumber.ListCount <= 0 Or Trim(lstSubPart.Text) = "" Then
        MsgBox "请您选择要删除的子部位!", vbExclamation, "提示"
        Exit Sub
    End If

    If MsgBox("您确定要删除该子部位吗?", vbYesNo Or vbQuestion, "") <> vbYes Then
        Exit Sub
    End If
    Dim strSql As String
    strSql = "DELETE FROM CheckSubPart WHERE ID = '" + lstSubNumber.Text + "'"
    If Not ExecuteNonQuery(strSql) Then
        MsgBox "删除失败, 请与系统管理员联系!", vbExclamation, "提示"
        Exit Sub
    Else
        MsgBox "子部位删除成功!", vbExclamation, "提示"
    End If
    
    '检查部位----初始化子部位
    Call InitSubParts(lstPartMainPart.Text)
    
    
    
    Call InitMethodMainPart
    Call InitMethodSubParts(cmbMainPartId.Text)
    
    
    txtSubPart.Text = ""
    Exit Sub
ErrHandler:
    MsgBox "部位删除失败, 原因:" + Err.Description, vbExclamation, "提示"
End Sub

Private Sub btnModifyMainPart_Click(Shifit As Integer)
    On Error GoTo ErrHandler
    If lstPartMainPart.ListCount <= 0 Or Trim(lstPartMainPart.Text) = "" Then
        MsgBox "请选择要修改的主部位!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If Trim(txtMainPart.Text) = "" Then
        MsgBox "请输入主部位名称!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If InStr(txtMainPart.Text, "'") > 0 Then
        MsgBox "主部位名称中含有非法字符( < ' >  ,< - >), 请重新输入!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If InStr(txtMainPart.Text, "'") > 0 Then
        MsgBox "主部位名称中含有非法字符( < ' >  ,< - >), 请重新输入!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If MsgBox("您确定要修改吗?", vbYesNo Or vbQuestion, "") <> vbYes Then
        Exit Sub
    End If
    
    Dim strSql As String
    strSql = "SELECT ID FROM CheckMainPart WHERE Name = '" + Trim(txtMainPart.Text) + "'"
    If GetRecordNumber(strSql) > 0 Then
        'MsgBox "该部位已存在, 请重新修改!", vbExclamation, "提示"
        MsgBox "部位修改成功!", vbExclamation, "提示"
        Exit Sub
    End If
    
    strSql = "UPDATE  CheckMainPart SET Name = '" + Trim(txtMainPart.Text) _
        + "' WHERE NAME ='" + lstPartMainPart.Text + "'  "
    If Not ExecuteInsert(strSql) Then
        MsgBox "部位修改失败, 请与系统管理员联系!", vbExclamation, "提示"
        Exit Sub
    Else
        MsgBox "部位修改成功!", vbExclamation, "提示"
    End If
    
    Call InitMainParts
    Call InitSubParts("")
    
    
    '检查方式--主部位
    Call InitMethodMainPart
    Call InitMethodSubParts(cmbMainPartId.Text)
    
    txtMainPart.Text = ""
    txtSubPart.Text = ""
    Exit Sub
ErrHandler:
    MsgBox "部位修改失败, 原因:" + Err.Description, vbExclamation, "提示"
End Sub

Private Sub btnModifyMethod_Click(Shifit As Integer)
    On Error GoTo ErrHandler
    If lstCheckMethod.ListCount <= 0 Or Trim(lstCheckMethod.Text) = "" Then
        MsgBox "请选择要删除的检查方式!", vbExclamation, "提示"
        Exit Sub
    End If
    
    
    If Trim(txtMethod.Text) = "" Then
        MsgBox "请输入检查方式!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If InStr(txtMethod.Text, "'") > 0 Or InStr(txtMethod.Text, "-") > 0 Then
        MsgBox "检查方式名称中含有非法字符( < ' >  ,< - >), 请重新输入!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If Len(CStr(Trim(cmbCharge.Text))) > 5 Then
        MsgBox "检查费用数过大！", vbExclamation, "提示"
        Exit Sub
    End If
    
    Dim strCharge As String
    If CStr(Trim(cmbCharge.Text)) = "" Then
        strCharge = "0"
    Else
        strCharge = CStr(Trim(cmbCharge.Text))
    End If
    
    
    Dim strSql As String
    strSql = "SELECT ID FROM CheckMethod WHERE " _
        + " Name = '" + Trim(txtMethod.Text) + "'" _
        + " and CheckSubPartId ='" + cmbSubPartId.Text + "'" _
        + " and CHARGE ='" + strCharge + "'"
        
        
    If GetRecordNumber(strSql) > 0 Then
        MsgBox "该检查方式已存在, 请重新输入!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If MsgBox("您确定要修改吗?", vbYesNo Or vbQuestion, "") <> vbYes Then
        Exit Sub
    End If
    
    
    strSql = "UPDATE  CheckMethod SET Name = '" + Trim(txtMethod.Text)
    strSql = strSql + "',CHARGE = '" + strCharge
    If Trim(cmbAgensName.Text) <> "" Then
        strSql = strSql + "',AGENSNAME = '" + Trim(cmbAgensName.Text)
    Else
        strSql = strSql + "',AGENSNAME = '" + " "
    End If
    If Trim(cmbGosage.Text) <> "" Then
        strSql = strSql + "',GOSAGE = '" + Trim(cmbGosage.Text)
    Else
        strSql = strSql + "',GOSAGE + '" + " "
    End If
    If Trim(txtGosageFee.Text) <> "" Then
        strSql = strSql + "',GOSAGE_FEE = '" + Trim(txtGosageFee.Text)
    Else
        strSql = strSql + "',GOSAGE_FEE = '" + "0"
    End If
    strSql = strSql + "' WHERE ID ='" + lstMethodNumber.Text + "'"
    
    
    If Not ExecuteNonQuery(strSql) Then
        MsgBox "检查方式修改失败, 请与系统管理员联系!", vbExclamation, "提示"
        Exit Sub
    Else
        MsgBox "检查方式修改成功!", vbExclamation, "提示"
    End If
    
    Call InitMethodMethods(cmbSubPartId.Text)
    txtMethod.Text = ""
    cmbCharge.Text = ""
    cmbAgensName.Text = ""
    cmbGosage.Text = ""
    txtGosageFee.Text = "0"
    
    Exit Sub
ErrHandler:
    MsgBox "部位修改失败, 原因:" + Err.Description, vbExclamation, "提示"
End Sub

'状态管理----修改状态
Private Sub btnModifyPatientStates_Click(Shifit As Integer)
    On Error GoTo ErrHandler
    If lstPatientState.ListCount <= 0 Or Trim(lstPatientState.Text) = "" Then
        MsgBox "请输入要修改的状态!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If Trim(txtPatientState.Text) = "" Then
        MsgBox "请输入要修改的状态!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If InStr(txtPatientState.Text, "'") > 0 Or InStr(txtPatientState.Text, "-") > 0 Then
        MsgBox "状态中含有非法字符( < ' >  ,< - >), 请重新输入!", vbExclamation, "提示"
        Exit Sub
    End If
    
    Dim strSql As String
    strSql = "SELECT ID FROM State WHERE Name = '" + Trim(txtPatientState.Text) + "'"
    If GetRecordNumber(strSql) > 0 Then
        MsgBox "该状态已存在, 请重新修改!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If MsgBox("您确定要修改吗?", vbYesNo Or vbQuestion, "") <> vbYes Then
        Exit Sub
    End If
    strSql = "UPDATE  State SET State = '" + Trim(txtPatientState.Text) _
        + "' WHERE ID ='" + lstPatientStateId.Text + "'  "
    If Not ExecuteInsert(strSql) Then
        MsgBox "状态修改失败, 请与系统管理员联系!", vbExclamation, "提示"
        Exit Sub
    Else
        MsgBox "状态修改成功!", vbExclamation, "提示"
    End If
    
    Call InitPatientStates
    txtPatientState.Text = ""
    Exit Sub
ErrHandler:
    MsgBox "部位修改失败, 原因:" + Err.Description, vbExclamation, "提示"
End Sub

Private Sub btnModifySubPart_Click(Shifit As Integer)
    On Error GoTo ErrHandler
    
    If Trim(txtSubPart.Text) = "" Then
        MsgBox "请选择要修改的子部位!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If InStr(txtSubPart.Text, "'") > 0 Then
        MsgBox "子部位名称中含有非法字符( < ' >  ,< - >), 请重新输入!", vbExclamation, "提示"
        Exit Sub
    End If
    Dim strSql As String
    strSql = "SELECT ID FROM CheckSubPart WHERE Name = '" + Trim(txtSubPart.Text) + "'"
    If GetRecordNumber(strSql) > 0 Then
        MsgBox "该子部位已存在, 请重新修改!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If MsgBox("您确定要修改吗?", vbYesNo Or vbQuestion, "") <> vbYes Then
        Exit Sub
    End If
    strSql = "UPDATE  CheckSubPart SET Name = '" + Trim(txtSubPart.Text) _
        + "' WHERE ID ='" + lstSubNumber.Text + "'  "
    If Not ExecuteNonQuery(strSql) Then
        MsgBox "部位修改失败, 请与系统管理员联系!", vbExclamation, "提示"
        Exit Sub
    Else
        MsgBox "部位修改成功!", vbExclamation, "提示"
    End If
    
    Call InitSubParts(lstPartMainPart.Text)
    Call InitMethodMainPart
    Call InitMethodSubParts(cmbMainPartId.Text)
    
    txtSubPart.Text = ""
    Exit Sub
ErrHandler:
    MsgBox "部位修改失败, 原因:" + Err.Description, vbExclamation, "提示"
End Sub




Private Sub cmbCharge_KeyPress(KeyAscii As Integer)
On Error Resume Next
    '只允许退格键和数字键
    If KeyAscii <> 8 And KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
        KeyAscii = 0
    End If
    
    Exit Sub
End Sub

'
Pr