📄 frmreportlist.frm

📁 1、以DLL形式提供医生工作站 2、根据【检查项目】
💻 FRM
📖 第 1 页 / 共 5 页
字号:
上一页 1 2 3 45
    End If
        
    rsRegisterInit.Open strSql, myConn
    'Set dgReportList.DataSource = rsRegisterInit
    Set myDgReportList.DataSource = rsRegisterInit
    
    Call SetDgReportLayout(myDgReportList)
    
    
    InitReportList = True
    Exit Function
ErrHandler:
    InitReportList = False
    Debug.Print Err.Description
End Function

Private Sub SetDgReportLayout(dg)
'On Error GoTo ErrHandler
    
    
    '1 CHECKREPORTID,2 编号,3 姓名,4 姓名拼音，5 性别, 6 年龄, 7 设备检查序号，8 拍片部位,
    '9  影像描述, 10 诊断结果,11 检查医生, 12 检查日期, 13 CHECK_LIST_ID,14 已打印 ,15 提请审核,16 已审核
    
    Dim i As Long
    
    dg.left = dgReportList.left
    dg.Top = dgReportList.Top
    dg.Width = dgReportList.Width
    dg.Height = dgReportList.Height
    
    dg.Font.Size = 11
    'myDgReportList.Font.Bold = True
    dg.FontFixed.Size = 11
    'dg.FontFixed.Bold = True
    
    For i = 0 To dg.Cols - 1
        dg.ColWidth(i) = dg.Width / (dg.Cols - 2)
    Next
    '第1列
    dg.ColWidth(0) = 200
    'CHECKREPORTID
    dg.ColWidth(1) = 0
    '编号
    dg.ColWidth(2) = dg.ColWidth(3) * 5 / 3
    '姓名
    dg.ColWidth(3) = dg.ColWidth(3) * 5 / 3
    
    '姓名拼音
    'dg.ColWidth(4) = dg.ColWidth(4) * 2
    dg.ColWidth(4) = 0
    '性别
    dg.ColWidth(5) = dg.ColWidth(5) * 4 / 5
    
    '年龄
    dg.ColWidth(6) = dg.ColWidth(6) * 4 / 5
        
    '设备检查序号
    dg.ColWidth(7) = dg.ColWidth(7) * 2
    '拍片部位
    dg.ColWidth(8) = dg.ColWidth(8) + dg.ColWidth(9) ' _
        '+ dg.ColWidth(0) + dg.ColWidth(10)  + dg.ColWidth(13)
    
    '影像描述
    dg.ColWidth(9) = 0
    
    '诊断结果
    dg.ColWidth(10) = 0
    
    '检查医生
    dg.ColWidth(11) = dg.ColWidth(11) * (3 / 2)
    '检查日期
    dg.ColWidth(12) = 2400 ' dg.ColWidth(12) * (5 / 3)
    
    
    '1 CHECKREPORTID,2 编号,3 姓名,4 姓名拼音，5 性别, 6 年龄, 7 设备检查序号，8 拍片部位,
    '9  影像描述, 10 诊断结果,11 检查医生, 12 检查日期, 13 CHECK_LIST_ID,14 已印报告,15 提请审核,16 已审核
    
    'CHECK_LIST_ID
    dg.ColWidth(13) = 0
    
    
    '审核通过
    'dg.ColWidth(12) = dg.ColWidth(13)
        
    dg.ColWidth(14) = 1100
    dg.ColWidth(15) = 1100
    dg.ColWidth(16) = 1000
    dg.ColWidth(17) = 1000
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
End Sub

'初始化病人状态信息
Private Sub InitializeState()
On Error GoTo ErrHandler
    Dim rsState As New ADODB.Recordset
    Dim strSql As String
    strSql = "select State from State"
    
    If myConn.State <> adStateOpen Then
        myConn.CursorLocation = adUseClient
        myConn.Open modGlobalDbConnect.GetConnectionString
    End If
    
    If myConn.State = adStateClosed Then
        MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
        Exit Sub
    End If
    
    If rsState.State = adStateOpen Then
        rsState.Close
    End If
    rsState.Open strSql, myConn
    If rsState.RecordCount <= 0 Then
        MsgBox "请添加状态!", vbExclamation, "提示"
        rsState.Close
        Set rsState = Nothing
        Exit Sub
    End If
    
    cmbState.Clear
    Do While Not rsState.EOF And Not rsState.BOF
        cmbState.AddItem rsState.Fields("State")
        rsState.MoveNext
    Loop
    
    cmbState.ListIndex = -1
    rsState.Close
    Set rsState = Nothing
    
    Exit Sub
ErrHandler:
'    MsgBox "状态初始化失败!", vbExclamation, "提示"
    MsgBox Err.Description
    
End Sub


Private Sub txtCheckNumber_KeyPress(KeyAscii As Integer)
    ' 8表示Back Space
    If KeyAscii = 8 Then
        Exit Sub
    End If
    If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
        KeyAscii = 0
    End If
    
    
End Sub

Private Sub txtHospitalNumber_KeyPress(KeyAscii As Integer)
On Error GoTo ErrHandler
    If Asc("0") < KeyAscii < Asc("9") And Asc("A") < KeyAscii < Asc("Z") And Asc("a") < KeyAscii < Asc("z") Then
    Else
        KeyAscii = 0
    End If
    Exit Sub
ErrHandler:
    
End Sub

Private Sub txtPatientAge_KeyPress(KeyAscii As Integer)
' 8表示Back Space
    If KeyAscii = 8 Then
        Exit Sub
    End If
    If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
        KeyAscii = 0
    End If
    
    
End Sub

Private Function Audit() As Boolean
On Error GoTo ErrHandler
    If Len(Trim(Me.txtDescription.Text)) <= 0 Then
        MsgBox "还未添加影像描述!", vbExclamation, "提示"
        Audit = False
        Exit Function
    End If
    
    If Len(Trim(Me.txtImpression.Text)) <= 0 Then
        MsgBox "还未添加诊断结果!", vbExclamation, "提示"
        Audit = False
        Exit Function
    End If
    
    Dim strSql As String
    
    strSql = "SELECT ID FROM CHECK_REPORT WHERE ID = '" + CStr(myDgReportList.TextMatrix(myDgReportList.Row, 1)) + "'"
    If GetRecordNumber(strSql) = 0 Then
        MsgBox "该患者报告单还未生成！", vbExclamation, "提示"
        Audit = False
        Exit Function
    End If
    
    strSql = "SELECT ID FROM CHECK_REPORT WHERE ID = '" + CStr(myDgReportList.TextMatrix(myDgReportList.Row, 1)) + "'AND (IS_AUDITED IS  NOT NULL  AND IS_AUDITED = '是')"
    If GetRecordNumber(strSql) > 0 Then
        MsgBox "该患者报告单已经审核 ！", vbExclamation, "提示"
        Audit = False
        Exit Function
    End If


    Dim strNow As String
    strNow = CStr(Now)
    
    strSql = "update CHECK_REPORT SET "
    strSql = strSql + " AUDIT_DATE = '" + strNow
    strSql = strSql + "', AUDIT_DOCTOR_ID = '" & USER_DISPLAY_NAME & ""
    strSql = strSql + "', IS_AUDITED = '是' "
    strSql = strSql + ", IS_AUDIT_PASSED = '是' "
    strSql = strSql + " WHERE ID = '" + myDgReportList.TextMatrix(myDgReportList.Row, 1) + "'"

    
    '===事务处理开始====================================================
    Dim myConn As New ADODB.Connection
    myConn.CursorLocation = adUseClient
    myConn.Open modGlobalDbConnect.GetConnectionString
    
    If myConn.State = adStateClosed Then
        MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
        Exit Function
    End If
    
    myConn.BeginTrans '开始
    '执行语句
    myConn.Execute strSql
    If Err.Number = 0 Then
        myConn.CommitTrans '---提交事務
        'MsgBox "<报告单>保存成功.", vbExclamation, "提示"
    Else
        myConn.RollbackTransaction
        MsgBox "<报告单>审核失败!", vbExclamation, "提示"
        Audit = False
    End If
    '===事务处理结束====================================================
    
    Audit = True
    Exit Function
ErrHandler:
    
    MsgBox "审核失败, 原因:" + Err.Description, vbExclamation, "提示"
    Audit = False
End Function

