frmreportedit.frm

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

'单击事件----状态/患者来源 下拉框
Private Sub cmbState_Click()
On Error GoTo ErrHandler
    txtState.Text = cmbState.Text
Exit Sub
ErrHandler:
End Sub


'窗体加载事件
Private Sub Form_Load()
On Error GoTo ErrHandler
    m_DbConn.CursorLocation = adUseClient
    If m_DbConn.STATE <> adStateOpen Then
        m_DbConn.Open modGlobalDbConnect.GetConnectionString
    End If
    
    If m_DbConn.STATE <> adStateOpen Then
        Exit Sub
    End If
    
    Dim strError As String
    If False = InitReportEditStaticInfo(m_DbConn, strError) Then
        MsgBox strError, vbExclamation, "初始化"
    End If
    
    '检查
    strDiagnoseState = STATE_ZC
    
    dtStartDate.Value = Now - 7
    dtEndDate.Value = Now
    Exit Sub
ErrHandler:
    

End Sub
















'单击事件--列出影像描述及诊断结果
Private Sub lsvHistory_Click()
On Error GoTo ErrHandler
    If lsvHistory.ListItems.Count <> 0 Then
        txtDescription.Text = lsvHistory.SelectedItem.SubItems(3)
        txtImpression.Text = lsvHistory.SelectedItem.SubItems(4)
    End If
    
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
End Sub



'输入事件--只能输入数字
Private Sub txtAuditorPassword_KeyPress(KeyAscii As Integer)
On Error GoTo ErrHandler
    '只允许退格键和数字键
    If KeyAscii <> 8 And KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
        KeyAscii = 0
    End If
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
End Sub

'单击事件--标记焦点在检查结果
Private Sub txtDiagnoseResult_Click()
On Error GoTo ErrHandler
    strWordStoreSign = "txtResult"
    Exit Sub
ErrHandler:

End Sub

'输入事件--只能输入数字
Private Sub txtPatientAge_KeyPress(KeyAscii As Integer)
On Error GoTo ErrHandler
    '只允许退格键和数字键
    If KeyAscii <> 8 And KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
        KeyAscii = 0
    End If
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
End Sub

'单击事件--标记焦点在影像描述
Private Sub txtPhotoDescription_Click()
On Error GoTo ErrHandler
    strWordStoreSign = "txtDescription"
    Exit Sub
ErrHandler:
End Sub

'
'说明：初始化报告编辑界面动态信息，包括<患者信息>，<私有模板>等
'作者：冷家锋
'时间：2008-11-11 14：20
'p_strCheckListID<IN>:CHECKLIST_ID
'p_strErr<OUT>:函数执行过程中出错信息
Public Function InitReportEditDynamicInfo(ByVal p_strCheckListID As String, _
    ByVal p_DBConn As ADODB.Connection, _
    ByRef p_strErr As String) As Boolean
    On Error GoTo ErrHandler
    Dim strCheckListID As String, strErr As String, bRet As Boolean
    
    '初始化患者记录ID
    m_strCurListID = p_strCheckListID
    
    
    If InitPatientInfo(p_strCheckListID, m_ptInfo, p_DBConn, strErr) = True Then
        lblCheckNumber.Caption = m_ptInfo.PATIENT_ID
        txtPatientName.Text = m_ptInfo.PATIENT_NAME
        txtPatientName_PHONETIC.Text = m_ptInfo.PATIENT_NAME_PHONETIC
        txtSex.Text = m_ptInfo.PATIENT_SEX
        txtPatientAge.Text = m_ptInfo.PATIENT_AGE
        
        txtAgeWeigh.Text = m_ptInfo.AGE_WEIGHT
        txtState.Text = m_ptInfo.STATE
        txtHospitalNumber.Text = m_ptInfo.HOSPITAL_NUM
        txtBedNumber.Text = m_ptInfo.BED_NUM
        txtAllCheckParts.Text = m_ptInfo.ALL_CHECK_PART
        
        txtApplyDept.Text = GetDeptNameByID(m_ptInfo.APPLY_DEPT_ID, m_DbConn, p_strErr)
        If CorrespondApplyDept(m_ptInfo.APPLY_DEPT_ID, p_strErr) = False Then
            p_strErr = "CorrespondApplyDept 执行错误!"
        End If
        txtApplyDoctor.Text = m_ptInfo.APPLY_DOCT_ID
        txtPhotoDescription.Text = m_ptInfo.FILM_DESCRIPTION
        txtDiagnoseResult.Text = m_ptInfo.DIAGNOSIS_RESULT
        txtCharge.Text = m_ptInfo.CHECK_FEE
        txtExamClass.Text = m_ptInfo.EXAM_CLASS
        
        
        m_strCheckDoctor = m_ptInfo.CHECK_DOCTOR_ID
        m_dList_CheckDate = m_ptInfo.CHECK_DATE
        m_strAuditDoctorName = m_ptInfo.AUDIT_DOCTOR_ID
    Else
        p_strErr = strErr + "<患者信息初始化>"
        InitReportEditDynamicInfo = False
        Exit Function
    End If
    
    
    If False = GetPatientHistoryList(m_ptInfo.PATIENT_NAME, False, "", lsvHistory, m_DbConn, strErr) Then
        p_strErr = strErr + "<患者历史记录初始化>"
        InitReportEditDynamicInfo = False
    End If
    
    '报告编辑控件状态初始化
    Dim p_checkDoct As String
    If m_ptInfo.CHECK_DOCTOR_ID <> "" Then
        p_checkDoct = m_ptInfo.CHECK_DOCTOR_ID
    Else
        p_checkDoct = USER_DISPLAY_NAME
    End If

    
    InitReportEditDynamicInfo = True
    Exit Function
ErrHandler:
    InitReportEditDynamicInfo = False
End Function



'说明：初始化报告编辑界面<静态>信息，包括<性别>下拉框, <状态>下拉框,<公共模板>树等
'作者：冷家锋
'时间：2008-11-11 14：20
'p_DBConn<IN>:数据库连接
'p_strErr<OUT>:函数执行过程中出错信息
Private Function InitReportEditStaticInfo(ByVal p_DBConn As ADODB.Connection, _
    ByRef p_strError As String) As Boolean
    
    On Error GoTo ErrHandler
    Dim strErr As String, bRet As Boolean

    If False = InitCmbSex(cmbSex, strErr) Then
        p_strError = strErr + "<性别初始化>"
    End If
    
    If False = InitCmbAgeWeight(cmbAgeWeigh, strErr) Then
        p_strError = strErr + "<年龄单位初始化>"
    End If

    Dim strFilmDeptID As String
    
    If InitApplyDept(strFilmDeptID, m_dptApplyDept, m_nApplyDeptCount, m_DbConn, strErr) Then
        Dim i As Long, nLow As Long, nHigh As Long
        nLow = LBound(m_dptApplyDept)
        nHigh = nLow + m_nApplyDeptCount - 1
        
        cmbApplyDepartment.Clear
        cmbApplyDepartmentID.Clear
        For i = nLow To nHigh
            cmbApplyDepartment.AddItem m_dptApplyDept(i).DEPT_NAME
            cmbApplyDepartmentID.AddItem m_dptApplyDept(i).DEPT_ID
        Next
    Else
        p_strError = strErr + "<申请科室初始化>"
    End If
    
    
    If False = InitPatientState(cmbState, m_DbConn, strErr) Then
        p_strError = strErr + "<患者状态初始化>"
    End If
    InitReportEditStaticInfo = True
    Exit Function
ErrHandler:
    p_strError = Err.Description
    InitReportEditStaticInfo = False
End Function



'说明：函数－－审核报告
'作者：刘辉
'时间：2008-11-12
'[STRING]p_CurListID[IN]　待审核记录ID
'[STRING]p_AuditDoct[IN]  审核医师姓名
'[adodb.Connection]p_DBConn[OUT] 待初始化的数据库连接
'[stirng]p_bAuditPass[IN] 审核标记：TRUE为审核通过，FALSE为审核退回
'[STRING]p_strErr [OUT] 函数执行过程中的错误信息

Private Function AuditReport(ByVal p_CurListID As String, ByVal p_AuditDoct As String, _
    ByVal p_MyConn As ADODB.Connection, ByVal p_bAuditPass As Boolean, ByRef p_strErr As String) As Boolean
On Error GoTo ErrHandler
    If p_CurListID = "" Then
        AuditReport = False
        p_strErr = "AuditReport参数p_CurListID 为空!"
        Exit Function
    End If
    
    If p_AuditDoct = "" Then
        AuditReport = False
        p_strErr = "AuditReport参数p_AuditDoct 为空"
        Exit Function
    End If
    
    If p_MyConn Is Nothing Then
        AuditReport = False
        p_strErr = "AuditReport参数p_MyConn 为空"
        Exit Function
    End If
    
    Dim strNow As String
    strNow = CStr(Now)
    
    Dim strUpdateCheckList As String
    strUpdateCheckList = strUpdateCheckList + "UPDATE CHECK_LIST SET "
    If p_bAuditPass = True Then
        strUpdateCheckList = strUpdateCheckList + "CHECK_STATE ='已审核'"
    Else
        strUpdateCheckList = strUpdateCheckList + "CHECK_STATE ='审核退回'"
    End If
    strUpdateCheckList = strUpdateCheckList + ",AUDIT_DOCT_ID ='" + p_AuditDoct + "'"
    strUpdateCheckList = strUpdateCheckList + ",AUDIT_DATE ='" + strNow + "'"
    strUpdateCheckList = strUpdateCheckList + " WHERE ID='" + p_CurListID + "'"
    
    
    '===事务处理开始====================================================
    p_MyConn.CursorLocation = adUseClient
    If p_MyConn.STATE = adStateClosed Then
        p_MyConn.Open modGlobalDbConnect.GetConnectionString
    End If
    
    p_MyConn.BeginTrans '开始
    '执行语句
    p_MyConn.Execute strUpdateCheckList
    If Err.Number = 0 Then
        p_MyConn.CommitTrans '---提交事務
        If p_bAuditPass = True Then
            m_ptInfo.CHECK_STATE = "已审核"
        Else
            m_ptInfo.CHECK_STATE = "审核退回"
        End If
        'zlj 20080907
'        txtDiagnoseResult.Text = strDiagnoseResult '去除此为急诊报告
        'MsgBox "<报告单>保存成功.", vbExclamation, "提示"
    Else
        p_MyConn.RollbackTransaction
        AuditReport = False
        p_strErr = "审核失败!"
        Exit Function
    End If
    '===事务处理结束====================================================

    AuditReport = True
    Exit Function
ErrHandler:
    AuditReport = False
    p_strErr = p_strErr + Err.Description
End Function



'
''说明：打印报告单函数
''作者：刘辉
''时间：2008-11-12
''[STRING]p_strCurListID [IN] 记录ID
''[ADODB.Connection]p_MyConn [IN] 数据库连接
''[STRING]p_strErr [IN] 错误信息
'Public Function PrintReport(ByVal p_strCurListID As String, _
'    ByVal p_MyConn As ADODB.Connection, ByRef p_strErr As String) As Boolean
'On Error GoTo ErrHandler
'    If p_strCurListID = "" Then
'        PrintReport = False
'        p_strErr = "PrintReport参数p_strCurListID 为空!"
'        Exit Function
'    End If
'
'    If p_MyConn Is Nothing Then
'        PrintReport = False
'        p_strErr = "PrintReport参数p_strCurListID 为空"
'        Exit Function
'    End If
'
'    Dim strErr As String
'    '保存报告
'    If btnSave.Enabled = True Then
'        If SaveReport(p_strCurListID, p_MyConn, strErr) = False Then
'            Me.btnSave.Enabled = True
'            PrintReport = False
'            p_strErr = "保存报告单失败!" + strErr
'            Exit Function
'        End If
'        frmReportEdit.btnEditReport.Enabled = True
'        frmReportEdit.btnSave.Enabled = Not frmReportEdit.btnEditReport.Enabled
'        frmReportEdit.btnCancel.Enabled = frmReportEdit.btnSave.Enabled
'        frmReportEdit.txtPhotoDescription.Enabled = frmReportEdit.btnSave.Enabled
'        frmReportEdit.txtDiagnoseResult.Enabled = frmReportEdit.btnSave.Enabled
'        frmReportEdit.frmPatientInfo.Enabled = frmReportEdit.btnSave.Enabled
'        frmReportEdit.frmDiagnoseFlag.Enabled = frmReportEdit.btnSave.Enabled
'        frmReportEdit.lvResults.Enabled = frmReportEdit.btnSave.Enabled
'
'        frmReportEdit.btnPreviewReport.Enabled = True
'        frmReportEdit.btnPrint.Enabled = frmReportEdit.btnPreviewReport.Enabled
'    End If
'
'    '审核报告
'    If chkEmergencyTreatment.Value = 0 Then
'        If USER_POWER <> POWER_COMMON_USER Then
'            Dim strSql As String
'            strSql = "SELECT ID FROM CHECK_LIST WHERE CHECK_STATE ='待审核' OR CHECK_STATE='已审核' AND ID ='" _
'                + p_strCurListID + "'"
'            If GetRecordNumber(strSql) = 0 Then
'                p_strErr = "该患者报告单还未生成!"
'                PrintReport = False
'                Exit Function
'            End If
'
'            If AuditReport(p_strCurListID, USER_DISPLAY_NAME, p_MyConn, True, strErr) = True Then
'                m_strAuditDoctorName = USER_DISPLAY_NAME
'                m_ptInfo.AUDIT_DOCTOR_ID = USER_DISPLAY_NAME
'            Else
'                p_strErr = "报告单审核失败!" + strErr
'                PrintRe