frmbclb.frm

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

VERSION 5.00
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 FrmBCLB 
   BackColor       =   &H80000018&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "已有档案"
   ClientHeight    =   4650
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   9210
   Icon            =   "FrmBCLB.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4650
   ScaleWidth      =   9210
   StartUpPosition =   3  '窗口缺省
   Begin XPControls.XPCommandButton cmdModifySelection 
      Height          =   465
      Left            =   7140
      TabIndex        =   4
      Top             =   4020
      Width           =   1335
      _ExtentX        =   2355
      _ExtentY        =   820
      Enabled         =   0   'False
      Caption         =   "加减项"
      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
   Begin XPControls.XPCommandButton CmdBuCha 
      Height          =   435
      Left            =   780
      TabIndex        =   1
      Top             =   4020
      Width           =   1185
      _ExtentX        =   2090
      _ExtentY        =   767
      Enabled         =   0   'False
      Caption         =   "补  检"
      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
   Begin MSComctlLib.ListView ListView1 
      Height          =   3585
      Left            =   150
      TabIndex        =   0
      Top             =   240
      Width           =   8895
      _ExtentX        =   15690
      _ExtentY        =   6324
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   0   'False
      FullRowSelect   =   -1  'True
      GridLines       =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   12648384
      BorderStyle     =   1
      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
      NumItems        =   0
   End
   Begin XPControls.XPCommandButton CmdNew 
      Cancel          =   -1  'True
      Height          =   435
      Left            =   4875
      TabIndex        =   2
      Top             =   4020
      Width           =   1485
      _ExtentX        =   2619
      _ExtentY        =   767
      Caption         =   "新   建"
      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
   Begin XPControls.XPCommandButton cmdFuCha 
      Height          =   465
      Left            =   2745
      TabIndex        =   3
      Top             =   4020
      Width           =   1335
      _ExtentX        =   2355
      _ExtentY        =   820
      Enabled         =   0   'False
      Caption         =   "复  查"
      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 = "FrmBCLB"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mstrFormName As String

Private Sub cmdFuCha_Click()
    If ListView1.SelectedItem Is Nothing Then
        MsgBox "请选择一条记录", vbInformation, "未选择记录"
        Exit Sub
    End If
    
    If MsgBox("确定复查客户“" & ListView1.SelectedItem.Text & "”吗？", vbQuestion + vbOKCancel + vbDefaultButton1, "确定") = vbOK Then
        '记录复查的GUID
        gBCLBGUID = CLng(Mid(ListView1.SelectedItem.Key, 2))
        gblFuCha = True
        gBFHealthID = ListView1.SelectedItem.SubItems(1)
        gBFName = ListView1.SelectedItem.Text
        
        Unload Me
        If genuVersion = WLB Then
            Select Case mstrFormName
                Case "frmRegister"
                    frmRegister.ReCheck gBCLBGUID, True
                Case "FrmAffirm"
                    FrmAffirm.ReCheck gBCLBGUID, ReCheckPerson
                Case "FrmAffirmLvw"
                    FrmAffirmLvw.ReCheck gBCLBGUID, ReCheckPerson
                Case Else
                    '
            End Select
        Else
            FrmBZB_Input.ReCheck gBCLBGUID, True
        End If
    End If
End Sub

Private Sub cmdModifySelection_Click()
    If ListView1.SelectedItem Is Nothing Then
        MsgBox "请选择一条记录", vbInformation, "未选择记录"
        Exit Sub
    End If
    
    If MsgBox("确定要修改客户“" & ListView1.SelectedItem.Text & "”选择的项目吗？", vbQuestion + vbOKCancel + vbDefaultButton1, "确定") = vbOK Then
        '记录复查的GUID
        gBCLBGUID = CLng(Mid(ListView1.SelectedItem.Key, 2))
        gblFuCha = True
        gBFHealthID = ListView1.SelectedItem.SubItems(1)
        gBFName = ListView1.SelectedItem.Text
        
        gJJXGuid = gBCLBGUID
        
        Unload Me
        If genuVersion = WLB Then
            Select Case mstrFormName
                Case "FrmAffirm"
                    FrmAffirm.ReCheck gBCLBGUID, ModifySelection
                Case "FrmAffirmLvw"
                    FrmAffirmLvw.ReCheck gBCLBGUID, ModifySelection
                Case Else
                    '
            End Select
        Else
            FrmBZB_Input.ReCheck gBCLBGUID, True
        End If
    End If
End Sub

Private Sub CmdNew_Click()
    gblSFBC = False
    Unload Me
End Sub

Private Sub cmdBuCha_Click()
    If ListView1.SelectedItem Is Nothing Then
        MsgBox "请选择一条记录", vbInformation, "未选择记录"
        Exit Sub
    End If
    
    If MsgBox("确定补查客户“" & ListView1.SelectedItem.Text & "”吗？", vbQuestion + vbOKCancel + vbDefaultButton1, "确定") = vbOK Then
        '记录补查的GUID
        gBCLBGUID = CLng(Mid(ListView1.SelectedItem.Key, 2))
        gblBuCha = True
        gBFHealthID = ListView1.SelectedItem.SubItems(1)
        gBFName = ListView1.SelectedItem.Text
        
        Unload Me
        If genuVersion = WLB Then
            Select Case mstrFormName
                Case "frmRegister"
                    frmRegister.ReCheck gBCLBGUID, False
                Case "FrmAffirm"
                    FrmAffirm.ReCheck gBCLBGUID, MendCheck
                Case "FrmAffirmLvw"
                    FrmAffirmLvw.ReCheck gBCLBGUID, MendCheck
                Case Else
                    '
            End Select
        Else
            FrmBZB_Input.ReCheck gBCLBGUID, False
        End If
    End If
    
    
