⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmaffirmname.frm

📁 本系统可用于医院和专业体检中心的健康体检管理
💻 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 FrmAffirmName 
   BackColor       =   &H80000018&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "姓名确认"
   ClientHeight    =   4995
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   9000
   Icon            =   "FrmAffirmName.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4995
   ScaleWidth      =   9000
   StartUpPosition =   1  'CenterOwner
   Begin MSComctlLib.ListView ListView1 
      Height          =   3825
      Left            =   60
      TabIndex        =   0
      Top             =   240
      Width           =   8895
      _ExtentX        =   15690
      _ExtentY        =   6747
      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 CmdAffirm 
      Height          =   435
      Left            =   2610
      TabIndex        =   1
      Top             =   4260
      Width           =   1245
      _ExtentX        =   2196
      _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 CmdCancel 
      Height          =   435
      Left            =   4890
      TabIndex        =   2
      Top             =   4260
      Width           =   1245
      _ExtentX        =   2196
      _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
End
Attribute VB_Name = "FrmAffirmName"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub CmdAffirm_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 = ListView1.SelectedItem.SubItems(5)
'        gblFuCha = True
'        gBFHealthID = ListView1.SelectedItem.SubItems(1)
'        gBFName = ListView1.SelectedItem.Text
        
        Unload Me
        If genuVersion = WLB Then
            FrmAffirm.ReCheck gBCLBGUID, True
        Else
'            FrmBZB_Input.ReCheck gBCLBGUID, True
        End If
    End If
    

End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Dim rsTemp As ADODB.Recordset
    Dim rsTemp1 As ADODB.Recordset
    
    Dim strSQL As String
    Dim strDWID As String
    
    Dim itemX As ListItem
    
'    '******************20040420加入 闻**************************
'    '补查和复查控制
'    gblBuCha = False
'    gblFuCha = False
'    '******************20040420加入完 闻************************
'
'    '******************20040618加入 闻**************************
'    '在单机版中不需处理补查,故屏蔽此按钮
'    If genuVersion <> WLB Then
'        Me.CmdBuCha.Visible = False
'    End If
'    '******************20040618加入完 闻************************
    
    '初始化ListView1
    ListView1.ColumnHeaders.Add , , " 姓名 ", ListView1.Width * 1.5 / 12
    ListView1.ColumnHeaders.Add , , "档案号", ListView1.Width * 2.5 / 12
    ListView1.ColumnHeaders.Add , , "性别", ListView1.Width * 1 / 12
    ListView1.ColumnHeaders.Add , , "年龄", ListView1.Width * 1 / 12
    ListView1.ColumnHeaders.Add , , "单位名称", ListView1.Width * 6 / 12
    ListView1.ColumnHeaders.Add , , "GUID", ListView1.Width * 0 / 12

      
    ListView1.View = lvwReport
    ListView1.FullRowSelect = True
   ' ListView1.GridLines = True
    ListView1.LabelEdit = lvwManual
    
    '向ListView1中填入数据
    Set rsTemp = New ADODB.Recordset
    Set rsTemp1 = New ADODB.Recordset
    
    If gintBCLBSource = 0 Then '如果是从姓名来则
        strSQL = "select * from SET_GRXX where YYRXM like '%" & gBCLBName & "%'"
    ElseIf gintBCLBSource = 1 Then '档案号
        strSQL = "select * from SET_GRXX where HealthID='" & gBCLBHealthID & "'"
    Else '身份证号
        strSQL = "select * from SET_GRXX where YYRSFZH like '%" & gBCLBName & "%'"
    End If
    rsTemp.Open strSQL, GCon, adOpenDynamic, adLockReadOnly
    rsTemp.MoveFirst
    Do While Not rsTemp.EOF
        Set itemX = ListView1.ListItems.Add(, , rsTemp.Fields("YYRXM"))
        itemX.SubItems(1) = rsTemp.Fields("HealthID")
        itemX.SubItems(2) = rsTemp.Fields("SEX")
        itemX.SubItems(3) = rsTemp.Fields("Age")
        '如果有YYID,则说明为团检客户,则加入单位名称
        If IsNull(rsTemp.Fields("YYID")) = False Then
            rsTemp1.Open "select DWID from YY_TJDJ WHERE YYID='" & rsTemp.Fields("YYID") & "'", GCon, adOpenDynamic, adLockReadOnly
            strDWID = rsTemp1.Fields("DWID")
            rsTemp1.Close
            rsTemp1.Open "select * from SET_DW where DWID='" & strDWID & "'", GCon, adOpenDynamic, adLockOptimistic
            itemX.SubItems(4) = rsTemp1.Fields("DWMC")
            rsTemp1.Close
        End If
        itemX.SubItems(5) = rsTemp.Fields("GUID")
        rsTemp.MoveNext
        
        '选中第一条记录
        Set Me.ListView1.SelectedItem = Me.ListView1.ListItems(1)
        ListView1_Click
    Loop
End Sub

Private Sub ListView1_Click()
    If ListView1.ListItems.Count > 0 Then
        gBCLBGUID = ListView1.SelectedItem.SubItems(5)
    End If
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -