frmmain.frm.bak

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

    Dim strSql As String
    Dim rsGetFilmPath As New ADODB.Recordset
    If rsGetFilmPath.STATE = adStateOpen Then
        rsGetFilmPath.Close
    End If
    
    strSql = "SELECT PHOTO_PATH FROM CHECK_PART WHERE CHECK_LIST_ID='" + p_strCheckListID + "'"
    rsGetFilmPath.Open strSql, p_DBConn
    
    nCheckPartCount = rsGetFilmPath.RecordCount
    Dim i As Long
    For i = 0 To nCheckPartCount - 1
        Load dcmList(i)
        InitDcm (dcmList(i))
        
        'dcmList(i).left = picBottom.Width / 5
        dcmList(i).FreeMemory
        dcmList(i).Visible = False
    Next
    
        
        
    If rsGetFilmPath.RecordCount > 0 Then
        rsGetFilmPath.MoveFirst
        For i = 0 To nCheckPartCount - 1
            If Not IsNull(rsGetFilmPath.Fields("PHOTO_PATH")) Then
                dcmList(i).OPENFILENAME = rsGetFilmPath("PHOTO_PATH")
            End If
            rsGetFilmPath.MoveNext
        Next
    Else
        
    End If
    
    InitFilmList = True
    Exit Function
ErrHandler:
    InitFilmList = False
    p_strErr = Err.Description
End Function




'说明：初始化患者部位路径信息
'p_strCheckListID <IN>: CHECKLIST 的ID
'p_strPartPaths    <OUT>: 图像路径数组
'p_nPartPathCount <IN>: 图像路径数组个数
'p_DBConn <IN>: 数据库连接
'p_strError <OUT>: 执行过程中遇到的错误
'Return Value: True if Success, False if Failure
Public Function InitPartsInfo(ByVal p_strCheckListID As String, _
    ByRef p_strPartPaths() As String, ByRef p_nPartPathCount As Long, _
    ByVal p_DBConn As ADODB.Connection, _
    ByRef p_strError As String) As Boolean
On Error GoTo ErrHandler
    If p_strCheckListID = "" Then
        p_strError = ""
        InitPartsInfo = False
        Exit Function
    End If
    
    If p_DBConn Is Nothing Then
        If InitDBConnect(p_DBConn, p_strError) Then
            p_strError = "数据库连接尚未初始化"
            InitPartsInfo = False
        End If
        Exit Function
    End If
    '==============================================================
    
    Dim strSql As String, i As Long
    
    strSql = "SELECT ID ,PHOTO_PATH FROM CHECK_PART  WHERE CHECK_LIST_ID = '" _
        + p_strCheckListID + "' AND IS_PHOTO_DELETED ='否'"
    
    Dim rsPhotoPath As New ADODB.Recordset
    If rsPhotoPath.STATE <> adStateClosed Then
        rsPhotoPath.Close
    End If
    
    If p_DBConn.CursorLocation <> adUseClient Then
        p_DBConn.CursorLocation = adUseClient
    End If
    
    If p_DBConn.STATE <> adStateOpen Then
        p_strError = "数据库连接尚未打开"
        InitPartsInfo = False
        Exit Function
    End If
    
    rsPhotoPath.Open strSql, p_DBConn
    
    Dim strDcmListFileName As String

    p_nPartPathCount = rsPhotoPath.RecordCount
    If p_nPartPathCount <= 0 Then
        p_strError = "患者图像路径数为0(零)"
        ReDim p_strPartPaths(0)
        InitPartsInfo = False
        Exit Function
    End If
    
    ReDim p_strPartPaths(0 To p_nPartPathCount - 1)
    
    For i = 0 To p_nPartPathCount - 1
        If Not IsNull(rsPhotoPath.Fields("PHOTO_PATH")) Then
             p_strPartPaths(i) = GetAbsolutePath(DCM_LOCAL_ROOT, rsPhotoPath.Fields("PHOTO_PATH"))
        End If
        rsPhotoPath.MoveNext
    Next
    
    rsPhotoPath.Close
    Set rsPhotoPath = Nothing
    
    InitPartsInfo = True
    Exit Function
ErrHandler:
    p_strError = "患者图像路径获取失败"
    InitPartsInfo = False
End Function




'说明：初始化数据库连接，
'作者：冷家锋
'时间：2008-11-12 09：35
'p_DBConn   <OUT>:  待初始化的数据库连接
'p_strErr       <OUT>：函数执行过程中的错误信息
Public Function InitDBConnect(ByRef p_DBConn As ADODB.Connection, ByRef p_strErr As String) As Boolean
    On Error GoTo ErrHandler
    If p_DBConn.STATE <> adStateOpen Then
        p_DBConn.Open modGlobalDbConnect.GetConnectionString
    End If
    
    If p_DBConn.STATE <> adStateOpen Then
        p_strErr = "数据库连接失败"
        InitDBConnect = False
        Exit Function
    End If
    
    InitDBConnect = True
    Exit Function