End Sub

Private Sub ListView1_Click()
    Dim rstemp As ADODB.Recordset
    Dim strSQL As String
    
    If Me.ListView1.SelectedItem Is Nothing Then
        CmdBuCha.Enabled = False
        cmdFuCha.Enabled = False
        cmdModifySelection.Enabled = False
    Else
        '判断是否已生成总监结论，如果已有则不能补查
        Dim rs As ADODB.Recordset
        Set rs = GCon.Execute("select * from DATA_ZJJL where guid='" & Mid(ListView1.SelectedItem.Key, 2) & "'")
        If rs.RecordCount <= 0 Then
            CmdBuCha.Enabled = True
        Else
            CmdBuCha.Enabled = False
        End If
        
        cmdFuCha.Enabled = True
        
        '只有已经登记过的客户，才允许加减项
        Set rstemp = New ADODB.Recordset
        strSQL = "select QRDJ from SET_GRXX" _
                & " where GUID=" & CLng(Val(Mid(ListView1.SelectedItem.Key, 2)))
        rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
        If rstemp.RecordCount > 0 Then
            If rstemp("QRDJ") = 0 Then
                cmdModifySelection.Enabled = False
            Else
                cmdModifySelection.Enabled = True
            End If
            rstemp.Close
        Else
            cmdModifySelection.Enabled = False
        End If
    End If
End Sub

Private Sub ListView1_DblClick()
'    cmdOK_Click
End Sub

'被调函数
'参数1：主调窗体名
'参数2：查询语句的条件
Public Function ShowBCLB(ByVal strFormName As String, ByVal strCondition As String) As Boolean
On Error GoTo ErrMsg
    Dim Status
    Dim rstemp As ADODB.Recordset
    Dim rsDW As ADODB.Recordset
    Dim strSQL As String
    Dim itemX As ListItem
    Dim strOldHealthID As String '记录添加的上一个系统档案号，以便每个客户只出现一条记录
    
    '******************20040420加入 闻**************************
    '补查和复查控制
    gblBuCha = False
    gblFuCha = False
    '******************20040420加入完 闻************************
    
    '在单机版中不需处理补查，故屏蔽此按钮
    If genuVersion <> WLB Then
        Me.CmdBuCha.Visible = False
        cmdModifySelection.Visible = False
    Else
        '如果不是登记界面，不允许加减项
        If strFormName <> FrmAffirmLvw.name Then
            cmdModifySelection.Visible = False
        End If
    End If
    
    '初始化ListView1
    With Me.ListView1
        .ColumnHeaders.Add , , " 姓名 ", ListView1.Width * 1.5 / 12
        .ColumnHeaders.Add , , g_strSystemIDTitle, ListView1.Width * 2.5 / 12
        .ColumnHeaders.Add , , g_strSystemIDTitle, ListView1.Width * 2.5 / 12
        If Not g_blnSystemID Then
            .ColumnHeaders(2).Width = 0
        End If
        If Not g_blnSelfID Then
            .ColumnHeaders(3).Width = 0
        End If
        .ColumnHeaders.Add , , "性别", ListView1.Width * 1 / 12
        .ColumnHeaders.Add , , "年龄", ListView1.Width * 1 / 12
        .ColumnHeaders.Add , , "体检日期", .Width * 3 / 12
        .ColumnHeaders.Add , , "单位名称", ListView1.Width * 4 / 12
    End With
    
    '向ListView1中填入数据
    strSQL = "select distinct * from SET_GRXX where " & strCondition _
            & " order by HealthID desc,GUID desc"
    Set rstemp = New ADODB.Recordset
    rstemp.Open strSQL, GCon, adOpenForwardOnly, adLockReadOnly
    Do While Not rstemp.EOF
        If rstemp("HealthID") <> strOldHealthID Then
            Set itemX = ListView1.ListItems.Add(, HEADER & rstemp("GUID"), rstemp("YYRXM"))
            itemX.SubItems(1) = rstemp("HealthID")
            itemX.SubItems(2) = rstemp("SelfBH") & ""
            itemX.SubItems(3) = rstemp("SEX")
            itemX.SubItems(4) = rstemp("Age") & ""
            itemX.SubItems(5) = rstemp("TJRQ")
            '如果有YYID，则说明为团检客户，则加入单位名称
            itemX.SubItems(6) = GetPersonUnit(rstemp("GUID"), "")
            
            strOldHealthID = rstemp("HealthID") '记录刚添加的客户的系统档案号
        End If
        
        rstemp.MoveNext
    Loop
    
    If Me.ListView1.ListItems.Count >= 1 Then
        '选中第一条记录
        Set Me.ListView1.SelectedItem = Me.ListView1.ListItems(1)
    End If
    ListView1_Click

    mstrFormName = strFormName
    Me.Show vbModal
    
    GoTo ExitLab
    
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    '
End Function