📄 frmreportlist.frm
字号:
EndProperty
ForeColor = &H00000000&
Height = 255
Left = 0
TabIndex = 19
Top = 960
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 = &H00000000&
Height = 255
Left = 0
TabIndex = 18
Top = 600
Width = 1095
End
Begin VB.Label lblPatientNum
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 = &H00000000&
Height = 255
Left = 0
TabIndex = 17
Top = 240
Width = 1095
End
End
Begin VB.Frame frmMiddle
BackColor = &H00F1E7DA&
Height = 3615
Left = 0
TabIndex = 33
Top = 1440
Width = 12380
Begin MSHierarchicalFlexGridLib.MSHFlexGrid dgReportList
Height = 3255
Left = 120
TabIndex = 35
Top = 240
Visible = 0 'False
Width = 12135
_ExtentX = 21405
_ExtentY = 5741
_Version = 393216
BackColor = 14737632
FocusRect = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 11.25
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 = "frmReportList"
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 CHECK_LIST_ID, 14 已打印 ,15 提请审核,16 已审核
Const REPORT_LIST_INIT_FIELDS = " SELECT CHECKREPORTID,编号,姓名,姓名拼音,性别, to_char(年龄) || " _
+ " 年龄单位 as 年龄 ,to_char(MACHINE_NAME) || FILM_NO AS 设备检查序号, 拍片部位," _
+ " 影像描述, 诊断结果 ,CHECK_DOCT_ID as 检查医生," _
+ " TO_CHAR(检查日期,'YYYY-MM-DD HH24:MI:SS') as 报告日期 ,CHECK_LIST_ID , 已印报告, " _
+ "IS_AUDITED as 提请审核,IS_AUDIT_PASSED as 已审核 , AUDIT_DOCTOR_ID as 审核医生" 'IS_AUDIT_PASSED AS 审核通过 ,
Private Sub btnAuditReport_Click(Shifit As Integer)
On Error GoTo Err_Handle:
If myDgReportList.Rows <= 1 Then
MsgBox "列表中没有报告，请筛选！", vbExclamation, "提示"
Exit Sub
End If
If Trim(lblDDoctor.Caption) = "" Then
MsgBox "请在列表中选择报告！", vbExclamation, "提示"
Exit Sub
End If
If USER_POWER <> POWER_DEPARTMENT_LEADER Then
' frmAudit.Left = Me.Left + Me.Width / 2 - frmAudit.Width / 2
' frmAudit.Top = Me.Top + Me.Height / 2 - frmAudit.Height / 2
' frmAudit.Left = Me.Left - frmAudit.Width / 2
' frmAudit.Top = Me.Top - frmAudit.Height / 2
frmAudit.left = Me.dgReportList.left + Me.dgReportList.Width - frmAudit.Width
frmAudit.Top = Me.dgReportList.Top + Me.dgReportList.Height
cmbAuditor.ListIndex = 0
cmbAuditorId.ListIndex = 0
txtAuditorPassword.Text = ""
chkDo.Value = 0
frmAudit.Visible = True
' MsgBox "您没有审核的权限！", vbExclamation, "提示"
Exit Sub
End If
If Audit Then
Call cmdSearche_Click
MsgBox "审核成功！", vbExclamation, "提示"
End If
Err_Handle:
End Sub
Private Sub btnExit_Click(Shifit As Integer)
On Error GoTo ErrHandler
frmAudit.Visible = False
Exit Sub
ErrHandler:
End Sub
'修改按钮单击 ----事件
Private Sub btnModifyReport_Click(Shift As Integer)
On Error GoTo Err_Handle:
'判断报告编辑窗体是否加载
Dim frm As Object
Dim blnFlag As Boolean
For Each frm In Forms
Debug.Print frm.Caption + " " + frm.Name
If frm.Caption = "报告编辑" And frm.Name = "frmReportEdit" Then
' Debug.Print frm.Caption + " " + frm.Name
blnFlag = True
Exit For
End If
Next frm
If blnFlag Then
Dim a As Integer
a = MsgBox("有未保存的报告，是否放弃？", vbOKCancel, "确认")
If a = vbOK Then
Unload frmReportEdit
Else
frmReportEdit.WindowState = 2
frmReportEdit.SetFocus
Exit Sub
End If
End If
If myDgReportList.Rows <= 1 Then
MsgBox "列表中没有报告，请筛选！", vbExclamation, "提示"
Exit Sub
End If
If Trim(lblDDoctor.Caption) = "" Then
MsgBox "请在列表中选择报告！", vbExclamation, "提示"
Exit Sub
End If
' If USER_POWER <> POWER_DEPARTMENT_LEADER Then
' MsgBox "您没有修改的权限！", vbExclamation, "提示"
' Exit Sub
' End If
'1 CHECKREPORTID,2 编号,3 姓名,4 姓名拼音，5 性别, 6 年龄, 7 设备检查序号，8 拍片部位,
'9 影像描述, 10 诊断结果,11 检查医生, 12 检查日期, 13 CHECK_LIST_ID
If Not IsNull(myDgReportList.TextMatrix(myDgReportList.Row, 1)) Or Not IsNull(myDgReportList.TextMatrix(myDgReportList.Row, 2)) Then
frmReportEdit.CURRENT_REPORT_ID = CStr(myDgReportList.TextMatrix(myDgReportList.Row, 1))
MODIFY_REPORT = True
'zlj 20080905
Dim strSql As String
strSql = "SELECT B.ID FROM CHECK_LIST A,CHECK_REPORT B " + _
"Where A.ID = b.CHECK_LIST_ID And A.CHECK_DATE = b.CHECK_DATE AND B.CHECK_LIST_ID='" + _
Trim(CStr(myDgReportList.TextMatrix(myDgReportList.Row, 13))) + "'"
If myConn.State <> adStateClosed Then
myConn.Close
End If
myConn.Open modGlobalDbConnect.GetConnectionString
If myConn.State = adStateClosed Then
MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
Exit Sub
End If
myConn.CursorLocation = adUseClient
Dim rsCheckReportId As New ADODB.Recordset
rsCheckReportId.Open strSql, myConn
If rsCheckReportId.RecordCount = 1 Then
If Trim(frmReportEdit.CURRENT_REPORT_ID) <> Trim(rsCheckReportId.Fields("ID")) Then
MsgBox "当前选择的是历史记录，不能修改，将转到该患者的最新报告！", vbExclamation, "提示"
frmReportEdit.CURRENT_REPORT_ID = Trim(rsCheckReportId.Fields("ID"))
End If
Else
MsgBox "当前记录异常，请联系管理员！", vbExclamation, "提示"
Exit Sub
End If
'zlj 20080905
REPORT_RETURN_FLAG = Trim(Me.Name)
Load frmReportEdit
Call frmReportEdit.Activate
frmReportEdit.Show
End If
Exit Sub
Err_Handle:
MsgBox Err.Description, vbExclamation, "提示"
End Sub
Private Sub btnUndoAuditReport_Click(Shifit As Integer)
On Error GoTo Err_Handle:
If myDgReportList.Rows <= 1 Then
MsgBox "列表中没有报告，请筛选！", vbExclamation, "提示"
Exit Sub
End If
If Trim(lblDDoctor.Caption) = "" Then
MsgBox "请在列表中选择报告！", vbExclamation, "提示"
Exit Sub
End If
If USER_POWER <> POWER_DEPARTMENT_LEADER Then
frmAudit.left = Me.dgReportList.left + Me.dgReportList.Width - frmAudit.Width
frmAudit.Top = Me.dgReportList.Top + Me.dgReportList.Height
cmbAuditor.ListIndex = 0
cmbAuditorId.ListIndex = 0
txtAuditorPassword.Text = ""
chkDo.Value = 1
frmAudit.Visible = True
' MsgBox "您没有弃审的权限！", vbExclamation, "提示"
Exit Sub
End If
If UndoAudit Then
Call cmdSearche_Click
MsgBox "弃审成功！", vbExclamation, "提示"
End If
Err_Handle:
End Sub
Private Sub cmbAuditor_Change()
On Error GoTo ErrHandler
If cmbAuditorId.ListCount > cmbAuditor.ListIndex Then
cmbAuditorId.ListIndex = cmbAuditor.ListIndex
End If
txtAuditorPassword.SetFocus
Exit Sub
ErrHandler:
'msgbox "",vbExclamation,"提示"
End Sub
Private Sub cmbAuditor_Click()
On Error GoTo ErrHandler
If cmbAuditorId.ListCount > cmbAuditor.ListIndex Then
cmbAuditorId.ListIndex = cmbAuditor.ListIndex
End If
txtAuditorPassword.SetFocus
Exit Sub
ErrHandler:
'msgbox "",vbExclamation,"提示"
End Sub
Private Sub cmdbtnConfirm_Click(Shifit As Integer)
On Error GoTo Err_Handle:
' Dim strInputPassword As String
' strInputPassword = InputBoxPW("请输入有审核权限的", "输入密码")
' strInputPassword = Trim(strInputPassword)
Dim rsUser As New ADODB.Recordset
Dim sqlExecute As String
sqlExecute = "SELECT ID, Name,DOCTOR_NAME,UserPassword, UserPower,DepartmentId FROM Doctor WHERE UserPassword = '" _
& Trim(txtAuditorPassword.Text) & "' AND UserPower=" & POWER_DEPARTMENT_LEADER & " AND ID='" & Trim(cmbAuditorId.Text) & "'"
If myConn.State <> adStateClosed Then
myConn.Close
End If
myConn.Open modGlobalDbConnect.GetConnectionString
If myConn.State = adStateClosed Then
MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
Exit Sub
End If
rsUser.Open sqlExecute, myConn
If rsUser.RecordCount <= 0 Then
' MsgBox "该用户名不存在, 请重新选择", vbExclamation, "用户登录"
MsgBox "输入的密码不正确！", vbExclamation, "提示"
rsUser.Close
myConn.Close
Set myConn = Nothing
Exit Sub
End If
If chkDo.Value = 0 Then
If Audit Then
frmAudit.Visible = False
Call cmdSearche_Click
MsgBox "审核成功！", vbExclamation, "提示"
End If
End If
If chkDo.Value = 1 Then
If UndoAudit Then
frmAudit.Visible = False
Call cmdSearche_Click
MsgBox "弃审成功！", vbExclamation, "提示"
End If
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -