frmnewsick.frm

VB6.0编写的医院影像系统

Dim tNodex As MSComctlLib.Node
Dim rsSick As ADODB.Recordset

    sDate = Mid(sKey, 1)
    sSQL = "select sick_id,sick_no,sick_name from sick_info where checkdate='" & sDate & "'"

    Set rsSick = GDB.Execute(sSQL)
    With rsSick
    Do While Not .EOF
        Set tNodex = trvSickInfo.Nodes.Add(sKey, tvwChild, TREEKEY & CStr(rsSick!sick_id), rsSick!sick_no & " " & rsSick!sick_name, 2)
        tNodex.Tag = rsSick!sick_id
        .MoveNext
    Loop
    End With

    rsSick.Close
    Set rsSick = Nothing
    
    If Not trvSickInfo.Nodes(1).Expanded Then trvSickInfo.Nodes(1).Expanded = True
    
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If msStatus = "New" Or msStatus = "Modify" Then
        If MsgBox("确认要退出病人信息登记吗？", vbQuestion + vbYesNo, "提示") = vbYes Then
            Cancel = False
        Else
            Cancel = True
            Exit Sub
        End If
    Else
        Cancel = False
    End If
End Sub


'**********************************************************
'功    能：响应各种操作
'**********************************************************
'Private Sub tlbToolsDO(ByVal Tool As ActiveBarLibraryCtl.Tool)
'On Error GoTo err
'Dim IsSave As Boolean
'Dim NodeX As Object
'
'    Select Case Tool.Name
'        Case gACTBAR_TOOL_ADD
'            mlSickID = 0                   '表示新增单据的序号为0
'            msStatus = "New"
'            iOldOperateStatus = iOperateStatus
'            iOperateStatus = genuTktOperate.CST_TYPE_NEWADD
'
'            Call iniTkt
'            Call SetTktLocked(msStatus)
'
'            trvSickInfo.DropHighlight = trvSickInfo.SelectedItem
'            Call SetToolEnable(tlbTools, iOperateStatus, trvSickInfo.SelectedItem)
'        Case gACTBAR_TOOL_MODIFY
'            msStatus = "Modify"
'            iOldOperateStatus = iOperateStatus
'            iOperateStatus = genuTktOperate.CST_TYPE_MODIFY
'
'            txtModifyDate.Text = Format(Date, "YYYY-MM-DD")
'            Call SetTktLocked(msStatus)
'            Call SetToolEnable(tlbTools, iOperateStatus, trvSickInfo.SelectedItem)
'        Case gACTBAR_TOOL_DELETE
''            If Not CheckCurTktValid(tvwHeader, lCurTktID, lCurNodeIndex) Then Exit Sub
''            If pMsgbox("你确认要删除单据" & tvwHeader.SelectedItem.Text & "？", vbQuestion + vbYesNo) = vbNo Then
''                Exit Sub
''            End If
''            lCurTktID = IIf(Left(tvwHeader.SelectedItem.Key, Len(TREEKEY)) <> TREEKEY, 0, CLng(tvwHeader.SelectedItem.Tag))
''            iOldOperateStatus = iOperateStatus
''            iOperateStatus = genuTktOperate.CST_TYPE_DELETE
''            If DoEditTkt(iOperateStatus, lCurTktID) Then
''                Call SaveInTkt(iOperateStatus, lCurTktID, cTkt, Me.spdDetail)
''                iOldOperateStatus = iOperateStatus
''                iOperateStatus = genuTktOperate.CST_TYPE_INIT
''                Call SetOperateTktDtl(iOperateStatus)
''            Else
''                iOperateStatus = iOldOperateStatus
''            End If
''            Call SetToolEnable(tlbTools, iOperateStatus, tvwHeader.SelectedItem)
'        Case gACTBAR_TOOL_SAVE
''            RefreshDataBeforeSave spdDetail
''            tlbTools.SetFocus
''
''            If iOperateStatus <> genuTktOperate.CST_TYPE_NEWADD Then
'            If Not CheckTktValid Then Exit Sub
''            End If
''            IsSave = False
'
'            Call SaveTktInfo
'
''            iOldOperateStatus = iOperateStatus
''            iOperateStatus = genuTktOperate.CST_TYPE_SAVE
'            Call SetTktLocked(msStatus)
'            Call SetToolEnable(tlbTools, iOperateStatus, trvSickInfo.SelectedItem)
'            trvSickInfo.Enabled = True
'
'
'        Case gACTBAR_TOOL_CANCEL
'            iOldOperateStatus = iOperateStatus
'            iOperateStatus = genuTktOperate.CST_TYPE_CANCEL
'            If Trim(txtCode.Text) <> "" Or Trim(txtName.Text) <> "" Then
'                If MsgBox("你确认要取消新增吗？", vbQuestion + vbYesNo, "取消内容") = vbNo Then
'                    Exit Sub
'                End If
'            End If
'            Call CancelOperate
'            Call SetToolEnable(tlbTools, iOperateStatus, trvSickInfo.SelectedItem)
'        Case gACTBAR_TOOL_EXIT
'            Unload Me
'    End Select
'
'
'    Exit Sub
'err:
'    iOperateStatus = iOldOperateStatus
'    Call SetToolEnable(tlbTools, iOperateStatus, trvSickInfo.SelectedItem)
'
'End Sub