ErrHandler:
    p_strErr = Err.Description
    InitDBConnect = False
End Function






'说明：方法----根据患者拍片路径，初始化DCM控件列表
'p_strPaths <IN>： 图像路径数组
'p_nPathCount <IN>: 图像张数
'p_dcmList <OUT>: DCM控件数组
'p_strError <OUT>: 方法执行过程中的错误信息
'Return Value: True if Success, False if Failure
Private Function InitPatientDcmList(ByRef p_strPaths() As String, _
    ByVal p_nPathCount As Long, _
    ByRef p_strError As String) _
    As Boolean
On Error GoTo ErrHandler
    dcmList(0).FreeMemory
    Dim i As Long
    For i = 1 To dcmList.Count - 1
        dcmList(i).FreeMemory
        Unload dcmList(i)
    Next
    
    If p_nPathCount <= 0 Then
        p_strError = "图像路径数目为0"
        InitPatientDcmList = False
        Exit Function
    End If
    
    If IsNull(p_strPaths) Then
        p_strError = "图像路径数目为0"
        InitPatientDcmList = False
        Exit Function
    End If
    
    If LBound(p_strPaths) < 0 Or UBound(p_strPaths) < 0 Then
        p_strError = "图像路径数目为0"
        InitPatientDcmList = False
        Exit Function
    End If
    
    '判断患者胶片数，如果多于12张，则按CT图片处理只显示一张
    If p_nPathCount > 0 And p_nPathCount <= 12 Then
        For i = 1 To p_nPathCount - 1
            dcmList(0).left = 0
            dcmList(0).Top = 0
            'dcmList(0).Width = picBottom.Width / 6
            'dcmList(0).Height = picBottom.Height / ((p_nPathCount - 1) \ 6 + 1)
            
            '动态加载DICOM控件
            Load dcmList(i)
            If i Mod 6 = 0 Then
                dcmList(i).left = dcmList(0).left
                dcmList(i).Top = dcmList(0).Top + dcmList(0).Height * i / 6
            Else
                dcmList(i).left = dcmList(i Mod 6 - 1).left + dcmList(i Mod 6 - 1).Width
                dcmList(i).Top = dcmList(i - 1).Top
            End If
                dcmList(i).Width = dcmList(0).Width
                dcmList(i).Height = dcmList(0).Height
            Call InitDcm(dcmList(i))
            dcmList(i).FreeMemory
            dcmList(i).Visible = False
        Next
    Else
        p_nPathCount = 1
    End If
    
    If p_nPathCount = 1 Then
        dcmList(0).left = 0
        dcmList(0).Top = 0
        'dcmList(0).Width = picBottom.Width / 6
        'dcmList(0).Height = picBottom.Height
    End If
    
    '========================================================================
    
    'For i = LBound(p_strPaths) To UBound(p_strPaths)
    For i = 0 To p_nPathCount - 1
        '如果文件名为空或者路径不正确（可能胶片已保存入光盘），则打开默认的图片
        If p_strPaths(i) = "" Or Dir(p_strPaths(i), vbArchive Or vbHidden Or vbReadOnly Or vbSystem Or vbNormal) = "" Then
            If Dir(DEFAULT_IMAGE, vbArchive Or vbHidden Or vbReadOnly Or vbSystem Or vbNormal) <> "" Then
                dcmList(i).OpenFile DEFAULT_IMAGE
                dcmList(i).ImageTool = 14
                dcmList(i).Visible = True
                dcmList(i).ImageZoomBestFit = True
            End If
        Else
            dcmList(i).OpenFile (p_strPaths(i))
            dcmList(i).ImageTool = 14
            dcmList(i).Visible = True
            dcmList(i).ImageZoomBestFit = True
        End If
    Next


    InitPatientDcmList = True
    Exit Function
ErrHandler:
    p_strError = Err.Description
End Function


'窗体初始化接口
Public Function I_Init(ByVal p_strPatientID As String) As Boolean
    Dim strErr As String, bRet As Boolean
    If Trim(p_strPatientID) = "" Then
        MsgBox "患者ID为空", vbExclamation, "初始化"
    End If
    
    
    
    '初始化DCM控件
    If False = InitDcm(dcmList(0)) Then
        MsgBox "DCM控件加载失败, 重新安装可能解决问题.", vbExclamation, "初始化"
        Exit Function
    End If
        
    '初始化检查类型/影像科室
    If False = InitCheckItems(strErr) Then
        MsgBox "检查类型初始化失败：" + strErr, vbExclamation, "初始化"
    End If
    
    '初始化该患者的影像检查列表
    Call InitCheckListByPatientID(p_strPatientID)
    
    
    If False = InitPatientInfo(p_strPatientID, m_ptInfo, strErr) Then
        MsgBox "患者信息初始化失败:" + strErr, vbExclamation, "患者基本信息初始化"
    Else
        Call InitPatientInfoDisplay(m_ptInfo)
    End If
End Function

Private Function InitCheckListByPatientID(ByVal p_strPatientID) As Boolean
    Dim strSql As String
    
    'ID,PATIENT_ID,REG_DATE,CHECK_DATE,ALL_CHECK_PART,
    'FILM_DESCRIPTION,FILM_IMPRESSION
    strSql = "SELECT ID ,PATIENT_ID AS 患者编号,REG_DATE AS 申请日期 , CHECK_DATE AS 检查日期, " _
        + " ALL_CHECK_PART AS 检查部位, FILM_DESCRIPTION , FILM_IMPRESSION " _
        + " FROM CHECK_LIST WHERE PATIENT_ID='" + p_strPatientID + "'"
    

    
    
    Call Activate(strSql)
End Function

'初始化患者基本信息
Private Function InitPatientInfo(ByVal p_strPatientID As String, ByRef ptInfo As ClsPatientInfo, ByRef p_strErr As String) As Boolean
    On Error GoTo ErrHandler
    If Trim(p_strPatientID) = "" Then
        p_strErr = "患者ID为空"
        InitPatientInfo = False
        Exit Function
    End If
    Dim strSql As String, rsPatient As New ADODB.Recordset, myConn As New ADODB.Connection
    '编号，姓名，性别，年龄，出生日期
    strSql = "SELECT PATIENT_NAME,PATIENT_SEX,PATIENT_AGE,AGE_WEIGHT    , PATIENT_BIRTHDAY " _
        + " FROM CHECK_LIST WHERE PATIENT_ID='" + p_strPatientID + "' AND ROWNUM<=1"
    If rsPatient.STATE <> adStateClosed Then
        rsPatient.Close
    End If
    
    myConn.CursorLocation = adUseClient
    If myConn.STATE <> adStateOpen Then
        myConn.Open modGlobalDbConnect.GetConnectionString
    End If
    rsPatient.Open strSql, myConn
    If rsPatient.RecordCount <= 0 Then
        p_strErr = "患者ID对应的患者不存在"
        InitPatientInfo = False
        Exit Function
    End If
    
    ptInfo.PATIENT_ID = p_strPatientID
    
    If Not IsNull(rsPatient.Fields("PATIENT_NAME")) Then
        ptInfo.PATIENT_NAME = rsPatient.Fields("PATIENT_NAME")
    End If
    
    If Not IsNull(rsPatient.Fields("PATIENT_SEX")) Then
        ptInfo.PATIENT_SEX = rsPatient.Fields("PATIENT_SEX")
    End If
    
    '年龄
    If Not IsNull(rsPatient.Fields("PATIENT_AGE")) Then
        ptInfo.PATIENT_AGE = rsPatient.Fields("PATIENT_AGE")
    End If
    '年龄单位
    If Not IsNull(rsPatient.Fields("AGE_WEIGHT")) Then
        ptInfo.AGE_WEIGHT = rsPatient.Fields("AGE_WEIGHT")
    End If
    
    '出生日期
    If Not IsNull(rsPatient.Fields("PATIENT_BIRTHDAY")) Then
        ptInfo.PATIENT_BIRTHDAY = rsPatient.Fields("PATIENT_BIRTHDAY")
    End If
    
    
    rsPatient.Close
    Set rsPatient = Nothing
    myConn.Close
    Set myConn = Nothing
    
    
    InitPatientInfo = True
    Exit Function
ErrHandler:
    p_strErr = Err.Description
    InitPatientInfo = False
End Function

'初始化显示的患者信息，各LABEL
Private Function InitPatientInfoDisplay(ByVal p_ptInfo As ClsPatientInfo) As Boolean
    lblPatientID.Caption = m_ptInfo.PATIENT_ID
    lblPatientName.Caption = m_ptInfo.PATIENT_NAME
    lblPatientSex.Caption = m_ptInfo.PATIENT_SEX
    lblPatientAge.Caption = m_ptInfo.PATIENT_AGE
    lblPatientBirthday.Caption = m_ptInfo.PATIENT_BIRTHDAY
    
End Function




Private Function ThisResize()
	On Error GoTo ErrHandler
    frmCheckList.Width = picMdi.Width - 2 * frmCheckList.left
    'picView.Width = Me.Width
    Exit Function
  ErrHandler:
    
End Function