frmsearch.frm

一个小型的社区医疗管理软件。只有100多K。功能还可以。英文界面

VERSION 5.00
Begin VB.Form frmSearch 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Search A Patient"
   ClientHeight    =   2715
   ClientLeft      =   3675
   ClientTop       =   4335
   ClientWidth     =   7230
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   2715
   ScaleWidth      =   7230
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton cmdSearch 
      Caption         =   "Search for Patients"
      Height          =   495
      Left            =   5400
      TabIndex        =   3
      Top             =   120
      Width           =   1455
   End
   Begin VB.CommandButton cmdDelete 
      Caption         =   "Delete Patient Record"
      Height          =   495
      Left            =   5400
      TabIndex        =   5
      Top             =   1320
      Width           =   1455
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "Cancel"
      Height          =   495
      Left            =   5400
      TabIndex        =   6
      Top             =   2040
      Width           =   1455
   End
   Begin VB.CommandButton cmdEdit 
      Caption         =   "Edit Patient Record"
      Height          =   495
      Left            =   5400
      TabIndex        =   4
      Top             =   720
      Width           =   1455
   End
   Begin VB.ListBox lstNames 
      Height          =   2010
      Left            =   120
      TabIndex        =   2
      Top             =   600
      Width           =   4815
   End
   Begin VB.TextBox txtLastName 
      Height          =   285
      Left            =   2400
      TabIndex        =   1
      Top             =   120
      Width           =   2535
   End
   Begin VB.Line Line1 
      X1              =   5400
      X2              =   6840
      Y1              =   1920
      Y2              =   1920
   End
   Begin VB.Label Label1 
      Caption         =   "Enter the Patient's Last Name:"
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   2175
   End
End
Attribute VB_Name = "frmSearch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'******************************************************
'Medi-Assist - Program Dossier
'frmSearch
'Puraj Pravinchandra Patel
'Carlisle School - Martinsville, Virginia USA
'Computer Used: Pentium II 233, 144MB SDRAM, Windows 98
'Microsoft Visual Basic 6.0
'23 March 2000
'This form is responsible for searching, updating,
'and deleting patient records.
'******************************************************

Option Explicit

'declare global variable
Public intIndex As Integer
Private intarray() As Integer

'declare user defined type
Private Type PatientRecord

    strLast As String * 20
    strFirst As String * 20
    strMiddle As String * 1
    strAddress As String * 55
    strCity As String * 25
    strState As String * 2
    strZipCode As String * 10
    strPhone As String * 14
    strInsName As String * 45
    strInsured As String * 40
    strInsPolicy As String * 25
    
End Type

Private Sub cmdCancel_Click()

    'clear search string
    txtLastName.Text = ""
    
    'clear list box
    lstNames.Clear
    
    'terminate form
    Unload Me

End Sub

Private Sub cmdDelete_Click()
    
    'declare local variables
    Dim intFileNum As Integer, lngLen As Long, lngRec As Long
    Dim udtPatient As PatientRecord, intIndex As Integer
    Dim intTempIndex As Integer, intTempFileNum As Integer

    'check if a patient is selected
    If lstNames.SelCount = 0 Then
            
        'display error message
        MsgBox "Please select a patient from the list to continue.", 16, "Error"
        
        'set focus to listbox
        lstNames.SetFocus
    
    Else
    
        'get record number of selected patient
        intIndex = intarray(lstNames.ListIndex + 1)
    
        'open original data file
        intFileNum = FreeFile
        lngLen = LenB(udtPatient)
        Open "c:\data.puj" For Random As #intFileNum Len = lngLen
        
        'open temporary data file
        intTempFileNum = FreeFile
        Open "c:\tempdata.puj" For Random As #intTempFileNum Len = lngLen
        
        'determint number of records
        lngRec = NumRecords(intFileNum, lngLen)
        
        'delete selected patient record
        For intTempIndex = 1 To lngRec
        
            If intTempIndex <> intIndex Then
        
                Get #intFileNum, intTempIndex, udtPatient
                
                Put #intTempFileNum, intTempIndex, udtPatient
                
            End If
        
        Next intTempIndex
        
        'close original file
        Close #intFileNum
        
        'close temporary file
        Close #intTempFileNum
        
        'delete original data file
        Kill "c:\data.puj"
        
        'rename temporary file to original
        Name "c:\tempdata.puj" As "c:\data.puj"
        
        'clear listbox
        lstNames.Clear
        
    End If
        
End Sub

Private Sub cmdEdit_Click()
    
    'delcare local variables
    Dim intFileNum As Integer, lngLen As Long, lngRec As Long
    Dim udtPatient As PatientRecord

    'get record number for selected patient
    intIndex = intarray(lstNames.ListIndex + 1)

    'open data file
    intFileNum = FreeFile
    lngLen = LenB(udtPatient)
    Open "c:\data.puj" For Random As #intFileNum Len = lngLen

    'obtain selected patient record
    Get #intFileNum, intIndex, udtPatient

    'show the edit form
    frmEdit.Show

    'send current patient data to edit form
    frmEdit.txtLast.Text = udtPatient.strLast
    frmEdit.txtFirst.Text = udtPatient.strFirst
    frmEdit.txtMiddle.Text = udtPatient.strMiddle
    frmEdit.txtAddress.Text = udtPatient.strAddress
    frmEdit.txtCity.Text = udtPatient.strCity
    frmEdit.txtState.Text = udtPatient.strState
    frmEdit.txtZipCode.Text = udtPatient.strZipCode
    frmEdit.txtPhone.Text = udtPatient.strPhone
    frmEdit.txtInsName.Text = udtPatient.strInsName
    frmEdit.txtInsured.Text = udtPatient.strInsured
    frmEdit.txtInsPolicy.Text = udtPatient.strInsPolicy

    'close file
    Close #intFileNum
    
    'clear search string
    txtLastName.Text = ""
    
    'clear list box
    lstNames.Clear
    
    'terminate form
    Unload Me

End Sub

Private Sub cmdSearch_Click()

    'declare local variables
    Dim udtPatient As PatientRecord
    Dim strSearchString As String, lngNumRec As Long
    Dim lngLen As Long, intFileNum As Integer, intIndex As Integer
    Dim intubound As Integer

    'clear list box
    lstNames.Clear
    
    'open data file
    intFileNum = FreeFile
    lngLen = LenB(udtPatient)
    Open "c:\data.puj" For Random As #intFileNum Len = lngLen

    'determine number of records
    lngNumRec = NumRecords(intFileNum, lngLen)

    'get user entered search string
    strSearchString = txtLastName.Text

    'redimension array to fit record numbers
    ReDim intarray(1 To 1)
    intubound = 1
    
    'search for patient
    For intIndex = 1 To lngNumRec

        Get #intFileNum, intIndex, udtPatient
        
        If LCase(strSearchString) Like LCase(Trim(udtPatient.strLast)) Then
            
            lstNames.AddItem Trim(udtPatient.strLast) & "," & Space(1) & Trim(udtPatient.strFirst) & vbCrLf
            intarray(intubound) = intIndex
            intubound = intubound + 1
            ReDim Preserve intarray(1 To intubound)
            cmdEdit.Enabled = True
            cmdDelete.Enabled = True

        End If

    Next intIndex

    'display information message if there are no patient matches
    If lstNames.ListCount = 0 Then

        lstNames.AddItem "There are no matches for that search query."
        cmdEdit.Enabled = False
        cmdDelete.Enabled = False

    End If
    
    'close file
    Close #intFileNum

End Sub

Function NumRecords(ByVal intFileNum As Integer, ByVal lngLen As Long) As Integer

    'determine number of records
    If LOF(intFileNum) Mod lngLen = 0 Then

        NumRecords = (LOF(intFileNum) \ lngLen)

    Else

        NumRecords = (LOF(intFileNum) \ lngLen) + 1

    End If

End Function

Private Sub Form_Load()

    'disable command buttons to prevent error
    cmdEdit.Enabled = False
    cmdDelete.Enabled = False

End Sub

Private Sub txtLastName_Change()

    'clear list box
    lstNames.Clear

End Sub