Code:
Public Sub Import_Health_Education()
Dim add As String, diabtype As Long
rsmain.Open "Select * from dbo_tbl_DM_Wellness", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
Do Until rsmain.EOF
If Not IsNull(rsmain!LastName) And Not IsNull(rsmain!FirstName) And Not IsNull(rsmain!DOB) Then
strsql = "Select PersonID From dbo_tbl_person where lastname = """ & rsmain!LastName & """ and firstname = """ & _
rsmain!FirstName & """ and dob = #" & rsmain!DOB & "#"
rsperson.Open strsql, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
If rsperson.EOF Then
strsql = "Insert Into dbo_tbl_Person (PersonKey,LastName,Firstname,DOB,Gender,HPCode,pcp) Values (""" & _
Left(rsmain!LastName, 4) & Left(rsmain!FirstName, 4) & Format(rsmain!DOB, "mmddyyyy") & """,""" & _
rsmain!LastName & """,""" & rsmain!FirstName & """," & _
IIf(IsNull(rsmain!DOB), "Null", "#" & rsmain!DOB & "#") & ",""" & _
rsmain!Gender & """,""" & rsmain!hpcode & """,""" & rsmain!pcp & """)"
rsout.ActiveConnection = CurrentProject.Connection
rsout.CommandText = strsql
rsout.Execute
rsperson.Close
strsql = "Select PersonID From dbo_tbl_person where lastname = """ & rsmain!LastName & """ and firstname = """ & _
rsmain!FirstName & """ and dob = #" & rsmain!DOB & "#"
rsperson.Open strsql, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
End If
End If
'Save Addresses
add = Replace(rsmain!StreetAddress, Chr(34), "")
strsql = "insert into dbo_tbl_Address (personid, address, unit,city,state,zip,zipplus,addtype,chdate," & _
"chby) values " & _
"(" & rsperson!PersonID & ",""" & add & """,""" & """,""" & rsmain!City & """,""" & rsmain!State & """,""" & _
rsmain!zip & """,""" & rsmain!zipplus & """," & _
2 & ", #" & Date & "#,""" & GetLoginName() & """)"
rsout.ActiveConnection = CurrentProject.Connection
rsout.CommandText = strsql
rsout.Execute
If Not IsNull(rsmain!email) Then
strsql = "insert into dbo_tbl_emails (personid,emailaddress) values (" & rsperson!PersonID & ",""" & rsmain!email & """)"
rsout.CommandText = strsql
rsout.Execute
End If
'Home Phone
If Not IsNull(rsmain!phone) Then
If IsNumeric(Left(rsmain!phone, 1)) Then
strsql = "insert into dbo_tbl_phone (personid,phonenumber,phonetype) values(" & rsperson!PersonID & ",""" & rsmain!phone & """,1)"
Else
strsql = "insert into dbo_tbl_phone (personid,phonenumber,phonetype) values(" & rsperson!PersonID & ",""" & Left(rsmain!phone, 12) & """,1)"
End If
rsout.CommandText = strsql
rsout.Execute
End If
strsql = "Select DiabTypeID from dbo_tbl_diab_type where DiabDesc = """ & rsmain!diabtype & """"
rsdiab.Open strsql, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
If rsdiab.EOF Then diabtype = 3 Else diabtype = rsdiab!diabtypeid
strsql = "insert into dbo_tbl_Health_Education(personid,status,Date_Recd,Referred_Date,Referred_Source,ClassType,DiabType,last_Office_Visit,Closed_Reason) values " & _
"(" & rsperson!PersonID & "," & IIf(rsmain!Status = 2, 9, 8) & ",#" & rsmain!HE_Received & "#,#" & rsmain!Referred_Date & "#,""" & rsmain!referral_source & """," & _
rsmain!Type & "," & diabtype & "," & IIf(IsNull(rsmain!last_office_visit), "Null", "#" & rsmain!last_office_visit & "#") & _
",""" & rsmain!closed_reason & """)"
rsout.CommandText = strsql
rsout.Execute
strsql = "Select * from dbo_tbl_Contacts1 where PatientID = " & rsmain!PatientID
rscontacts.Open strsql, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
Do Until rscontacts.EOF
strsql = "Insert Into dbo_tbl_contacts (contactdate,contacttext,personid,createdby,contacttype,programtype) values (#" & _
rscontacts!ContactDate & "#,""" & rscontacts!contactdesc & """," & rsperson!PersonID & ",""" & GetLoginName() & """,1,2)"
rsout.ActiveConnection = CurrentProject.Connection
rsout.CommandText = strsql
rsout.Execute
rscontacts.MoveNext
Loop
rsperson.Close
rsmain.MoveNext
Loop
End Sub
As you can see the same routine is used several times and works all except for the last one.