formemployeechange.frm

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

                    
                    '未选择科室
                    If intIndex = -1 Then
                        MsgBox "请选择“" & TextName.Text & "”所管理的科室！", vbInformation, "提示"
                        .SetFocus
                        GoTo ExitLab
                    End If
                    
                    '已选择科室
                    rsAddEmployee("KSID") = LongToString(.ItemData(intIndex), 2)
                End With
            ElseIf CmbJS.ItemData(CmbJS.ListIndex) = Val(GManager.SysTemCJYS) Then
                '首先判断用户是否选择了科室
                With lstKeShi
                    intIndex = -1
                    For i = 0 To .ListCount - 1
                        If .Selected(i) = True Then
                            intIndex = i
                            ksTemp = ksTemp & "," & LongToString(.ItemData(i), 2)
'                            Exit For
                        End If
                    Next
                    ksTemp = Right(ksTemp, Len(ksTemp) - 1)
                    '未选择科室
                    If intIndex = -1 Then
                        MsgBox "请选择“" & TextName.Text & "”所管理的科室！", vbInformation, "提示"
                        .SetFocus
                        GoTo ExitLab
                    End If
                    
                    '已选择科室
                    rsAddEmployee("KSID") = ksTemp 'LongToString(.ItemData(intIndex), 2)
                End With

            Else
                rsAddEmployee("KSID") = ""
            End If
            '*****************************************************
            '*****************************************************
            
            If (OptionMale.Value = True) Then
                rsAddEmployee("Sex") = "男"
            Else
                rsAddEmployee("Sex") = "女"
            End If
            If DTPZZSJ.Value <> "" Then
                rsAddEmployee("ZZSJ") = DTPZZSJ.Value
            Else
                rsAddEmployee("ZZSJ") = Null
            End If
            If TextTelphoneHome.Text <> "" Then
                rsAddEmployee("TelphoneHome") = TextTelphoneHome.Text
            Else
                rsAddEmployee("TelphoneHome") = Null
            End If
            If TextTelphoneMobile.Text <> "" Then
                rsAddEmployee("TelphoneMobile") = TextTelphoneMobile.Text
            Else
                rsAddEmployee("TelphoneMobile") = Null
            End If
            If TextAddress.Text <> "" Then
                rsAddEmployee("Address") = TextAddress.Text
            Else
                rsAddEmployee("Address") = Null
            End If
            
            rsAddEmployee("JSID") = CmbJS.ItemData(CmbJS.ListIndex)
            
            rsAddEmployee("Password") = TextPassword.Text
            rsAddEmployee("EmployeeID") = MAXID
            GoSub WriteSign
            rsAddEmployee.Update
            rsAddEmployee.Close
            Set rsAddEmployee = Nothing
            
            '添加到左侧的列表
            Set itmTemp = lvwEmployee.ListItems.Add(, "W" & MAXID, TextName.Text)
'            itmTemp.SubItems(1) = cmbClassify.Text

             '***************20040531加入 闻*********************
            strSQL = "select JSID,JSMC from SET_JS_Index where JSID=" & CmbJS.ItemData(CmbJS.ListIndex)
            Set rsChange = New ADODB.Recordset
            rsChange.Open strSQL, GCon, adOpenStatic, adLockReadOnly
            itmTemp.SubItems(1) = rsChange("JSMC")
            '***************20040531加入 闻*********************
            
           Set lvwEmployee.SelectedItem = itmTemp
            
            'Unload FormInsertEmployee
            'Set FormInsertEmployee = Nothing
             
            '重新打开记录集
'            rsTemp.Close
'            rsTemp.Open "SELECT * FROM RY_Employee", GCon, 3, 3
'            rsTemp.Find "EmployeeID=" & MAXID
            CommandDelete.Enabled = True
        Else
'            ClearAllInput
'            rsTemp.Close
'            rsTemp.Open "select * from RY_Employee", GCon, 3, 3
'            rsTemp.MoveFirst
'            SaveDirect = "SEE"
'            DisplayEmployee
        End If
    Else
        '****************************************************************
        '修改用户
        '****************************************************************
        '首先取得当前选择客户的记录集
        strSQL = "select * from RY_Employee" _
                & " where EmployeeID=" _
                & Val(Mid(lvwEmployee.SelectedItem.Key, 2))
        Set rstemp = New ADODB.Recordset
        rstemp.Open strSQL, GCon, adOpenKeyset, adLockOptimistic
        
        '修改时检查用户名是否被修改
        If rstemp("Name") <> TextName.Text Then
            '如果不同，检查修改后的名字是否已经存在
            strSQL = "select Count(*) from RY_Employee" _
                    & " where Name='" & TextName.Text & "'"
            Set rsGetRows = New ADODB.Recordset
            rsGetRows.Open strSQL, GCon, adOpenForwardOnly, adLockReadOnly
            If rsGetRows(0) >= 1 Then
                MsgBox "该用户已经存在，请核对后重新输入！", vbInformation, "提示"
                TextName.SetFocus
                GoTo ExitLab
            End If
            rsGetRows.Close
        End If
        
        rstemp("Name") = TextName.Text
    
        If (CStr(DTPBorn.Value) <> "") Then
            rstemp("Born") = DTPBorn.Value
        Else
            rstemp("Born") = Null
        End If
        
        rstemp("ZhiWu") = ComboZhiWu.Text 'LongToString(ComboZhiWu.ItemData(ComboZhiWu.ListIndex), 2)
        
        '********************20040530加入 闻******************
        '*****************************************************
        '角色
        '*****************************************************
        rstemp("JSID") = CmbJS.ItemData(CmbJS.ListIndex)
        If LongToString(CmbJS.ItemData(CmbJS.ListIndex), 2) = GManager.SystemKSYS Then   '如果是科室医生
            '首先判断用户是否选择了科室
            With lstKeShi
                intIndex = -1
                For i = 0 To .ListCount - 1
                    If .Selected(i) = True Then
                        intIndex = i
                        Exit For
                    End If
                Next
                
                '未选择科室
                If intIndex = -1 Then
                    MsgBox "请选择“" & TextName.Text & "”所管理的科室！", vbInformation, "提示"
                    .SetFocus
                    GoTo ExitLab
                End If
                
                '已选择科室
                rstemp("KSID") = LongToString(.ItemData(intIndex), 2)
            End With
            
        ElseIf LongToString(CmbJS.ItemData(CmbJS.ListIndex), 2) = GManager.SysTemCJYS Then
            '首先判断用户是否选择了科室
            With lstKeShi
                intIndex = -1
                For i = 0 To .ListCount - 1
                    If .Selected(i) = True Then
                        intIndex = i
                        ksTemp = ksTemp & "," & LongToString(.ItemData(i), 2)
'                        Exit For
                    End If
                Next
                ksTemp = Right(ksTemp, Len(ksTemp) - 1)
                
                '未选择科室
                If intIndex = -1 Then
                    MsgBox "请选择“" & TextName.Text & "”所管理的科室！", vbInformation, "提示"
                    .SetFocus
                    GoTo ExitLab
                End If
                
                '已选择科室
                rstemp("KSID") = ksTemp ' LongToString(.ItemData(intIndex), 2)
            End With

        Else
            rstemp("KSID") = ""
        End If
        '*****************************************************
        '*****************************************************
        '********************20040530加入完 闻******************
        
        '*****************************************************
        '管理类别
        '*****************************************************
'        rsTemp("Rank") = LongToString(cmbClassify.ItemData(cmbClassify.ListIndex), 2)
'        If cmbClassify.ItemData(cmbClassify.ListIndex) = Val(GManager.SystemKSYS) Then
        rstemp("Rank") = LongToString(CmbJS.ItemData(CmbJS.ListIndex), 2)
'        If CmbJS.ItemData(CmbJS.ListIndex) = Val(GManager.SystemKSYS) Then
'            '首先判断用户是否选择了科室
'            With lstKeShi
'                intIndex = -1
'                For i = 0 To .ListCount - 1
'                    If .Selected(i) = True Then
'                        intIndex = i
'                        Exit For
'                    End If
'                Next
'
'                '未选择科室
'                If intIndex = -1 Then
'                    MsgBox "请选择“" & TextName.Text & "”所管理的科室！", vbInformation, "提示"
'                    .SetFocus
'                    GoTo ExitLab
'                End If
'
'                '已选择科室
'                rstemp("KSID") = LongToString(.ItemData(intIndex), 2)
'            End With
'        Else
'            rstemp("KSID") = ""
'        End If
        '*****************************************************
        '*****************************************************
        
        
        If (OptionMale.Value = True) Then
            rstemp("Sex") = "男"
        Else
            rstemp("Sex") = "女"
        End If
        If (DTPZZSJ.Value <> "") Then
            rstemp("ZZSJ") = DTPZZSJ.Value
        Else
            rstemp("ZZSJ") = ""
        End If
        If TextTelphoneHome.Text <> "" Then
            rstemp("TelphoneHome") = TextTelphoneHome.Text
        Else
            rstemp("TelphoneHome") = ""
        End If
        If TextTelphoneMobile.Text <> "" Then
            rstemp("TelphoneMobile") = TextTelphoneMobile.Text
        Else
            rstemp("TelphoneMobile") = ""
        End If
        If TextAddress.Text <> "" Then
            rstemp("Address") = TextAddress.Text
        Else
            rstemp("Address") = ""
        End If
        
        rstemp("Password") = TextPassword.Text
        
        If MsgBox("确定修改吗?", vbQuestion + vbOKCancel, "是否确定") = vbOK Then
'            GoSub WriteSign
            rstemp.Update
            rstemp.Close
            '写入签名
            strSQL = "select EmployeeID,Sign from RY_Employee" _
                    & " where EmployeeID=" _
                    & Val(Mid(lvwEmployee.SelectedItem.Key, 2))
            Set rstemp = New ADODB.Recordset
            rstemp.Open strSQL, GCon, adOpenDynamic, adLockOptimistic
            GoSub WriteSign
            If strTempFile <> "" Then
                rstemp.Update
            Else
                rstemp.Close
            End If
            
            '更新左侧的列表
            lvwEmployee.SelectedItem.Text = TextName.Text
'            lvwEmployee.SelectedItem.SubItems(1) = cmbClassify.Text
            '***************20040531加入 闻*********************
            strSQL = "select JSID,JSMC from SET_JS_Index where JSID=" & CmbJS.ItemData(CmbJS.ListIndex)
            Set rsChange = New ADODB.Recordset
            rsChange.Open strSQL, GCon, adOpenStatic, adLockReadOnly
            lvwEmployee.SelectedItem.SubItems(1) = rsChange("JSMC")
            '***************20040531加入 闻*********************
        Else
            'rs.Close
'            'cn.Close
'            Set rsTemp = Nothing
'            Set cn = Nothing
        End If
    End If
    
    EnableInput False
    lvwEmployee_Click
    lstKeShi.Enabled = False
    GoTo ExitLab
'写入签名
WriteSign:
    If imgSign.PICTURE <> 0 Then
        strTempFile = GetTempPathW & "Sign.jpg"
        If Dir(strTempFile) <> "" Then Kill strTempFile
        SavePicture imgSign.PICTURE, strTempFile
        If menuOperation = Add Then
            Call FileToColumn(rsAddEmployee("Sign"), strTempFile)
        Else
            Call FileToColumn(rstemp("Sign"), strTempFile)
        End If
    End If
    Return
   
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Me.MousePointer = vbDefault
End Sub

Private Sub Form_Load()
On Error GoTo ErrMsg
    Dim Status
    Dim strSQL As String
    Dim strNull As String
    Dim rsEmployee As ADODB.Recordset
    Dim itmTemp As ListItem
    Dim rstemp As ADODB.Recordset
    Dim i As Integer
    
    Screen.MousePointer = vbArrowHourglass
  
  
      '判断RY_Employee表KSID字段长度，小于250则修改为250
    Dim rs As ADODB.Recordset
    Set rs = GCon.Execute("select col_length('RY_Employee','KSID')")
    If rs.Fields(0) < 250 Then
        GCon.Execute "ALTER TABLE RY_Employee ALTER COLUMN KSID varchar(250)"
        
        GCon.Execute "delete from  set_js_index"
        GCon.Execute "insert into  set_js_index(jsid,jsmc) values('1','系统管理员')"
        GCon.Execute "insert into  set_js_index(jsid,jsmc) values('2','超级医生')"
        GCon.Execute "insert into  set_js_index(jsid,jsmc) values('3','科室医生')"
        GCon.Execute "insert into  set_js_index(jsid,jsmc) values('4','录入员')"
                
        GCon.Execute "update  RY_Employee set jsid='' where jsid>4"
        MsgBox "由于对系统预设的角色进行了重新定义，请重新定义现有用户的角色！", vbInformation, "重要提示"
    End If
    Set rs = Nothing

    '获取科室设置
    strSQL = "select * from SET_KSSZ order by ksmc"
    Set rstemp = New ADODB.Recordset
    rstemp.Open strSQL, GCon, adOpenForwardOnly, adLockReadOnly
    If rstemp.EOF Then
        MsgBox "数据库遭到损坏，请与" & g_strDevelopCompany & "软件科技有限公司联系！", vbExclamation, "提示"
        GoTo ExitLab
    End If
    '加载科室
    Do
        lstKeShi.AddItem rstemp("KSMC")
        lstKeShi.ItemData(lstKeShi.NewIndex) = rstemp("KSID")
        rstemp.MoveNext
    Loop Until rstemp.EOF
    rstemp.Close
  
    '获取管理级别
    strSQL = "select * from Classifys"
    Set rstemp = New ADODB.Recordset
    rstemp.Open strSQL, GCon, adOpenForwardOnly, adLockReadOnly
    If rstemp.EOF Then
        MsgBox "数据库遭到损坏，请与" & g_strDevelopCompany & "软件科技有限公司联系！", vbExclamation, "提示"
        GoTo ExitLab
    End If
    '加载管理级别
    Do
        cmbClassify.AddItem rstemp("ClassifyName")
        cmbClassify.ItemData(cmbClassify.NewIndex) = rstemp("ClassifyID")
        rstemp.MoveNext
    Loop Until rstemp.EOF
    rstemp.Close
    
    '*************************20040530加入 闻**************************
    '加载角色
    Set rstemp = New ADODB.Recordset
    strSQL = "select * from SET_JS_Index order by jsid"
    rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
    CmbJS.AddItem ""
    CmbJS.ItemData(CmbJS.NewIndex) = 0
    If rstemp.RecordCount > 0 Then
        rstemp.MoveFirst
        Do While Not rstemp.EOF
            CmbJS.AddItem rstemp("JSMC")
            CmbJS.ItemData(CmbJS.NewIndex) = rstemp("JSID")