frmedittemplate.frm

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

'添加疾病类别----公共
Private Sub btnAddCategory_Click(Shifit As Integer)
    On Error GoTo ErrHandler
    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
    
    strSql = "INSERT INTO DiagTemplateCategoryPub (ID,CategoryName,DEPARTMENTID) " _
        + " VALUES( DiagTempCategoryPub_SEQUENCE.NEXTVAL,'" + Trim(txtCategory.Text) + "','" _
        + CStr(DEPARTMENT_ID) + "' )"
    
    
    '===事务处理开始====================================================
    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 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 btnAddCategoryPersonal_Click(Shifit As Integer)
On Error GoTo ErrHandler
    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
    
    strSql = "INSERT INTO DiagTemplateCategoryPri (ID,CategoryName,DOCTORID) " _
    + " VALUES( DiagTempCategoryPri_SEQUENCE.NEXTVAL,'" + Trim(txtCategoryPersonal.Text) _
    + "','" + CStr(USER_ID) + "'  )"
    
    '===事务处理开始====================================================
    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
    '===事务处理结束====================================================
    
    Call InitCategoriesPersonal
    If Trim(lstCategoryPersonalId.Text) <> "" Then
        Call InitIllNamesPersonal(lstCategoryPersonalId.Text)
    End If
    txtCategoryPersonal.Text = ""
    txtIllNamePersonal.Text = ""
    
    txtFilmDescriptionPersonal.Text = ""
    txtDiagnoseResultPersonal.Text = ""
    Exit Sub
ErrHandler:
    MsgBox "部位添加失败, 原因:" + Err.Description, vbExclamation, "提示"
    
End Sub

'添加疾病名称----公共
Private Sub btnAddIllName_Click(Shifit As Integer)
On Error GoTo ErrHandler
    If lstCategoryId.ListCount <= 0 Or Trim(lstCategoryId.Text) = "" Then
        MsgBox "请先选择<疾病种类>, 再添加对应的<疾病名称>!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If InStr(Trim(txtIllName.Text), " ") > 0 Then
        MsgBox "请输入要添加的<疾病名称>, 名称中空格为无效字符!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If Trim(txtIllName.Text) = "" Then
        MsgBox "请输入要添加的<疾病名称>!", vbExclamation, "提示"
        Exit Sub
    End If
    
    Dim strZDLB As String
    If optPubState(0).Value = False And optPubState(1).Value = False Then
        MsgBox "请选择<正常>或<异常>!", vbExclamation, "提示"
        Exit Sub
    Else
        strZDLB = IIf(optPubState(0).Value, STATE_ZC, STATE_YC)
    End If
    
    
    
    If stringCheck(Trim(txtIllName.Text)) = False Then
        Exit Sub
    End If
    
    Dim strSql As String
    'zlj 20080904
'    strSql = "SELECT ID FROM DiagTemplateIllPub WHERE IllName = '" _
'        + Trim(txtIllName.Text) + "'" + " and CATEGORYID = '" + Trim(lstCategoryId.Text) + "'"
    strSql = "SELECT ID FROM DiagTemplateIllPub WHERE IllName = '" + Trim(txtIllName.Text) + "'" _
        + " AND ZDLB ='" + Trim(strZDLB) + "'" _
        + " AND FilmDescription ='" + Trim(txtFilmDescription.Text) + "' AND DiagnoseResult = '" _
        + Trim(txtDiagnoseResult.Text) _
        + "'" + " and CATEGORYID = '" + Trim(lstCategoryId.Text) + "'"
    If GetRecordNumber(strSql) > 0 Then
        MsgBox "该疾病名称已存在, 请重新添加!", vbExclamation, "提示"
        Exit Sub
    End If
    
    
    If MsgBox("您确认该疾病名称对应的<影像所见>和<诊断结果>?", vbQuestion Or vbYesNo) = vbNo Then
        Exit Sub
    End If
    
    strSql = "INSERT INTO DiagTemplateIllPub (ID,IllName, CategoryId, FilmDescription, DiagnoseResult,ZDLB,JCSB) VALUES( HTPACS_SEQUENCE.NEXTVAL,'" _
        + Trim(txtIllName.Text) + "' , '" + Trim(lstCategoryId.Text) + "','" _
        + Trim(txtFilmDescription.Text) + "','" + Trim(txtDiagnoseResult.Text) + "','" + Trim(strZDLB) + "','" + Trim(STATION_NAME) + _
        "' )"
        
    ErrNumber = 0
    
    '===事务处理开始====================================================
    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
    '===事务处理结束====================================================
    
    'Call InitMainParts
    If Len(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 btnAddIllNamePersonal_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(txtIllNamePersonal.Text), " ") > 0 Then
        MsgBox "请输入要添加的<疾病名称>, 名称中空格为无效字符!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If Trim(txtIllNamePersonal.Text) = "" Then
        MsgBox "请输入要添加的<疾病名称>", vbExclamation, "提示"
        Exit Sub
    End If
    
    Dim strZDLB As String
    If optPriState(0).Value = False And optPriState(1).Value = False Then
        MsgBox "请选择<正常>或<异常>!", vbExclamation, "提示"
        Exit Sub
    Else
        strZDLB = IIf(optPriState(0).Value, STATE_ZC, STATE_YC)
    End If
    
    If stringCheck(Trim(txtIllNamePersonal.Text)) = False Then
        Exit Sub
    End If
    
    Dim strSql As String
    'zlj 20080904
'    strSql = "SELECT ID FROM DiagTemplateIllPri WHERE IllName = '" _
'         + Trim(txtIllNamePersonal.Text) + "'" + " and CATEGORYID = '" _
'         + Trim(lstCategoryPersonalId.Text) + "'"
         
    strSql = "SELECT ID FROM DiagTemplateIllPri WHERE IllName = '" + Trim(txtIllNamePersonal.Text) + "'" _
        + " AND ZDLB ='" + Trim(strZDLB) + "'" _
        + " AND FilmDescription ='" + Trim(txtFilmDescriptionPersonal.Text) + "' AND DiagnoseResult = '" _
        + Trim(txtDiagnoseResultPersonal.Text) _
        + "'" + " and CATEGORYID = '" + Trim(lstCategoryPersonalId.Text) + "'"
    If GetRecordNumber(strSql) > 0 Then
        MsgBox "该疾病名称已存在, 请重新添加!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If MsgBox("您确认该疾病名称对应的<影像所见>和<诊断结果>?", vbQuestion Or vbYesNo) = vbNo Then
        Exit Sub
    End If
    
'    strSql = "INSERT INTO DiagTemplateIllPri (IllName, CategoryId, FilmDescription, DiagnoseResult,ID) VALUES( '" _
'        + Trim(txtIllNamePersonal.Text) + "' , '" + Trim(lstCategoryPersonalId.Text) + "','" _
'        + Trim(txtFilmDescriptionPersonal.Text) + "','" + Trim(txtDiagnoseResultPersonal.Text) _
'        + "',HTPACS_SEQUENCE.NEXTVAL )"
    
    strSql = "INSERT INTO DiagTemplateIllPri (ID,IllName, CategoryId, FilmDescription, DiagnoseResult,ZDLB,JCSB) VALUES( HTPACS_SEQUENCE.NEXTVAL,'" _
        + Trim(txtIllNamePersonal.Text) + "' , '" + Trim(lstCategoryPersonalId.Text) + "','" _
        + Trim(txtFilmDescriptionPersonal.Text) + "','" + Trim(txtDiagnoseResultPersonal.Text) + "','" + strZDLB + "','" + STATION_NAME + _
        "' )"
    
    '===事务处理开始====================================================
    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 btnBack_Click(Shifit As Integer)
On Error GoTo ErrHandler
    Unload Me
    frmCheckList.SetFocus
    Exit Sub
ErrHandler:
     MsgBox Err.Description, vbExclamation, "提示"
End Sub



'公共模板----按钮事件--删除 疾病名称----
Private Sub btnDeleteIllName_Click(Shifit As Integer)
On Error GoTo ErrHandler
    If lstIllNameId.ListCount <= 0 Or Trim(lstIllNameId.Text) = "" Or lstIllName.ListCount <= 0 _
        Or Trim(lstIllName.Text) = "" Then