frmmdimain.frm

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

        Exit Sub
    End If
    
    Dim nStart As Long
    Dim nEnd As Long
    Dim strRegStart As String
    Dim strRegEnd As String

    nStart = InStr(dtRegisterStart.Value, " ")     '第1个空格位置
    If nStart <= 0 Then
        MsgBox "日期错误，请与管理员联系!", vbExclamation, "提示"
        Exit Sub
    End If

    strRegStart = left(dtRegisterStart.Value, nStart - 1) + CStr(" 00:00:00")
    
    
    nEnd = InStr(dtRegisterEnd.Value, " ")      '第1个空格位置
    If nEnd <= 0 Then
        MsgBox "日期错误，请与管理员联系!", vbExclamation, "提示"
        Exit Sub
    End If

    strRegEnd = left(dtRegisterEnd.Value, nEnd - 1) + CStr(" 23:59:59")
    
    CHECK_LIST_SQL = CHECK_LIST_SQL + " and REG_DATE >= '" + strRegStart + "'"
    CHECK_LIST_SQL = CHECK_LIST_SQL + " and REG_DATE <= '" + strRegEnd + "'"
    
    If btnDiagnosed.Value = True Then
        CHECK_LIST_SQL = CHECK_LIST_SQL + " and IS_CHECKED = '是'"
    End If
    If btnNoDiagnosed.Value = True Then
        CHECK_LIST_SQL = CHECK_LIST_SQL + " and IS_CHECKED = '否'"
    End If
        
    If Len(Trim(txtCheckNumber.Text)) > 0 Then
        If stringCheck(Trim(txtCheckNumber.Text)) = False Then
            Exit Sub
        End If
        CHECK_LIST_SQL = CHECK_LIST_SQL + " and PATIENT_ID = '" + Trim(txtCheckNumber.Text) + "'"
    End If
    
    If Len(Trim(txtPatientName.Text)) > 0 Then
        If stringCheck(Trim(txtPatientName.Text)) = False Then
            Exit Sub
        End If
        CHECK_LIST_SQL = CHECK_LIST_SQL + " and PATIENT_NAME = '" + Trim(txtPatientName.Text) + "'"
    End If
    
    If Len(Trim(cmbPatientSex.Text)) > 0 Then
        CHECK_LIST_SQL = CHECK_LIST_SQL + " and PATIENT_SEX = '" + Trim(cmbPatientSex.Text) + "'"
    End If
    
    
    CHECK_LIST_SQL = CHECK_LIST_SQL + modCheckList.CHECK_LIST_ORDER
    
    If myDgCheckList.Rows <= 1 Then
        Controls.Remove ("mydgCreate")
        Set myDgCheckList = Controls.Add("MSHierarchicalFlexGridLib.MSHFlexGrid", "mydgCreate", picMdi)

        myDgCheckList.Visible = True
        myDgCheckList.SelectionMode = flexSelectionByRow
    End If
    
    Call Activate(CHECK_LIST_SQL)
    tmrCheckPart.Enabled = False
    
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
End Sub

Private Sub btnShowReport_Click()
On Error GoTo ErrHandler
    If myDgCheckList.Row < 1 Then
        MsgBox "请选择一名患者!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If Not IsNull(myDgCheckList.TextMatrix(myDgCheckList.Row, 1)) Then
        m_strCurList_ID = Trim(myDgCheckList.TextMatrix(myDgCheckList.Row, 1))
        
        Dim strSql As String
        strSql = "SELECT ID FROM CHECK_REPORT WHERE CHECK_LIST_ID = '" + Trim(m_strCurList_ID) + "'"
        If GetRecordNumber(strSql) > 0 Then
            modReportEdit.g_bModifyReport = True
        Else
            modReportEdit.g_bModifyReport = False
        End If
    Else
        Exit Sub
    End If
    
    '加载报告编辑================================
    Load frmReportEdit
    Dim strError As String, myConn As New ADODB.Connection
    myConn.CursorLocation = adUseClient
    If myConn.STATE <> adStateOpen Then
        myConn.Open modGlobalDbConnect.GetConnectionString
    End If
    
    If myConn.STATE = adStateOpen Then
        If False = frmReportEdit.InitReportEditDynamicInfo(m_strCurList_ID, myConn, strError) Then
            MsgBox strError, vbExclamation, "报告编辑信息初始化"
        End If
    End If
    frmReportEdit.Show
    'END OF 加载报告编辑================================
    
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
End Sub

Private Sub cmbCheckItemName_Click()
On Error GoTo ErrHandler
    If cmbCheckItemID.ListCount >= cmbCheckItemName.ListIndex Then
        cmbCheckItemID.ListIndex = cmbCheckItemName.ListIndex
    End If
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
End Sub

'双击事件---显示胶片编辑
Private Sub dcmList_OnDblClick(Index As Integer)
On Error GoTo ErrHandler
    Dim strErr As String
    Load frmPhoto
    Debug.Print dcmList(Index).OPENFILENAME
    If frmPhoto.InitPhoto(dcmList(Index).OPENFILENAME, strErr) = False Then
        MsgBox "胶片显示错误!" + strErr, vbExclamation, "提示"
        Exit Sub
    End If
    frmPhoto.Show
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
End Sub

'双击事件----动态MSHFlexGrid
Private Sub myDgCheckList_DblClick()
On Error GoTo ErrHandler
    If myDgCheckList.Row < 1 Then
        Exit Sub
    End If
    
    If Not IsNull(myDgCheckList.TextMatrix(myDgCheckList.Row, 1)) Then
        m_strCurList_ID = myDgCheckList.TextMatrix(myDgCheckList.Row, 1)
        
        'curCheckNumber = myDgCheckList.TextMatrix(myDgCheckList.Row, 2)
        'curPatientName = myDgCheckList.TextMatrix(myDgCheckList.Row, 4)
    Else
        Exit Sub
    End If
    
    myConn.CursorLocation = adUseClient
    If myConn.STATE = adStateClosed Then
        myConn.Open modGlobalDbConnect.GetConnectionString
    End If
    
    Dim strErr As String
    If False = InitPartsInfo(m_strCurList_ID, m_strCheckPartsPaths, m_nCheckPartsCount, myConn, strErr) Then
        strErr = strErr + "<患者部位信息初始化>"
        Exit Sub
    Else
        If False = InitPatientDcmList(m_strCheckPartsPaths, m_nCheckPartsCount, strErr) Then
            strErr = strErr + "<DCM图像列表初始化>"
            Exit Sub
'        Else
'            If False = InitDcmEdit(dcmList(0).OPENFILENAME, DEFAULT_IMAGE, dcmEdit(0), strErr) Then
'                p_strErr = strErr + "<DCM图像加载>"
'                InitFilmEditDynamicInfo = False
'                Exit Function
'            End If
        End If
    End If
    
    'Load frmPhoto
    'frmPhoto.Show vbModal
    'Call frmCheckResult.GetPatientFilmAndReport(CStr(m_strCurList_ID))
    
    
    Exit Sub
ErrHandler:
     MsgBox Err.Description + strErr, vbExclamation, "提示"
End Sub

'双击事件---记录列表
Private Sub dgResult_Click()
On Error GoTo ErrHandler
    If dgResult.Rows > 0 Then
        Exit Sub
    End If
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
End Sub

Private Sub MDIForm_Activate()
On Error GoTo ErrHandler
    Dim strSql As String
    If cmbCheckItemID.Text <> "" Then
        strSql = DEFAULT_CHECK_LIST + " AND PHOTO_DEPT_ID='" + Trim(cmbCheckItemID.Text) + "'"
    End If
    strSql = strSql + CHECK_LIST_ORDER
    Call Activate(strSql)
   
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
End Sub

Private Sub MDIForm_Load()
On Error GoTo ErrHandler
    picMdi.left = picTop.left
    picMdi.Width = picTop.Width
    
    Call InitDcm(dcmList(0))
    If dcmList(0).LicenseIsOK = False Then
        MsgBox "程序错误, 重新安装可能解决问题.", vbExclamation, "加载"
        Exit Sub
    End If
    
    Set myDgCheckList = Controls.Add("MSHierarchicalFlexGridLib.MSHFlexGrid", "mydgCreate", picMdi)
    myDgCheckList.Visible = True
    myDgCheckList.SelectionMode = flexSelectionByRow
    
    Dim strErr As String
    If InitCheckItems(strErr) = False Then
        MsgBox "检查项目初始化错误!" + strErr, vbExclamation, "提示"
    End If
    
    dtRegisterStart.Value = Now - 7
    dtRegisterEnd.Value = Now
    
    DEFAULT_IMAGE = App.Path & "\" & "NoImage.bmp"
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
    
