frmtjdw.frm

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

         Left            =   165
         TabIndex        =   40
         Top             =   810
         Width           =   1575
      End
      Begin VB.Label Label1 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "联系人电子邮箱："
         Height          =   255
         Left            =   165
         TabIndex        =   37
         Top             =   2670
         Width           =   1575
      End
      Begin VB.Label Label2 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "单位名称："
         Height          =   255
         Index           =   0
         Left            =   165
         TabIndex        =   36
         Top             =   345
         Width           =   1575
      End
      Begin VB.Label Label3 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "拼音缩写："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   6975
         TabIndex        =   35
         Top             =   2835
         Visible         =   0   'False
         Width           =   1575
      End
      Begin VB.Label Label4 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "五笔缩写："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   6975
         TabIndex        =   34
         Top             =   3285
         Visible         =   0   'False
         Width           =   1575
      End
      Begin VB.Label Label5 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "单位联系人："
         Height          =   255
         Left            =   165
         TabIndex        =   33
         Top             =   1275
         Width           =   1575
      End
      Begin VB.Label Label6 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "联系人办公电话："
         Height          =   255
         Left            =   165
         TabIndex        =   32
         Top             =   1740
         Width           =   1575
      End
      Begin VB.Label Label7 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "联系人移动电话："
         Height          =   255
         Left            =   165
         TabIndex        =   31
         Top             =   2205
         Width           =   1575
      End
      Begin VB.Label Label8 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "单位负责人："
         Height          =   255
         Left            =   150
         TabIndex        =   30
         Top             =   3135
         Width           =   1575
      End
      Begin VB.Label Label9 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "负责人办公电话："
         Height          =   255
         Left            =   165
         TabIndex        =   29
         Top             =   3600
         Width           =   1575
      End
      Begin VB.Label Label10 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "负责人移动电话："
         Height          =   255
         Left            =   165
         TabIndex        =   28
         Top             =   4065
         Width           =   1575
      End
      Begin VB.Label Label11 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "联系地址："
         Height          =   255
         Left            =   180
         TabIndex        =   27
         Top             =   4530
         Width           =   1575
      End
      Begin VB.Label Label12 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "邮政编码："
         Height          =   255
         Left            =   3630
         TabIndex        =   26
         Top             =   796
         Width           =   1110
      End
      Begin VB.Label Label13 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "业务银行："
         Height          =   255
         Left            =   3630
         TabIndex        =   25
         Top             =   1262
         Width           =   1110
      End
      Begin VB.Label Label14 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "银行帐号："
         Height          =   255
         Left            =   3630
         TabIndex        =   24
         Top             =   1728
         Width           =   1110
      End
      Begin VB.Label Label15 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "企业性质："
         Height          =   255
         Left            =   3630
         TabIndex        =   23
         Top             =   2194
         Width           =   1110
      End
   End
End
Attribute VB_Name = "frmTJDW"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim menuOperation As OperationType

Private Sub lvwDWei_KeyUp(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyUp, vbKeyDown
            LvwDWei_Click
        Case Else
            '
    End Select
End Sub

Private Sub txtShortName_KeyPress(KeyAscii As Integer)
    EnterToTab KeyAscii
End Sub

Private Sub txtTDWMC_KeyPress(KeyAscii As Integer)
    EnterToTab KeyAscii
End Sub

Private Sub txtTDWMC_LostFocus()
    txtTDWMC.Text = Trim(txtTDWMC.Text)
End Sub

Private Sub cmdAdd_Click()
    ClearInput
    EnableInput True
    
    cmdAdd.Enabled = False
    cmdModify.Enabled = False
    cmdSave.Enabled = True
    cmdDelete.Enabled = False
    
    menuOperation = Add
End Sub

Private Sub cmdCancel_Click()
    Me.Hide
    Unload Me
End Sub

Private Sub cmdDelete_Click()
On Error GoTo ErrMsg
    Dim Status
    Dim strSQL As String
    Dim cmd As ADODB.Command
    Dim intIndex As Integer
    Dim rstemp As ADODB.Recordset
    Dim tmpYYID As String
    Dim rsDX As ADODB.Recordset
    

    '是否有选择
    If lvwDWei.SelectedItem Is Nothing Then
        MsgBox "请在左侧的列表里面选择要删除的单位！", vbInformation, "提示"
        GoTo ExitLab
    End If
    
    '权限控制
    If gstrClassifyID <> GManager.SystemXTGL Then
        MsgBox "只有系统管理员才有权限删除！请联系系统管理员。", vbExclamation, "提示"
        GoTo ExitLab
    End If
    
    If MsgBox("该操作不可恢复！" & vbCrLf & "确实要删除单位“" & txtTDWMC.Text & "”吗？" & vbCrLf _
                & "该操作将删除该单位的所有体检数据及有与该单位有关的所有信息！", _
            vbExclamation + vbYesNo + vbDefaultButton2, "警告") = vbNo Then GoTo ExitLab
            
    Me.MousePointer = vbHourglass
    Set cmd = New ADODB.Command
    Set cmd.ActiveConnection = GCon
    strSQL = "delete from SET_DW" _
            & " where DWID='" & Mid(lvwDWei.SelectedItem.Key, 2) & "'"
    cmd.CommandText = strSQL
    cmd.Execute
    
    strSQL = "delete from SET_DW_Append" _
            & " where DWID='" & Mid(lvwDWei.SelectedItem.Key, 2) & "'"
    cmd.CommandText = strSQL
    cmd.Execute
    
    strSQL = "delete from SET_DW_HT" _
            & " where DWID='" & Mid(lvwDWei.SelectedItem.Key, 2) & "'"
    cmd.CommandText = strSQL
    cmd.Execute
    
    '删除该单位的人员，并删除该单位人员所有体检数据
    Set rstemp = New ADODB.Recordset
    strSQL = "select * from YY_TJDJ where DWID='" & Mid(lvwDWei.SelectedItem.Key, 2) & "'"
    rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
    If rstemp.RecordCount > 0 Then
        '暂存该单位的YYID
        tmpYYID = rstemp("YYID")
        '删除该单位的预约信息
        strSQL = "delete from YY_TJDJ where DWID='" & Mid(lvwDWei.SelectedItem.Key, 2) & "'"
        cmd.CommandText = strSQL
        cmd.Execute
        '找出该单位所有人员的信息
        strSQL = "select * from SET_GRXX where YYID='" & tmpYYID & "'"
        Set rstemp = New ADODB.Recordset
        rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
        If rstemp.RecordCount > 0 Then
            rstemp.MoveFirst
            Do While Not rstemp.EOF
                Set rsDX = New ADODB.Recordset
                strSQL = "select DXPYSX from SET_DX where DXID in (select DXID from YY_SJDJDX where GUID=" & rstemp("GUID") & ")"
                rsDX.Open strSQL, GCon, adOpenStatic, adLockReadOnly
                '删除该人的体检数据
                If rsDX.RecordCount > 0 Then
                    rsDX.MoveFirst
                    Do While Not rsDX.EOF
                        strSQL = "delete from [DATA_" & rsDX("DXPYSX") & "] where GUID=" & rstemp("GUID")
                        cmd.CommandText = strSQL
                        cmd.Execute
                        rsDX.MoveNext
                    Loop
                    '删除该人所登记的项目
                    strSQL = "delete from YY_SJDJDX where GUID=" & rstemp("GUID")
                    cmd.CommandText = strSQL
                    cmd.Execute
                End If
                rstemp.MoveNext
            Loop
        End If
        '删除该单位的所有人在SET_GRXX中的数据
        strSQL = "delete from SET_GRXX where YYID='" & tmpYYID & "'"
        cmd.CommandText = strSQL
        cmd.Execute

    End If
    
    '从列表中删除