Receiving Error Code 3021

[tlitman09]

I am attempting to create a function that will determine the minimum and maximum dates within a patients length of stay. for example:

Patient StartDate EndDate
pat1 1/1/2009 1/3/2009
pat1 1/4/2009 1/6/2009
pat1 2/15/2009 2/20/2009

The result would be that one function gives the admit/min start date and the other gives the discharge/max end date. Therefore, pat1 would have two separate length of stays. pat1's first length of stay would be from 1/1/2009 to 1/6/2009 and pat1's second length of stay would be from 2/15/2009 to 2/20/2009. Right now I only have a function to return the patients admit date/beginning length of stay, but I am receiving the error code 3021: no current record. The odd part of this is that it will loop through until "i" is 33, then I receive the error. When I run the module, the debugger shows that it is erroring out at the line:

patient1 = rstSorted.Fields("patientName")


If anybody could help me it would be greatly appreciated.

Thanks,
Tyler

Public Function dateStart()
 
    Dim db As Database
    Dim rst1 As Recordset
    Dim rstCount As Long
    Dim i As Long
    Dim patient1 As String
    Dim patient2 As String
    Dim endDateCheck As Date
    Dim startDateCheck As Date
    Dim rstSorted As Recordset
 
    Set db = CurrentDb
    Set rst1 = db.OpenRecordset("MyRecords", dbOpenDynaset)
 
    rst1.Sort = "patientName"
    Set rstSorted = rst1.OpenRecordset()
    rstSorted.MoveLast
    rstSorted.MoveFirst
    rstCount = rstSorted.RecordCount
 
    i = 1
 
    Do While Not rstSorted.EOF Or rstSorted.BOF
        rstSorted.Move i
        'this is where it errors out
        '********************************
        patient1 = rstSorted.Fields("patientName")
        '********************************
        rstSorted.MoveNext
        patient2 = rstSorted.Fields("patientName")
        rstSorted.Move i
 
        If patient1 = patient2 Then
            endDateCheck = rstSorted.Fields("endDate")
            rstSorted.MoveNext
            startDateCheck = rstSorted.Fields("startDate")
            endDateCheck = DateAdd("d", 1, endDateCheck)
                If endDateCheck = startDateCheck Then
                    rstSorted.Move i
                    dateStart = rstSorted.Fields("startDate")
                End If
        Else
            dateStart = 0
        End If
 
        i = i + 1
 
    Loop
 
rst1.Close
rstSorted.Close
Set rst1 = Nothing
Set rstSorted = Nothing
Set db = Nothing
 
 
End Function

 

[tlitman09]

It turns out I was trying to moveNext and did not check for EOF. Now the only problem is that the function does not return a value when put into a query. Any ideas?

Thanks,
Tyler

here is the new code

Public Function dateStart() As String

    Dim db As Database
    Dim rst1 As Recordset
    Dim rstCount As Long
    Dim i As Integer
    Dim patient1 As String
    Dim patient2 As String
    Dim endDateCheck As Date
    Dim startDateCheck As Date
    Dim rstSorted As Recordset
          
    Set db = CurrentDb
    Set rst1 = db.OpenRecordset("MyRecords", dbOpenDynaset)
    
    rst1.Sort = "patientName"
    Set rstSorted = rst1.OpenRecordset()
    rstSorted.MoveLast
    rstSorted.MoveFirst
    rstCount = rstSorted.RecordCount
    
    i = 1
    
    Do While Not rstSorted.EOF Or rstSorted.BOF
        rstSorted.Move i
        patient1 = rstSorted.Fields("patientName")
        rstSorted.MoveNext
        If rstSorted.EOF = True Then
            rst1.Close
            rstSorted.Close
            Set rst1 = Nothing
            Set rstSorted = Nothing
            Set db = Nothing
            Exit Function
        End If
        patient2 = rstSorted.Fields("patientName")
        rstSorted.Move i
        
        If patient1 = patient2 Then
            endDateCheck = rstSorted.Fields("endDate")
            rstSorted.MoveNext
            startDateCheck = rstSorted.Fields("startDate")
            endDateCheck = DateAdd("d", 1, endDateCheck)
                If endDateCheck = startDateCheck Then
                    rstSorted.Move i
                    dateStart = rstSorted.Fields("startDate")
                End If
        Else
            dateStart = 0
        End If
               
        i = i + 1
    Loop
    
rst1.Close
rstSorted.Close
Set rst1 = Nothing
Set rstSorted = Nothing
Set db = Nothing
        
    
End Function

 

[tlitman09]

Never mind. I just limited the data to one person and it worked. I forgot and attempted to change it back and run the query again. Then I received the error on the same "patient1 =" line.

sorry
Tyler

 

[tlitman09]

Ok, now it definitely works. The only problem I am having now is that it only returns 12:00:00 AM in every field. Does anyone know why this would be the case?

Thanks,
tyler

Public Function dateStart() As Date
    'Create My variables
    Dim db As Database
    Dim rstOriginal As Recordset
    Dim rstCount As Long
    Dim i As Integer
    Dim patient1 As String
    Dim patient2 As String
    Dim endDateCheck As Date
    Dim startDateCheck As Date
    Dim rstSorted As Recordset
          
    'Set The Recordset
    Set db = CurrentDb
    Set rstOriginal = db.OpenRecordset("MyRecords", dbOpenDynaset)
    
    'Sort The Original Recordset
    'Create A New Recordset To Hold Sorted Data
    rstOriginal.Sort = "patientName"
    Set rstSorted = rstOriginal.OpenRecordset()
    rstSorted.MoveLast
    rstSorted.MoveFirst
    rstCount = rstSorted.RecordCount
    
    'Assign i For Do While Loop
    i = 1
    
    'Begin Do While Loop
    Do While Not rstSorted.EOF Or rstSorted.BOF
        rstSorted.Move i
        'Exit Function If End Of Recordset
        If rstSorted.EOF = True Then
            rstOriginal.Close
            rstSorted.Close
            Set rst1 = Nothing
            Set rstSorted = Nothing
            Set db = Nothing
            Exit Function
        End If
        patient1 = rstSorted.Fields("patientName")
        rstSorted.MoveNext
        'Move Next And Test For End Of Recordset
        If rstSorted.EOF = True Then
            rst1.Close
            rstSorted.Close
            Set rst1 = Nothing
            Set rstSorted = Nothing
            Set db = Nothing
            Exit Function
        End If
        patient2 = rstSorted.Fields("patientName")
        rstSorted.Move i
        
        'Test For Same Patient Name
        If patient1 = patient2 Then
            endDateCheck = rstSorted.Fields("endDate").Value
            rstSorted.MoveNext
            startDateCheck = rstSorted.Fields("startDate").Value
            endDateCheck = DateAdd("d", 1, endDateCheck)
                'Test If Prior End Date + 1 = Next Start Date
                If endDateCheck = startDateCheck Then
                    'If True Return First Start Date
                    rstSorted.Move i
                    dateStart = rstSorted.Fields("startDate")
                End If
        Else
            'If Not True Return 0
            dateStart = 0
        End If
        'Move To The Next Record Using Variable i
        i = i + 1
    Loop
'Prepare To Exit Function
rst1.Close
rstSorted.Close
Set rst1 = Nothing
Set rstSorted = Nothing
Set db = Nothing
        
    
End Function

 

[PeterF]

You get the same value for every record because the function does the same calculation every time. In order to work you should have give a parameter to the function like:

Public Function dateStart(patient1 As String) As Date

But if you do that it would be faster to use the Dmin and Dmax functions to get your min and max date in stead of looping a recordset.

 

[tlitman09]

Would the dmin and dmax functions give me the max and min dates for a length of stay? If so, that would be awesome! How would I go about using that function?

Thanks,
Tyler

 

[tlitman09]

I tried to put in patient1 as string, but it froze. I don't know whether this is because it has to go through 1700 records or if it is stuck in a loop? I am just looking for a faster way to do this process other than exporting the data to excel and entering all of the dates manually.

I Really Appreciate The Suggestions,
Tyler

 

[PeterF]

Untested and no errorhandling (You need one).

Public Function dateStart(Patientname As String) As Date
   dateStart = DMax("startDate", "MyRecord", "patientName=" & Patientname)
End Function

Note: This would only get te latest date.
Testing for the enddate would require the startdate also to see if there's a valid one.

 

[tlitman09]

There is an error because the Patient Name has a comma in it, so it is throwing off the syntax. EX: smith,j
Do you have any idea how I could fix that?
Also, will this give the end date of each length of stay, or just the max end date for each patient name?

Thanks,
Tyler

 

[PeterF]

The function will only give the last startdate, if you want to total it you need to loop the recordset. How is your database structure? How did you call the function?

 

[tlitman09]

I called the function in a separate query from where the function is pulling its record set. I was able to fix the comma issue by inserting quotes on either side, but it only returns the last value as you stated. I will attach an example database for you to look at if you wouldn't mind?

Thanks,
Tyler

 

[PeterF]

I can't open the file in the moment (I'm viewing mobile).
When I'm home I will. I gues you want to total all visits?

 

[tlitman09]

Yes and no. I do want to total the visits, but only for each length of stay. I also need to have it return the dates of each beginning and ending length of stay, not just the length/number of days. Therefore, if there is a break in the dates for a specific person, then I need the function to return the minimum startDate in that length of stay.

For example,

PatientName******StartDate****EndDate***FunctionReturns

smith,j**********1/1/2009*****1/2/2009****1/1/2009
smith,j**********1/3/2009*****1/4/2009****1/1/2009
smith,j**********1/8/2009*****1/9/2009****1/8/2009

The maximum amount of records with the same name would be about 5 to 6. I started to create another function to do the same thing (using a similar idea as your previous code) but in a different way. The only issue is that it starts at the row where the first patientName that is passed to the function is found in the open recordset. I will post the start of the code below. I seem to be running into the same issue which is how to break up the starting dates between the 2nd and 3rd smith,j entry while the function returns 1/1/2009 for the first two records of smith,j.

Thanks again,
Tyler

p.s. The code is a little messy, but it is just an idea.

Public Function patientAdmit(patientName As String) As Integer
    Dim patientNameCount As Integer
    Dim dbs As Database
    Dim rst As Recordset
    Dim i As Long
    Dim patientNamePosition As Long
 
    'create variables to hold multiple patient admit and discharge dates
    Dim patientStartDate(8) As Date
    Dim patientEndDate(8) As Date
 
 
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("MyRecords", dbOpenDynaset)
 
    'find record number where first patient name input by query appears
    rst.FindFirst ("patientName=" & "'" & patientName & "'")
    patientNamePosition = rst.AbsolutePosition
 
    rst.Move patientNamePosition
 
        'count the number of records with the same patient name
        patientNameCount = DCount("patientName", "MyRecords", "patientName=" & " & patientName & ")
 
        'perform operation based on number of records with same patient name
        Select Case patientNameCount
            Case 1
                patientAdmit = DMin("startDate", "MyRecords", "patientName=" & "'" & patientName & "'")
 
            Case 2
                patientStartDate(1) = rst.Fields("startDate")
                patientEndDate(1) = rst.Fields("endDate")
                rst.MoveNext
                patientStartDate(2) = rst.Fields("startDate")
                patientEndDate(2) = rst.Fields("endDate")
                If DateAdd("d", 1, patientEndDate(1)) = patientStartDate(2) Then
                    patientAdmit = DMin("startDate", "MyRecords", "patientName=" & "'" & patientName & "'")
                Else
                    patientAdmit = patientStartDate(1)
                End If
 
            Case 3
                patientStartDate(1) = rst.Fields("startDate")
                patientEndDate(1) = rst.Fields("endDate")
                rst.MoveNext
                patientStartDate(2) = rst.Fields("startDate")
                patientEndDate(2) = rst.Fields("endDate")
                rst.MoveNext
                patientStartDate(3) = rst.Fields("startDate")
                patientEndDate(3) = rst.Fields("endDate")
                If DateAdd("d", 1, patientEndDate(1)) = patientStartDate(2) Then
                    If DateAdd("d", 1, patientEndDate(2)) = patientStartDate(3) Then
                        admitDate = patientEndDate(1)
                    End If
                Else
                    admitDate = patientStartDate(1)
 
 
        End Select
 
 
End Function

 

[PeterF]

Dmax/Dmin won't do you much good in this case.
Because you are working with the complete data in your recordset it won't work. I altered your code and think this is close to what you are after.

Public Function patientAdmit(patientName As String, startdate As Date) As Date
    Dim dbs As Database
    Dim rst As Recordset
    Dim StrSQl As String
    Dim Startdates(10) As Date 'create a matrix of 10 positions
    Dim enddates(10) As Date
    Dim i As Integer
    
    On Error GoTo ErrorAndExit

    StrSQl = "SELECT patientName, startDate, endDate " & _
             "FROM MyRecords " & _
             "WHERE (((patientName)= '" & patientName & "') " & _
             "AND ((startDate)<= #" & Format(startdate, "mm-dd-yyyy") & "#) ) " & _
             "ORDER BY MyRecords.startDate DESC;"

    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(StrSQl)
 
    'check recordset
    If Not rst.EOF And Not rst.BOF Then
        rst.MoveLast
        rst.MoveFirst
    End If

    i = 0 'initialise counter
    
    While Not rst.EOF And Not rst.BOF
        If rst.RecordCount = 1 Then         'if theres only one entry no furter testing
            patientAdmit = rst!startdate
        Else
            Startdates(i) = rst!startdate       'dump dates in an array
            enddates(i) = Nz(rst!Enddate, Date) 'if no enddate entered us today
            If i > 0 Then                       'if more the one date check for
                If enddates(i) + 1 = Startdates(i - 1) Then
                    patientAdmit = rst!startdate
                Else
                patientAdmit = Startdates(i - 1)
                GoTo Exitfunction                'no need for further looping
                End If
            End If
        End If
    rst.MoveNext
    i = i + 1
    Wend
GoTo Exitfunction

ErrorAndExit:
    MsgBox "Error: " & Err.Description & vbNewLine & "Errornumber: " & Err.Number, vbOKOnly, "Error"

Exitfunction:
Set dbs = Nothing
Set rst = Nothing

End Function

 

[tlitman09]

That is amazing! You are awesome. This is exactly what I was looking for. Now I just have to create a function to return the end date. I will try to follow your code to create that.

Thank you so much,
Tyler

 

[tlitman09]

If you don't mind me asking, what does the line in the SQL string after the and do? Is that how you are determining the record the patient name is currently passing to the function?

Thank you again,
Tyler

 

[tlitman09]

Sorry to ask again, but I can not seem to figure out how to make the end dates work like the start dates do. This code works for most of them, but it seems to have an issue with some of them. For example:

I receive the following for one of the patients(picture attached).

The first record is not returning the correct discharge date. Any idea why?

Thank you so much,
Tyler

Public Function patientDischarge(patientName As String, endDate As Date) As Date
Dim dbs As Database
    Dim rst As Recordset
    Dim StrSQl As String
    Dim Startdates(10) As Date 'create a matrix of 10 positions
    Dim enddates(10) As Date
    Dim i As Integer
 
    On Error GoTo ErrorAndExit
    'CHANGES FROM PATIENTADMIT()
    'StrSQL ((endDate)>= instead of ((endDate)<=
    'StrSQL startDate occurrances changed to endDate
    'In if then statement moveprevious and movenext added
    'else statement patientDischarge = enddates(i) instead of enddates(i - 1)
 
    StrSQl = "SELECT patientName, startDate, endDate " & _
             "FROM MyRecords " & _
             "WHERE (((patientName)= '" & patientName & "') " & _
             "AND ((endDate)>= #" & Format(endDate, "mm-dd-yyyy") & "#) ) " & _
             "ORDER BY MyRecords.endDate DESC;"
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(StrSQl)
 
    'check recordset
    If Not rst.EOF And Not rst.BOF Then
        rst.MoveLast
        rst.MoveFirst
    End If
    i = 0 'initialise counter
 
    While Not rst.EOF And Not rst.BOF
        If rst.RecordCount = 1 Then         'if theres only one entry no furter testing
            patientDischarge = rst!endDate
        Else
            Startdates(i) = rst!startdate       'dump dates in an array
            enddates(i) = Nz(rst!endDate, Date) 'if no enddate entered us today
            If i > 0 Then                       'if more the one date check for
                If enddates(i) + 1 = Startdates(i - 1) Then
                    rst.MovePrevious
                    patientDischarge = rst!endDate
                    rst.MoveNext
                Else
                patientDischarge = enddates(i)
                GoTo Exitfunction                'no need for further looping
                End If
            End If
        End If
    rst.MoveNext
    i = i + 1
    Wend
