frmnewttmddc.frm

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

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{0B81E4A9-BE4E-4AEF-9272-33AB5B51C6FC}#1.0#0"; "XPControls.ocx"
Begin VB.Form FrmNewTTMDDC 
   BackColor       =   &H80000009&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "团体名单导出"
   ClientHeight    =   7485
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   10650
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   9
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "FrmNewTTMDDC.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7485
   ScaleWidth      =   10650
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      BackColor       =   &H80000018&
      Height          =   7320
      Left            =   3825
      TabIndex        =   6
      Top             =   90
      Width           =   6735
      Begin MSComctlLib.ListView lvwPeople 
         Height          =   7020
         Left            =   105
         TabIndex        =   7
         Top             =   180
         Width           =   6495
         _ExtentX        =   11456
         _ExtentY        =   12383
         View            =   3
         LabelEdit       =   1
         MultiSelect     =   -1  'True
         LabelWrap       =   -1  'True
         HideSelection   =   0   'False
         FullRowSelect   =   -1  'True
         GridLines       =   -1  'True
         _Version        =   393217
         ForeColor       =   -2147483640
         BackColor       =   -2147483643
         BorderStyle     =   1
         Appearance      =   1
         NumItems        =   12
         BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            Text            =   "序号"
            Object.Width           =   1129
         EndProperty
         BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   1
            Text            =   "档案号"
            Object.Width           =   1834
         EndProperty
         BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   2
            Text            =   "姓名"
            Object.Width           =   1482
         EndProperty
         BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   3
            Text            =   "性别"
            Object.Width           =   952
         EndProperty
         BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   4
            Text            =   "年龄"
            Object.Width           =   952
         EndProperty
         BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   5
            Text            =   "分组编号"
            Object.Width           =   1834
         EndProperty
         BeginProperty ColumnHeader(7) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   6
            Text            =   "分组名称"
            Object.Width           =   2117
         EndProperty
         BeginProperty ColumnHeader(8) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   7
            Text            =   "家庭电话"
            Object.Width           =   2540
         EndProperty
         BeginProperty ColumnHeader(9) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   8
            Text            =   "办公电话"
            Object.Width           =   2540
         EndProperty
         BeginProperty ColumnHeader(10) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   9
            Text            =   "移动电话"
            Object.Width           =   2540
         EndProperty
         BeginProperty ColumnHeader(11) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   10
            Text            =   "查询码"
            Object.Width           =   2540
         EndProperty
         BeginProperty ColumnHeader(12) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   11
            Text            =   "体检日期"
            Object.Width           =   2540
         EndProperty
      End
   End
   Begin VB.Frame Frame2 
      BackColor       =   &H80000018&
      Caption         =   "选择单位"
      Height          =   6045
      Left            =   75
      TabIndex        =   3
      Top             =   90
      Width           =   3690
      Begin VB.TextBox txtName 
         Height          =   285
         Left            =   120
         TabIndex        =   5
         ToolTipText     =   "输入单位名称然后回车进行查找"
         Top             =   5610
         Width           =   3450
      End
      Begin VB.CheckBox chkZJOnly 
         BackColor       =   &H80000018&
         Caption         =   "仅显示已总检人员"
         Height          =   285
         Left            =   120
         TabIndex        =   4
         Top             =   5310
         Width           =   2235
      End
      Begin MSComctlLib.TreeView tvwDWei 
         Height          =   5025
         Left            =   90
         TabIndex        =   9
         Top             =   240
         Width           =   3525
         _ExtentX        =   6218
         _ExtentY        =   8864
         _Version        =   393217
         HideSelection   =   0   'False
         LabelEdit       =   1
         Style           =   7
         Appearance      =   1
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
   End
   Begin VB.Frame Frame3 
      BackColor       =   &H80000018&
      Height          =   735
      Left            =   60
      TabIndex        =   0
      Top             =   6225
      Width           =   3690
      Begin VB.CheckBox chkPrintImmediate 
         BackColor       =   &H80000018&
         Caption         =   "导出后立即打印"
         Height          =   315
         Left            =   1710
         TabIndex        =   1
         Top             =   270
         Width           =   1785
      End
      Begin XPControls.XPCommandButton cmdExportToExcel 
         Height          =   390
         Left            =   240
         TabIndex        =   2
         Top             =   210
         Width           =   1305
         _ExtentX        =   2302
         _ExtentY        =   688
         Enabled         =   0   'False
         Caption         =   "导出到Excel(T)"
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   5070
      Top             =   3225
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin XPControls.XPCommandButton cmdExit 
      Height          =   390
      Left            =   1125
      TabIndex        =   8
      Top             =   7065
      Width           =   1305
      _ExtentX        =   2302
      _ExtentY        =   688
      Caption         =   "退出(E)"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
End
Attribute VB_Name = "FrmNewTTMDDC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub chkZJOnly_Click()
    If Not (tvwDWei.SelectedItem Is Nothing) Then
        tvwDWei_Click
    End If
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdExportToExcel_Click()
    Dim Status
    Dim strSQL As String
    Dim rstemp As ADODB.Recordset
    Dim strFileName As String
    Dim strYYID As String
    Dim intCount As Integer
    Dim blnPrintImmediate As Boolean
    Dim strPeoples As String
    Dim blnZJOnly As Boolean
    Dim strReturn As String
    Dim lngPosition As Long
    
    Me.MousePointer = vbHourglass
    
    '是否有选择
    If tvwDWei.SelectedItem Is Nothing Then GoTo ExitLab
        
    '是否只显示已总检人员
    blnZJOnly = CBool(chkZJOnly.Value)
    
    '是否立即打印
    blnPrintImmediate = CBool(chkPrintImmediate.Value)
    
    '获取文件名
    If Len(tvwDWei.SelectedItem.Key) = 1 Then
        '选择了根节点
        strFileName = ""
    ElseIf Len(tvwDWei.SelectedItem.Key) = 12 Then
        '选择了分组节点
        strFileName = GetFileName(Me.CommonDialog1, "Microsoft Excel 工作簿（*.xls）|*.xls", _
                "另存为", "团体名单_" & tvwDWei.SelectedItem.Text & "分组" & ".xls", WRITEFILE)
        '记录预约编号
        strYYID = Mid(tvwDWei.SelectedItem.Key, 2)
    Else
        '选择了分组节点
        strFileName = GetFileName(Me.CommonDialog1, "Microsoft Excel 工作簿（*.xls）|*.xls", _
                "另存为", "团体名单_" & tvwDWei.SelectedItem.Parent.Text & "_" _
                & tvwDWei.SelectedItem.Text & ".xls", WRITEFILE)
        '记录预约编号
        strYYID = Mid(tvwDWei.SelectedItem.Parent.Key, 2)

    End If
    If strFileName = "" Then GoTo ExitLab
    
On Error GoTo ErrMsg
    '创建临时表
    strSQL = "CREATE TABLE " & TempTable _
            & " ([GUID] bigint primary key,序号 int,档案号 Varchar(20)" _
            & ",姓名 Varchar(20),性别 Varchar(2),年龄 Varchar(5),分组 int,分组名称 Varchar(40)" _
            & ",家庭电话 Varchar(20),办公电话 Varchar(20),移动电话 Varchar(20)" _
            & ",查询码 Varchar(20),体检日期 smalldatetime" _
            & ")"
    If CreateTable(TempTable, True, strSQL) = False Then GoTo ExitLab
    
    '向临时表写入数据
    strSQL = "insert into " & TempTable _
            & "(GUID,档案号,姓名,性别,年龄,分组,分组名称,家庭电话,办公电话,移动电话,查询码,体检日期)"
    strSQL = strSQL & " select SET_GRXX.GUID,"
    If Not g_blnSelfID Then
        strSQL = strSQL & "SET_GRXX.HealthID"
    Else
        strSQL = strSQL & "SET_GRXX.SelfBH"
    End If
    If Len(tvwDWei.SelectedItem.Key) = 12 Then
        '选择了单位节点
        strSQL = strSQL & ",YYRXM,SET_GRXX.SEX,Age,FZ_FZSY.FZID,FZMC,YYRJTDH,YYRBGDH,YYRYDDH,CXM,TJRQ" _
                & " from SET_GRXX,FZ_FZSJ,FZ_FZSY" _
                & " where SET_GRXX.YYID='" & strYYID & "'" _
                & " and SET_GRXX.GUID=FZ_FZSJ.GUID" _
                & " and FZ_FZSY.FZID=FZ_FZSJ.FZID" _
                & " and FZ_FZSY.YYID='" & strYYID & "'" _
                & " and FZ_FZSJ.YYID='" & strYYID & "'"
    Else
        '选择了分组节点
        strSQL = strSQL & ",YYRXM,SET_GRXX.SEX,Age,FZ_FZSY.FZID,FZMC,YYRJTDH,YYRBGDH,YYRYDDH,CXM,TJRQ" _
                & " from SET_GRXX,FZ_FZSJ,FZ_FZSY" _
                & " where SET_GRXX.YYID='" & strYYID & "'" _
                & " and SET_GRXX.GUID=FZ_FZSJ.GUID" _
                & " and FZ_FZSY.FZID=FZ_FZSJ.FZID" _
                & " and FZ_FZSY.FZID=" & Val(Mid(tvwDWei.SelectedItem.Key, 13)) _
                & " and FZ_FZSY.YYID='" & strYYID & "'" _
                & " and FZ_FZSJ.YYID='" & strYYID & "'"
        
    End If
    If blnZJOnly Then
        strSQL = strSQL & " and SET_GRXX.GUID in(" _
                    & "select GUID from DATA_ZJJL" _
                & ")"
    End If
    strSQL = strSQL & " order by YYRXM"
    GCon.Execute strSQL
    
    '设置“序号”列
    strSQL = "select GUID,序号 from " & TempTable
    Set rstemp = New ADODB.Recordset
    rstemp.Open strSQL, GCon, adOpenKeyset, adLockBatchOptimistic
    If rstemp.RecordCount > 0 Then
        rstemp.MoveFirst
        intCount = 1
        Do While Not rstemp.EOF
            rstemp("序号") = intCount
            
            intCount = intCount + 1
            rstemp.MoveNext
        Loop
        rstemp.UpdateBatch
        
        rstemp.Close
    End If
    Set rstemp = Nothing
    
    strSQL = "select 序号,档案号,姓名,性别,年龄,分组,分组名称,家庭电话,办公电话,移动电话,查询码,体检日期" _
            & " from " & TempTable
    Call ExportToExcel(strSQL, strFileName, tvwDWei.SelectedItem.Text, _
            "团体名单导出", "4,8.5,7.4,5.1,5.1,4.3,10,10,10,10,14.5,15", blnClose:=True)
    
    '导出统计Sheet页
    '创建临时表
    strSQL = "CREATE TABLE " & TempTable _
            & " (序号 int,统计项目 Varchar(30)" _
            & ",结果 Varchar(8000)" _
            & ")"
    If CreateTable(TempTable, True, strSQL) = False Then GoTo ExitLab
    
    '总人数
    strReturn = GetPersonCheckStatus(ALL_PERSON, strYYID)
    intCount = CInt(Val(strReturn))
    strSQL = "insert into " & TempTable & " values(" _
            & "1,'总人数','" & CStr(intCount) & "'" _
            & ")"
    GCon.Execute strSQL
    
    '待登记人员
    strReturn = GetPersonCheckStatus(UNREGISTER, strYYID, , , , True)
    lngPosition = InStr(1, strReturn, HEADER)
    intCount = Left(strReturn, lngPosition - 1)
    strPeoples = Mid(strReturn, lngPosition + 1)
    
    strSQL = "insert into " & TempTable & " values(" _
            & "2,'待登记(" & intCount & " 人)','" & strPeoples & "'" _
            & ")"
    GCon.Execute strSQL
    
    '待体检人员
    strReturn = GetPersonCheckStatus(UNCHECK, strYYID, , , , True)
    lngPosition = InStr(1, strReturn, HEADER)
    intCount = Left(strReturn, lngPosition - 1)
    strPeoples = Mid(strReturn, lngPosition + 1)
    
    strSQL = "insert into " & TempTable & " values(" _
            & "3,'已登记未体检(" & intCount & " 人)','" & strPeoples & "'" _
            & ")"