modreportedit.bas

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

Attribute VB_Name = "modReportEdit"
'----------------------------------------------------------------------------------------------------
'文件：modReportEdit.bas
'作者：冷家锋
'时间：2008-11-11
'说明：报告编辑界面所需相关方法
'----------------------------------------------------------------------------------------------------




Option Explicit

'全局变量

'检查部位分类数组
'g_CheckMainParts(0-N,0-1):g_CheckMainParts(0-N,0)存放部位ID，g_CheckMainParts(0-N,1)存放部位NAME
Public g_CheckMainParts() As String

'子部位数组
'g_CheckSubParts(0-N,0-2):g_CheckSubParts(0-N,0)存放子部位ID，g_CheckSubParts(0-N,1)存放子部位NAME
'g_CheckSubParts(0-N,2)子部位检查方法,g_CheckSubParts(0-N,3)子部位检查费用



Public g_CheckSubParts() As String

Public g_bModifyReport As Boolean

'TREEVIEW KEY值 前缀
Const PRE_KEY_MAIIN = "M"
Const PRE_KEY_SUB = "S"
'
''==支持类型=======================================================
'Public Type TypePatientInfo
'    PATIENT_ID As String    '患者ID
'    PATIENT_NAME As String  '患者姓名
'    PATIENT_NAME_PHONETIC As String '姓名拼音
'    PATIENT_SEX As String       '患者性别
'    PATIENT_AGE As String       '年龄               1-----5
'    AGE_WEIGHT As String        '年龄单位
'    PATIENT_BIRTHDAY As String '出生日期
'    APPLY_DEPT_ID As String     '申请科室ID/全称
'    APPLY_DOCT_ID As String     '申请医生ID/真实姓名
'    VISIT_AREA As String            '病区编号       '目前为空，
'    STATE As String                     '患者来源，住院/门诊        6-------10
'    HOSPITAL_NUM As String      '住院号
'    BED_NUM As String               '病床号
'    STUDY_DATE  As String           '拍片时间
'    MACHINE_NAME As String      '拍片设备型号
'    ALL_CHECK_PART As String    '检查部位
'    CHECK_DOCTOR_ID As String '检查医师ID/真实姓名
'    CHECK_DATE  As String           '检查日期                   11--------15
'    AUDIT_DOCTOR_ID  As String  '审核医生ID/真实姓名
'    AUDIT_DATE As String                '审核日期
'    FILM_DESCRIPTION As String      '影像描述
'    DIAGNOSIS_RESULT As String              '检查结果
'    DOCTOR_ADVICE As String             '医师建议              16---------20
'    CHECK_FEE As String                     '检查费用
'    EXAM_CLASS As String                    '检查主部位
'    METHOD As String                        '检查方式
'    NEGATIVE As String                          '阴性?                  '新建报告，不需设置
'    IS_EMERGENT As String                   '是否急诊               '新建报告，不需设置, 审核过的报告需去除<急诊标识>
'    CHECK_STATE As String       '报告状态
'End Type

Public Type DeptInfo
    DEPT_ID As String   '科室ID
    DEPT_NAME As String '科室名称
End Type

'申请科室数组
Public g_ApplylDept() As DeptInfo

'=========================================================









'作者：刘辉
'时间：2008-11-11
'功能：根据影像科室获取其检查部位分类
'//[STRING] p_FilmDeptID[IN]--影像科室ID
'//[ADODB.Connection] p_MyConn[IN]--数据库连接
'//[STRING] p_strErr[OUT]--错误信息
 
Public Function InitMainCheckParts(ByVal p_FilmDeptID As String, _
    ByVal p_MyConn As ADODB.Connection, ByRef p_strErr As String) As Boolean
On Error GoTo ErrHandler
    If p_FilmDeptID = "" Then
        InitMainCheckParts = False
        p_strErr = "p_FilmDeptID 为空"
        Exit Function
    End If
    
    If p_MyConn Is Nothing Then
        InitMainCheckParts = False
        p_strErr = "p_MyConn 为空"
        Exit Function
    End If
    
    Dim strSql As String
    strSql = "SELECT ID,NAME FROM CHECKMAINPART WHERE DEPT_ID ='" + p_FilmDeptID + "'"

    Dim rsCheckParts As New ADODB.Recordset
    If rsCheckParts.STATE = adStateOpen Then
        rsCheckParts.Close
    End If
    
    rsCheckParts.Open strSql, p_MyConn
    
    Dim nCount As Long
    Dim i As Long
    nCount = rsCheckParts.RecordCount
    ReDim g_CheckMainParts(nCount, 2)
    If nCount > 0 Then
        For i = 0 To nCount - 1
            If Not IsNull(Trim(rsCheckParts.Fields("ID"))) _
                And Not IsNull(rsCheckParts.Fields("NAME")) Then
                g_CheckMainParts(i, 0) = Trim(rsCheckParts.Fields("ID"))
                g_CheckMainParts(i, 1) = Trim(rsCheckParts.Fields("NAME"))
            End If
            rsCheckParts.MoveNext
        Next
    End If
    
    InitMainCheckParts = True
    Exit Function
