dlgpersonreport.frm

本系统可用于医院和专业体检中心的健康体检管理

                                    Else
                                        strDXPYSX = rstemp("DXPYSX")
                                        strXXPYSX = rstemp("XXPYSX")
                                        
                                        
                                        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 & "'"
                            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
                                    strSQL = "select TCMC from SET_TC where TCID=" & rstemp("TCID")
                                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)
                            '***************20050524加入 闻*********************
                            Case gtypTemplateID.FZMC
                            strSQL = "select FZMC from FZ_FZSY,FZ_FZSJ" _
                                & " where FZ_FZSY.FZID=FZ_FZSJ.FZID" _
                                & " and  FZ_FZSY.YYID=FZ_FZSJ.YYID" _
                                & " and GUID=" & arrGUID(i)
                            '***************20050524加入完  闻*********************

                        End Select
                        
                    Case gtypHeader.PICTURE
'                        docTemps.InlineShapes.AddPicture App.Path & "\样品.jpg", False, True
'                        strSQL = "picture"
                End Select
                
                '提交查询
                If strSQL <> "" And strSQL <> "picture" Then
                    Set rstemp = New ADODB.Recordset
                    rstemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
                    If rstemp.RecordCount > 0 Then
                        strPrint = rstemp(0) & ""
                        rstemp.Close
                    Else
                        strPrint = ""
                    End If
                End If
                
                '写入标签位置
                bookColl.Range.Text = strPrint
                If strSQL = "picture" Then
                    'bookColl.Application.Selection.InlineShapes.AddPicture App.Path & "\样品.jpg", False, True
                    bookColl.Range.InlineShapes.AddPicture App.Path & "\样品.jpg", False, True
                End If
                '清除
                strPrint = ""
                strSQL = ""
            End If
        Next
        
        '保存报表文件
        
        docTemps.SaveAs arrReportFile(i)
        docTemps.Close
    Next i
    
    '清除缓冲区
    Erase arrGUID
    Erase arrReportFile
    
    MsgBox "导出完毕！", vbInformation, "提示"
    
    GoTo ExitLab
    
    '根据书签名获得项目ID等信息
Get_XMID:
    strXMID = "" '初始化
    
    m = InStr(1, strBookName, "【", vbTextCompare)
    n = InStr(m, strBookName, "】", vbTextCompare)
    If (n > m) And (m > 0) Then
        strXMID = Mid(strBookName, m + 1, n - m - 1)
    End If
     
    Return '返回

ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
On Error Resume Next
    Set docTemps = Nothing
    If Not (WordTemps Is Nothing) Then
        WordTemps.Quit
    End If
    Set WordTemps = Nothing
    Me.MousePointer = vbDefault
End Sub

Private Sub cmdPreviewUniversal_Click()
    frmGreport.Show
    frmGreport.showReport mlngGUID
    Unload Me
End Sub