Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Complicated algorithm - could not figure this out by mys
Message
 
 
To
15/07/2002 16:14:02
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Miscellaneous
Thread ID:
00678774
Message ID:
00678844
Views:
18
Hi Steve,

All are good points, thanks a lot. I made few other changes. You're right, I don't need an additional skip. Here is my current code:
********************************************************************
*  Description.......: PopulateBldMstr - this program is supposed to create
*                    : one BldMstr record from multiple records in the source file
*  Calling Samples...: PopulateBldMstr('RegMstr','RegOut')
*  Parameter List....: tcSourceTable, tcOutTable
*  Created by........: Nadya Nosonovsky 07/12/2002 12:49:16 PM
*  Modified by.......: Nadya Nosonovsky 07/15/2002 04:39:51 PM
********************************************************************
lparameter tcSourceTable, tcOutTable
local lcDataDir, lnStartTime
lnStartTime = seconds()				&& # seconds since midnight
lcDataDir = curdir()+'Data\'

if vartype(m.tcSourceTable)<>"C" or not file(forceext(m.lcDataDir+m.tcSourceTable,'DBF'))
	tcSourceTable = getfile('DBF', '', '', 0, 'Select Source Table')
endif

if vartype(m.tcOutTable)<>"C"
	tcOutTable = InputBox('Enter output table name','Choose name for output file')
endif

if empty(m.tcOutTable)
	return .f.
endif

if file(forceext(m.lcDataDir+m.tcOutTable,'DBF')) and messagebox('File '+ m.tcOutTable + ;
		' already exists.' + chr(13) + 'Do you want to re-create it?',36,'File already exists')=7
	return && User doesn't want to produce a new file
endif

if not UseTble(m.lcDataDir+'BldMstr','Template')
	return .f.
endif

if not UseTble(iif(empty(justpath(m.tcSourceTable)),m.lcDataDir,"")+ m.tcSourceTable, ;
		'Srce','exclusive','Geo') && Assume, it already has the correct index
	return .f.
endif

if not UseTble('Lookups!Towns','Towns','shared noupdate','FullName')
	return .f.
endif

if not UseTble('Lookups!Lender','Lender','shared noupdate','FullName')
	return .f.
endif

select Template
use in select('OutTble')
copy to (m.lcDataDir+m.tcOutTable) with cdx && Create a copy of the template
use in Template && Close

if not UseTble(m.lcDataDir+m.tcOutTable, 'OutTble')
	return .f.
endif

local lcAddress, ldDate, lnBuyerCount, ;
	lnSellerCount, lnPrice, lnMortgage, lnRecNum, lcBuyerRel

select OutTble
scatter memvar memo

select Srce
go top
lcAddress = upper(Srce.City+Srce.Address+Srce.LotUnit)


private plHalt, plNoQuestion
plNoQuestion = .f.

local lcPrevOnEsc, lcPrevEscape, lnCount, lnReccount, lnUpdateNumber, ;
	lcMsgTail, lcStatusBar, loTherm, lnElapsed, lnTally

* support user Escapes for interrupting the main loop
lcPrevOnEsc = on('escape')				&& save previous Escape handler
lcPrevEscape = set('escape')			&& previous Escape enablement state
set escape on							&& enable escape handling
plHalt = .f.							&& allow loop to run until this flag is toggled
on escape plHalt = .t.					&& force immediate termination if user escapes
lnReccount=reccount()
set message to 'Processing '+transform(m.lnReccount)+' records'
do case
case m.lnReccount<100 && Very rare case
	lnUpdateNumber=1
case between(m.lnReccount,100,10000)
	lnUpdateNumber=100
case m.lnReccount>10000
	lnUpdateNumber=val('1'+replicate('0',len(transform(m.lnReccount))-3))
endcase
* assemble fixed portion of status bar message outside of loop, for speed
lcMsgTail = "/" + transform(m.lnReccount) + ".  Wait or press Esc to cancel ..."

*--- instantiate thermometer bar class....
wait window nowait "Processing " + transform(m.lnReccount) + " records from " + ;
	m.tcSourceTable + chr(13)+ " to " + m.tcOutTable


loTherm = newobject("thermometer", "wg.vcx","", ;
	"Processing "+transform(m.lnReccount)+" records from "+ m.tcSourceTable,m.lnReccount)

loTherm.show()
lcStatusBar=set('status bar')
set status bar on

store 0 to lnCount, lnBuyerCount, lnSellerCount, lnRecNum, lnTally

local llSale, llInsert
llSale = .f.
llInsert = .f.

*set step on

do while not eof()

	release arrMtgInfo, arrSaleInfo && Release array from the previous address
	select OutTble
	scatter memvar blank

	store 0 to lnPrice, lnMortgage, lnBuyerCount, lnSellerCount

	lcAddress = upper(Srce.City+Srce.Address+Srce.LotUnit)

	if m.plHalt && User is trying to stop the process

		if m.plQuestion && Question was aksed in the inner loop
			exit
		else
			if messagebox('Do you want to stop the process?',36,'Stop Process')=6
				exit
			else
				plHalt = .f.
			endif
		endif
	endif

** Update status message
	if m.lnCount>0  and mod(m.lnCount,100) = 0
		set message to 'Record # '+transform(m.lnCount)+m.lcMsgTail
	endif

** Update thermometer
	if m.lnCount>0  and mod(m.lnCount,m.lnUpdateNumber) = 0
		loTherm.update(m.lnCount)
	endif

	select towns
	locate for State='MA' and fullname = proper(Srce.City)
	if found()
		town = towns.town
		ccode = towns.ccode
	else && Should not happen
		town = space(4)
		ccode = space(2)
	endif

	select Srce
	Pstreet = alltrim(Srce.Address)+ ;
		iif(not alltrim(Srce.LotUnit) $ Srce.Address,alltrim(Srce.LotUnit),'')

	lnRecNum = m.lnRecNum+1

	store .f. to llSale, llInsert

** Inner loop within the same address
	do while upper(Srce.City+Srce.Address+Srce.LotUnit)= m.lcAddress
		lnCount=m.lnCount+1
		
		lcBuyerRel = BuyerRel
		
		if m.plHalt

			if messagebox('Do you want to stop the process?',36,'Stop Process')=6
				plQuestion = .t.
				exit
			else
				plHalt = .f.
			endif
		endif

** Update status message
		if m.lnCount>0 and mod(m.lnCount,100) = 0
			set message to 'Record # '+transform(m.lnCount)+ m.lcMsgTail
		endif

** Update thermometer
		if m.lnCount>0 and mod(m.lnCount,m.lnUpdateNumber) = 0
			loTherm.update(m.lnCount)
		endif

		scatter memvar
		lnPrice = Srce.Price
		lnMortgage = Srce.Mortgage

		if inlist(Srce.DocType,'DEED','FDAFT') and empty(m.Source)
			source = 'S'
			ldDate = date
			llSale = .t.
			select Srce

			if type('arrSaleInfo[1]')='U' && Array doesn't exist yet
				local array arrSaleInfo[1,3]
				arrSaleInfo[1,1] = Srce.DocketRef
				arrSaleInfo[1,2] = Srce.Book
				arrSaleInfo[1,3] = Srce.page
			endif

			lnPrice = Price
			replace RecNum with m.lnRecNum
		endif

		if not empty(Srce.LenderName)
			lName =  substr(Srce.LenderName,1,40)
			if seek(m.lName,'Lender')
				Lender = Lender.code
				lName = ""
			endif
		endif

&& Buyer List
		if not empty(Srce.BuyerName) and m.lnBuyerCount = 1
			Buyer2 = Srce.BuyerName
			lnBuyerCount = 2
		endif

		if not empty(Srce.BuyerName) and m.lnBuyerCount = 0
			Buyer1 = Srce.BuyerName
			lnBuyerCount = 1
		endif


&& Seller List
		if not empty(Srce.SellerName) and m.lnSellerCount = 1
			Seller2 = Srce.SellerName
			lnSellerCount = 2
		endif

		if not empty(Srce.SellerName) and m.lnSellerCount = 0
			Seller1 = Srce.SellerName
			lnSellerCount = 1
		endif

		if Srce.DocType = 'MTG' && Starts from MTG or it's a new MTG record
			source = 'M'
			llSale = .f.

			if type('arrMtgInfo[1]')='U' && Array doesn't exist yet
				local array arrMtgInfo[1,3]
				arrMtgInfo[1,1] = Srce.DocketRef
				arrMtgInfo[1,2] = Srce.Book
				arrMtgInfo[1,3] = Srce.page
				lnMortgage = Mortgage
				replace RecNum with m.lnRecNum in Srce
			else
				if arrMtgInfo[1,1] <> Srce.DocketRef or ;
						arrMtgInfo[1,2] <> Srce.Book  or ;
						arrMtgInfo[1,3] <> Srce.page
					llInsert = .t.
				else && Continue with other Mortgage info
					replace RecNum with m.lnRecNum in Srce
				endif
			endif  && arrMtgInfo
		endif && DocType

		if m.llInsert
			if type('arrSaleInfo[1]')<>'U' && Sale Array does exist
				DocketRef = arrSaleInfo[1,1]
				Book = arrSaleInfo[1,2]
				page = arrSaleInfo[1,3]
				source = 'S'
				Price = m.lnPrice
				Mortgage = m.lnMortgage
				date = m.ldDate
			else && Mortgage only
				source = 'M'
				DocketRef = arrMtgInfo[1,1]
				Book = arrMtgInfo[1,2]
				page = arrMtgInfo[1,3]
				Mortgage = m.lnMortgage
				Price = 0
			endif

			select OutTble
			RecNum = m.lnRecNum
			insert into OutTble from memvar
			lnRecNum = m.lnRecNum + 1
			store 0 to lnPrice, lnMortgage, lnBuyerCount, lnSellerCount
			lnTally = m.lnTally + 1 && New record was added

			scatter memvar fields ;
				date, DeedType, source, Price, Mortgage, ;
				Buyer1, Buyer2, BuyerRel, Seller1, Seller2, SellerRel, ;
				lName, Lender, DocketRef, Book, page blank
			select Srce
			release arrSaleInfo, arrMtgInfo
			llInsert = .f.
		endif

		if eof('Srce')
			exit
		endif

		skip && New record in inner loop
	enddo

	if not seek(m.lnRecNum,'OutTble','RecNum') && This info is not yet inserted into outtble
		if type('arrSaleInfo[1]')<>'U' && Sale Array does exist
			DocketRef = arrSaleInfo[1,1]
			Book = arrSaleInfo[1,2]
			page = arrSaleInfo[1,3]
			source = 'S'
			Price = m.lnPrice
			Mortgage = m.lnMortgage
			date = m.ldDate
		else && Mortgage only		
			source = 'M'
			DocketRef = arrMtgInfo[1,1]
			Book = arrMtgInfo[1,2]
			page = arrMtgInfo[1,3]
			Mortgage = m.lnMortgage
			Price = 0
		endif
		
        BuyerRel = m.lcBuyerRel
        
		RecNum = m.lnRecNum
		insert into OutTble from memvar
		lnTally = m.lnTally + 1 && New record was added
	endif

	select Srce
	if eof('Srce')
		exit
	endif
*	skip && Skip in the outer loop - don't need it
enddo

on escape &lcPrevOnEsc

if m.lcPrevEscape='OFF'
	set escape off
endif

if m.lcStatusBar = 'OFF'
	set status bar off
endif

local lnEndTime, lnElapsedTime, lnMinutes, lnSeconds
lnEndTime = seconds()
lnElapsedTime=m.lnEndTime-m.lnStartTime
lnMinutes=int(m.lnElapsedTime/60)
lnSeconds=round(m.lnElapsedTime-m.lnMinutes*60,0)

wait "Created "+transform(m.lnTally)+" records in " + m.tcOutTable+" in: "+ ;
	iif(m.lnMinutes>0, transform(m.lnMinutes)+" minutes ","")+ ;
	transform(m.lnSeconds) + " seconds..." window nowait
>Hello Nadya,
>
>I noticed you fixed one problem...you moved the following to the bottom of the inner loop:
>
>
>if eof()
>    exit
>endif
>skip && New record in inner loop
>
>However, the SKIP should be first. You are already on a record (you are processing one), eof() won't occur until you issue a SKIP while sitting on the last record.
>
>Also, the inner loop processes appears to process more than one record that have the same address. When the last record of a given record is processed, you do something that relates to a sale without a mortgage. Then you do another skip, in the outer loop. Does this cause some records to not be processed? IOW, there are some records that would never see the top of the loop.
>
>How do you ensure the addresses are typed the same way? Is it possible that there are two entries with the same physical address, that are entered slightly differently?


I guess, it's possible, but it would make my algorithm more complicated. I need to do some auto processing first. Then I need to present result to the user. User should be able to indicate problems and Un-Link/Link together some records.

I haven't thought about this part of UI yet, because I was busy (the whole day today) on this hard algorithm. I believe I fixed it now, but I'm not 100% sure.

If you want and have some spare time, I can send you the tables and the latest program. You can try to play with it.

How does it sound?


Thanks again for your help.

Such as '1111 Oak Drive', and '1111 Oak Dr.' on the next record.
>
>Another point, since you are not doing a SCAN/ENDSCAN, it would seem safer to me if you are more explicit with your work areas, just in case the work area gets changed. For example:
>
>
>do while not eof('Srce')
>...
>    skip 1 in Srce
>enddo
>
>
>>Here is my new code. Does anybody see problems?
>< SNIP >
If it's not broken, fix it until it is.


My Blog
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform