📄 frmreport.frm
字号:
Height = 255
Left = 360
TabIndex = 67
Top = 1118
Width = 975
End
Begin VB.Label lblSickType
BackStyle = 0 'Transparent
Caption = "病人类型:"
Height = 255
Left = 360
TabIndex = 66
Top = 398
Width = 975
End
Begin VB.Label lblBelongSec
BackStyle = 0 'Transparent
Caption = "所属科室:"
Height = 255
Left = 360
TabIndex = 65
Top = 758
Width = 975
End
Begin VB.Label lblFamily
BackStyle = 0 'Transparent
Caption = "家庭信息:"
Height = 255
Left = 5520
TabIndex = 64
Top = 1515
Width = 1095
End
Begin VB.Label lblUnit
BackStyle = 0 'Transparent
Caption = "单位信息:"
Height = 255
Left = 5520
TabIndex = 63
Top = 1155
Width = 1095
End
Begin VB.Label lblSickBirth
BackStyle = 0 'Transparent
Caption = "出生日期:"
Height = 255
Left = 8160
TabIndex = 62
Top = 405
Width = 1095
End
Begin VB.Label lblSickName
BackStyle = 0 'Transparent
Caption = "姓名:"
ForeColor = &H00800000&
Height = 255
Left = 360
TabIndex = 61
Top = 1485
Width = 1095
End
Begin VB.Label lblWard
BackStyle = 0 'Transparent
Caption = "所在病区:"
Height = 255
Left = 2715
TabIndex = 60
Top = 758
Width = 1095
End
Begin VB.Label lblSickNo
BackStyle = 0 'Transparent
Caption = "病人号码:"
ForeColor = &H00000000&
Height = 255
Left = 2715
TabIndex = 59
Top = 398
Width = 855
End
Begin VB.Label lblSickSex
BackStyle = 0 'Transparent
Caption = "性别:"
ForeColor = &H00800000&
Height = 255
Left = 2715
TabIndex = 58
Top = 1485
Width = 1095
End
Begin VB.Label lblSickClass
BackStyle = 0 'Transparent
Caption = "分类:"
Height = 255
Left = 5535
TabIndex = 57
Top = 765
Width = 1095
End
Begin VB.Label lblSSStyle
BackStyle = 0 'Transparent
Caption = "超声类型:"
ForeColor = &H00800000&
Height = 255
Left = 345
TabIndex = 56
Top = 2175
Width = 1095
End
Begin VB.Label lblSSNo
BackStyle = 0 'Transparent
Caption = "超声号:"
ForeColor = &H00800000&
Height = 255
Left = 2745
TabIndex = 55
Top = 2175
Width = 1095
End
Begin VB.Label lblOrgan
BackStyle = 0 'Transparent
Caption = "检查部位:"
ForeColor = &H00800000&
Height = 255
Left = 345
TabIndex = 54
Top = 3255
Width = 1095
End
Begin VB.Label lblClinic
BackStyle = 0 'Transparent
Caption = "临床诊断:"
Height = 255
Left = 345
TabIndex = 53
Top = 2895
Width = 1095
End
Begin VB.Label lblCharge
BackStyle = 0 'Transparent
Caption = "检查费用:"
Height = 255
Left = 2745
TabIndex = 52
Top = 3615
Width = 1035
End
Begin VB.Label lblOrganNum
BackStyle = 0 'Transparent
Caption = "脏器数:"
Height = 255
Left = 360
TabIndex = 51
Top = 3615
Width = 1215
End
Begin VB.Label lblDescribe
BackStyle = 0 'Transparent
Caption = "图像描述:"
ForeColor = &H00800000&
Height = 255
Left = 345
TabIndex = 50
Top = 3945
Width = 1095
End
Begin VB.Label lblDDoctor
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "检查医师:"
ForeColor = &H00800000&
Height = 255
Left = 345
TabIndex = 49
Top = 2535
Width = 1095
End
Begin VB.Label lblSSection
BackStyle = 0 'Transparent
Caption = "送检科室:"
Height = 255
Left = 8220
TabIndex = 48
Top = 2175
Width = 1095
End
Begin VB.Label lblSHospital
BackStyle = 0 'Transparent
Caption = "送检医院:"
Height = 255
Left = 5520
TabIndex = 47
Top = 2175
Width = 1095
End
Begin VB.Label lblSDoctor
BackStyle = 0 'Transparent
Caption = "送检医师:"
Height = 255
Left = 5520
TabIndex = 46
Top = 2535
Width = 1095
End
Begin VB.Label lblDiagDay
BackStyle = 0 'Transparent
Caption = "检查日期:"
ForeColor = &H00800000&
Height = 255
Left = 2745
TabIndex = 45
Top = 2535
Width = 1095
End
Begin VB.Label lblUSTip
BackStyle = 0 'Transparent
Caption = "超声提示1:"
ForeColor = &H00000000&
Height = 255
Index = 0
Left = 345
TabIndex = 44
Top = 5745
Width = 1035
End
Begin VB.Label lblUSTip
BackStyle = 0 'Transparent
Caption = "超声提示2:"
ForeColor = &H00000000&
Height = 270
Index = 1
Left = 5520
TabIndex = 43
Top = 5745
Width = 1035
End
Begin VB.Label lblUSTip
BackStyle = 0 'Transparent
Caption = "超声提示3:"
ForeColor = &H00000000&
Height = 255
Index = 2
Left = 345
TabIndex = 42
Top = 6135
Width = 1035
End
Begin VB.Label lblUSTip
BackStyle = 0 'Transparent
Caption = "超声提示4:"
ForeColor = &H00000000&
Height = 255
Index = 3
Left = 5520
TabIndex = 41
Top = 6135
Width = 1035
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "检查报告"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 105
TabIndex = 40
Top = 1830
Width = 1335
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "病人信息"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 105
TabIndex = 37
Top = 75
Width = 1335
End
End
Attribute VB_Name = "frmReport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public WorkType As String
Public FoundSick As Boolean '是否已经根据病人号或病人姓名找到病人信息
Public rsUSSick As ADODB.Recordset '查找病人的记录集
Private Const MIN_WIDTH As Integer = 10500 '窗体的最小宽度
Private Const MIN_HEIGHT As Integer = 7140 '窗体的最小高度
Private Const RIGHT_MARGIN As Integer = 630
Private Loading As Boolean '正在加载中的标志,防治cboUSStyle的误操作
Public Loaded As Boolean '是否加载
Public Saved As Boolean '是否已经保存
Public blnNewSick As Boolean '是否是新病人
Public VFs As New ImageFiles '视频文件集合
Public IFs As New ImageFiles '图片集合名称
Public VideoFileName As String '视频文件名称
Public VideoSoundFileName As String '视频配音文件名称
'Public OrganChosen(200) As Integer '已选器官数组
Public Property Get US_NO() As String
'就是txtUSNO的内容
US_NO = txtUSNo.Text
End Property
Private Sub cboOrganName_Change()
Dim i As Integer
modCommon.OrganModelNameChosenStr = cboOrganName.Text
For i = 0 To 19
modCommon.TempLoadFlag(i) = False
modCommon.OldTempLoadFlag(i) = False
Next i
End Sub
Private Sub cboOrganName_Click()
Dim strSQL As String
Dim rsTemp As ADODB.Recordset
Dim OrganName As String
'设置从属信息
modCommon.OrganModelNameChosen = cboOrganName.Text
modCommon.OrganModelNameChosenStr = modCommon.OrganModelNameChosenStr & modCommon.OrganModelNameChosen
cboOrganName.Text = modCommon.OrganModelNameChosenStr
OrganName = modCommon.OrganModelNameChosen
strSQL = "SELECT * FROM US_ORGAN_COMB WHERE COMB_NAME = '" & OrganName & "'"
Set rsTemp = OpenRSClient(strSQL)
If rsTemp.RecordCount > 0 Then
txtOrganNum.Text = Val(txtOrganNum.Text) + Val(rsTemp!ORGAN_NUM & vbNullString) ''rsTemp!ORGAN_NUM & vbNullString
Select Case cboUSStyle.Text
Case "黑白超声"
txtCharge.Text = Val(txtCharge.Text) + Val(rsTemp!BW_PRICE & vbNullString) ''rsTemp!BW_PRICE & vbNullString
Case "彩超"
txtCharge.Text = Val(txtCharge.Text) + Val(rsTemp!COLOR_PRICE & vbNullString) '' rsTemp!COLOR_PRICE & vbNullString
Case "心超"
txtCharge.Text = Val(txtCharge.Text) + Val(rsTemp!HEART_PRICE & vbNullString) '' rsTemp!HEART_PRICE & vbNullString
Case Else
End Select
End If
'释放对象
Set rsTemp = Nothing
'如果立即打开模板
If IniUS.GetString("USReport", "PopTemplateDirectly", False) Then
modCommon.PopOrganTemp (OrganName)
End If
End Sub
Private Sub cboUSStyle_Click()
'如果是用户输入超声号，则立即退出
If IniUS.GetString("Report", "UserInputUSNO", 0) Then
Exit Sub
End If
'如果不是在Loading状态,则每改变该内容将重新生成US_NO
If Me.WorkType = "Add" Then
txtUSNo.Text = NewUSNo(cboUSStyle.Text)
End If
End Sub
Private Sub cmdSelOrganTemp_Click()
frmOrganTemp.Show , frmMain
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim ComboName As String
Dim strSQL As String
Dim rsTemp As New ADODB.Recordset
On Error GoTo ErrHandle
Select Case WorkType
Case "Browse"
'如果是浏览以往的记录,则不响应快捷键
Exit Sub
Case "Add"
End Select
'对键盘事件进行先处理
Select Case KeyCode
Case vbKeyReturn
'如果是回车键,则首先判断是否存在下拉框的用数字索引的可能
ComboName = GetComboName(Me.ActiveControl)
If ComboName <> vbNullString Then
If IsNumeric(Me.ActiveControl.Text) Then
strSQL = "SELECT ITEMDATA FROM US_REPORT_ITEM_DETAIL WHERE CLASS_NAME = '" & ComboName & "' AND ITEMINDEX = " & CStr(Me.ActiveControl.Text)
rsTemp.Open strSQL, ConnUS, , adLockReadOnly
If rsTemp.RecordCount = 0 Then
Me.ActiveControl.Text = vbNullString
Beep
Exit Sub
Else
Me.ActiveControl.Text = rsTemp!ItemData
End If
End If
End If
'如果当前是图象描述,则判断是否在行内回车
If Me.ActiveControl Is txtDescribe Then
If IniUS.GetString("Report", "CrInDescribe", 0) Then
Exit Sub
End If
End If
SendKeys "{TAB}"
Case US_KEY_ITEMDETAIL
'如果是"弹出选择框",则弹出该控件的响应选择框
Select Case Me.ActiveControl.Name
Case "cboOrganName"
'弹出器官选择窗体
If USV.AllowOrganTemplate Then
With frmSelOrgan
.Show vbModal
If .Cancel Or .Organ = vbNullString Then Exit Sub
cboOrganName.Text = .Organ
End With
End If
Case "txtUSTip"
If USV.AllowOrganTemplate Then
'弹出超声提示窗体
Select Case IniUS.GetString("Report", "TipMode")
Case 0
frmTipDetail.WorkType = "Select"
frmTipDetail.Show , frmMain
Case 1
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -