modreportedit.bas

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

        Next
    End If
    
  
    InitCheckDictionary = True
    Exit Function
ErrHandler:
    p_strError = Err.Description
    InitCheckDictionary = False
  End Function



'作者：冷家锋
'时间：2008-11-11-10-52
'说明: 获取患者历史记录
'p_strPatientName<IN>:患者姓名
'p_bFuzzyQuery<IN>:是否模糊查询
'p_strWhereClause<IN>:条件子句
'p_lvCheckDictionary<OUT>:词库ListView
'p_DBConn<IN>:数据库连接
'p_strError<OUT>：函数执行过程中的错误信息
'返回值：患者信息初始化正确，返回TRUE，否则返回FALSE
Public Function GetPatientHistoryList( _
    ByVal p_strPatientName As String, _
    ByVal p_bFuzzyQuery As Boolean, _
    ByVal p_strWhereClause As String, _
    ByRef p_lvHistory As ListView, _
    ByVal p_DBConn As ADODB.Connection, _
    ByRef p_strError As String) As Boolean
    On Error GoTo ErrHandler
     
     If Trim(p_strPatientName) = "" Then
        p_strError = "患者姓名为空"
        GetPatientHistoryList = False
        Exit Function
     End If
     
     If p_DBConn Is Nothing Then
        p_strError = "数据库连接尚未初始化"
        GetPatientHistoryList = False
        Exit Function
    End If
        
        
    If p_DBConn.STATE <> adStateOpen Then
         p_strError = "数据库连接尚未打开"
        GetPatientHistoryList = False
        Exit Function
    End If
    
    If p_DBConn.CursorLocation <> adUseClient Then
        p_DBConn.CursorLocation = adUseClient
    End If
'=========================================================================]
    Dim strSql As String
    Dim rsLsv As New ADODB.Recordset
    

    
'    strSql = "SELECT PATIENT_NAME as 姓名,TO_CHAR(PATIENT_BIRTHDAY,'YYYY-MM-DD') AS 出生日期," _
'        + "ALL_CHECK_PART AS 检查部位,FILM_DESCRIPTION as 影像描述," _
'        + "FILM_IMPRESSION as 印象结果,CHECK_DOCT_ID as 检查医师," _
'        + " CHECK_DATE as 检查日期 FROM CHECK_LIST WHERE 1=1 " _
'        + " AND PATIENT_NAME "

    strSql = "SELECT PATIENT_NAME as 姓名,CHECK_DOCT_ID as 检查医师," _
        + " CHECK_DATE as 检查日期 ,FILM_DESCRIPTION as 影像描述,FILM_IMPRESSION as 印象结果 " _
        + " FROM CHECK_LIST WHERE 1=1 " _
        + " AND PATIENT_NAME "
        
    If p_bFuzzyQuery = True Then
        strSql = strSql + " like '%" + p_strPatientName + "%'"
    Else
        strSql = strSql + " ='" + p_strPatientName + "'"
    End If
    
    If p_strWhereClause <> "" Then
        strSql = strSql + " AND " + p_strWhereClause
    End If
        
    If rsLsv.STATE = adStateOpen Then
        rsLsv.Close
    End If
    rsLsv.Open strSql, p_DBConn
    
    p_lvHistory.View = lvwReport
    p_lvHistory.ColumnHeaders.Clear
    p_lvHistory.ListItems.Clear
    
    If rsLsv.RecordCount <= 0 Then
        p_strError = "该患者没有历史记录"
        GetPatientHistoryList = False
        Exit Function
    End If
    
    Dim rItem As ListItem
    Dim i As Integer
    Dim j As Integer
    
    p_lvHistory.ColumnHeaders.Add , , rsLsv.Fields(0).Name, p_lvHistory.Width / 4
    p_lvHistory.ColumnHeaders.Add , , rsLsv.Fields(1).Name, p_lvHistory.Width / 4
    p_lvHistory.ColumnHeaders.Add , , rsLsv.Fields(2).Name, p_lvHistory.Width / 2
    p_lvHistory.ColumnHeaders.Add , , rsLsv.Fields(3).Name, p_lvHistory.Width / 4
    p_lvHistory.ColumnHeaders.Add , , rsLsv.Fields(4).Name, p_lvHistory.Width / 4
    'p_lvHistory.ColumnHeaders.Add , , rsLsv.Fields(5).Name, p_lvHistory.Width / 6
    'p_lvHistory.ColumnHeaders.Add , , rsLsv.Fields(6).Name, p_lvHistory.Width / 4
    
    If rsLsv.RecordCount > 0 Then
        rsLsv.MoveFirst
        For i = 0 To rsLsv.RecordCount - 1
            If Not IsNull(rsLsv.Fields("姓名")) Then
                p_lvHistory.ListItems.Add , , rsLsv("姓名").Value
                For j = 1 To rsLsv.Fields.Count - 1
                    If IsNull(rsLsv(j).Value) = False Then
                        p_lvHistory.ListItems(i + 1).SubItems(j) = rsLsv(j).Value
                    End If
                Next
            End If
            rsLsv.MoveNext
        Next
    End If
    

    GetPatientHistoryList = True
    Exit Function
    
ErrHandler:
    p_strError = Err.Description
    GetPatientHistoryList = False
    Exit Function
End Function




'作者：冷家锋
'时间：2008-11-11-10-52
'说明: 初始化私有模板
'p_FilmDoctID<IN>:影像医师ID, 目前以真实姓名代替
'p_tvPrivate<OUT>:私有模板树
'p_DBConn<IN>:数据库连接
'p_strError<OUT>：函数执行过程中的错误信息
'返回值：患者信息初始化正确，返回TRUE，否则返回FALSE
Public Function InitPrivateTemplate( _
    ByVal p_FilmDoctID As String, _
    ByRef p_tvPrivate As TreeView, _
    ByVal p_DBConn As ADODB.Connection, _
    ByRef p_strError As String) As Boolean
    On Error GoTo ErrHandler
     
     If Trim(p_FilmDoctID) = "" Then
        p_strError = "医师ID为空"
        InitPrivateTemplate = False
        Exit Function
     End If
     
     If p_DBConn Is Nothing Then
        p_strError = "数据库连接尚未初始化"
        InitPrivateTemplate = False
        Exit Function
    End If
        
        
    If p_DBConn.STATE <> adStateOpen Then
         p_strError = "数据库连接尚未打开"
        InitPrivateTemplate = False
        Exit Function
    End If
    
    If p_DBConn.CursorLocation <> adUseClient Then
        p_DBConn.CursorLocation = adUseClient
    End If
'=========================================================================]
    
    Dim strSql As String
    strSql = "select DISTINCT ID,CATEGORYNAME FROM " _
        + " DIAGTEMPLATECATEGORYPRI WHERE DOCTORID ='" + CStr(p_FilmDoctID) + "'"
    
    Dim rsPrivate As New ADODB.Recordset
    
    If rsPrivate.STATE = adStateOpen Then
        rsPrivate.Close
    End If

    If p_DBConn.STATE = adStateClosed Then
        MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
        Exit Function
    End If
    
     rsPrivate.Open strSql, p_DBConn
    If rsPrivate.RecordCount <= 0 Then
        p_strError = "您还没有私人模板"
        InitPrivateTemplate = False
        Exit Function
    Else
       Dim i As Long
       p_tvPrivate.Nodes.Clear
       p_tvPrivate.SingleSel = True
       p_tvPrivate.Nodes.Add , , "Root", "检查部位"
       For i = 0 To rsPrivate.RecordCount - 1
         If Not IsNull(rsPrivate.Fields(0)) Or Not IsNull(rsPrivate.Fields("CATEGORYNAME")) Then
            p_tvPrivate.Nodes.Add "Root", 4, PRE_KEY_MAIIN + CStr(rsPrivate.Fields(0)), CStr(rsPrivate.Fields("CATEGORYNAME"))
            
            strSql = "SELECT DISTINCT  ILLNAME FROM " _
            + " DIAGTEMPLATEILLPRI WHERE CATEGORYID = '" + CStr(rsPrivate.Fields(0)) + "'"
        
        
            Dim rsPrivateIll As New ADODB.Recordset
                    
            
            If rsPrivateIll.STATE = adStateOpen Then
                rsPrivateIll.Close
            End If
            
            If p_DBConn.STATE = adStateClosed Then
                MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
                Exit Function
            End If
            rsPrivateIll.Open strSql, p_DBConn
                  
            Dim j As Long
            For j = 0 To rsPrivateIll.RecordCount - 1
                If Not IsNull(rsPrivateIll.Fields("ILLNAME")) Then
                    p_tvPrivate.Nodes.Add PRE_KEY_MAIIN + CStr(rsPrivate.Fields(0)), 4, PRE_KEY_SUB + CStr(rsPrivate.Fields(0)) + CStr(rsPrivateIll.Fields("ILLNAME")), CStr(rsPrivateIll.Fields("ILLNAME"))
                    'tvPublic.ImageList = ImageList1
                End If
                rsPrivateIll.MoveNext
            Next
          End If
          
          rsPrivate.MoveNext
       Next
    End If
    
    For i = 0 To p_tvPrivate.Nodes.Count - 1
        p_tvPrivate.Nodes("Root").Expanded = True
    Next

    InitPrivateTemplate = True
    Exit Function
    
