📄 frmristools.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form frmRISTools
BorderStyle = 1 'Fixed Single
Caption = "体检软件－RIS 项目对应设置"
ClientHeight = 7545
ClientLeft = 45
ClientTop = 435
ClientWidth = 10260
Icon = "frmRISTools.frx":0000
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7545
ScaleWidth = 10260
StartUpPosition = 2 'CenterScreen
Begin MSComctlLib.ImageList ImageList1
Left = 4440
Top = 4500
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 3
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmRISTools.frx":0442
Key = "Close"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmRISTools.frx":0894
Key = "Open"
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmRISTools.frx":0CE6
Key = "Item"
EndProperty
EndProperty
End
Begin VB.Frame Frame2
Caption = "项目对应"
Height = 6105
Left = 120
TabIndex = 1
Top = 1260
Width = 10005
Begin MSComctlLib.TreeView tvwXiangMu
Height = 5685
Left = 120
TabIndex = 13
Top = 270
Width = 3255
_ExtentX = 5741
_ExtentY = 10028
_Version = 393217
HideSelection = 0 'False
LabelEdit = 1
Style = 7
ImageList = "ImageList1"
Appearance = 1
End
Begin VB.CommandButton cmdSave
Caption = "保存(&S)"
Height = 405
Left = 3660
TabIndex = 12
Top = 2580
Width = 1245
End
Begin VB.TextBox txtRISID
Height = 285
Left = 3720
TabIndex = 9
ToolTipText = "回车即可保存"
Top = 1290
Width = 1095
End
Begin MSComctlLib.ListView lvwRISXiangMu
Height = 5685
Left = 5220
TabIndex = 8
Top = 270
Width = 4665
_ExtentX = 8229
_ExtentY = 10028
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = 0 'False
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
Icons = "ImageList1"
SmallIcons = "ImageList1"
ColHdrIcons = "ImageList1"
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 4
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "ID"
Object.Width = 1236
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "检查设备"
Object.Width = 1589
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "检查部位"
Object.Width = 2118
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "检查方法"
Object.Width = 2470
EndProperty
End
Begin VB.Label lblInfo
Height = 795
Left = 3450
TabIndex = 11
Top = 1680
Width = 1665
End
Begin VB.Label lblTitle
Height = 615
Left = 3480
TabIndex = 10
Top = 330
Width = 1545
End
End
Begin VB.Frame Frame1
Caption = "基本数据"
Height = 1065
Left = 120
TabIndex = 0
Top = 60
Width = 10005
Begin VB.CommandButton cmdBasicSave
Caption = "保存"
Height = 435
Left = 8940
TabIndex = 14
Top = 450
Width = 945
End
Begin VB.Frame Frame5
Caption = "开单医师"
Height = 735
Left = 7020
TabIndex = 6
Top = 240
Width = 1815
Begin VB.ComboBox cmbKDYS
Height = 315
Left = 90
TabIndex = 7
Top = 300
Width = 1605
End
End
Begin VB.Frame Frame4
Caption = "开单科别"
Height = 735
Left = 4575
TabIndex = 4
Top = 240
Width = 2385
Begin VB.ComboBox cmbKDKB
Height = 315
Left = 120
TabIndex = 5
Top = 300
Width = 2175
End
End
Begin VB.Frame Frame3
Caption = "开单医院"
Height = 735
Left = 150
TabIndex = 2
Top = 240
Width = 4365
Begin VB.ComboBox cmbKDYY
Height = 315
Left = 90
TabIndex = 3
Top = 300
Width = 4185
End
End
End
End
Attribute VB_Name = "frmRISTools"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmbKDKB_Click()
On Error GoTo ErrMsg
Dim strSQL As String
Dim rsTemp As ADODB.Recordset
Me.MousePointer = vbArrowHourglass
cmbKDYS.Clear
strSQL = "select REQ_P from RIS_H_D_P" _
& " where REQ_H='" & cmbKDYY.Text & "'" _
& " and REQ_D='" & cmbKDKB.Text & "'"
Set rsTemp = New ADODB.Recordset
rsTemp.Open strSQL, GRISCon, adOpenForwardOnly, adLockReadOnly
If Not rsTemp.EOF Then
Do
cmbKDYS.AddItem rsTemp("REQ_P")
rsTemp.MoveNext
Loop While Not rsTemp.EOF
rsTemp.Close
End If
GoTo ExitLab
ErrMsg:
MsgBoxW Err
ExitLab:
Me.MousePointer = vbDefault
End Sub
Private Sub cmbKDYY_Click()
On Error GoTo ErrMsg
Dim strSQL As String
Dim rsTemp As ADODB.Recordset
Me.MousePointer = vbArrowHourglass
cmbKDKB.Clear
strSQL = "select distinct REQ_D from RIS_H_D_P" _
& " where REQ_H='" & cmbKDYY.Text & "'"
Set rsTemp = New ADODB.Recordset
rsTemp.Open strSQL, GRISCon, adOpenForwardOnly, adLockReadOnly
If Not rsTemp.EOF Then
Do
cmbKDKB.AddItem rsTemp("REQ_D")
rsTemp.MoveNext
Loop While Not rsTemp.EOF
rsTemp.Close
End If
GoTo ExitLab
ErrMsg:
MsgBoxW Err
ExitLab:
Me.MousePointer = vbDefault
End Sub
Private Sub cmdBasicSave_Click()
Call SetSystemProperty("KDYY", cmbKDYY.Text)
Call SetSystemProperty("KDKB", cmbKDKB.Text)
Call SetSystemProperty("KDYS", cmbKDYS.Text)
End Sub
Private Sub cmdSave_Click()
On Error GoTo ErrMsg
Dim strSQL As String
Dim rsTemp As ADODB.Recordset
Dim strKey As String
Dim intRISID As Integer
Dim blnKillRelation As Boolean
Dim i As Integer
Me.MousePointer = vbHourglass
If Not cmdSave.Enabled Then GoTo ExitLab
'是否选择了左侧的项目
If tvwXiangMu.SelectedItem Is Nothing Then
MsgBox "请在左侧的树型结构中选择体检项目！", vbInformation, "提示"
GoTo ExitLab
End If
strKey = Mid(tvwXiangMu.SelectedItem.Key, 2)
If Len(strKey) < 7 Then
MsgBox "请在左侧树型结构中选择体检项目！", vbInformation, "提示"
GoTo ExitLab
End If
'RIS ID
txtRISID.Text = Trim(txtRISID.Text)
If txtRISID.Text = "" Then
'检查是否删除对应关系
strSQL = "select BHID from SET_XX" _
& " where XXID='" & strKey & "'"
Set rsTemp = New ADODB.Recordset
rsTemp.Open strSQL, GCon, adOpenForwardOnly, adLockReadOnly
If Not IsNull(rsTemp("BHID")) Then
If MsgBox("您没有输入体检项目 " & tvwXiangMu.SelectedItem.Text _
& " 在RIS系统中对应的ID号，这将清除该体检项目与RIS系统的关联！" _
& vbCrLf & "确认要继续吗？", _
vbQuestion + vbYesNo + vbDefaultButton2, "提示") = vbYes Then
blnKillRelation = True
Else
GoTo ExitLab
End If
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -