Recordset to update table

  • Thread starter Thread starter Dale
  • Start date Start date
D

Dale

I have an encounters table which represents patient visits. I would like to
sequentially number groups of encounters and update the encounter number to
the encounters table. There are two tables, patients and encounters with
many encounters for each patient however I've only used the encounters table
in my code. I'm not sure how best to do this...the code I've written is
taking a long time to complete on a table of one million records. Can
someone offer how to make this more efficient? Thanks in advance.


Dim dbs As DAO.Database, rst As DAO.Recordset, rst2 As DAO.Recordset, fld As
DAO.Field
Dim strSQL As String, strSQL2 As String, strStart As String, strEnd As
String
strStart = CStr(Now())
Set dbs = CurrentDb
strSQL = "SELECT tblEncounters.PatientID,
tblEncounters.DTID,tblencounters.encnum, (Select Count(*) From tblEncounters
As T2 Where T2.PatientID ="
strSQL = strSQL & " tblEncounters.PatientID AND T2.[dtid] <
tblEncounters.[dtid])+1 AS Encounter FROM tblEncounters"
strSQL2 = "tblencounters"
Set rst = dbs.OpenRecordset(strSQL, dbOpenDynaset)
Set rst2 = dbs.OpenRecordset(strSQL2, dbOpenTable)
Set fld = rst2("encnum")
Do While Not rst.EOF
If rst2!PatientID = rst!PatientID And rst2!dtid = rst!dtid Then
rst2.Edit
fld = rst!encounter
rst2.Update
rst2.MoveNext
End If
rst.MoveNext
Loop
rst.Close
rst2.Close
Set dbs = Nothing
strEnd = CStr(Now())
MsgBox "Operation complete: Started " & strStart & " and Ended " &
strEnd
 
So I tried filtering against the patient table...not any faster...I'm over
in my head...Thanks to anyone who can see where I could speed this process
up...


Dim dbs As DAO.Database, rstEncounters As DAO.Recordset, rstPatients As
DAO.Recordset, rstFilter As DAO.Recordset, fld As DAO.Field
Dim strSQL As String, strSQL2 As String, strStart As Double, strEnd As
Double, lngCount As Long
strStart = Timer
Set dbs = CurrentDb
strSQL = "SELECT tblPatients.PatientID, tblEncounters.DTID,
tblEncounters.ENCNum " _
& "FROM tblPatients INNER JOIN tblEncounters ON
tblPatients.PatientID = tblEncounters.PatientID" _
& " ORDER BY tblEncounters.DTID"
strSQL2 = "tblPatients"
Set rstEncounters = dbs.OpenRecordset(strSQL, dbOpenDynaset)
Set rstPatients = dbs.OpenRecordset(strSQL2)
rstPatients.MoveFirst

Do While Not rstPatients.EOF
rstEncounters.Filter = "PatientID='" & rstPatients!PatientID& "'"
Set rstFilter = rstEncounters.OpenRecordset
lngCount = 1

Do While Not rstFilter.EOF
Debug.Print rstFilter.RecordCount
'For Each fld In rstFilter.Fields
rstFilter.Edit
rstFilter!encnum = lngCount
rstFilter.Update
'Exit For
rstFilter.MoveNext
'Next
lngCount = lngCount + 1
Loop

rstFilter.Close
rstPatients.MoveNext

Loop
'lngCount = 1
'rst.MoveLast
'Debug.Print rst.RecordCount
rstEncounters.Close
rstPatients.Close
Set dbs = Nothing
strEnd = Timer
MsgBox "Operation completed: " & Format(((strEnd - strStart) / 60),
"###0.000") & " minutes"
 
Back
Top