Bellow is the whole code of this procedure. It took me several hours to write and debug and find all dependancies of various PKs in our system. I would appreciate your suggestions of improving this code.
if vartype(m.goApp) = 'U' and vartype(m.gcDatabasePath) = 'U'
private gcDatabasePath
gcDatabasePath = getfile('DBC','Select Database','Select',1, ;
'Select Database to de-dup Patients')
if empty(m.gcDatabasePath)
return .f.
else
open database (m.gcDatabasePath)
set database to (m.gcDatabasePath)
endif
endif
if not ('common_utility') $ lower(set("Procedure"))
set procedure to common_utility additive
endif
local lcError, loDeDup
loDeDup = newobject('DedupPatients')
lcError = loDeDup.RunProcess()
=messagebox(m.lcError)
return m.lcError
define class DedupPatients as BusinessProcess
lRunUpdates = .f.
lStopProcess = .f.
name = "DedupPatients"
lRealError = .f.
procedure CommitChanges
lparameters tnUpdated
local llReturn, lcError
local array laError[1]
with this
begin transaction
lcError = ""
if m.tnUpdated > 0
if not tableupdate(.t.,.t.,'Scheduled_Letters')
=aerror(laError)
lcError = "Error in updating Scheduled_Letters table: " + ;
laError[2] + ;
chr(13) + chr(10) + .GetTriggerError()
endif
if empty(m.lcError)
if not tableupdate(.t.,.t.,'Insurances')
=aerror(laError)
lcError = "Error in updating Insurances table: " + ;
laError[2] + ;
chr(13) + chr(10) + .GetTriggerError()
endif
endif
if empty(m.lcError)
if not tableupdate(.t.,.t.,'Trans')
=aerror(laError)
lcError = "Error in updating Trans table: " + ;
laError[2] + ;
chr(13) + chr(10) + .GetTriggerError()
endif
endif
if empty(m.lcError)
if not tableupdate(.t.,.t.,'Address')
=aerror(laError)
lcError = "Error in updating Address table: " + ;
laError[2] + ;
chr(13) + chr(10) + .GetTriggerError()
endif
endif
if empty(m.lcError)
if not tableupdate(.t.,.t.,'Phones')
=aerror(laError)
lcError = "Error in updating Phones table: " + ;
laError[2] + ;
chr(13) + chr(10) + .GetTriggerError()
endif
endif
if empty(m.lcError)
if not tableupdate(.t.,.t.,'Names')
=aerror(laError)
lcError = "Error in updating Names table: " + ;
laError[2] + ;
chr(13) + chr(10) + .GetTriggerError()
endif
endif
if empty(m.lcError)
if not tableupdate(.t.,.t.,'Patients')
=aerror(laError)
lcError = "Error in updating Patients table: " + ;
laError[2] + ;
chr(13) + chr(10) + .GetTriggerError()
endif
endif
endif
if empty(m.lcError)
end transaction
.WriteToLogfile("Committed all changes...")
llReturn = .t.
else
rollback
tablerevert(.t.,"Trans")
tablerevert(.t.,"Address")
tablerevert(.t.,"Names")
tablerevert(.t.,"Phones")
tablerevert(.t.,"Insurances")
tablerevert(.t.,"Scheduled_Letters")
tablerevert(.t.,"Patients")
.cError = lcError
llReturn = .f.
=messagebox(m.lcError)
endif
endwith
return m.llReturn
endproc
procedure OpenProcessTables
use in select('Trans')
use MMVisCollect!trans again in 0 alias trans shared
cursorsetprop("Buffering",5,'Trans')
use in select('Names')
use MMVisCollect!Names again in 0 alias Names shared
cursorsetprop("Buffering",5,'Names')
use in select('Patients')
use MMVisCollect!Patients again in 0 ;
alias Patients shared
cursorsetprop("Buffering",5,'Patients')
use in select('Insurances')
use MMVisCollect!Insurances again in 0 alias Insurances shared
cursorsetprop("Buffering",5,'Insurances')
use in select('Address')
use MMVisCollect!Address again in 0 alias Address shared
cursorsetprop("Buffering",5,'Address')
use in select('Phones')
use MMVisCollect!Phones again in 0 alias Phones shared
cursorsetprop("Buffering",5,'Phones')
use in select('Scheduled_Letters')
use MMVisCollect!Scheduled_Letters again in 0 alias Scheduled_Letters shared
cursorsetprop("Buffering",5,'Scheduled_Letters')
endproc
procedure RunProcess
this.OpenProcessTables()
local lcError
lcError = ""
try
select cPatients_pk, tEntered_Date, ;
tLast_Updated_Date, Patients.dDOB, ;
Patients.cSSN, Patients.cSex_Code, step1.cntDups from Patients ;
inner join ;
(select count(*) as cntDups, Patients.dDOB, Patients.cSSN ;
from Patients group by 2,3 having cntDups >1 where cSSN<>space(9) and dDOB<>{}) step1 ;
on Patients.dDOB = step1.dDOB and Patients.cSSN = step1.cSSN ;
order by Patients.dDOB, Patients.cSSN ;
into cursor curPossibleDups
index on cPatients_pk tag cPat_pk
set order to
select cr.cPatients_pk, cr.tEntered_Date, ;
cr.tLast_Updated_Date, cr.dDOB, cr.cSSN, cr.cSex_Code, ;
Names.cf_Name, Names.cl_Name, Names.cM_Initial, ;
Address.cStreet1, Address.cCity, ;
nvl(cAREA_CODE,space(3)) as cAREA_CODE, ;
nvl(cEXCHANGE,space(3)) as cEXCHANGE, ;
nvl(cLAST_FOUR, space(4)) as cLAST_FOUR, cntDups, Names.cNames_pk ;
from curPossibleDups cr inner join Names ;
on cr.cPatients_pk = Names.cPointer_fk ;
inner join Address ;
on cr.cPatients_pk = Address.cPointer_fk ;
left join Phones ;
on cr.cPatients_pk = Phones.cPointer_fk ;
order by 4,5,6,8,7 ;
where Names.iAlias_Flag = 0 ;
into cursor curDupPatients readwrite
select min(cr.cPatients_pk) as cPatients_pk, ;
min(cr.tEntered_Date) as tEntered_Date, ;
min(cr.tLast_Updated_Date) as tLast_Updated_Date, ;
cr.dDOB, cr.cSSN, cr.cSex_Code, ;
cr.cf_Name, cr.cl_Name, cr.cM_Initial, ;
cr.cStreet1, cr.cCity, ;
cr.cAREA_CODE, ;
cr.cEXCHANGE, ;
cr.cLAST_FOUR, cntDups ;
from curDupPatients cr ;
group by cr.dDOB, cr.cSSN, cr.cSex_Code, ;
cr.cf_Name, cr.cl_Name, cr.cM_Initial, ;
cr.cStreet1, cr.cCity, ;
cr.cAREA_CODE, ;
cr.cEXCHANGE, ;
cr.cLAST_FOUR, cntDups ;
order by 4,5,6,8,7 ;
into cursor curKeep readwrite
select distinct cr.* , iif(isnull(cr2.cPatients_pk), ;
"ELIMINATE", space(9)) as cEliminate ;
from curDupPatients cr ;
left join curKeep cr2 on cr.cPatients_pk = cr2.cPatients_pk ;
order by cr.dDOB, cr.cSSN, cr.cSex_Code, ;
cr.cf_Name, cr.cl_Name, cr.cM_Initial, ;
cr.cStreet1, cr.cCity, ;
cr.cAREA_CODE, ;
cr.cEXCHANGE, ;
cr.cLAST_FOUR, ;
cr.cntDups, cEliminate ;
into cursor curWork readwrite
select distinct * from curWork into cursor curWork nofilter
count to lnEliminate for cEliminate = 'ELIMINATE'
if messagebox("We're going to eliminate " + transform(m.lnEliminate) + " patients PK. Proceed?",4) = 6
local lcPatients_pk, lcEliminate, lnUpdated, lcNames_pk
select curWork
private glDontUpdateUserAndTime
glDontUpdateUserAndTime = .t.
lnUpdated = 0
scan
if empty(cEliminate)
lcPatients_pk = cPatients_pk
lcNames_pk = cNames_pk
else
if not xEmpty(m.lcPatients_pk)
lcEliminate = cPatients_pk
update Scheduled_Letters set cNames_fk = m.lcNames_pk ;
where cNames_fk = curWork.cNames_pk
update Insurances set cPatients_fk = m.lcPatients_pk ;
where cPatients_fk = m.lcEliminate
update trans set cPatients_fk = m.lcPatients_pk ;
where cPatients_fk = m.lcEliminate
lnUpdated = m.lnUpdated + _tally
delete from Names where cPointer_fk = m.lcEliminate
delete from Address where cPointer_fk = m.lcEliminate
delete from Phones where cPointer_fk = m.lcEliminate
delete from Patients where cPatients_pk = m.lcEliminate
endif
endif
endscan
this.CommitChanges(m.lnUpdated)
endif
catch to loErr
lcError = Log_Error(m.loErr)
endtry
return m.lcError
endproc
enddefine
If it's not broken, fix it until it is.
My Blog 
