frmadd.frm

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

        MsgBox "Please enter a Last Name to continue.", 16, "Error"
        txtLast.SetFocus
        
    Else
        
        'send user entered data to User Defined Type
        udtPatient.strLast = Trim(txtLast.Text)
        udtPatient.strFirst = Trim(txtFirst.Text)
        udtPatient.strMiddle = Trim(txtMiddle.Text)
        udtPatient.strAddress = Trim(txtAddress.Text)
        udtPatient.strCity = Trim(txtCity.Text)
        udtPatient.strState = Trim(txtState.Text)
        udtPatient.strZipCode = Trim(txtZipCode.Text)
        udtPatient.strPhone = Trim(txtPhone.Text)
        udtPatient.strInsName = Trim(txtInsName.Text)
        udtPatient.strInsured = Trim(txtInsured.Text)
        udtPatient.strInsPolicy = Trim(txtInsPolicy.Text)
        Put #intFileNum, (lngNumRec + 1), udtPatient
    
        'close file
        Close #intFileNum
        
        'sort records in file
        Call Sort(lngNumRec)
        
        'clear textboxes
        Call ClearTextboxes
            
        'terminate form
        Unload Me
        
    End If
    
    'close file
    Close #intFileNum
    
End Sub

Sub Sort(ByVal lngNumRec As Integer)
    
    'declare local variables
    Dim strarray() As String
    Dim intIndex As Integer, strtemp() As String, intprevpos As Integer
    Dim intFileNum As Integer
    Dim udtPatient As PatientRecord
    Dim lngLen As Long
    
    'generate array from existing data file
    Call GenerateArray(intFileNum, lngNumRec, strarray())
    
    'open database for adding new patient record
    intFileNum = FreeFile
    lngLen = LenB(udtPatient)
    Open "c:\data.puj" For Random As #intFileNum Len = lngLen
    
    'redimension array
    ReDim strtemp(1 To 11)
    
    'insertion sort
    For intIndex = LBound(strarray, 2) + 1 To UBound(strarray, 2)
    
        strtemp(1) = strarray(1, intIndex)
        strtemp(2) = strarray(2, intIndex)
        strtemp(3) = strarray(3, intIndex)
        strtemp(4) = strarray(4, intIndex)
        strtemp(5) = strarray(5, intIndex)
        strtemp(6) = strarray(6, intIndex)
        strtemp(7) = strarray(7, intIndex)
        strtemp(8) = strarray(8, intIndex)
        strtemp(9) = strarray(9, intIndex)
        strtemp(10) = strarray(10, intIndex)
        strtemp(11) = strarray(11, intIndex)
        intprevpos = intIndex - 1
        
        Do While intprevpos > LBound(strarray, 2) And strarray(1, intprevpos) > strtemp(1)
            
            strarray(1, intprevpos + 1) = strarray(1, intprevpos)
            strarray(2, intprevpos + 1) = strarray(2, intprevpos)
            strarray(3, intprevpos + 1) = strarray(3, intprevpos)
            strarray(4, intprevpos + 1) = strarray(4, intprevpos)
            strarray(5, intprevpos + 1) = strarray(5, intprevpos)
            strarray(6, intprevpos + 1) = strarray(6, intprevpos)
            strarray(7, intprevpos + 1) = strarray(7, intprevpos)
            strarray(8, intprevpos + 1) = strarray(8, intprevpos)
            strarray(9, intprevpos + 1) = strarray(9, intprevpos)
            strarray(10, intprevpos + 1) = strarray(10, intprevpos)
            strarray(11, intprevpos + 1) = strarray(11, intprevpos)
            intprevpos = intprevpos - 1
            
        Loop
        
        If strarray(1, intprevpos) > strtemp(1) Then
        
            strarray(1, intprevpos + 1) = strarray(1, intprevpos)
            strarray(2, intprevpos + 1) = strarray(2, intprevpos)
            strarray(3, intprevpos + 1) = strarray(3, intprevpos)
            strarray(4, intprevpos + 1) = strarray(4, intprevpos)
            strarray(5, intprevpos + 1) = strarray(5, intprevpos)
            strarray(6, intprevpos + 1) = strarray(6, intprevpos)
            strarray(7, intprevpos + 1) = strarray(7, intprevpos)
            strarray(8, intprevpos + 1) = strarray(8, intprevpos)
            strarray(9, intprevpos + 1) = strarray(9, intprevpos)
            strarray(10, intprevpos + 1) = strarray(10, intprevpos)
            strarray(11, intprevpos + 1) = strarray(11, intprevpos)
            
            strarray(1, intprevpos) = strtemp(1)
            strarray(2, intprevpos) = strtemp(2)
            strarray(3, intprevpos) = strtemp(3)
            strarray(4, intprevpos) = strtemp(4)
            strarray(5, intprevpos) = strtemp(5)
            strarray(6, intprevpos) = strtemp(6)
            strarray(7, intprevpos) = strtemp(7)
            strarray(8, intprevpos) = strtemp(8)
            strarray(9, intprevpos) = strtemp(9)
            strarray(10, intprevpos) = strtemp(10)
            strarray(11, intprevpos) = strtemp(11)
            
        Else
        
            strarray(1, intprevpos + 1) = strtemp(1)
            strarray(2, intprevpos + 1) = strtemp(2)
            strarray(3, intprevpos + 1) = strtemp(3)
            strarray(4, intprevpos + 1) = strtemp(4)
            strarray(5, intprevpos + 1) = strtemp(5)
            strarray(6, intprevpos + 1) = strtemp(6)
            strarray(7, intprevpos + 1) = strtemp(7)
            strarray(8, intprevpos + 1) = strtemp(8)
            strarray(9, intprevpos + 1) = strtemp(9)
            strarray(10, intprevpos + 1) = strtemp(10)
            strarray(11, intprevpos + 1) = strtemp(11)
            
        End If
        
    Next intIndex
    
    'close file
    Close #intFileNum
    
    'send array data to file
    Call arraytofile(strarray(), lngNumRec)
    