End Sub



Private Function MachineConfig()
On Error GoTo ErrHandler
    Dim strConfigFilePath As String
    strConfigFilePath = App.Path + "\" + CONFIG_FILE_NAME
    Dim nRet As Long
    
    Dim strStationName As String
    strStationName = Space(256)
    
    nRet = GetPrivateProfileString("WORKSTATION", "STATION_NAME", "", _
        strStationName, 256, strConfigFilePath)

    If nRet > 0 Then
        strStationName = left(strStationName, nRet)
    End If

    Exit Function
ErrHandler:
    
    
End Function


'获取检查结果
Public Sub Activate(strSql As String)
    On Error GoTo ErrHandler
    Dim rsRegister As New ADODB.Recordset
    If rsRegister.STATE = 1 Then
        rsRegister.Close
    End If
    If myConn.STATE = adStateClosed Then
        myConn.Open modGlobalDbConnect.GetConnectionString
    End If
        
    If myConn.STATE = adStateClosed Then
        MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
        tmrCheckPart.Enabled = False
        Exit Sub
    End If
    
    rsRegister.Open strSql, myConn
    Set myDgCheckList.DataSource = rsRegister
    
    Call AdjustDgResult(myDgCheckList)
   
    Exit Sub
ErrHandler:
    MsgBox "检查结果获取失败, 原因:" + Err.Description, vbExclamation, "提示"

End Sub


'设置患者列表中列的宽度
Private Sub AdjustDgResult(dg As MSHFlexGrid)
On Error Resume Next
    Dim i As Integer
    Dim colcount As Integer
    Dim wid As Long
    
    dg.Font.Size = 11
    dg.FontFixed.Size = 11
    dg.left = dgResult.left
    dg.Top = dgResult.Top
    dg.Width = dgResult.Width
    dg.Height = dgResult.Height
    
    colcount = dg.Cols
    
    '1 ID,2 编号，3设备检查序号，4 姓名，5姓名拼音，6 性别，7 年龄，8 拍片部位，9 状态，
    '10 住院号，11 登记日期，12 检查医生，13 已写报告 ，14 已出打印,15 提请审核报告 ，16 已审核报告,17 审核医生 ，18检查日期。
    'wid = (dg.Width) / (colcount - 1)
    wid = 800
    For i = 1 To colcount - 1
        dg.ColWidth(i) = wid
    Next
    dg.ColWidth(0) = 200
    dg.ColWidth(1) = 0
    
    '编号
'    dg.ColWidth(2) = 2 * wid
    dg.ColWidth(2) = 0
    '设备检查序号
    dg.ColWidth(3) = 2 * wid + 400
    '姓名
    dg.ColWidth(4) = 2 * wid
    '姓名拼音
    'dg.ColWidth(5) = 5 / 3 * wid
    dg.ColWidth(5) = 0
    '性别
    'Me.dgResult.ColWidth(3) = 2 / 3 * wid
    dg.ColWidth(6) = 2 / 3 * wid + 400
    '年龄
    'Me.dgResult.ColWidth(4) = 2 / 3 * wid
    dg.ColWidth(7) = wid
    'Me.dgResult.ColWidth(5) = 2 / 3 * wid
    
    '拍片部位
    dg.ColWidth(8) = wid * 4
    '状态
    dg.ColWidth(9) = 2 / 3 * wid + 400
    
    '住院号
    dg.ColWidth(10) = 5 / 3 * wid
    
    dg.ColWidth(11) = 2400 '2 * wid
    
    dg.ColWidth(12) = 4 / 3 * wid
    dg.ColWidth(13) = 4 / 3 * wid
    
'    dg.ColWidth(14) = 4 / 3 * wid '打印
'    dg.ColWidth(15) = 4 / 3 * wid '提请审核
'    dg.ColWidth(16) = 4 / 3 * wid '审核通过