******************************************************************** * 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,
>if eof() > exit >endif >skip && New record in inner loop>
>do while not eof('Srce') >... > skip 1 in Srce >enddo >>