Using the following code I get Runtime Error 3027; Object is Read Only:
Private Sub FixCC_To_Hospice()
On Error GoTo PROC_ERR
Dim cd As DAO.Database
Dim rs As DAO.Recordset
Dim SQL As String
Dim rc As Integer
SQL = "SELECT P.PatientID, P.CC_OriginalStatus, P.CC_CurrentStatus, A.PatientID, A.AdmissionID, A.CurrentCC_Status, A.DateOfAdmission " & _
"FROM tblPatientInformation P, tblAdmissions A " & _
"WHERE (P.PatientID = A.PatientID) AND (P.CC_OriginalStatus = 'NTUC') " & _
"ORDER BY P.PatientID, A.DateOfAdmission"
Set cd = CurrentDb()
Set rs = cd.OpenRecordset(SQL, dbOpenDynaset)
If rs.EOF = False Then
rc = rs.RecordCount
Debug.Print "Record count: " & rc
Else
MsgBox "No records found!", vbOKOnly + vbInformation, "No records found..."
Exit Sub
End If
rs.MoveFirst
Dim found As Boolean
found = False
Dim pn1 As String
Dim pn2 As String
Dim cs1 As String
Dim cs2 As String
Do While rs.EOF = False
cs1 = rs("CurrentCC_Status").Value
pn1 = rs("A.PatientID").Value
rs.MoveNext
cs2 = rs("CurrentCC_Status").Value
pn2 = rs("A.PatientID").Value
If pn1 = pn2 And found = False Then
If cs1 = "NTUC" And cs2 = "CC(Live Discharge) -> O-VC Hospice" Then
found = True
rs.Edit
rs("CurrentCC_Status").Value = "CC(NTUC) -> O-VC Hospice"
rs.Update
End If
Else
If pn1 <> pn2 Then
found = False
End If
End If
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Set cd = Nothing
PROC_EXIT:
Exit Sub
PROC_ERR:
MsgBox Err.Description
Resume PROC_EXIT
End Sub