End Sub

Sub arraytofile(ByRef strarray() As String, ByVal lngNumRec As Long)
    
    'declare local variables
    Dim intIndex As Integer
    Dim udtTemp As PatientRecord
    Dim intFileNum As Integer, lngLen As Long
    
    'open temporary data file
    intFileNum = FreeFile
    lngLen = LenB(udtTemp)
    Open "c:\tempdata.puj" For Random As #intFileNum Len = lngLen
        
    'copy array data to user defined type
    For intIndex = 1 To (lngNumRec + 1)
    
        udtTemp.strLast = strarray(1, intIndex)
        udtTemp.strFirst = strarray(2, intIndex)
        udtTemp.strMiddle = strarray(3, intIndex)
        udtTemp.strAddress = strarray(4, intIndex)
        udtTemp.strCity = strarray(5, intIndex)
        udtTemp.strState = strarray(6, intIndex)
        udtTemp.strZipCode = strarray(7, intIndex)
        udtTemp.strPhone = strarray(8, intIndex)
        udtTemp.strInsName = strarray(9, intIndex)
        udtTemp.strInsured = strarray(10, intIndex)
        udtTemp.strInsPolicy = strarray(11, intIndex)
        Put #intFileNum, intIndex, udtTemp
        
    Next intIndex
    
    'close file
    Close #intFileNum
    
    'delete original file
    Kill "c:\data.puj"
    
    'rename temporary file to original file
    Name "c:\tempdata.puj" As "c:\data.puj"
    
End Sub

Sub GenerateArray(ByVal intFileNum As Integer, ByVal lngNumRec As Integer, ByRef strarray() As String)
    
    'declare local variables
    Dim intIndex As Integer, lngLen As Long
    Dim udtTemp As PatientRecord
    
    'redimension array to fit file data
    ReDim Preserve strarray(1 To 11, 1 To (lngNumRec + 1))
    
    'open file
    intFileNum = FreeFile
    lngLen = LenB(udtTemp)
    Open "c:\data.puj" For Random As #intFileNum Len = lngLen
    
    'send file data to array
    For intIndex = 1 To (lngNumRec + 1)
    
        Get #intFileNum, intIndex, udtTemp
        
        strarray(1, intIndex) = udtTemp.strLast
        strarray(2, intIndex) = udtTemp.strFirst
        strarray(3, intIndex) = udtTemp.strMiddle
        strarray(4, intIndex) = udtTemp.strAddress
        strarray(5, intIndex) = udtTemp.strCity
        strarray(6, intIndex) = udtTemp.strState
        strarray(7, intIndex) = udtTemp.strZipCode
        strarray(8, intIndex) = udtTemp.strPhone
        strarray(9, intIndex) = udtTemp.strInsName
        strarray(10, intIndex) = udtTemp.strInsured
        strarray(11, intIndex) = udtTemp.strInsPolicy
        
    Next intIndex

    'close file
    Close #intFileNum
    
End Sub

Function NumRecords(ByVal intFileNum As Integer, ByVal lngLen As Long) As Integer
    
    'determine number of records in file
    If LOF(intFileNum) Mod lngLen = 0 Then
        
        NumRecords = (LOF(intFileNum) \ lngLen)
    
    Else
        
        NumRecords = (LOF(intFileNum) \ lngLen) + 1
    
    End If
    
End Function

Private Sub cmdCancel_Click()

    'clear textboxes
    Call ClearTextboxes
    
    'hide form
    Me.Hide
    
End Sub

Sub ClearTextboxes()

    'clear all textboxes
    txtLast.Text = ""
    txtFirst.Text = ""
    txtMiddle.Text = ""
    txtAddress.Text = ""
    txtCity.Text = ""
    txtState.Text = ""
    txtZipCode.Text = ""
    txtPhone.Text = ""
    txtInsName.Text = ""
    txtInsured.Text = ""
    txtInsPolicy.Text = ""
    
End Sub