frmreportlist.frm

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

        
Err_Handle:
End Sub

Private Sub cmdClear_Click()
On Error GoTo ErrHandler

    txtCheckNumber.Text = ""
    txtPatientName.Text = ""
    txtHospitalNumber.Text = ""
    txtPatientAge.Text = ""
    cmbAge.ListIndex = -1
    cmbState.ListIndex = -1
    cmbCheckPartName.ListIndex = -1
    cmbPatientSex.ListIndex = -1
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
    
'诊断结果未定
End Sub

Private Sub CmdExit_Click()
On Error GoTo ErrHandler
    Unload Me
    Exit Sub
ErrHandler:
    
End Sub

'检索按钮 事件
Private Sub cmdSearche_Click()
On Error GoTo ErrHandler
    Dim strSql As String

    strSql = REPORT_LIST_INIT_FIELDS _
        + " FROM VIEW_CHECK_REPORT  WHERE MACHINE_NAME = '" _
    + STATION_NAME + "'" + " AND PHOTO_DEPT_ID ='" + CStr(DEPARTMENT_ID) + "'"


    If stringCheck(Trim(txtCheckNumber.Text)) = False Then
        Exit Sub
    End If
    
    If Len(Trim(txtCheckNumber.Text)) > 0 Then
       strSql = strSql + " and 编号= '" + Trim(txtCheckNumber.Text) + "'"
    End If
    
    If stringCheck(Trim(txtPatientName.Text)) = False Then
        Exit Sub
    End If
    
    
    If txtPatientName.Visible And Len(Trim(txtPatientName.Text)) > 0 Then
        strSql = strSql + " and 姓名= '" + Trim(txtPatientName.Text) + "'"
    End If
    
    If Len(Trim(cmbPatientSex.Text)) > 0 Then
       strSql = strSql + " and 性别='" + Trim(cmbPatientSex.Text) + "'"
    End If
    
    If stringCheck(Trim(txtPatientAge.Text)) = False Then
        Exit Sub
    End If
    
    If Len(Trim(txtPatientAge.Text)) > 0 Then
       strSql = strSql + "and 年龄= '" + Trim(txtPatientAge.Text) + "'"
    End If
    
    If Len(Trim(cmbAge.Text)) > 0 Then
       strSql = strSql + "and 年龄单位 = '" + Trim(cmbAge.Text) + "'"
    End If
    
     If Len(Trim(cmbState.Text)) > 0 Then
       strSql = strSql + " and 状态= '" + Trim(cmbState.Text) + "'"
    End If
    
    If stringCheck(Trim(txtHospitalNumber.Text)) = False Then
        Exit Sub
    End If
    
    If Len(Trim(txtHospitalNumber.Text)) > 0 Then
       strSql = strSql + " and 住院号= '" + Trim(txtHospitalNumber.Text) + "'"
    End If
    
    '诊断结果未定
    
    'If Len(Trim(cmbCheckPartName.Text)) > 0 Then
    '    strSql = strSql + "and 拍片部位 ='" + Trim(cmbCheckPartName.Text) + "'"
    'End If
    
    Dim nStart As Long
    Dim nEnd As Long
    Dim strStartDate As String
    Dim strEndDate As String
    
    If chkStartDate.Value = 1 Then
        nStart = InStr(dtStartDate.Value, " ")
        If nStart <= 0 Then
            MsgBox "日期错误，请与管理员联系!", vbExclamation, "提示"
        End If
    
        strStartDate = left(dtStartDate.Value, nStart - 1) + CStr(" 00:00:00")
        strSql = strSql + " and 检查日期 >= '" + strStartDate + "'"
    End If
    
    If chkEndDate.Value = 1 Then
        nEnd = InStr(dtEndDate.Value, " ")
        If nEnd <= 0 Then
            MsgBox "日期错误，请与管理员联系!", vbExclamation, "提示"
        End If
    
        strEndDate = left(dtEndDate.Value, nEnd - 1) + CStr(" 23:59:59")
        strSql = strSql + " and 检查日期<= '" + strEndDate + "'"
    End If
    
    strSql = strSql + modCheckReport.CHECK_REPORT_ORDER
    REPORT_LIST_SQL = strSql
    
    'If dgReportList.Rows <= 1 Then
    'Unload Me
        'frmReportList.SetFocus
    If myDgReportList.Rows <= 1 Then
        Controls.Remove ("mydgCreate")
        Set myDgReportList = Controls.Add("MSHierarchicalFlexGridLib.MSHFlexGrid", "mydgCreate", frmMiddle)

        myDgReportList.Visible = True
        myDgReportList.SelectionMode = flexSelectionByRow
    End If
    
    If rsRegister.State = 1 Then
        rsRegister.Close
        Set rsRegister = Nothing
        Set myDgReportList.DataSource = Nothing
    End If
    
    rsRegister.Open strSql, myConn
    'Set dgReportList.DataSource = rsRegister
    Set myDgReportList.DataSource = rsRegister
    
    '1 CHECKREPORTID,2 编号,3 姓名,4 姓名拼音，5 性别, 6 年龄, 7 设备检查序号，8 拍片部位,
    '9  影像描述, 10 诊断结果,11 检查医生, 12 检查日期, 13 CHECK_LIST_ID,14 已打印 ,15 提请审核,16 已审核
    
    
    Call SetDgReportLayout(myDgReportList)
    
    myDgReportList.Row = 0
    
    '清除诊断信息
    lblDDoctor.Caption = ""
    lblDate.Caption = ""
    txtDescription.Text = ""
    txtImpression.Text = ""
    
    
    Exit Sub
ErrHandler:
       MsgBox Err.Description, vbExclamation, "提示"
       
End Sub

Private Sub frmCheck_DragDrop(Source As Control, x As Single, y As Single)

End Sub

'选择记录事件==========================
'动态MSHFlexGrid
Private Sub myDgReportList_Click()
On Error GoTo ErrHandler

   

    If myDgReportList.Row < 1 Then
        Exit Sub
    End If
    
    lblDDoctor.Caption = ""
    lblDate.Caption = ""
    txtDescription.Text = ""
    txtImpression.Text = ""
    
    '1 CHECKREPORTID,2 编号,3 姓名,4 姓名拼音，5 性别, 6 年龄, 7 设备检查序号，8 拍片部位,
    '9  影像描述, 10 诊断结果,11 检查医生, 12 检查日期, 13 CHECK_LIST_ID,14 已打印 ,15 提请审核,16 已审核
    
    '检查医生
    lblDDoctor.Caption = Trim(myDgReportList.TextMatrix(myDgReportList.Row, 11))
    
    '检查日期
    lblDate.Caption = Trim(myDgReportList.TextMatrix(myDgReportList.Row, 12))
    txtDescription.Text = Trim(myDgReportList.TextMatrix(myDgReportList.Row, 9))
    txtImpression.Text = Trim(myDgReportList.TextMatrix(myDgReportList.Row, 10))
    
    If Trim(myDgReportList.TextMatrix(myDgReportList.Row, 11)) = "是" Then
        btnModifyReport.Enabled = False
    Else
        btnModifyReport.Enabled = True
    End If
    Exit Sub
    
    
    
    
ErrHandler:
     MsgBox "选择报告列表失败, 原因:" + Err.Description, vbExclamation, "提示"
     'Err.Description
End Sub

'静态MSHFlexGrid
Private Sub dgReportList_Click()
On Error GoTo ErrHandler
    If dgReportList.Row < 1 Then
        Exit Sub
    End If
    
    lblDDoctor.Caption = ""
    lblDate.Caption = ""
    txtDescription.Text = ""
    txtImpression.Text = ""
    
    '1 CHECKREPORTID,2 编号,3 姓名,4 姓名拼音，5 性别, 6 年龄, 7 设备检查序号，8 拍片部位,
    '9  影像描述, 10 诊断结果,11 检查医生, 12 检查日期, 13 CHECK_LIST_ID
    
    '检查医生
    lblDDoctor.Caption = Trim(dgReportList.TextMatrix(dgReportList.Row, 11))
    
    '检查日期
    lblDate.Caption = Trim(dgReportList.TextMatrix(dgReportList.Row, 12))
    txtDescription.Text = Trim(dgReportList.TextMatrix(dgReportList.Row, 9))
    txtImpression.Text = Trim(dgReportList.TextMatrix(dgReportList.Row, 10))
    'If Trim(dgReportList.TextMatrix(dgReportList.Row, 11)) = "是" Then
    '    btnModifyReport.Enabled = False
    'Else
    '    btnModifyReport.Enabled = True
    'End If
    
    
    Exit Sub
    
ErrHandler:
     MsgBox Err.Description, vbExclamation, "提示"
End Sub
'选择记录事件==========================


Private Sub Form_Resize()
On Error GoTo ErrHandler
    Me.Top = frmSubTop.Top + frmSubTop.Height
    Me.left = frmSubLeft.Width + frmSubLeft.left
    Me.Width = RIGHT_WINDOW_WIDTH
    Me.Height = RIGHT_WINDOW_HEIGHT
    
    
    frmTop.Width = RIGHT_WINDOW_WIDTH
    
    frmMiddle.Width = RIGHT_WINDOW_WIDTH
    Me.dgReportList.Width = frmMiddle.Width - 2 * Me.dgReportList.left
    
    Me.frmResult.Width = RIGHT_WINDOW_WIDTH
    Me.frmResult.Height = Me.Height - Me.frmTop.Height - Me.frmMiddle.Height - 50
    
    Me.txtDescription.Width = Me.frmResult.Width - Me.txtDescription.left * 2
    Me.txtImpression.Width = Me.txtDescription.Width
    btnModifyReport.left = Me.txtDescription.left + Me.txtDescription.Width - btnModifyReport.Width
    btnAuditReport.left = Me.txtDescription.left + Me.txtDescription.Width - Me.btnModifyReport.Width - Me.btnUndoAuditReport.Width - Me.btnAuditReport.Width
    btnUndoAuditReport.left = Me.txtDescription.left + Me.txtDescription.Width - Me.btnModifyReport.Width - Me.btnUndoAuditReport.Width / 2
    
    myDgReportList.left = dgReportList.left
    myDgReportList.Top = dgReportList.Top
    myDgReportList.Width = dgReportList.Width
    myDgReportList.Height = dgReportList.Height + 2000
    
    
    
    Exit Sub
ErrHandler:
    
End Sub



Private Sub Form_Activate()
On Error GoTo ErrHandler
    
    Call InitializeState

    If REPORT_LIST_SQL = "" Then
        REPORT_LIST_SQL = REPORT_LIST_INIT_FIELDS _
            + " FROM VIEW_CHECK_REPORT WHERE MACHINE_NAME = '" _
    + STATION_NAME + "'" + " AND PHOTO_DEPT_ID ='" + CStr(DEPARTMENT_ID) + "'" _
    + " AND TO_CHAR(检查日期,'YYYY-MM-DD') = TO_CHAR(SYSDATE,'YYYY-MM-DD') " _
    + modCheckReport.CHECK_REPORT_ORDER
    
    End If
    
    
    If False = InitReportList Then
        MsgBox "检查报告单列表初始化失败, 请与系统管理员联系!", vbExclamation, "提示"
        Unload Me
        Exit Sub
        
    End If
    
    If False = InitFrmAudit Then
        MsgBox "审核列表初始化失败, 请与系统管理员联系!", vbExclamation, "提示"
        Unload Me
        Exit Sub
    End If
        
    
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
End Sub

Private Sub Form_Load()
On Error GoTo ErrHandler
    'Me.BackColor = mHLSRGB.COLORSET
    
    dtStartDate.Value = Now
    dtEndDate.Value = Now
    
    dgReportList.SelectionMode = flexSelectionByRow
    
    Set myDgReportList = Controls.Add("MSHierarchicalFlexGridLib.MSHFlexGrid", "mydgCreate", frmMiddle)

    myDgReportList.Visible = True
    myDgReportList.SelectionMode = flexSelectionByRow
    
    Dim rsRegisterInit As New ADODB.Recordset
    myConn.CursorLocation = adUseClient
    If myConn.State = 0 Then
        myConn.Open modGlobalDbConnect.GetConnectionString
    End If
    
    If myConn.State = adStateClosed Then
        MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
        Exit Sub
    End If
    




    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
    Unload Me
End Sub

'
Private Function InitReportList() As Boolean
On Error GoTo ErrHandler
    Dim strSql As String

    strSql = REPORT_LIST_SQL
    
    'REPORT_LIST_INIT_FIELDS _
     '   " FROM VIEW_CHECKREPORT "
     

    If myConn.State <> adStateOpen Then
        myConn.Open modGlobalDbConnect.GetConnectionString
    End If
    
    If myConn.State = adStateClosed Then
        MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
        Exit Function
    End If
    
    
    If rsRegisterInit.State = 1 Then
        rsRegisterInit.Close