ErrHandler:
    InitMainCheckParts = False
    p_strErr = "InitMainCheckParts" + Err.Description
End Function

'作者：刘辉
'时间：2008-11-11 10：40
'功能：根据部位分类ID初始化子部位数组
'//[STRING] p_MainCheckPartID[IN]--检查部位分类
'//[ADODB.Connection] p_MyConn[IN]--数据库连接
'//[STRING] p_strErr[OUT]--错误信息
Public Function InitSubCheckParts(ByVal p_MainCheckPartID, _
    ByVal p_MyConn As ADODB.Connection, ByRef p_strErr As String) As Boolean
On Error GoTo ErrHandler
    If p_MainCheckPartID = "" Then
        p_strErr = "p_MainCheckPartID为空!"
        InitSubCheckParts = False
        Exit Function
    End If
    
    If p_MyConn Is Nothing Then
        p_strErr = "p_MyConn为空"
        InitSubCheckParts = False
        Exit Function
    End If
    
    Dim rsCheckSubParts As New ADODB.Recordset
    Dim i As Long
    Dim nCount As Long
    Dim strSql As String
    
    If rsCheckSubParts.STATE = adStateOpen Then
        rsCheckSubParts.Close
    End If
    
    strSql = "SELECT ID,NAME,CHECK_METHOD,CHARGE FROM CHECKSUBPART " _
        + " WHERE CHECKMAINPARTID ='" + p_MainCheckPartID + "'"
    
    rsCheckSubParts.Open strSql, p_MyConn
    
    nCount = rsCheckSubParts.RecordCount
    ReDim g_CheckSubParts(nCount, 4)
    If nCount > 0 Then
        For i = 0 To nCount - 1
            If Not IsNull(rsCheckSubParts.Fields("ID")) _
                And Not IsNull(rsCheckSubParts.Fields("NAME")) Then
                g_CheckSubParts(i, 0) = Trim(rsCheckSubParts.Fields("ID"))
                g_CheckSubParts(i, 1) = Trim(rsCheckSubParts.Fields("NAME"))
            End If
            
            If Not IsNull(rsCheckSubParts.Fields("CHECK_METHOD")) Then
                g_CheckSubParts(i, 2) = Trim(rsCheckSubParts.Fields("CHECK_METHOD"))
            End If
            
            If Not IsNull(rsCheckSubParts.Fields("CHARGE")) Then
                g_CheckSubParts(i, 3) = Trim(rsCheckSubParts.Fields("CHARGE"))
            End If
            rsCheckSubParts.MoveNext
        Next
    End If
    Exit Function
ErrHandler:
    InitSubCheckParts = False
    p_strErr = Err.Description
End Function



'作者：冷家锋
'时间：2008-11-11-09-01
'说明: 根据CHECK_LIST ID初始化患者信息
'p_CheckListID<IN>:CHECKLIST的ID
'p_PatientInfo<OUT>:患者信息结构体（类型）
'p_DBConn<IN>:数据库连接
'返回值：患者信息初始化正确，返回TRUE，否则返回FALSE
Public Function InitPatientInfo(ByVal p_strCheckListID As String, _
    ByRef p_PatientInfo As ClsPatientInfo, ByVal p_DBConn As ADODB.Connection, _
    ByRef p_strError As String) As Boolean
On Error GoTo ErrHandler
        If Trim(p_strCheckListID) = "" Then
            p_strError = "CHECKLIST_ID为空"
            InitPatientInfo = False
            Exit Function
        End If
                
        If p_DBConn Is Nothing Then
            p_strError = "数据库连接尚未初始化"
            InitPatientInfo = False
            Exit Function
        End If
        
        If p_DBConn.STATE <> adStateOpen Then
             p_strError = "数据库连接尚未初始化"
            InitPatientInfo = False
            Exit Function
        End If
