frmnewsick.frm

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

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmNewSick 
   Caption         =   "病人信息管理"
   ClientHeight    =   8460
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   11610
   ClipControls    =   0   'False
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   9.75
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   OLEDropMode     =   1  'Manual
   ScaleHeight     =   8460
   ScaleWidth      =   11610
   WindowState     =   2  'Maximized
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   9120
      Top             =   3720
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   2
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmNewSick.frx":0000
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmNewSick.frx":0452
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.TreeView trvSickInfo 
      Height          =   7215
      Left            =   0
      TabIndex        =   0
      Top             =   720
      Width           =   2295
      _ExtentX        =   4048
      _ExtentY        =   12726
      _Version        =   393217
      Indentation     =   265
      LabelEdit       =   1
      Sorted          =   -1  'True
      Style           =   7
      SingleSel       =   -1  'True
      ImageList       =   "ImageList1"
      BorderStyle     =   1
      Appearance      =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
End
Attribute VB_Name = "frmNewSick"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private mlSickID As Long
Private msStatus As String

Private Sub iniTkt()
    
    mlSickID = 0
    txtCode.Text = ""
    txtName = ""
    txtCheckDate.Text = Format(Date, "YYYY-MM-DD")
    txtModifyDate.Text = Format(Date, "YYYY-MM-DD")
    DTPicker1.Value = "1980-01-01"
    Combo1.ListIndex = 0
    Combo2.ListIndex = 0
    
    RichTextBox1.Text = ""
    RichTextBox2.Text = ""

End Sub

Private Sub SetTktLocked(ByVal msStatus As String)
    
    Select Case msStatus
        Case "Init"
            trvSickInfo.Enabled = True
            txtCode.Locked = True
            txtName.Locked = True
            DTPicker1.Enabled = False
            Combo1.Locked = True
            Combo2.Locked = True
            RichTextBox1.Locked = True
            RichTextBox2.Locked = True
        Case "New"
            trvSickInfo.Enabled = False
            txtCode.Locked = False
            txtName.Locked = False
            DTPicker1.Enabled = True
            Combo1.Locked = False
            Combo2.Locked = False
            RichTextBox1.Locked = False
            RichTextBox2.Locked = False
        Case "Modify"
            trvSickInfo.Enabled = False
            txtCode.Locked = False
            txtName.Locked = False
            DTPicker1.Enabled = True
            Combo1.Locked = False
            Combo2.Locked = False
            RichTextBox1.Locked = False
            RichTextBox2.Locked = False
        Case Else

    End Select
    
End Sub

Private Sub SaveTktInfo()
Dim lID As Long
Dim sCode As String, sName As String
Dim dBirth As Date, CheckDate As Date
Dim sClass As String, sSex As String
Dim sUnit As String, sFamily As String
Dim sSQL As String
Dim cNode As MSComctlLib.Node, tNode As MSComctlLib.Node
    
    Set Sick = New clsSick
    
    If iOperateStatus = genuTktOperate.CST_TYPE_NEWADD Then
        lID = GetMaxID("sick_info", "sick_id")
    
        With Sick
            .SickID = lID
            .SickNo = txtCode.Text
            .SickName = txtName.Text
            .SickBirth = Format(DTPicker1.Value, "YYYY-MM-DD")
            .SickUnit = RichTextBox1.Text
            .SickFamily = RichTextBox2.Text
            .CheckDate = Format(Date, "YYYY-MM-DD")
            .ModifyDate = Format(Date, "YYYY-MM-DD")
            .SickClass = Combo1.Text
            .SickSex = Combo2.Text
        End With
        
        Call Sick.SaveSick
    ElseIf iOperateStatus = genuTktOperate.CST_TYPE_MODIFY Then
        With Sick
            .SickID = mlSickID
            .SickNo = txtCode.Text
            .SickName = txtName.Text
            .SickBirth = Format(DTPicker1.Value, "YYYY-MM-DD")
            .SickUnit = RichTextBox1.Text
            .SickFamily = RichTextBox2.Text
            .CheckDate = Format(txtCheckDate.Text, "YYYY-MM-DD")
            .ModifyDate = Format(Date, "YYYY-MM-DD")
            
            .SickClass = Combo1.Text
            .SickSex = Combo2.Text
        End With
        
        Call Sick.ModifySick
    End If
    
    If iOperateStatus = genuTktOperate.CST_TYPE_NEWADD Then
        sCode = Sick.SickNo
        sName = Sick.SickName
        
        CheckDate = Format(Sick.CheckDate, "YYYY-MM-DD")
        
        Call ModifySickTree(lID, CheckDate, cNode)
        
        Set tNode = trvSickInfo.Nodes.Add(cNode.Text, tvwChild, TREEKEY & CStr(lID), sCode & " " & sName, 2)
        tNode.Tag = lID
        tNode.Selected = True
        
        initial
    End If
    
End Sub

Private Sub ModifySickTree(ByVal lID As Long, ByVal CheckDate As Date, ByRef pNode As MSComctlLib.Node)
Dim tNode As MSComctlLib.Node

    Set pNode = Nothing
    trvSickInfo.Nodes(1).Expanded = True
    For Each tNode In trvSickInfo.Nodes
        If tNode.Text = CStr(CheckDate) Then
            Set pNode = tNode
            Exit For
        End If
    Next
    
    If pNode Is Nothing Then
        Set pNode = trvSickInfo.Nodes.Add(ROOTTAG & ROOTKEY, tvwChild, CStr(CheckDate), CStr(CheckDate), 1)
    End If
    
    pNode.Expanded = True
    
End Sub

Private Sub initial()
    
    txtCode.Text = ""
    txtName.Text = ""
    DTPicker1.Value = Date
    If Combo1.ListCount > 0 Then
        Combo1.ListIndex = 0
    End If
    If Combo2.ListCount > 0 Then
        Combo2.ListIndex = 0
    End If
    RichTextBox1.Text = ""
    RichTextBox2.Text = ""
    
End Sub

Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
    
    EnterToTab KeyCode
    
End Sub

Private Sub Combo2_KeyDown(KeyCode As Integer, Shift As Integer)
    
    EnterToTab KeyCode
    
End Sub

Private Sub DTPicker1_KeyDown(KeyCode As Integer, Shift As Integer)
    
    EnterToTab KeyCode
    
End Sub

Private Sub Form_Load()
            
'    Call iniComBox
    Call CreatSickTree
'    Call SetTktLocked(msStatus)
    
'    Call SetToolEnable(tlbTools, iOperateStatus, trvSickInfo.SelectedItem)
    
End Sub

Private Sub iniComBox()
Dim rsSex As ADODB.Recordset
Dim rsType As ADODB.Recordset
Dim sSQL1 As String, sSQL2 As String
Dim iCount1 As Long, iCount2 As Long

    sSQL1 = "select * from report_item_detail " & _
            " where class_id=27 "
    Set rsType = GDB.Execute(sSQL1)
    
    iCount1 = 0
    With rsType
    Do While Not .EOF
        Combo1.AddItem rsType!ItemData
        Combo1.ItemData(iCount1) = rsType!itemdata_id
        iCount1 = iCount1 + 1
        .MoveNext
    Loop
    End With
    If Combo1.ListCount > 0 Then Combo1.ListIndex = 0
    
    
    sSQL2 = "select * from report_item_detail " & _
            " where class_id=29 "
    Set rsSex = GDB.Execute(sSQL2)
    
    iCount2 = 0
    With rsSex
    Do While Not .EOF
        Combo2.AddItem rsSex!ItemData
        Combo2.ItemData(iCount2) = rsSex!itemdata_id
        iCount2 = iCount2 + 1
        .MoveNext
    Loop
    End With
    If Combo2.ListCount > 0 Then Combo2.ListIndex = 0
    
    rsSex.Close
    rsType.Close
    
    Set rsSex = Nothing
    Set rsType = Nothing
    
End Sub

Private Sub CreatSickTree()
Dim sSQL As String
Dim sDate As Date
Dim Nodx As MSComctlLib.Node
Dim rsDate As ADODB.Recordset
    
    With trvSickInfo
        .Nodes.Clear
        .Nodes.Add , , "*-1", "病人信息", 1
    End With
    
    sSQL = "select distinct checkdate as checkdate from sick_info "
    Set rsDate = GDB.Execute(sSQL)
    With rsDate
    Do While Not .EOF
        Set Nodx = trvSickInfo.Nodes.Add("*-1", tvwChild, rsDate!CheckDate, rsDate!CheckDate, 1)
        Call AddSickCode(rsDate!CheckDate)
        .MoveNext
    Loop
    End With
    
    Nodx.Selected = True
    
    rsDate.Close
    Set rsDate = Nothing
    
End Sub

Private Sub AddSickCode(ByVal sKey As String)
Dim sSQL As String
Dim sDate As Date