frmedittemplate.frm

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

        MsgBox "请选择要删除的<疾病名称>!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If MsgBox("您确定要删除吗?", vbYesNo Or vbQuestion, "") <> vbYes Then
        Exit Sub
    End If
    Dim strSql As String
    strSql = "DELETE FROM DiagTemplateIllPub WHERE ID = '" + lstIllNameId.Text + "'"
    
    '===事务处理开始====================================================
    Dim myConn As New ADODB.Connection
    myConn.CursorLocation = adUseClient
    myConn.Open modGlobalDbConnect.GetConnectionString
    
    If myConn.State = adStateClosed Then
        MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
        Exit Sub
    End If
    
    myConn.BeginTrans '开始
    '执行语句
    myConn.Execute strSql
    If Err.Number = 0 Then
        myConn.CommitTrans '---提交事務
        MsgBox "删除成功.", vbExclamation, "提示"
    Else
        myConn.RollbackTransaction
        MsgBox "删除失败!", vbExclamation, "提示"
    End If
    '===事务处理结束====================================================
        
    If Trim(lstCategoryId.Text) Then
        Call InitIllNames(lstCategoryId.Text)
    End If
    txtIllName.Text = ""
    
    txtFilmDescription.Text = ""
    txtDiagnoseResult.Text = ""
    Exit Sub
ErrHandler:
    MsgBox "疾病名称删除失败, 原因:" + Err.Description, vbExclamation, "提示"
End Sub

'删除疾病名称----私人
Private Sub btnDeleteIllNamePersonal_Click(Shifit As Integer)
On Error GoTo ErrHandler
    If lstIllNameIdPersonal.ListCount <= 0 Or Trim(lstIllNameIdPersonal.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 DiagTemplateIllPri WHERE ID = '" + lstIllNameIdPersonal.Text + "'"
    
    '===事务处理开始====================================================
    Dim myConn As New ADODB.Connection
    myConn.CursorLocation = adUseClient
    myConn.Open modGlobalDbConnect.GetConnectionString
    
    If myConn.State = adStateClosed Then
        MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
        Exit Sub
    End If
    
    myConn.BeginTrans '开始
    '执行语句
    myConn.Execute strSql
    If Err.Number = 0 Then
        myConn.CommitTrans '---提交事務
        MsgBox "删除成功.", vbExclamation, "提示"
    Else
        myConn.RollbackTransaction
        MsgBox "删除失败!", vbExclamation, "提示"
    End If
    '===事务处理结束====================================================
    
    If Trim(lstCategoryPersonalId.Text) <> "" Then
        Call InitIllNamesPersonal(lstCategoryPersonalId.Text)
    End If
    txtIllNamePersonal.Text = ""
    
    txtFilmDescriptionPersonal.Text = ""
    txtDiagnoseResultPersonal.Text = ""
    Exit Sub
ErrHandler:
    MsgBox "疾病名称删除失败, 原因:" + Err.Description, vbExclamation, "提示"
End Sub

'删除部位----公共
Private Sub btnDeleteMainPart_Click(Shifit As Integer)
On Error GoTo ErrHandler
    If lstCategory.ListCount <= 0 Or lstCategory.Text = "" Then
        MsgBox "请选择要删除的<疾病类别>!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If MsgBox("您确定要删除吗?", vbYesNo Or vbQuestion, "") <> vbYes Then
        Exit Sub
    End If
    Dim strSql1 As String
    Dim strSql2 As String
    strSql1 = "DELETE FROM DiagTemplateCategoryPub WHERE ID = '" + lstCategoryId.Text + "'"
    strSql2 = "DELETE FROM DiagTemplateIllPub WHERE CategoryId = '" + lstCategoryId.Text + "'"
    '需要事务处理，以保证一致性
    
    'If Not ExecuteNonQuery(strSql) Then
    '    MsgBox "删除失败, 请与系统管理员联系!", vbExclamation, "提示"
    '    Exit Sub
    'Else
        'strSql = "DELETE FROM DiagTemplateIllPub WHERE CategoryId = '" _
        '    + lstCategoryId.Text + "'"
            
        'If Not ExecuteNonQuery(strSql) Then
        '    MsgBox "<疾病类别>相应<疾病名称>删除失败, 请与系统管理员联系!", vbExclamation, "提示"
        '    Exit Sub
        'End If
    '    MsgBox "删除成功!", vbExclamation, "提示"
    'End If
    
    
    '===事务处理开始====================================================
    Dim myConn As New ADODB.Connection
    myConn.CursorLocation = adUseClient
    myConn.Open modGlobalDbConnect.GetConnectionString
    
    If myConn.State = adStateClosed Then
        MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
        Exit Sub
    End If
    
    myConn.BeginTrans '开始
    '执行语句
    myConn.Execute strSql1
    myConn.Execute strSql2
    If Err.Number = 0 Then
        myConn.CommitTrans '---提交事務
    Else
        myConn.RollbackTransaction
        MsgBox "删除失败!", vbExclamation, "提示"
    End If
    '===事务处理结束====================================================
        
    Call InitCategories
    If lstCategory.ListCount > 0 And Trim(lstCategory.Text) <> "" Then
        Call InitIllNames(lstCategoryId.Text)
    Else
        
    End If
    txtCategory.Text = ""
    txtIllName.Text = ""
    lstIllName.Clear
    txtFilmDescription.Text = ""
    txtDiagnoseResult.Text = ""
    Exit Sub
ErrHandler:
    MsgBox "<疾病类别>删除失败, 原因:" + Err.Description, vbExclamation, "提示"
End Sub

'删除主部位----私人
Private Sub btnDeleteMainPartPersonal_Click(Shifit As Integer)
On Error GoTo ErrHandler
    If lstCategoryPersonalId.ListCount <= 0 Or Trim(lstCategoryPersonalId.Text) = "" Then
        MsgBox "请选择要删除的<疾病类别>!", vbExclamation, "提示"
        Exit Sub
    End If
    If MsgBox("您确定要删除吗?", vbYesNo Or vbQuestion, "") <> vbYes Then
        Exit Sub
    End If
    Dim strSql1 As String
    Dim strSql2 As String
    strSql1 = "DELETE FROM DiagTemplateCategoryPri WHERE ID = '" + lstCategoryPersonalId.Text + "'"
    strSql2 = " DELETE FROM DIAGTEMPLATEILLPRI WHERE CATEGORYID='" _
                    + Trim(lstCategoryPersonalId.Text) + "'"
    
    '===事务处理开始====================================================
    Dim myConn As New ADODB.Connection
    myConn.CursorLocation = adUseClient
    myConn.Open modGlobalDbConnect.GetConnectionString
    
    If myConn.State = adStateClosed Then
        MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
        Exit Sub
    End If
    
    myConn.BeginTrans '开始
    '执行语句
    myConn.Execute strSql1
    myConn.Execute strSql2
    If Err.Number = 0 Then
        myConn.CommitTrans '---提交事務
        MsgBox "删除成功.", vbExclamation, "提示"
    Else
        myConn.RollbackTransaction
        MsgBox "删除失败!", vbExclamation, "提示"
    End If
    '===事务处理结束====================================================
        
    Call InitCategoriesPersonal
    If Trim(lstCategoryPersonalId.Text) <> "" Then
        Call InitIllNamesPersonal(lstCategoryPersonalId.Text)
    End If
    txtCategoryPersonal.Text = ""
    txtIllNamePersonal.Text = ""
    lstIllNamePersonal.Clear
    txtFilmDescriptionPersonal.Text = ""
    txtDiagnoseResultPersonal.Text = ""
    Exit Sub
ErrHandler:
    MsgBox "<疾病类别>删除失败, 原因:" + Err.Description, vbExclamation, "提示"
End Sub

'公共模板----修改主部位
Private Sub btnModifyMainPart_Click(Shifit As Integer)
On Error GoTo ErrHandler
    If lstCategory.ListCount <= 0 Or Trim(lstCategory.Text) = "" Then
        MsgBox "请选择要修改的的<疾病类别>!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If InStr(Trim(txtCategory.Text), " ") > 0 Then
        MsgBox "请输入要修改的<疾病类别>, 类别中空格为无效字符!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If Trim(txtCategory.Text) = "" Then
        MsgBox "请输入要修改的<疾病类别>,!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If stringCheck(Trim(txtCategory.Text)) = False Then
        Exit Sub
    End If
    
    Dim strSql As String
    strSql = "SELECT ID FROM DiagTemplateCategoryPub WHERE CategoryName = '" _
        + Trim(txtCategory.Text) + "'" + " AND DEPARTMENTID = '" + CStr(DEPARTMENT_ID) + "'"
    If GetRecordNumber(strSql) > 0 Then
        MsgBox "该疾病类别已存在, 请重新修改!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If MsgBox("您确定要修改吗?", vbYesNo Or vbQuestion, "") <> vbYes Then
        Exit Sub
    End If
    strSql = "UPDATE  DiagTemplateCategoryPub SET CategoryName = '" + Trim(txtCategory.Text) _
        + "' WHERE ID ='" + Trim(lstCategoryId.Text) + "'  "
    
    '===事务处理开始====================================================
    Dim myConn As New ADODB.Connection
    myConn.CursorLocation = adUseClient
    myConn.Open modGlobalDbConnect.GetConnectionString
    
    If myConn.State = adStateClosed Then
        MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
        Exit Sub
    End If
    
    myConn.BeginTrans '开始
    '执行语句
    myConn.Execute strSql
    If Err.Number = 0 Then
        myConn.CommitTrans '---提交事務
        MsgBox "<疾病类别>修改成功.", vbExclamation, "提示"
    Else
        myConn.RollbackTransaction
        MsgBox "<疾病类别>修改失败!", vbExclamation, "提示"
        Exit Sub
    End If
    '===事务处理结束====================================================
    
    Call InitCategories
    If Len(Trim(lstCategoryId.Text)) <> "" Then
        Call InitIllNames(lstCategoryId.Text)
    End If
    txtCategory.Text = ""
    txtIllName.Text = ""
    
    txtFilmDescription.Text = ""
    txtDiagnoseResult.Text = ""
    Exit Sub
ErrHandler:
    MsgBox "疾病类别修改失败, 原因:" + Err.Description, vbExclamation, "提示"
End Sub

'修改疾病类别---私人
Private Sub btnModifyMainPartPersonal_Click(Shifit As Integer)
On Error GoTo ErrHandler
    If lstCategoryPersonalId.ListCount <= 0 Or Trim(lstCategoryPersonalId.Text) = "" Then
        MsgBox "请选择要修改的<疾病类别>!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If InStr(Trim(txtCategoryPersonal.Text), " ") > 0 Then
        MsgBox "请输入要修改的<疾病类别>, 类别中空格为无效字符!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If Trim(txtCategoryPersonal.Text) = "" Then
        MsgBox "请输入要修改的<疾病类别>!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If stringCheck(Trim(txtCategoryPersonal.Text)) = False Then
        Exit Sub
    End If
    
    Dim strSql As String
    strSql = "SELECT ID FROM DiagTemplateCategoryPri WHERE CategoryName = '" _
        + Trim(txtCategoryPersonal.Text) + "'" _
        + " AND DOCTORID = '" + CStr(USER_ID) + "'"
    If GetRecordNumber(strSql) > 0 Then
        MsgBox "该疾病类别已存在, 请重新修改!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If MsgBox("您确定要修改吗?", vbYesNo Or vbQuestion, "") <> vbYes Then
        
        Exit Sub
    End If
    strSql = "UPDATE  DiagTemplateCategoryPri SET CategoryName = '" + Trim(txtCategoryPersonal.Text) _
        + "' WHERE ID ='" + Trim(lstCategoryPersonalId.Text) + "'  "
        
    '===事务处理开始====================================================
    Dim myConn As New ADODB.Connection
    myConn.CursorLocation = adUseClient
    myConn.Open modGlobalDbConnect.GetConnectionString
    
    If myConn.State = adStateClosed Then
        MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
        Exit Sub
    End If
    
    myConn.BeginTrans '开始
    '执行语句
    myConn.Execute strSql
    If Err.Number = 0 Then
        myConn.CommitTrans '---提交事務
        MsgBox "<疾病类别>修改成功.", vbExclamation, "提示"
    Else
        myConn.Rollback