'===================================================================
        
        
        Dim strSql As String
        Dim rsPatient As New ADODB.Recordset
        
        strSql = "SELECT PATIENT_ID AS 编号 ,to_char(MACHINE_NAME) || FILM_NO AS 设备检查序号,PATIENT_NAME AS 姓名," _
        + " PATIENT_NAME_PHONETIC AS 姓名拼音,PATIENT_SEX AS 性别,PATIENT_BIRTHDAY AS 出生日期," _
        + " PATIENT_AGE AS 年龄 ,AGE_WEIGHT AS 年龄单位," _
        + " ALL_CHECK_PART as 拍片部位,STATE AS 状态,HOSPITAL_NUM AS 住院号,BED_NUM AS 病床号," _
        + " APPLY_DEPT_ID AS 申请科室,APPLY_DOCT_ID AS 申请医师, ALL_CHECK_PART  AS 原始部位, " _
        + " CHECK_DOCT_ID AS  检查医师, CHECK_DATE AS 检查日期,CHECK_STATE AS 报告状态 ,IS_EMERGENCY AS 是否急诊," _
        + " AUDIT_DOCT_ID as 审核医师, AUDIT_DATE AS 审核日期," _
        + " FILM_DESCRIPTION AS 影像描述, FILM_IMPRESSION AS 诊断结果 ,CHECK_FEE as 检查费用,EXAM_CLASS as 主部位 ,METHOD as 检查方式 " _
        + " FROM CHECK_LIST " _
        + " WHERE  ID='" + p_strCheckListID + "'"

        If rsPatient.STATE = adStateOpen Then
            rsPatient.Close
        End If
    
        rsPatient.Open strSql, p_DBConn
        
        If rsPatient.RecordCount <= 0 Then
            MsgBox "获取该患者信息失败, 请与系统管理员联系!", vbExclamation, "提示"
            Exit Function
        End If
        
        If Not IsNull(rsPatient.Fields("编号")) Then
            p_PatientInfo.PATIENT_ID = rsPatient.Fields("编号")
        Else
            p_PatientInfo.PATIENT_ID = "未知"
        End If
        
        If Not IsNull(rsPatient.Fields("姓名")) Then
            p_PatientInfo.PATIENT_NAME = rsPatient.Fields("姓名")
        Else
           p_PatientInfo.PATIENT_NAME = ""
        End If
        
        
        If Not IsNull(rsPatient.Fields("姓名拼音")) Then
            p_PatientInfo.PATIENT_NAME_PHONETIC = rsPatient.Fields("姓名拼音")
        Else
            p_PatientInfo.PATIENT_NAME_PHONETIC = "未知"
        End If

        If Not IsNull(rsPatient.Fields("性别")) Then
            p_PatientInfo.PATIENT_SEX = rsPatient.Fields("性别")
        End If
        
        If Not IsNull(rsPatient.Fields("年龄")) Then
            p_PatientInfo.PATIENT_AGE = rsPatient.Fields("年龄")
        Else
            p_PatientInfo.PATIENT_AGE = "未知"
        End If
        
        If Not IsNull(rsPatient.Fields("年龄单位")) Then
           p_PatientInfo.AGE_WEIGHT = rsPatient.Fields("年龄单位")
        End If
    
        If Not IsNull(rsPatient.Fields("拍片部位")) Then
            p_PatientInfo.ALL_CHECK_PART = rsPatient.Fields("拍片部位")
        End If
        
        If Not IsNull(rsPatient.Fields("状态")) Then
            p_PatientInfo.STATE = rsPatient.Fields("状态")
        End If
        
        If Not IsNull(rsPatient.Fields("病床号")) Then
            p_PatientInfo.BED_NUM = rsPatient.Fields("病床号")
        End If
        
        If Not IsNull(rsPatient.Fields("住院号")) Then
            p_PatientInfo.HOSPITAL_NUM = rsPatient.Fields("住院号")
        Else
             p_PatientInfo.HOSPITAL_NUM = ""
        End If
        
        If Not IsNull(rsPatient.Fields("申请科室")) Then
            p_PatientInfo.APPLY_DEPT_ID = rsPatient.Fields("申请科室")
        End If
        
        If Not IsNull(rsPatient.Fields("申请医师")) Then
            p_PatientInfo.APPLY_DOCT_ID = rsPatient.Fields("申请医师")
        End If
        
        If Not IsNull(rsPatient.Fields("检查医师")) Then
            p_PatientInfo.CHECK_DOCTOR_ID = rsPatient.Fields("检查医师")
        End If
        
        If Not IsNull(rsPatient.Fields("检查日期")) Then
            p_PatientInfo.CHECK_DATE = rsPatient.Fields("检查日期")
        End If
        
        If Not IsNull(rsPatient.Fields("报告状态")) Then
            p_PatientInfo.CHECK_STATE = rsPatient.Fields("报告状态")
        End If
        
        If Not IsNull(rsPatient.Fields("是否急诊")) Then
            p_PatientInfo.IS_EMERGENT = rsPatient.Fields("是否急诊")
        End If
        
        If Not IsNull(rsPatient.Fields("审核医师")) Then
            p_PatientInfo.AUDIT_DOCTOR_ID = rsPatient.Fields("审核医师")
        End If
        
        If Not IsNull(rsPatient.Fields("审核日期")) Then
            p_PatientInfo.AUDIT_DATE = rsPatient.Fields("审核日期")
        End If
          
        If Not IsNull(rsPatient.Fields("影像描述")) Then
            p_PatientInfo.FILM_DESCRIPTION = rsPatient.Fields("影像描述")
        End If
        
        If Not IsNull(rsPatient.Fields("诊断结果")) Then
            p_PatientInfo.DIAGNOSIS_RESULT = rsPatient.Fields("诊断结果")
        End If
        
        
        If Not IsNull(rsPatient.Fields("检查费用")) Then
            p_PatientInfo.CHECK_FEE = rsPatient.Fields("检查费用")
        Else
            p_PatientInfo.CHECK_FEE = "0"
        End If
            
        If Not IsNull(rsPatient.Fields("主部位")) Then
            p_PatientInfo.EXAM_CLASS = rsPatient.Fields("主部位")
        Else
            p_PatientInfo.EXAM_CLASS = ""
        End If