Private Function CheckTktValid() As Boolean
    
    CheckTktValid = False
    If Trim(txtCode.Text) = "" Or Trim(txtName.Text) = "" Then
        Exit Function
    End If
    CheckTktValid = True

End Function
Private Sub CancelOperate()
    
    msStatus = "Init"
    iniTkt
    SetTktLocked (msStatus)
    
End Sub
''*********************************************************
''功    能：使ActiveBar上所有的Tool都可以使用（即有效）
''修改日期：2002.09.11
''**********************************************************
'Public Sub SetAllToolEnable(ByRef cActiveBar As cTktTlbControl, Optional ByVal IsEnable As Boolean = True)
'On Error GoTo err
'
'    With cActiveBar
'        .tlAddNewEnable = IsEnable
'        .tlCancelEnable = IsEnable
'        .tlDeleteEnable = IsEnable
'        .tlExitEnable = IsEnable
'        .tlModifyEnable = IsEnable
'        .tlSaveEnable = IsEnable
'        .tlFindVisible = False
'        .tlInformationVisible = False
'        .tlPreviewVisible = False
'        .tlPrintVisible = False
'    End With
'
'    Exit Sub
'err:
'    err.Raise err.Number, err.Source, err.Description
'End Sub
'
'
''**********************************************************
''功    能：设置ActiveBar 上的各个Tool的Enable的值
''参    数：gOperateType =当前操作类型
''           trvNode = 树节点
''           sRight=操作员权限,具体实现待定
''修改日期：2002.09.11
''**********************************************************
'Public Sub SetToolEnable(ByRef cActiveBar As cTktTlbControl, ByVal gOperateType As genuTktOperate, _
'                ByVal trvNode As Node, Optional ByVal sRight As String = "")
'On Error GoTo err
'
'    Call SetAllToolEnable(cActiveBar, True)
'    With cActiveBar
'        Select Case gOperateType
'            Case genuTktOperate.CST_TYPE_INIT              '单据初始化操作状态
'                .tlAddNewEnable = True
'                .tlModifyEnable = False
'                .tlDeleteEnable = False
'                .tlCancelEnable = False
'                .tlSaveEnable = False
'                .tlExitEnable = True
'            Case genuTktOperate.CST_TYPE_CANCEL             '单据取消当前操作状态
'                .tlAddNewEnable = True
'                .tlModifyEnable = False
'                .tlDeleteEnable = False
'                .tlCancelEnable = False
'                .tlSaveEnable = False
'                .tlExitEnable = True
'            Case genuTktOperate.CST_TYPE_INFO              '单据删除状态
'                .tlAddNewEnable = True
'                .tlModifyEnable = True
'                .tlDeleteEnable = True
'                .tlCancelEnable = False
'                .tlSaveEnable = False
'                .tlExitEnable = True
'            Case genuTktOperate.CST_TYPE_DELETE             '单据删除状态
'                .tlAddNewEnable = False
'                .tlModifyEnable = False
'                .tlDeleteEnable = True
'                .tlCancelEnable = False
'                .tlSaveEnable = False
'                .tlExitEnable = True
'            Case genuTktOperate.CST_TYPE_MODIFY             '单据修改状态
'                .tlAddNewEnable = False
'                .tlModifyEnable = False
'                .tlDeleteEnable = False
'                .tlCancelEnable = True
'                .tlSaveEnable = True
'                .tlExitEnable = False
'            Case genuTktOperate.CST_TYPE_NEWADD             '单据新增状态
'                .tlAddNewEnable = False
'                .tlModifyEnable = False
'                .tlDeleteEnable = False
'                .tlCancelEnable = True
'                .tlSaveEnable = True
'                .tlExitEnable = False
'             Case genuTktOperate.CST_TYPE_CANCEL              '单据新增状态
'                .tlAddNewEnable = True
'                .tlModifyEnable = False
'                .tlDeleteEnable = False
'                .tlCancelEnable = False
'                .tlSaveEnable = False
'                .tlExitEnable = True
'            Case genuTktOperate.CST_TYPE_SAVE               '单据保存当前操作状态
'                ToolEnableByStatus cActiveBar, trvNode, gACTBAR_TOOL_ADD
'                ToolEnableByStatus cActiveBar, trvNode, gACTBAR_TOOL_CANCEL
'                ToolEnableByStatus cActiveBar, trvNode, gACTBAR_TOOL_DELETE
'                ToolEnableByStatus cActiveBar, trvNode, gACTBAR_TOOL_MODIFY
'                ToolEnableByStatus cActiveBar, trvNode, gACTBAR_TOOL_SAVE
'                .tlExitEnable = True
'        End Select
'        .InitTools
'    End With
'
'    Exit Sub
'err:
'    err.Raise err.Number, err.Source, err.Description
'End Sub


Private Sub SetSickInfo(ByVal lSickID As Long)
Dim sSQL As String
Dim i As Long
Dim rsSickInfo As ADODB.Recordset

    sSQL = "select * from sick_info where sick_id=" & lSickID
    Set rsSickInfo = GDB.Execute(sSQL)
    With rsSickInfo
    Do While Not .EOF
        txtCode.Text = rsSickInfo!sick_no
        txtName.Text = rsSickInfo!sick_name
        txtCheckDate.Text = Format(rsSickInfo!CheckDate, "YYYY-MM-DD")
        txtModifyDate.Text = Format(rsSickInfo!ModifyDate, "YYYY-MM-DD")
        DTPicker1.Value = rsSickInfo!sick_birth
        For i = 0 To Combo1.ListCount - 1
            Combo1.ListIndex = i
            If Combo1.Text = rsSickInfo!sick_class Then
                Exit For
            End If
        Next i
        
        For i = 0 To Combo2.ListCount - 1
            Combo2.ListIndex = i
            If Combo2.ItemData(i) = rsSickInfo!sick_sex Then
                Exit For
            End If
        Next i
        
        RichTextBox1.Text = rsSickInfo!sick_unit
        RichTextBox2.Text = rsSickInfo!sick_family
        
        .MoveNext
    Loop
    End With
    
    rsSickInfo.Close
    Set rsSickInfo = Nothing

End Sub

Private Sub trvSickInfo_Click()
Dim NodeX As MSComctlLib.Node

    Set NodeX = trvSickInfo.SelectedItem
    Select Case Left(NodeX.Key, 1)
        Case TREEKEY
            msStatus = "Init"
            mlSickID = NodeX.Tag
            iOperateStatus = genuTktOperate.CST_TYPE_INFO
            Call SetSickInfo(mlSickID)
            Call SetTktLocked(msStatus)
        Case Else
            iOperateStatus = genuTktOperate.CST_TYPE_INIT
    End Select
    
    trvSickInfo.DropHighlight = trvSickInfo.SelectedItem
    Call SetToolEnable(tlbTools, iOperateStatus, NodeX)

End Sub

Private Sub trvSickInfo_NodeClick(ByVal Node As MSComctlLib.Node)
    Call trvSickInfo_Click
End Sub

Private Sub txtcode_KeyDown(KeyCode As Integer, Shift As Integer)

    EnterToTab KeyCode
    
End Sub

Private Sub txtCode_LostFocus()
Dim sSQL As String
Dim sCode As String
Dim rs As ADODB.Recordset

    sCode = Trim(txtCode.Text)
    sSQL = "select * from sick_info where sick_no='" & sCode & "'"
    Set rs = GDB.Execute(sSQL)
    With rs
    If Not .EOF Then
        MsgBox "该病人号码已存在！", vbCritical + vbOKOnly, "提示"
    End If
    End With
        
    rs.Close
    Set rs = Nothing
    
End Sub

Private Sub txtname_KeyDown(KeyCode As Integer, Shift As Integer)

    EnterToTab KeyCode
    
End Sub