Private Function UndoAudit() As Boolean
On Error GoTo ErrHandler
    If Len(Trim(Me.txtDescription.Text)) <= 0 Then
        MsgBox "还未添加影像描述!", vbExclamation, "提示"
        UndoAudit = False
        Exit Function
    End If
    
    If Len(Trim(Me.txtImpression.Text)) <= 0 Then
        MsgBox "还未添加诊断结果!", vbExclamation, "提示"
        UndoAudit = False
        Exit Function
    End If
    
    Dim strSql As String
    
    strSql = "SELECT ID FROM CHECK_REPORT WHERE ID = '" + CStr(myDgReportList.TextMatrix(myDgReportList.Row, 1)) + "'"
    If GetRecordNumber(strSql) = 0 Then
        MsgBox "该患者报告单还未生成！", vbExclamation, "提示"
        UndoAudit = False
        Exit Function
    End If
    
    strSql = "SELECT ID FROM CHECK_REPORT WHERE ID = '" + CStr(myDgReportList.TextMatrix(myDgReportList.Row, 1)) + "' AND (IS_AUDITED IS  NULL OR IS_AUDITED = '否')  "
    If GetRecordNumber(strSql) > 0 Then
        MsgBox "该患者报告单还未审核 ！", vbExclamation, "提示"
        UndoAudit = False
        Exit Function
    End If


    Dim strNow As String
    strNow = CStr(Now)
    
    strSql = "update CHECK_REPORT SET "
    strSql = strSql + " AUDIT_DATE = '" + strNow
    strSql = strSql + "', AUDIT_DOCTOR_ID = '" & USER_DISPLAY_NAME & ""
    strSql = strSql + "', IS_AUDITED = '否' "
    strSql = strSql + ", IS_AUDIT_PASSED = '否' "
    strSql = strSql + " WHERE ID = '" + myDgReportList.TextMatrix(myDgReportList.Row, 1) + "'"

    
    '===事务处理开始====================================================
    Dim myConn As New ADODB.Connection
    myConn.CursorLocation = adUseClient
    myConn.Open modGlobalDbConnect.GetConnectionString
    
    If myConn.State = adStateClosed Then
        MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
        Exit Function
    End If
    
    myConn.BeginTrans '开始
    '执行语句
    myConn.Execute strSql
    If Err.Number = 0 Then
        myConn.CommitTrans '---提交事務
        'MsgBox "<报告单>保存成功.", vbExclamation, "提示"
    Else
        myConn.RollbackTransaction
        MsgBox "<报告单>弃审失败!", vbExclamation, "提示"
        UndoAudit = False
    End If
    '===事务处理结束====================================================
    
    UndoAudit = True
    Exit Function
ErrHandler:
    
    MsgBox "弃审失败, 原因:" + Err.Description, vbExclamation, "提示"
    UndoAudit = False
End Function


Function InitFrmAudit() As Boolean

        On Error GoTo Err_Handl:

        Dim rsUser As New ADODB.Recordset
        Dim sqlExecute As String
        sqlExecute = "SELECT ID, Name,DOCTOR_NAME,UserPassword, UserPower,DepartmentId FROM Doctor WHERE  UserPower=" & POWER_DEPARTMENT_LEADER
            
        If myConn.State <> adStateClosed Then
            myConn.Close
        End If
        myConn.Open modGlobalDbConnect.GetConnectionString
        
        If myConn.State = adStateClosed Then
            InitFrmAudit = False
            MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
            Exit Function
        End If
        
        rsUser.Open sqlExecute, myConn
            
        If rsUser.RecordCount <= 0 Then
            InitFrmAudit = False
'            MsgBox "该用户名不存在, 请重新选择", vbExclamation, "用户登录"
            MsgBox "您没有审核的权限！", vbExclamation, "提示"
            rsUser.Close
            myConn.Close
            Set myConn = Nothing
            Exit Function
        End If
        
        cmbAuditor.Clear
        cmbAuditorId.Clear
        Do While Not rsUser.EOF And Not rsUser.BOF
            cmbAuditor.AddItem rsUser.Fields("Name")
            cmbAuditorId.AddItem rsUser.Fields("ID")
            rsUser.MoveNext
        Loop
        
        cmbAuditor.ListIndex = -1
        cmbAuditorId.ListIndex = -1
        rsUser.Close
        Set rsUser = Nothing
        InitFrmAudit = True
        Exit Function
        
Err_Handl:
            InitFrmAudit = False
End Function
上一页 1 2 3 45
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -