Hi,
This is the entire function code:
Thanks
Function HerniaRepair()
Dim sqlStr As String
Dim rst As DAO.Recordset
Dim sqlInsert As String
Dim lName As String
Dim lMrn As String
Dim lInvNum As String
Dim lCpt As String
Dim lCpt54640 As Boolean
Dim lCptOverlap As Boolean
Dim lDOS As Date
Dim lProv As String
Dim PrevName As String
Dim PrevMrn As String
Dim PrevInvNum As String
Dim PrevCpt As String
Dim PrevDOS As Date
Dim PrevProv As String
Dim dummy
DoCmd.SetWarnings False
sqlStr = "SELECT * FROM URO_HERNIA_REPAIR_040909 ORDER BY invnum, cpt Desc "
Set rst = CurrentDb.OpenRecordset(sqlStr, dbOpenDynaset)
Debug.Print sqlStr
lName = rst!patname
lMrn = rst!mrn
lInvNum = rst!invnum
lCpt = rst!cpt
lDOS = rst!dos
lProv = rst!prov
With rst
Do Until rst.EOF
If rst!invnum = lInvNum Then
If rst!cpt = "54640" Then
lCpt54640 = True
End If
If rst!cpt = "49500" Or rst!cpt = "49501" Or rst!cpt = "49502" Or rst!cpt = "49503" Or rst!cpt = "49504" Or rst!cpt = "49505" Or rst!cpt = "49506" Or rst!cpt = "49507" And lCpt54640 = True Then
lCptOverlap = True
End If
PrevName = rst!patname
PrevMrn = rst!mrn
PrevInvNum = rst!invnum
PrevCpt = rst!cpt
PrevDOS = rst!dos
PrevProv = rst!prov
Else
If lCptOverlap = True Then
sqlInsert = "Insert into URO_HERNIA_REPAIR_UNIQUE (patname, mrn, invnum, DOS, PROV, cpt) " & " values ('" & Nz(pervName, "") & "','" & Nz(PrevMrn, "") & "','" & Nz(PrevInvNum, "") & "','" & Nz(PrevDOS, "") & "','" & Nz(PrevProv, "") & "','" & Nz(PrevCpt, "") & "')"
Debug.Print sqlInsert
DoCmd.RunSQL sqlInsert
lName = rst!patname
lMrn = rst!mrn
lInvNum = rst!invnum
lCpt = rst!cpt
lDOS = rst!dos
lProv = rst!prov
lCpt54640 = False
lCptOverlap = False
If rst!cpt = "54640" Then
lCpt54640 = True
End If
If rst!cpt = "49500" Or rst!cpt = "49501" Or rst!cpt = "49502" Or rst!cpt = "49503" Or rst!cpt = "49504" Or rst!cpt = "49505" Or rst!cpt = "49506" Or rst!cpt = "49507" And lCpt54640 = True Then
lCptOverlap = True
End If
PrevName = rst!patname
PrevMrn = rst!mrn
PrevInvNum = rst!invnum
PrevCpt = rst!cpt
PrevDOS = rst!dos
PrevProv = rst!prov
End If
rst.MoveNext
Loop
If lCptOverlap = True Then
sqlInsert = "Insert into URO_HERNIA_REPAIR_UNIQUE (patname,mrn,invnum,cpt) " & " values ('" & Nz(pervName, "") & "','" & Nz(PrevMrn, "") & "','" & Nz(PrevInvNum, "") & "','" & Nz(PrevCpt, "") & "')"
Debug.Print sqlInsert
DoCmd.RunSQL sqlInsert
End If
rst.Close
DoCmd.SetWarnings True
End With
End Function
Mo