📄 frmauditing.frm
字号:
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 0
TabIndex = 23
Top = 240
Width = 1095
End
Begin VB.Label lblPatientName
Alignment = 2 'Center
BackColor = &H00E0E0E0&
BackStyle = 0 'Transparent
Caption = "患者姓名"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 0
TabIndex = 22
Top = 600
Width = 1095
End
Begin VB.Label lblPatientSex
Alignment = 2 'Center
BackColor = &H00E0E0E0&
BackStyle = 0 'Transparent
Caption = "患者性别"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 0
TabIndex = 21
Top = 960
Width = 975
End
End
Begin VB.Frame frmResult
BackColor = &H00354B34&
Height = 4455
Left = 0
TabIndex = 2
Top = 3960
Width = 12380
Begin VB.TextBox txtDescription
BackColor = &H00FFFFFF&
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 1695
Left = 1440
MultiLine = -1 'True
TabIndex = 5
Top = 720
Width = 10815
End
Begin VB.TextBox txtImpression
BackColor = &H00FFFFFF&
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 1695
Left = 1440
MultiLine = -1 'True
TabIndex = 4
Top = 2520
Width = 10815
End
Begin GetData.XPB btnNoPass
Height = 420
Left = 8400
TabIndex = 3
Top = 240
Width = 1260
_ExtentX = 2223
_ExtentY = 741
Caption = "未通过审核"
FontColor = -2147483630
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin GetData.XPB btnPass
Height = 375
Left = 10440
TabIndex = 24
Top = 240
Width = 1215
_ExtentX = 2143
_ExtentY = 661
Caption = "审核通过"
FontColor = -2147483630
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Label lblDiagnoseDoctor
BackColor = &H00E0E0E0&
BackStyle = 0 'Transparent
Caption = "诊 断 者:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 240
TabIndex = 11
Top = 300
Width = 1215
End
Begin VB.Label lblDiagnoseDate
Alignment = 2 'Center
BackColor = &H00E0E0E0&
BackStyle = 0 'Transparent
Caption = "时间:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 3240
TabIndex = 10
Top = 300
Width = 615
End
Begin VB.Label lblDescription
BackColor = &H00E0E0E0&
BackStyle = 0 'Transparent
Caption = "影象所见"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 240
TabIndex = 9
Top = 720
Width = 975
End
Begin VB.Label lblImpression
Alignment = 2 'Center
BackColor = &H00E0E0E0&
BackStyle = 0 'Transparent
Caption = "诊断结果"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 240
TabIndex = 8
Top = 2520
Width = 975
End
Begin VB.Label lblDDoctor
BackColor = &H00E0E0E0&
BackStyle = 0 'Transparent
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 375
Left = 1440
TabIndex = 7
Top = 240
Width = 1455
End
Begin VB.Label lblDate
BackColor = &H00E0E0E0&
BackStyle = 0 'Transparent
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 375
Left = 3960
TabIndex = 6
Top = 240
Width = 3855
End
End
Begin VB.Frame frmMiddle
BackColor = &H0093A78D&
Height = 2535
Left = 0
TabIndex = 0
Top = 1440
Width = 12380
Begin MSHierarchicalFlexGridLib.MSHFlexGrid dgReportList
Height = 2175
Left = 120
TabIndex = 1
Top = 240
Visible = 0 'False
Width = 12135
_ExtentX = 21405
_ExtentY = 3836
_Version = 393216
BackColor = 14737632
FocusRect = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty FontFixed {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_NumberOfBands = 1
_Band(0).Cols = 2
End
End
End
Attribute VB_Name = "frmReportAuditing"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'------------------------------------------------------------------------------------
'文件：frmReportList.frm
'作者：刘辉
'时间：2008-3-31
'说明：登记--报告列表
'------------------------------------------------------------------------------------
Option Explicit
Dim WithEvents myDgReportList As MSHFlexGrid
Attribute myDgReportList.VB_VarHelpID = -1
Dim rsRegister As New ADODB.Recordset
Dim myConn As New ADODB.Connection
Dim rsRegisterInit As New ADODB.Recordset
Dim REPORT_LIST_SQL As String
'1 CHECKREPORTID,2 编号,3 姓名,4 性别, 5 年龄 ,
'6 拍片部位, 7 影像描述, 8 诊断结果 ,9 检查医生,
'10 检查日期 ,11 审核医生,12 审核日期,13 审核, 14 通过
Const REPORT_LIST_INIT_FIELDS = " SELECT CHECKREPORTID,编号,姓名,性别, to_char(年龄) || 年龄单位" _
+ " as 年龄 , 拍片部位, 影像描述, 诊断结果 ,CHECK_DOCT_ID as 检查医生, " _
+ " TO_CHAR(检查日期,'YYYY-MM-DD HH24:MI:SS') as 检查日期 , AUDIT_DOCTOR_ID as 审核医生," _
+ " TO_CHAR(审核日期,'YYYY-MM-DD HH24:MI:SS') AS 审核日期 , IS_AUDITED AS 审核," _
+ " IS_AUDIT_PASSED AS 通过"
'修改按钮单击 ----事件
Private Sub btnNoPass_Click(Shift As Integer)
On Error GoTo ErrHandler
'If dgReportList.Row <= 0 Then
If myDgReportList.Row <= 0 Then
Exit Sub
End If
'If USER_POWER <> POWER_DEPARTMENT_LEADER Then
' MsgBox "您没有修改的权限！", vbExclamation, "提示"
' Exit Sub
'End If
'CHECKREPORTID,编号,姓名,性别, 年龄 ,
'拍片部位, 影像描述, 诊断结果 ,检查医生, 检查日期
'frmReportEdit.CURRENT_REPORT_CHECKNUMBER = dgReportList.TextMatrix(dgReportList.Row, 2)
'CURRENT_REPORT_ID = dgReportList.TextMatrix(dgReportList.Row, 1)
'frmReportEdit.CURRENT_REPORT_CHECKNUMBER = myDgReportList.TextMatrix(myDgReportList.Row, 2)
If Not IsNull(myDgReportList.TextMatrix(myDgReportList.Row, 1)) Or Not IsNull(myDgReportList.TextMatrix(myDgReportList.Row, 2)) Then
'frmRecordEdit.CURRENT_REPORT_CHECKNUMBER = myDgReportList.TextMatrix(myDgReportList.Row, 2)
'CURRENT_REPORT_ID = myDgReportList.TextMatrix(myDgReportList.Row, 1)
'MODIFY_REPORT = True
Dim strSql As String
'strSql = "SELECT ID ,TO_CHAR(CHECK_DATE,'YYYY-MM-DD HH24:MI:SS') AS CHECK_DATE FROM CHECK_LIST WHERE PATIENT_ID ='" + CStr(myDgReportList.TextMatrix(myDgReportList.Row, 2)) + "'" _
'+ " AND CHECK_DATE = '" + myDgReportList.TextMatrix(myDgReportList.Row, 10) + "'"
strSql = "update CHECK_REPORT SET "
'strSql = strSql + " PHOTO_DESCRIPTION = '" + Trim(txtCheckPhotoDescription.Text)
'strSql = strSql + "', IMPRESSION = '" + Trim(txtCheckDiagnoseResult.Text)
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
'Dim myConn As New ADODB.Connection
'Dim rsCheckup As New ADODB.Recordset
'myConn.CursorLocation = adUseClient
'If myConn.State = adStateClosed Then
' myConn.Open modGlobalDbConnect.GetConnectionString
'End If
'If rsCheckup.State = 1 Then
' rsCheckup.Close
'End If
'rsCheckup.Open strSql, myConn
'If rsCheckup.RecordCount <= 0 Then
' frmRecordEdit.CURRENT_REPORT_CHECKNUMBER = ""
' CURRENT_REPORT_ID = ""
' MsgBox "报告错误！请与系统管理员联系", vbExclamation, "提示"
' MODIFY_REPORT = False
' Set myConn = Nothing
' Set rsGetID = Nothing
' Exit Sub
'Else
' If Not IsNull(rsGetID.Fields(0)) Then
' frmCheckList.CurList_ID = rsGetID.Fields(0)
' End If
'End If
'Set myConn = Nothing
'Set rsGetID = Nothing
'Unload Me
'Call frmRecordEdit.Activate
'frmRecordEdit.Show vbModal
End If
Call cmdSearche_Click
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -