📄 frmquery_mbbb.frm
字号:
strSQL = "select guid from set_grxx where HealthID='" & HEALTHID & "' and GUID<>" & arrGUID(i)
Set rs = New ADODB.Recordset
rs.Open strSQL, GCon, adOpenStatic, adLockReadOnly
If Not rs.EOF Then
SGUID = rs(0)
If Len(strXMID) = 7 Then '小项
'首先获取该项目所属大项的名称
strSQL = "select DXPYSX,XXPYSX,XXType from SET_XX,SET_ZH_Data,SET_DX" _
& " where SET_XX.XXID='" & strXMID & "'" _
& " and SET_XX.XXID=SET_ZH_Data.XXID" _
& " and SET_ZH_Data.DXID=SET_DX.DXID" _
& " and SET_DX.DXID in (" _
& "select DXID from YY_SJDJDX" _
& " where GUID=" & SGUID _
& ")"
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
blnGetResult = False
If rstemp.RecordCount > 0 Then
rstemp.MoveFirst
For j = 1 To rstemp.RecordCount
If IsNull(rstemp("DXPYSX")) Or IsNull(rstemp("XXPYSX")) Then
strSQL = ""
Else
strDXPYSX = rstemp("DXPYSX")
strXXPYSX = rstemp("XXPYSX")
intType = rstemp("XXType")
strSQL = "select [" & strXXPYSX & "] from [DATA_" & strDXPYSX & "]" _
& " where GUID=" & SGUID
Set rsResult = New ADODB.Recordset
rsResult.Open strSQL, GCon, adOpenStatic, adLockReadOnly
If rsResult.RecordCount > 0 Then
If Not IsNull(rsResult(0)) Then
If rsResult(0) <> "" Then
blnGetResult = True
rsResult.Close '提前取得体检结果时，关闭记录集
Exit For
End If
End If
rsResult.Close '正常关闭记录集
End If
End If
rstemp.MoveNext
Next j
rstemp.Close
End If
If Not blnGetResult Then
strSQL = ""
End If
ElseIf Len(strXMID) = 4 Then '无子项的大项
'获取大项的拼音缩写
strSQL = "select DXPYSX from SET_DX" _
& " where DXID='" & strXMID & "' and DXSFYZX=0"
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
If rstemp.RecordCount > 0 Then
If IsNull(rstemp("DXPYSX")) Or rstemp("DXPYSX") = "" Then
strSQL = ""
Else
strDXPYSX = rstemp("DXPYSX")
rstemp.Close
strSQL = "select [" & strDXPYSX & "Value] from [DATA_" & strDXPYSX & "]" _
& " where GUID=" & SGUID
End If
Else
strSQL = ""
End If
End If
End If
Case gtypHeader.RESULT
If Len(strXMID) = 7 Then '小项
'首先获取该项目所属大项的名称
strSQL = "select DXPYSX,XXPYSX,XXType from SET_XX,SET_ZH_Data,SET_DX" _
& " where SET_XX.XXID='" & strXMID & "'" _
& " and SET_XX.XXID=SET_ZH_Data.XXID" _
& " and SET_ZH_Data.DXID=SET_DX.DXID" _
& " and SET_DX.DXID in (" _
& "select DXID from YY_SJDJDX" _
& " where GUID=" & arrGUID(i) _
& ")"
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
blnGetResult = False
If rstemp.RecordCount > 0 Then
rstemp.MoveFirst
For j = 1 To rstemp.RecordCount
If IsNull(rstemp("DXPYSX")) Or IsNull(rstemp("XXPYSX")) Then
strSQL = ""
Else
strDXPYSX = rstemp("DXPYSX")
strXXPYSX = rstemp("XXPYSX")
intType = rstemp("XXType")
strSQL = "select [" & strXXPYSX & "] from [DATA_" & strDXPYSX & "]" _
& " where GUID=" & arrGUID(i)
Set rsResult = New ADODB.Recordset
rsResult.Open strSQL, GCon, adOpenStatic, adLockReadOnly
If rsResult.RecordCount > 0 Then
If Not IsNull(rsResult(0)) Then
If rsResult(0) <> "" Then
blnGetResult = True
rsResult.Close '提前取得体检结果时，关闭记录集
Exit For
End If
End If
rsResult.Close '正常关闭记录集
End If
End If
rstemp.MoveNext
Next j
rstemp.Close
End If
If Not blnGetResult Then
strSQL = ""
End If
ElseIf Len(strXMID) = 4 Then '无子项的大项
'获取大项的拼音缩写
strSQL = "select DXPYSX from SET_DX" _
& " where DXID='" & strXMID & "' and DXSFYZX=0"
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
If rstemp.RecordCount > 0 Then
If IsNull(rstemp("DXPYSX")) Or rstemp("DXPYSX") = "" Then
strSQL = ""
Else
strDXPYSX = rstemp("DXPYSX")
rstemp.Close
strSQL = "select [" & strDXPYSX & "Value] from [DATA_" & strDXPYSX & "]" _
& " where GUID=" & arrGUID(i)
End If
Else
strSQL = ""
End If
End If
'其它类
Case gtypHeader.OTHER
Select Case strXMID
Case gtypTemplateID.name
strSQL = "select YYRXM from SET_GRXX" _
& " where GUID=" & arrGUID(i)
Case gtypTemplateID.HEALTHID
strSQL = "select HealthID from SET_GRXX" _
& " where GUID=" & arrGUID(i)
Case gtypTemplateID.SEX
strSQL = "select SEX from SET_GRXX" _
& " where GUID=" & arrGUID(i)
Case gtypTemplateID.AGE
strSQL = "select AGE from SET_GRXX" _
& " where GUID=" & arrGUID(i)
Case gtypTemplateID.TJRQ
strSQL = "select TJRQ from SET_GRXX" _
& " where GUID=" & arrGUID(i)
Case gtypTemplateID.DYRQ
strPrint = CStr(Date)
Case gtypTemplateID.ZJJL
strSQL = "select JLValue from DATA_ZJJL" _
& " where GUID=" & arrGUID(i)
Case gtypTemplateID.ZJJY
strSQL = "select JYValue from DATA_ZJJY" _
& " where GUID=" & arrGUID(i)
Case gtypTemplateID.CXM
strSQL = "select CXM from SET_GRXX" _
& " where GUID=" & arrGUID(i)
Case gtypTemplateID.TCMC
Set rstemp = New ADODB.Recordset
strSQL = "select * from SET_GRXX where GUID='" & arrGUID(i) & "'"
rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
If IsNull(rstemp("YYID")) Or rstemp("YYID") = "" Then
'不属于团体
' cmbGDWei.ListIndex = -1
'获取体检时间和体检标准，是否选择套餐，以及如果选择套餐后的套餐编号
strSQL = "select XZTC,TCID from YY_SJDJ" _
& " where GUID=" & arrGUID(i)
Else
'属于团体
strYYID = rstemp("YYID")
'检查当前用户是否已经参与分组
' strSQL = "select FZID from FZ_FZSJ" _
' & " where GUID=" & arrGUID(i)
' Set rsTemp = New ADODB.Recordset
' rsTemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
' If rsTemp.RecordCount > 0 Then
' '有参与分组
' CmbFZ.ListIndex = rsTemp("FZID") - 1
'
' rsTemp.Close
' End If
'是否选择套餐，以及如果选择套餐后的套餐编号
strSQL = "select XZTC,TCID from YY_TJDJTC,FZ_FZSJ" _
& " where YY_TJDJTC.YYID='" & strYYID & "'" _
& " and FZ_FZSJ.YYID='" & strYYID & "'" _
& " and FZ_FZSJ.GUID=" & arrGUID(i) _
& " and YY_TJDJTC.FZID=FZ_FZSJ.FZID"
End If
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenKeyset, adLockOptimistic
If (rstemp.RecordCount > 0) And (Not (IsNull(rstemp("TCID")))) Then
If Not IsNull(rstemp("TCID")) And rstemp("TCID") <> "" Then
strSQL = "select TCMC from SET_TC where TCID=" & rstemp("TCID")
Else
strSQL = ""
End If
Else
strSQL = ""
End If
Case gtypTemplateID.DWMC
Set rstemp = New ADODB.Recordset
strSQL = "select * from SET_GRXX where GUID=" & arrGUID(i)
rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
If IsNull(rstemp("YYID")) Or rstemp("YYID") = "" Then
'不属于团体
strSQL = ""
Else
'属于团体
strYYID = rstemp("YYID")
strSQL = "select DWID from YY_TJDJ WHERE YYID='" & strYYID & "'"
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
If rstemp.RecordCount > 0 Then
strSQL = "select DWMC from SET_DW where DWID='" & rstemp("DWID") & "'"
Else
strSQL = ""
End If
End If
Case gtypTemplateID.LXDZ
strSQL = "select LXDZ from SET_GRXX" _
& " where GUID=" & arrGUID(i)
Case gtypTemplateID.JTDH
strSQL = "select YYRJTDH from SET_GRXX" _
& " where GUID=" & arrGUID(i)
Case gtypTemplateID.BGDH
strSQL = "select YYRBGDH from SET_GRXX" _
& " where GUID=" & arrGUID(i)
Case gtypTemplateID.YDDH
strSQL = "select YYRYDDH from SET_GRXX" _
& " where GUID=" & arrGUID(i)
'体检异常
Case gtypTemplateID.TJYC
strPrint = GetTJYCJLun(arrGUID(i))
'自定义档案号
Case gtypTemplateID.SELFID
strSQL = "select SelfBH from SET_GRXX" _
& " where GUID=" & arrGUID(i)
'自定义建议
Case gtypTemplateID.SELF_JY_1, gtypTemplateID.SELF_JY_2, _
gtypTemplateID.SELF_JY_3, gtypTemplateID.SELF_JY_4, _
gtypTemplateID.SELF_JY_5
'检索所有可用的自定义建议
strSQL = "select JYID,JYPYSX from SET_JY_INDEX" _
& " where not (JYMC is null)" _
& " order by JYSXH"
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
strSQL = "" '清空该变量，便于后面作出判断
If Not rstemp.EOF Then
For intJYIndex = 1 To rstemp.RecordCount
If intJYIndex = Val(strXMID) - Val(gtypTemplateID.SELF_JY_1) + 1 Then
strTableName = "[DATA_" & rstemp("JYPYSX") & "]"
strSQL = "select JYContent from " & strTableName _
& " where GUID=" & arrGUID(i)
Exit For
End If
rstemp.MoveNext
Next intJYIndex
rstemp.Close
End If
Case gtypTemplateID.HEALTH_STATUS
If gblnIsSpy Then
On Error Resume Next
strSQL = "select HealthName from SET_HEALTH" _
& " where HealthID in(" _
& "select HealthID from DATA_HealthStatus" _
& " where GUID=" & arrGUID(i) _
& ")"
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenForwardOnly, adLockReadOnly
If Err.Number Then
Err.Clear
strSQL = ""
Else
If Not rstemp.EOF Then rstemp.Close
End If
On Error GoTo ErrMsg
End If
Case gtypTemplateID.HEALTH_RESULT
If gblnIsSpy Then
On Error Resume Next
strSQL = "select HealthResult from DATA_HealthStatus" _
& " where GUID=" & arrGUID(i)
Set rstemp = New ADODB.Recordset
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -