Hi all
I hope someone can help me out with this.
I am trying to write a program to return the dependency of a patient at each contact made to them.
I have a database to start with that has all contacts made to every patient. I need to check each contact for the patient and see how many other contacts fall into all surrounding 7 day periods. I need to take the largest number of contacts and there durations and determine from that the patients dependency.
I have written something that works however it is extremely slow.
I'd appreciate if anyone could look at the following code and suggest any ways in which i could speed it up. I'm tied to using an access database at present.
Its not the tidiest of code at present, so apologies for that.
Hopefully the idea that i'm trying to convey makes sense, if not then i'll try and elaborate if necessary.
Thanks in advance
I hope someone can help me out with this.
I am trying to write a program to return the dependency of a patient at each contact made to them.
I have a database to start with that has all contacts made to every patient. I need to check each contact for the patient and see how many other contacts fall into all surrounding 7 day periods. I need to take the largest number of contacts and there durations and determine from that the patients dependency.
I have written something that works however it is extremely slow.
I'd appreciate if anyone could look at the following code and suggest any ways in which i could speed it up. I'm tied to using an access database at present.
Its not the tidiest of code at present, so apologies for that.
Code:
Private Sub cmdDependencyCalculation2_Click()
'Set up variables
Dim visitArray, durationArray
Dim sqlLimitPatients
Dim CurrentDate As Date
Dim CurrentPatient, CurrentPatientDiscipline, Dependency As String
Dim i, j, visitCount, maxDuration As Integer
Call DeleteDependency
'Initialise visitArray
visitArray = Array(0, 0, 0, 0, 0, 0, 0)
'set up connection string to CPE2000 database and then open.
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & DBase
cn.Open
sqlLimitPatients = "SELECT DISTINCT LHCC_CONTACTS.PATIENT_NO FROM LHCC_CONTACTS"
'Set up recordset, open up LHCC_CONTACTS table within CPE2000 database
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open sqlLimitPatients, cn, adOpenKeyset, adLockOptimistic
'Check size of recordset and go to first entry if possible
If rs.RecordCount > 0 Then
rs.MoveFirst
End If
Set rsReduced = New ADODB.Recordset
Set rsReducedContacts = New ADODB.Recordset
Set rsRC = New ADODB.Recordset
rsRC.CursorLocation = adUseClient
Set rsOutput = New ADODB.Recordset
rsOutput.CursorLocation = adUseClient
rsOutput.Open "LHCC_Dependency", cn, adOpenKeyset, adLockOptimistic
Do While rs.EOF = False
CurrentPatient = rs.Fields("PATIENT_NO")
visitCount = 0 'For each seven day period around current date of visit, count of visits is carried out. This variable stores the highest of these.
maxDuration = 0 'As with visit_count only the highest duration sum over the period.
j = 0 'Temp variable for loop
durationArray = Array(0, 0, 0, 0, 0, 0, 0) 'array to store duration sums for each of the 7 seven day periods
sqlGetContactsForPatientNumber = "SELECT * FROM LHCC_CONTACTS WHERE LHCC_CONTACTS.Patient_No = '" & CurrentPatient & "'"
rsReducedContacts.CursorLocation = adUseClient
rsReducedContacts.Open sqlGetContactsForPatientNumber, cn, adOpenKeyset, adLockOptimistic
CurrentPatientDiscipline = rsReducedContacts.Fields("Discipline")
'clone so that we can use both in calculations
rsReducedContacts.MoveFirst
Do While rsReducedContacts.EOF = False
CurrentDate = rsReducedContacts.Fields("DATE_OF_VISIT")
durationArray = Array(0, 0, 0, 0, 0, 0, 0)
For i = -6 To 0 Step 1
'For each iteration of the loop these variables store the first and last dates of the seven day period
daterangestart = DateAdd("d", i, CurrentDate): daterangeend = DateAdd("d", j, CurrentDate)
'SELECT query produced on the fly for each iteration of the loop.
'Returns the records where visits fall within the current 7 day period.
'From this it is easy to do a recordcount to get number of visits
sqlReduced = "SELECT * FROM LHCC_CONTACTS WHERE LHCC_CONTACTS.Patient_No = '" & CurrentPatient & "' AND LHCC_CONTACTS.Date_Of_visit between #" & daterangestart & "# and #" & daterangeend & "#"
rsRC.Open sqlReduced, cn, adOpenKeyset, adLockOptimistic
visitArray(i + 6) = rsRC.RecordCount
If rsRC.RecordCount <> 0 Then
rsRC.MoveFirst
Do While rsRC.EOF = False
durationArray(i + 6) = durationArray(i + 6) + rsRC.Fields("Duration")
rsRC.MoveNext
Loop
Else
durationArray(i + 6) = 0
End If
rsRC.Close
j = j + 1
Next
'Loop throgh both visitArray and durationArray to get value in each.
'Both these values are then assigned to variables
For k = 0 To 6 Step 1
If visitArray(k) > visit_count Then
visit_count = visitArray(k)
End If
If durationArray(k) > maxDuration Then
maxDuration = durationArray(k)
End If
Next
'At this point we have a patient number, maxduration, visit count, and discipline.
If visit_count > 5 Or maxDuration > 180 Then
Dependency = "high"
ElseIf maxDuration > 60 And maxDuration <= 180 And visit_count <= 5 Then
Dependency = "medium"
ElseIf maxDuration <= 60 And visit_count <= 5 Then
Dependency = "low"
End If
With rsOutput
.AddNew
.Fields("Patient_No") = CurrentPatient
.Fields("Discipline") = CurrentPatientDiscipline
.Fields("Dependency") = Dependency
.Update
End With
rsReducedContacts.MoveNext
Loop
rsReducedContacts.Close
rs.MoveNext
Loop
rs.Close
rsOutput.Close
cn.Close
End Sub
Hopefully the idea that i'm trying to convey makes sense, if not then i'll try and elaborate if necessary.
Thanks in advance