GoTo Exitfunction
ErrorAndExit:
    MsgBox "Error: " & Err.Description & vbNewLine & "Errornumber: " & Err.Number, vbOKOnly, "Error"
Exitfunction:
Set dbs = Nothing
Set rst = Nothing
End Function

 

[tlitman09]

Sorry, one more question. In this part of the code:

i = 0 'initialise counter
    
    While Not rst.EOF And Not rst.BOF
        If rst.RecordCount = 1 Then         'if theres only one entry no furter testing
            patientDischarge = rst!endDate
        Else
            Startdates(i) = rst!startdate       'dump dates in an array
            enddates(i) = Nz(rst!endDate, Date) 'if no enddate entered us today
            If i > 0 Then                       'if more the one date check for
                If enddates(i) + 1 = Startdates(i - 1) Then

What value is assigned to "i" after the array is populated? I am asking because when I try to do the end date, I do not know what value I am pulling with i or i-1 etc.

Thanks,
Tyler

 

[tlitman09]

Actually, I figured out the answers to two of the three questions, so you can disreguard them. Now, the only one I have is how to adapt this function to work for the end date?

Thanks,
Tyler

 

[tlitman09]

Never mind all together . I finally figured out what you did and was able to adapt it. Sorry for being such a pain .



Thank you so much for all of your help and time,
Tyler

Here is my final code.

Public Function patientDischarge(patientName As String, endDate As Date) As Date
    Dim dbs As Database
    Dim rst As Recordset
    Dim StrSQl As String
    Dim Startdates(10) As Date 'create a matrix of 10 positions
    Dim enddates(10) As Date
    Dim i As Integer
    
    On Error GoTo ErrorAndExit
    StrSQl = "SELECT patientName, startDate, endDate " & _
             "FROM MyRecords " & _
             "WHERE (((patientName)= '" & patientName & "') " & _
             "AND ((endDate)>= #" & Format(endDate, "mm-dd-yyyy") & "#) ) " & _
             "ORDER BY MyRecords.endDate ASC;"
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(StrSQl)
 
    'check recordset
    If Not rst.EOF And Not rst.BOF Then
        rst.MoveLast
        rst.MoveFirst
    End If
    i = 0 'initialise counter
    
    Do While Not rst.EOF And Not rst.BOF
        If rst.RecordCount = 1 Then         'if theres only one entry no furter testing
            patientDischarge = rst!endDate
        Else
            Startdates(i) = rst!startDate       'dump dates in an array
            enddates(i) = Nz(rst!endDate, Date) 'if no enddate entered us today
            If i > 0 Then                       'if more the one date check for
                If enddates(i - 1) + 1 = Startdates(i) Then
                    patientDischarge = enddates(i)
                Else
                    patientDischarge = enddates(i - 1)
                    GoTo Exitfunction           'no need for further looping
                End If
            End If
        End If
    rst.MoveNext
    i = i + 1
    Loop
GoTo Exitfunction
ErrorAndExit:
    MsgBox "Error: " & Err.Description & vbNewLine & "Errornumber: " & Err.Number, vbOKOnly, "Error"
Exitfunction:
Set dbs = Nothing
Set rst = Nothing

End Function