ErrHandler:
    p_strError = Err.Description
    InitPrivateTemplate = False
    Exit Function
End Function




'作者：冷家锋
'时间：2008-11-11-10-52
'说明: 初始化公共模板
'p_FilmDeptID<IN>:影像科室ID
'p_tvPrivate<OUT>:公共模板树
'p_DBConn<IN>:数据库连接
'p_strError<OUT>：函数执行过程中的错误信息
'返回值：患者信息初始化正确，返回TRUE，否则返回FALSE
Public Function InitPublicTemplate( _
    ByVal p_FilmDeptID As String, _
    ByRef p_tvPublic As TreeView, _
    ByVal p_DBConn As ADODB.Connection, _
    ByRef p_strError As String) As Boolean
    On Error GoTo ErrHandler
     
     If Trim(p_FilmDeptID) = "" Then
        p_strError = "影像科室ID为空"
        InitPublicTemplate = False
        Exit Function
     End If
     
     If p_DBConn Is Nothing Then
        p_strError = "数据库连接尚未初始化"
        InitPublicTemplate = False
        Exit Function
    End If
        
        
    If p_DBConn.STATE <> adStateOpen Then
         p_strError = "数据库连接尚未打开"
        InitPublicTemplate = False
        Exit Function
    End If
    
    If p_DBConn.CursorLocation <> adUseClient Then
        p_DBConn.CursorLocation = adUseClient
    End If
'=========================================================================]
    
    
    Dim strSql As String
    strSql = "SELECT DISTINCT ID,CATEGORYNAME FROM " _
    + " DIAGTEMPLATECATEGORYPUB WHERE DEPARTMENTID ='" + CStr(DEPARTMENT_ID) + "'"
 
    Dim rsPublic As New ADODB.Recordset
    
    If rsPublic.STATE = adStateOpen Then
        rsPublic.Close
    End If
    
    rsPublic.Open strSql, p_DBConn
    If rsPublic.RecordCount <= 0 Then
        p_strError = "尚未添加公共模板"
        InitPublicTemplate = False
        Exit Function
    Else
       Dim i As Long
       p_tvPublic.Nodes.Clear
       p_tvPublic.Nodes.Add , , "Root", "检查部位"
       For i = 0 To rsPublic.RecordCount - 1
          If Not IsNull(rsPublic.Fields(0)) Or Not IsNull(rsPublic.Fields("CATEGORYNAME")) Then
            p_tvPublic.Nodes.Add "Root", 4, PRE_KEY_MAIIN + CStr(rsPublic.Fields(0)), CStr(rsPublic.Fields("CATEGORYNAME"))
            strSql = "SELECT DISTINCT  ILLNAME FROM " _
            + " DIAGTEMPLATEILLPUB WHERE CATEGORYID = '" + CStr(rsPublic.Fields(0)) + "'"
            
            Dim rsPublicIll As New ADODB.Recordset
            
            If p_DBConn.STATE = adStateClosed Then
                p_strError = "数据库连接错误，请查看网络状态"
                InitPublicTemplate = False
                Exit Function
            End If
            
            If rsPublicIll.STATE = adStateOpen Then
                rsPublicIll.Close
            End If
            rsPublicIll.Open strSql, p_DBConn
                  
            Dim j As Long
            For j = 0 To rsPublicIll.RecordCount - 1
                If Not IsNull(rsPublicIll.Fields("ILLNAME")) Then
                    p_tvPublic.Nodes.Add PRE_KEY_MAIIN + CStr(rsPublic.Fields(0)), 4, PRE_KEY_SUB + CStr(rsPublic.Fields(0)) + CStr(rsPublicIll.Fields("ILLNAME")), CStr(rsPublicIll.Fields("ILLNAME"))
                    'tvPublic.ImageList = ImageList1
                End If
                rsPublicIll.MoveNext
            Next
            rsPublic.MoveNext
          End If
       Next
    End If
    
    For i = 0 To p_tvPublic.Nodes.Count - 1
        p_tvPublic.Nodes("Root").Expanded = True
    Next
    
    
    InitPublicTemplate = True
    Exit Function
    
ErrHandler:
    p_strError = Err.Description
    InitPublicTemplate = False
    Exit Function
End Function