📄 frmauditing.frm
字号:
Call myDgReportList_Click
'frmRecordEdit.SetFocus
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation, "提示"
End Sub
Private Sub btnPass_Click(Shifit As Integer)
On Error GoTo ErrHandler
If myDgReportList.Row <= 0 Then
Exit Sub
End If
'CHECKREPORTID,编号,姓名,性别, 年龄 ,
'拍片部位, 影像描述, 诊断结果 ,检查医生, 检查日期
If Not IsNull(myDgReportList.TextMatrix(myDgReportList.Row, 1)) Or Not IsNull(myDgReportList.TextMatrix(myDgReportList.Row, 2)) Then
Dim strSql As String
strSql = "update CHECK_REPORT SET "
strSql = strSql + " IS_AUDITED ='是' "
strSql = strSql + ", IS_AUDIT_PASSED ='是' "
strSql = strSql + ", AUDIT_DATE = '" + CStr(Now)
strSql = strSql + "', AUDIT_DOCTOR_ID = '" & USER_NAME & "'"
strSql = strSql + " WHERE ID = '" + myDgReportList.TextMatrix(myDgReportList.Row, 1) + "'"
If Not ExecuteInsert(strSql) Then
MsgBox "审核失败，请与管理员联系！", vbExclamation, "提示"
Else
MsgBox "审核成功。", vbExclamation, "提示"
End If
End If
Call cmdSearche_Click
Call myDgReportList_Click
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation, "提示"
End Sub
Private Sub cmdClear_Click()
On Error GoTo ErrHandler
txtCheckNumber.Text = ""
txtPatientName.Text = ""
cmbPatientSex.ListIndex = -1
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation, "提示"
'诊断结果未定
End Sub
Private Sub cmdExit_Click()
frmSubTopNew.lblAddressShow.Caption = preCaption
Unload Me
End Sub
'检索按钮 事件
Private Sub cmdSearche_Click()
On Error GoTo ErrHandler
Dim strSql As String
strSql = REPORT_LIST_INIT_FIELDS _
+ " FROM VIEW_CHECK_REPORT " _
+ " WHERE 1=1 " 'CHECKREPORTID = '" & CURRENT_REPORT_ID & "'"
If Len(Trim(txtCheckNumber.Text)) > 0 Then
strSql = strSql + " and 编号= '" + Trim(txtCheckNumber.Text) + "'"
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 obtAudited.Value = True Then
strSql = strSql + " and IS_AUDITED = '是'"
End If
If obtNoAudited.Value = True Then
strSql = strSql + " and IS_AUDITED = '否'"
End If
If obtPass.Value = True Then
strSql = strSql + " and IS_AUDIT_PASSED = '是'"
End If
If obtNoPass.Value = True Then
strSql = strSql + " and IS_AUDIT_PASSED = '否'"
End If
Dim nStart As Long
Dim nEnd As Long
Dim strStartDate As String
Dim strEndDate As String
If chkReportData.Value = 1 Then
nStart = InStr(dtStartDate.Value, " ")
strStartDate = dtStartDate.Value
If nStart > 0 Then
strStartDate = Left(dtStartDate.Value, nStart - 1) + CStr(" 00:00:00")
End If
strSql = strSql + " and 检查日期 >= '" + strStartDate + "'"
nEnd = InStr(dtEndDate.Value, " ")
strEndDate = dtEndDate.Value
If nEnd > 0 Then
strEndDate = Left(dtEndDate.Value, nEnd - 1) + CStr(" 23:59:59")
End If
strSql = strSql + " and 检查日期<= '" + strEndDate + "'"
End If
If chkAuditDate.Value = 1 Then
nStart = InStr(dtAuditStartDate.Value, " ")
strStartDate = dtAuditStartDate.Value
If nStart > 0 Then
strStartDate = Left(dtAuditStartDate.Value, nStart - 1) + CStr(" 00:00:00")
End If
strSql = strSql + " and 审核日期 >= '" + strStartDate + "'"
nEnd = InStr(dtAuditEndDate.Value, " ")
strEndDate = dtAuditEndDate.Value
If nEnd > 0 Then
strEndDate = Left(dtAuditEndDate.Value, nEnd - 1) + CStr(" 23:59:59")
End If
strSql = strSql + " and 审核日期<= '" + strEndDate + "'"
End If
strSql = strSql + " ORDER BY 检查日期 DESC "
'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
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 审核, 14 通过
Call SetDgReportLayout(myDgReportList)
'清除诊断信息
lblDDoctor.Caption = ""
lblDate.Caption = ""
txtDescription.Text = ""
txtImpression.Text = ""
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation, "提示"
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 审核, 14 通过
'检查医生
lblDDoctor.Caption = Trim(myDgReportList.TextMatrix(myDgReportList.Row, 9))
'检查日期
lblDate.Caption = Trim(myDgReportList.TextMatrix(myDgReportList.Row, 10))
txtDescription.Text = Trim(myDgReportList.TextMatrix(myDgReportList.Row, 7))
txtImpression.Text = Trim(myDgReportList.TextMatrix(myDgReportList.Row, 8))
If Trim(myDgReportList.TextMatrix(myDgReportList.Row, 14)) = "是" Then
btnNoPass.Enabled = False
btnPass.Enabled = False
Else
btnNoPass.Enabled = True
btnPass.Enabled = True
End If
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation, "提示"
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 审核, 14 通过
'检查医生
lblDDoctor.Caption = Trim(dgReportList.TextMatrix(dgReportList.Row, 9))
'检查日期
lblDate.Caption = Trim(dgReportList.TextMatrix(dgReportList.Row, 10))
txtDescription.Text = Trim(dgReportList.TextMatrix(dgReportList.Row, 7))
txtImpression.Text = Trim(dgReportList.TextMatrix(dgReportList.Row, 8))
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation, "提示"
End Sub
'选择记录事件==========================
Private Sub Form_Resize()
On Error GoTo ErrHandler
Me.Top = RIGHT_WINDOW_TOP
Me.Left = RIGHT_WINDOW_LEFT
Me.Width = RIGHT_WINDOW_WIDTH
Me.Height = RIGHT_WINDOW_HEIGHT
frmTop.Width = Me.Width - 50
frmMiddle.Width = frmTop.Width
Me.dgReportList.Width = frmMiddle.Width - 2 * Me.dgReportList.Left
frmResult.Width = frmTop.Width
Me.frmResult.Height = Me.Height - Me.frmTop.Height - Me.frmMiddle.Height
myDgReportList.Left = dgReportList.Left
myDgReportList.Top = dgReportList.Top
myDgReportList.Width = dgReportList.Width
myDgReportList.Height = dgReportList.Height
Exit Sub
ErrHandler:
End Sub
Private Sub Form_Activate()
On Error GoTo ErrHandler
preCaption = frmSubTopNew.lblAddressShow.Caption
frmSubTopNew.lblAddressShow.Caption = frmSubLeft.btnReportList.Caption
If REPORT_LIST_SQL = "" Then
REPORT_LIST_SQL = REPORT_LIST_INIT_FIELDS _
+ " FROM VIEW_CHECK_REPORT " _
+ " ORDER BY 检查日期 DESC "
End If
If False = InitReportList Then
MsgBox "检查报告单列表初始化失败, 请与系统管理员联系!", vbExclamation, "提示"
Unload Me
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
dtAuditStartDate.Value = Now
dtAuditEndDate.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
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 rsRegisterInit.State = 1 Then
rsRegisterInit.Close
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 审核, 14 通过
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 - 1)
Next
'拍片部位
dg.ColWidth(6) = dg.ColWidth(6) + dg.ColWidth(7) _
+ dg.ColWidth(0) - 600 + dg.ColWidth(8) + dg.ColWidth(1)
'第1列
dg.ColWidth(0) = 200
'编号
dg.ColWidth(2) = dg.ColWidth(2) * 6 / 5
'性别
dg.ColWidth(4) = dg.ColWidth(4) * 3 / 5
'年龄
dg.ColWidth(5) = dg.ColWidth(5) * 3 / 5
'检查日期
dg.ColWidth(10) = dg.ColWidth(4) * 6 / 5 + 600
'审查日期
dg.ColWidth(12) = dg.ColWidth(4) * 6 / 5 + 600
'审核
dg.ColWidth(13) = dg.ColWidth(13) * 3 / 5
'通过
dg.ColWidth(14) = dg.ColWidth(14) * 3 / 5
'CHECKREPORTID
dg.ColWidth(1) = 0
'影像描述
dg.ColWidth(7) = 0
'诊断结果
dg.ColWidth(8) = 0
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation, "提示"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -