📄 mdldatabase2.bas
字号:
'设置字体
.FontName = arrFormat(0)
.FontSize = arrFormat(1)
.FontBold = arrFormat(2)
.FontItalic = arrFormat(3)
.FontUnderline = arrFormat(4)
' .Alignment = arrFormat(5)
'设置临时文本框的属性
With txtTemp
.FontName = arrFormat(0)
.FontSize = arrFormat(1)
.FontBold = arrFormat(2)
.FontItalic = arrFormat(3)
.FontUnderline = arrFormat(4)
'' .Alignment = arrFormat(5)
.Width = objPrint.ScaleX(rsReport("ReportWidth"), vbMillimeters, txtTemp.Container.ScaleMode)
End With
'定位坐标
sngLeft = rsReport("ReportLeft")
sngTop = rsReport("ReportTop")
'获取关联信息
strFormat = rsReport("ReportRelation")
strPrint = ""
If strFormat = "" Then
'尚未建立关联的情况
'此种情况无需打印
Else
intFlag = Val(Left(strFormat, InStr(1, strFormat, ",") - 1))
strID = Mid(strFormat, InStr(1, strFormat, ",") + 1)
'分析关联
Select Case intFlag
Case WKShi
'*********************************************************
'科室名称
'*********************************************************
strPrint = rsReport("ReportText")
Case WDX '大项
'*********************************************************
'*********************************************************
'首先判断该大项是否有小项
strSQL = "select DXPYSX,DXSFYZX from SET_DX" _
& " where DXID='" & strID & "'"
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
If rstemp.RecordCount > 0 Then
If rstemp("DXSFYZX") = 1 Then
'有子项的大项，直接打印大项名称
strPrint = rsReport("ReportText")
Else
'对于无子项的大项，需输出客户体检结果
strSQL = "select [" & rstemp("DXPYSX") & "Value]" _
& " from [DATA_" & rstemp("DXPYSX") & "]" _
& " where GUID=" & lngGUID
rstemp.Close
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
If rstemp.RecordCount > 0 Then
If Not IsNull(rstemp(0)) Then
strPrint = rstemp(0)
End If
rstemp.Close
End If
End If
End If
Case WXX '小项
'*********************************************************
'*********************************************************
'首先取得该小项的拼音缩写
strSQL = "select XXPYSX from SET_XX" _
& " where XXID='" & strID & "'"
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
If rstemp.RecordCount > 0 Then
strPrint = GetExistResult(lngGUID, Left(strID, 4), rstemp("XXPYSX"), strID, True)
rstemp.Close
End If
' Case WDoctor
'科室医生
'判断当前属于哪个科室
' strSQL = "select top 1 ReportRelation from [REPORT_" & strPYSX & "]" _
' & " where left(ReportRelation,1)=" & WKShi & " or left(ReportRelation,1)=" & WDX & " or left(ReportRelation,1)=" & WXX
' Set rsTemp = New ADODB.Recordset
' rsTemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
' If rsTemp.RecordCount > 0 Then
' strSQL = "select Name from RY_Employee,SET_KSSZ" _
' & " where RY_Employee.KSID=SET_KSSZ.KSID" _
' & " and RY_Employee.KSID='" & Left(Mid(rsTemp(0), 3), 2) & "'"
' rsTemp.Close
' Set rsTemp = New ADODB.Recordset
' rsTemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
' If rsTemp.RecordCount > 0 Then
' strPrint = rsTemp(0)
' rsTemp.Close
' End If
' End If
Case WXJie '科室小结
'*********************************************************
'*********************************************************
strSQL = "select XJValue from Data_KSXJ" _
& " where KSID='" & strID & "'" _
& " and GUID=" & lngGUID
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
If rstemp.RecordCount > 0 Then
If Not IsNull(rstemp(0)) Then
strPrint = rstemp(0)
End If
rstemp.Close
'需要多行打印
blnMultiline = True
End If
Case WHealthID
'*********************************************************
'档案号
'*********************************************************
If Not g_blnSelfID Then
strPrint = rsPerson("HealthID")
Else
strPrint = rsPerson("SelfBH") & ""
End If
Case WCXM
'*********************************************************
'查询码
'*********************************************************
strPrint = rsPerson("CXM") & ""
Case WSN
'*********************************************************
'体检序号
'*********************************************************
strPrint = rsPerson("TJSerialNum")
Case WName
'*********************************************************
'姓名
'*********************************************************
strPrint = rsPerson("YYRXM")
Case WSex
'*********************************************************
'性别
'*********************************************************
strPrint = rsPerson("SEX")
Case WSFZH
'*********************************************************
'姓名
'*********************************************************
strPrint = rsPerson("YYRSFZH")
Case WAge
'*********************************************************
'性别
'*********************************************************
strPrint = rsPerson("AGE") & ""
Case WDWei
'*********************************************************
'单位
'*********************************************************
strSQL = "select DWMC from SET_DW,SET_GRXX,YY_TJDJ" _
& " where GUID=" & lngGUID _
& " and not (SET_GRXX.YYID is null)" _
& " and SET_GRXX.YYID=YY_TJDJ.YYID" _
& " and YY_TJDJ.DWID=SET_DW.DWID"
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
If Not rstemp.EOF Then
If Not IsNull(rstemp(0)) Then
strPrint = rstemp(0)
End If
rstemp.Close
End If
Case WPhone
'*********************************************************
'联系电话
'*********************************************************
strSQL = "select YYRYDDH from SET_GRXX" _
& " where GUID=" & lngGUID
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
If Not rstemp.EOF Then
If Not IsNull(rstemp(0)) Then
strPrint = rstemp(0)
End If
rstemp.Close
End If
Case WZJJLun
'*********************************************************
'总检结论
'*********************************************************
'查询语句还需要加体检日期的判断
strSQL = "select JLValue from DATA_ZJJL" _
& " where GUID=" & lngGUID
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
If Not rstemp.EOF Then
If Not IsNull(rstemp(0)) Then
strPrint = rstemp(0)
End If
rstemp.Close
'需要多行打印
blnMultiline = True
End If
Case WZJJYi
'*********************************************************
'总检建议
'*********************************************************
strSQL = "select JYValue from DATA_ZJJY" _
& " where GUID=" & lngGUID
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
If Not rstemp.EOF Then
If Not IsNull(rstemp(0)) Then
strPrint = rstemp(0)
End If
rstemp.Close
'需要多行打印
blnMultiline = True
End If
Case WTJRQ
'*********************************************************
'体检日期
'*********************************************************
strPrint = rsPerson("TJRQ")
Case WDate
'*********************************************************
'打印日期
'*********************************************************
strPrint = Date
Case WTJTC
strSQL = "select * from SET_GRXX where GUID=" & lngGUID
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
If Not rstemp.EOF Then
If Not (IsNull(rstemp("YYID")) Or rstemp("YYID") = "") Then '是团检客户
tmpYYID = rstemp("YYID")
Set rstemp = New ADODB.Recordset
strSQL = "select * from FZ_FZSJ where YYID='" & tmpYYID _
& "' and GUID=" & lngGUID
rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
If Not rstemp.EOF Then
tmpFZID = rstemp("FZID")
Set rstemp = New ADODB.Recordset
strSQL = "select * from YY_TJDJTC where YYID='" & tmpYYID _
& "' and FZID=" & tmpFZID _
& " and XZTC=1"
rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
If Not rstemp.EOF Then
tmpTCID = rstemp("TCID")
strSQL = "select * from SET_TC where TCID=" & tmpTCID
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
strPrint = rstemp("TCMC")
End If
End If
Else '是散检客户
strSQL = "select * from YY_SJDJ where GUID=" & lngGUID _
& " and XZTC=1"
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
If Not rstemp.EOF Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -