frmsubleft.frm

1、以DLL形式提供医生工作站 2、 根据【检查项目】

      _ExtentY        =   847
      _Version        =   393216
   End
End
Attribute VB_Name = "frmSubLeft"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'------------------------------------------------------------------------------------
'文件：frmSubLeft.frm
'作者：刘辉
'时间：2008-4-8
'说明：列表---子窗体
'------------------------------------------------------------------------------------
Option Explicit
 
Const HELP_FILE_NAME = "PACSHelp.chm"
Const CONFIG_EXE = "HT-CONFIG.exe"

Private Const SW_SHOW = 5

Private Sub btnBespeakRegister_Click(Shifit As Integer)
On Error GoTo ErrHandler
'    Load frmDrReg
'    frmDrReg.Show
'    frmDrReg.SetFocus
    Exit Sub
ErrHandler:
End Sub

'检查清单
Private Sub btnCheckList_Click(Shifit As Integer)
    On Error GoTo ErrHandler
    CHECK_LIST_SELECT = False
    'frmCheckList.Show
    Unload frmCheckList
    frmCheckList.SetFocus
    UploadOperation btnCheckList.Caption
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
End Sub
'模板管理
Private Sub btnEditTemplate_Click(Shifit As Integer)
    On Error GoTo ErrHandler
    'If USER_POWER <> POWER_DEPARTMENT_LEADER Then 'And USER_POWER <> POWER_ADMIN Then
    '    MsgBox "您没有维护的权限！", vbExclamation, "提示"
    '    Exit Sub
    'End If
    
    frmEditTemplate.SetFocus
    
     UploadOperation btnEditTemplate.Caption
ErrHandler:
    Debug.Print Err.Description
End Sub

Private Sub btnEixt_Click(Shifit As Integer)
On Error GoTo ErrHandler

    If MsgBox("您确认退出吗?", vbYesNo Or vbQuestion, "提示") = vbNo Then
        Exit Sub
    End If

    
'begin====停止接收服务===frmMdiMainUnload=========================================================

    Dim nRtn As Integer
    nRtn = ShellExecute(0, "open", modProgramEntry.KILL_EXE, modProgramEntry.HTSCP_EXE, App.Path, vbHide)
    If nRtn > 32 Then
    Else
        MsgBox "接收服务关闭失败!", vbExclamation, "提示"
    End If
    
'end====停止接收服务============================================================
    
    
    
    
    End
        Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
    End
End Sub
Private Sub btnHelp_Click(Shifit As Integer)
On Error GoTo ErrHandler

    Dim nRet As Long
    nRet = ShellExecute(0&, "open", "hh.exe", HELP_FILE_NAME, App.Path, 1)
    
    Exit Sub
    
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
End Sub



'按钮事件----注销
Private Sub btnLogoff_Click(Shifit As Integer)
    On Error GoTo ErrHandler
    Call LogOff
    
    
    Exit Sub
ErrHandler:
    
    
End Sub

Private Sub btnMaintainRegister_Click(Shifit As Integer)
On Error GoTo ErrHandler
     
     
     If USER_POWER <> POWER_DEPARTMENT_LEADER Then 'And USER_POWER <> POWER_ADMIN Then
        MsgBox "您没有维护的权限！", vbExclamation, "提示"
        Exit Sub
    End If
    'frmMaintain.Show
    'frmMaintain.SetFocus
    
    'UploadOperation btnRegister.Caption
    
    
    Exit Sub
    
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"

End Sub

'报告列表
Private Sub btnReportList_Click(Shifit As Integer)
On Error GoTo ErrHandler
    
    
    Exit Sub
    
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
End Sub

Private Sub btnStoreFile_Click(Shifit As Integer)
    On Error GoTo ErrHandler
    
    'frmRecordCD.Show vbModal
    
    Exit Sub
ErrHandler:
    
End Sub

Private Sub btnSystemConfig_Click(Shifit As Integer)
On Error GoTo ErrHandler

    
    
    If USER_POWER <> POWER_ADMIN And USER_POWER <> POWER_DEPARTMENT_LEADER Then
        MsgBox "您没有权限！", vbExclamation, "提示"
        Exit Sub
    End If
    frmConfig.Show
    frmConfig.SetFocus
    
'    Dim nRtn As Long
'
'    Dim hwndConfig As Long
'    'hwndConfig = FindWindow(0&, "HT-PACS配置程序")
'    'hwndConfig = FindWindow(vbNullString, "HT-CONFIG")
'    'Call ShowWindow(hwndConfig, 3)
'
'
'
'    Dim strProcessFullPath As String
'    Dim nProcessCount As Long
'    Dim nProcessId As Long
'    nProcessCount = MyEnumProcess(CONFIG_EXE, nProcessId, strProcessFullPath)
'    If nProcessCount >= 1 Then
'        nRtn = ShellExecute(0, "open", KILL_EXE, CONFIG_EXE, App.Path, vbHide)
'        If nRtn > 32 Then
'        Else
'            MsgBox "配置程序启动失败！", vbExclamation, "提示"
'            End
'        End If
'
'        Pause 500
'
'    Else
'
'    End If
'
'    nRtn = ShellExecute(0, "open", modProgramEntry.HTCONFIG, "", App.Path, vbHide)
'        If nRtn > 32 Then
'        Else
'            MsgBox "系统配置服务启动失败!", vbExclamation, "提示"
'        End If
'


    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
End Sub

Private Sub Form_Load()
On Error GoTo ErrHandler
    Me.Height = RIGHT_WINDOW_HEIGHT - 80
    frmGroupBotton.Height = Me.Height
    Exit Sub
ErrHandler:
End Sub


'系统维护
Private Sub btnSystemMaintenance_Click(Shifit As Integer)
On Error GoTo ErrHandler
    frmSystemMaintain.SetFocus
    
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
End Sub



Private Function LogOff() As Boolean
    'USER_ID  USER_NAME            USER_DISPLAY_NAME     USER_POWER
    'DEPARTMENT_ID    DEPARTMENT_POWER
On Error GoTo ErrHandler
        USER_ID = -1
        USER_NAME = ""
        USER_DISPLAY_NAME = ""
        USER_POWER = -1
        
        Unload frmSystemMaintain
        Unload frmEditTemplate
        
        
        frmMdiMain.lblUser.Caption = USER_DISPLAY_NAME
        frmMdiMain.lblIdentity.Caption = ""
        
        'frmRecordEdit.lblUser.Caption = USER_DISPLAY_NAME
        'frmRecordEdit.lblIdentity.Caption = ""
        
        
        'DEPARTMENT_ID = -1
        'DEPARTMENT_POWER = -1
        frmLogout.Show vbModal
        
        IF_LOGON = False
        
        
        LogOff = True
    Exit Function
    
ErrHandler:
    
End Function