Mike

Here is the whole module. I'm sure there is a ton of cleanup that could be done, and any help/suggustions greatly appreicated. This code is called from a UI form where they select the procedures, dates, physician and patient, then click find me a slot button. This is the once section of code that I know I can make better. I just haven't figured out how yet. It's fast if it finds a hit early, but if the search period is two weeks, and the available slots don't show till the last day, 2-3 minutes. My goal is return the results in under 30 seconds.

***************************************************************************************
* Program: ctManSet2.prg
* Purpose: Return a result set of available times to schedule a Manually created procedure set
***************************************************************************************
PARAMETERS tdStartDate,tdEndDate
* Load Our Library
LOCAL x
SET PROCEDURE TO ctsch3fun ADDI
IF VARTYPE(tdStartDate)=[T]
	tdEndDate=tdStartDate+(86400*90)
ENDIF
ldStartOn=tdStartDate
ldEndOn=tdEndDate
lnDaysToSearch=	TTOD(tdEndDate)-TTOD(tdStartDate)
lcStartDate=DTOC(tdStartDate)
lcEndDate=DTOC(tdEndDate)
PUBLIC gcResultString

gcResultString=""
***************************************************************************************
* Create our Temp Canidate Table to store our results into
***************************************************************************************
IF USED('xcanidate')
	SELECT xcanidate
	USE
ENDIF
IF SQLEXEC(gnConnHandle,[Select * from coCan],"xTemp") < 1
	=sqlerror()
	RETURN
ENDIF
SELECT * FROM xTemp INTO CURSOR xcanidate READWRITE

***************************************************************************************
* Get the requirements for the set
***************************************************************************************
IF SQLEXEC(gnConnHandle,[Select * from coManualSets],"xCurSetData") < 1
	=sqlerror()
	RETURN
ENDIF
SELECT * FROM xCurSetData INTO CURSOR curSetData READWRITE
FOR x=1 TO ctFindSlot.bblistview2.ROWS.COUNT
	lnProcID=VAL(ctFindSlot.bblistview2.LISTITEM(x,4).TEXT)
	IF SQLEXEC(gnConnHandle,[exec  lu_PossibleRoomsToUse ?lnProcID],"xRoomsToUse") < 1
		=sqlerror()
	ELSE

		SELECT xRoomsToUse
		SCAN
			m.procid=lnProcID
			m.proccode=xRoomsToUse.dcode
			m.initialProcTime=xRoomsToUse.defaulttime
			m.minOffset=VAL(ctFindSlot.bblistview2.LISTITEM(x,3).TEXT)
			m.maxOffSet=10
			m.RoomID=xRoomsToUse.RoomID
			m.RoomName=xRoomsToUse.RoomName
			m.deptID=xRoomsToUse.deptID
			m.SchedFrom=xRoomsToUse.SchedFrom
			m.SchedTo=xRoomsToUse.SchedTo
			m.description=ALLT(ctFindSlot.bblistview2.LISTITEM(x,2).TEXT)
			m.searchorder=VAL(ctFindSlot.bblistview2.LISTITEM(x,1).TEXT)
			m.lastSlotFound=IIF(ISNULL(xRoomsToUse.lastSlotFound),DATETIME(),xRoomsToUse.lastSlotFound)
			INSERT INTO curSetData FROM MEMVAR
			IF TTOD(m.lastSlotFound) > ldStartOn
				ldStartOn=TTOD(m.lastSlotFound)
				ldEndOn=ldStartOn+lnDaysToSearch
			ENDIF
		ENDSCAN
	ENDIF
ENDFOR
SELECT curSetData
xProcCtr=0
lnRoomID1=  ""
lcRoomName1=""
ltEarlyStart={}
ltEarlyEnd={}
lnEarlyRoomID=0
lcEarlyRoomName=''
lnEarlyDeptID=0

ctFindSlot.oXPBar.VISIBLE= .T.
***************************************************************************************
* Loop Counters for Debugging Only, serve no other purposes
***************************************************************************************
lnloopCtr1=0
lnLoopCtr2=0
lnLoopCtr3=0
lnLoopCtr4=0
lnLoopCtr5=0
lnLoopCtr6=0
IF RECCOUNT("curSetData")<1 
	lcMess="The selected procedure has not been assigned to any room group.  You must assign a procedure to one or more "
	lcMess=lcMess+"room groups in order to use this process."
	=MESSAGEBOX(lcMess,64+4096,"Care Tracker Enterprise",20000)
	return
ELSE
	***************************************************************************************
	* Determine How Many Differnt Procedures we have to schedule
	***************************************************************************************
	SELECT DIST procid AS stgID, minOffset,initialProcTime,DESCRIPTION FROM curSetData ORDER BY searchorder INTO CURSOR curStrings
	ltInitialDT={}
	PUBLIC ARRAY laSlots[RECCOUNT("curStrings"),7]
	SELECT curStrings
	llFirstProc=.T.
	lnSlotPtr=1
	llSlotFound=.F.
	lnProcCtr=1
	lnMinOff=0
	ltInitialProcEnd=0
	SELECT curStrings
	***************************************************************************************
	* Loop through each procedure finding a slot
	***************************************************************************************
	SCAN
		lnLoopCtr1 = lnLoopCtr1 + 1
		xProcCtr=xProcCtr+1
		***************************************************************************************
		* Get the Min OffSet
		***************************************************************************************
		lnOffSet=curStrings.minOffset
		***************************************************************************************
		* Get an array of room id's we can do this procedure in
		***************************************************************************************
		lnCurrID=curStrings.stgID
		SELECT DIST RoomID,SchedFrom,SchedTo,0,deptID,initialProcTime,minOffset,procid,RoomName,DESCRIPTION ;
			FROM curSetData ;
			WHERE curSetData.procid=lnCurrID ;
			INTO ARRAY laRooms
		llFirst=.T.
		lnMinutesRequired=IIF(ISNULL(curStrings.initialProcTime),30,curStrings.initialProcTime)
		SELECT curStrings
		lnProcID=curStrings.stgID
		ltSearchStart=CTOT(DTOC(ldStartOn)+[ ]+formattime(360))
		***************************************************************************************
		*!* Setup our search info
		***************************************************************************************
		llFirstDaysLoop=.T.
		lnEarlyProcID=lnProcID
		lcEarlyProcDesc=curStrings.DESCRIPTION

		***************************************************************************************
		* Build SQL Command to Get Room that are associated with the procedure
		***************************************************************************************
		lcCmd=[exec lu_RoomsToUse ?lnProcID]
		IF USED("RoomstoUse")
			SELECT RoomsToUse
			=TABLEREVERT(.T.)
			USE
		ENDIF
		IF SQLEXEC(gnConnHandle,lcCmd,"RoomsToUse")<1
			=sqlerror()
		ENDIF
		***************************************************************************************
		*!* Loop through the number of days available in the search
		***************************************************************************************

		FOR lnDays=1 TO lnDaysToSearch
			lnLoopCtr2 = lnLoopCtr2 + 1
			llInBlock=.f.
			ctFindSlot.oXPBar.CURVAL=(lnDays*2)
			=INKEY(.05)
			***************************************************************************************
			* Advance the search date
			***************************************************************************************
			IF !llFirstDaysLoop
				ldStartOn = ldStartOn + IIF(VARTYPE(ldStartOn)=[D],1,86400)
			ELSE
				llFirstDaysLoop=.F.
			ENDIF
			
			lnLoopStart=420
			lnLoopEnd=1020
			llDayOk=.t.
			lnDayStart=420
			lnDayEnd=1020
			***************************************************************************************
			* Check to see if doc, if assigned and required can be scheduled for this day
			***************************************************************************************
			IF ctFindSlot.frmDocID > 0 AND ctGetDocRequired(curStrings.stgID)
				lcChkDoc=chkDocDays(ldStartOn)
				llDayOk=IIF(STREXTRACT(lcChkDoc,[|],[|],1)='1',.t.,.f.)
				lnDayStart=STREXTRACT(lcChkDoc,[|],[|],2)
				lnLoopStart=VAL(lnDayStart)
				lnDayEnd=STREXTRACT(lcChkDoc,[|],[|],3)
				lnLoopEnd=VAL(lnDayEnd)
			ENDIF 						
			IF BETWEEN(DOW(ldStartOn),2,6) AND llDayOK && Only Check WeekDays and valid days for the physician
				***************************************************************************************
				* Loop through each room															  *
				***************************************************************************************
				ltEarlyStart={}
				ltEarlyEnd={}
				lnEarlyRoomID=0
				lcEarlyRoomName=''
				lnEarlyDeptID=0
				SELECT RoomsToUse
				lnLoopStart=IIF(lnProcCtr>1,cttimetonum(TTOC(ltInitialProcEnd,2)),lnLoopStart)
				***************************************************************************************
				* Go through the RoomsToUse cursor and put in the percentage used by day              *
				* This way we can limit the number of trips if the room utilization is already high   *
				***************************************************************************************
				SCAN
					m1=CTOT(DTOC(ldStartOn)+[ 07:00])
					m2=CTOT(DTOC(ldStartOn)+[ 17:00])
					lnRoomID=RoomsToUse.RoomID
					IF SQLEXEC(gnConnHandle,[exec ct_CheckRoomUtilizationByID ?lnRoomID,?m1,?m2],"curRoomUtil")<1
						=sqlerror()
					endif
					SELECT RoomsToUse
					REPLACE RoomsToUse.laPercent WITH curRoomUtil.laPercent
				ENDSCAN
				***************************************************************************************
				*!* Now loop through the available rooms for availablity, but only for rooms that are *
				* less than or equal to 90% utilized                                                  *
				***************************************************************************************
				SCAN FOR laPercent <= .90
					lnLoopCtr3 = lnLoopCtr3 + 1
					***********************************************************************************
					* Loop through the TimeofDay and look for an opening							  *
					***********************************************************************************
					FOR innerloop = lnLoopStart TO lnLoopEnd STEP gnFindIncr 	&&STEP 15
						lnLoopCtr4 = lnLoopCtr4 + 1
						SCAN 
							lnLoopCtr5 = lnLoopCtr5 + 1
							=INKEY(.005)
							lnRoomStart=RoomsToUse.SchedFrom/100*60
							lnRoomTo=(RoomsToUse.SchedTo/100*60)-curStrings.initialProcTime
							lnRoomID=RoomsToUse.RoomID
							***************************************************************************************
							* Check to see if the room is available during this time
							***************************************************************************************
							IF BETWEEN(innerloop,lnRoomStart,lnRoomTo)
								SET MESSAGE TO [Searching lnDays=]+TRANSFORM(lnDays)+[ proc: ]+TRANSFORM(lnProcID)+[ Room: ]+ALLT(RoomsToUse.RoomName)+[ Slot: ]+TRANSFORM(innerloop)
								***************************************************************************************
								* Set the search dateTime parameters
								***************************************************************************************
								ltSearchF=CTOT(DTOC(ldStartOn)+[ ]+formattime(innerloop))  &&lnRoomStart
								***************************************************************************************
								* Check the required offset (minutes) from the end of the first
								* procedure.  If we are not meeting the offset, skip and let it advance the datetime
								***************************************************************************************
								ltSearchT =ltSearchF+(lnMinutesRequired*60)
								IF lnProcCtr > 1 AND ltSearchF < (ltInitialProcEnd+(lnOffSet*60))
									***************************************************************************************
									* We Need to Advance the time
									***************************************************************************************
									llSlotFound=.F.
									llInBlock=.f.
								ELSE
									llPatConflict=.F.
									llDocConflict=.F.
									llInBlock=.f.
									llEquipCon=.f.
									***************************************************************************************
									* Build the string to search for existing cases in the time slot
									***************************************************************************************
									lcCmd=[SELECT meetingnumber,isblock,blockid,blkperid from meetings ]
									lcCmd=lcCmd+[WHERE roomid = ?lnRoomID ]
									lcCmd=lcCmd+[and iscancelled=0 ]
									lcCmd=lcCmd+[AND (begintime between ?ltSearchF and ?ltSearchT ]
									lcCmd=lcCmd+[OR endtime between ?ltSearchF and ?ltSearchT ]
									lcCmd=lcCmd+[OR ?ltSearchF between begintime and endtime ]
									lcCmd=lcCmd+[or ?ltSearchT between begintime and endtime)]

									IF SQLEXEC(gnConnHandle,lcCmd,"curConflict") < 1
										=sqlerror()
									ELSE
										***************************************************************************************
										* Check to see if we have a conflict (Reccount > 0)
										***************************************************************************************
										IF RECCOUNT("curConflict") > 0
											***************************************************************************************
											* No Good, there is already something booked in this timeslot and room
											***************************************************************************************
											llSlotFound=.F.
											lnBlockID=0
											***************************************************************************************
											* We might want to check for block here
											***************************************************************************************
											SELECT curConflict
											SCAN 
												lnLoopCtr6 = lnLoopCtr6 + 1
												IF blkperid=ctFindSlot.frmDocID
													lnBlockID=curConflict.blockID
													IF SQLEXEC(gnConnhandle,[exec lu_BlockMembers ?lnBlockID],"blkmembers") < 1
														=sqlerror()
													ELSE
														SELECT blkmembers
														IF RECCOUNT()>0
															GO bott
															ltLastCase=blkmembers.endtime
															lcCmd=[Select endtime from meetings ]
															lcCmd=lcCmd+[where isblock=1 and blockid=?lnBlockID ]
															SQLEXEC(gnConnHandle,lcCmd,"BlkInfo")
															lnSecondRemain=blkinfo.endtime-ltLastCase
															lnMinsAvail=INT(lnSecondRemain/60)
															IF lnMinsAvail > lnMinutesRequired	
																llSlotFound=.T.
																IF EMPTY(ltEarlyStart)
																	ltEarlyStart=ltLastCase
																	ltEarlyEnd=ltLastCase+(lnMinutesRequired*60)
																	lnEarlyRoomID=lnRoomID
																	lcEarlyRoomName=RoomsToUse.RoomName
																	lnEarlyDeptID=RoomsToUse.deptID
																ELSE
																	IF ltEarlyStart > ltLastCase
																		ltEarlyStart=ltLastCase
																		ltEarlyEnd=ltLastCase+(lnMinutesRequired*60)
																		lnEarlyRoomID=lnRoomID
																		lcEarlyRoomName=RoomsToUse.RoomName
																		lnEarlyDeptID=RoomsToUse.deptID
																	ENDIF
																ENDIF
																ltInitialProcEnd=ltEarlyEnd
																llSlotFound=.t.
																llInBlock=.t.
															ELSE
																lnBlockID=0
															endif
														ELSE
															lcCmd=[Select begintime from meetings ]
															lcCmd=lcCmd+[where isblock=1 and blockid=?lnBlockID ]
															SQLEXEC(gnConnHandle,lcCmd,"BlkInfo")
															llSlotFound=.T.
															IF EMPTY(ltEarlyStart)
																ltEarlyStart=ltSearchF
																ltEarlyEnd=ltSearchT
																lnEarlyRoomID=lnRoomID
																lcEarlyRoomName=RoomsToUse.RoomName
																lnEarlyDeptID=RoomsToUse.deptID
															ELSE
																IF ltEarlyStart > ltSearchF
																	ltEarlyStart=ltSearchF
																	ltEarlyEnd=ltSearchT
																	lnEarlyRoomID=lnRoomID
																	lcEarlyRoomName=RoomsToUse.RoomName
																	lnEarlyDeptID=RoomsToUse.deptID
																ENDIF
															ENDIF
															ltInitialProcEnd=ltEarlyEnd
															llSlotFound=.t.
															llInBlock=.t.
														endif
													ENDIF
													exit
												ENDIF
											endscan
										ELSE
											lnBlockID=0
											***************************************************************************************
											* Check for Equipment Conflict
											***************************************************************************************
											llEquipCon=ctFindSlotEquipChk(lnProcID,ltSearchF,ltSearchF,RoomsToUse.deptID)
											***************************************************************************************
											* Check For Patient Conflict
											***************************************************************************************
											IF ctFindSlot.frmPatientID > 0
												lcCmd=[Select meetingnumber from meetings ]
												lcCmd=lcCmd+[where patientid = ?ctFindSlot.frmPatientID ]
												lcCmd=lcCmd+[AND (begintime between ?ltSearchF and ?ltSearchT ]
												lcCmd=lcCmd+[OR endtime between ?ltSearchF and ?ltSearchT ]
												lcCmd=lcCmd+[OR ?ltSearchF between begintime and endtime ]
												lcCmd=lcCmd+[or ?ltSearchT between begintime and endtime)]
												IF SQLEXEC(gnConnHandle,lcCmd,'xPatConflict')<1
													=sqlerror()
												ELSE
													llPatConflict=IIF(RECCOUNT('xPatConflict')>0,.T.,.F.)
												ENDIF
											ENDIF
											***************************************************************************************
											* Surgeon Conflict
											***************************************************************************************
											IF ctFindSlot.frmDocID > 0
												lcCmd=[SELECT dbo.meetings.begintime, dbo.meetings.endtime, dbo.meetings.meetingnumber ]
												lcCmd=lcCmd+[FROM  dbo.meetings INNER JOIN ]
												lcCmd=lcCmd+[dbo.meetproc ON dbo.meetings.meetingnumber = dbo.meetproc.meetingnumber ]
												lcCmd=lcCmd+[where dbo.meetproc.coperid=?ctFindSlot.frmDocID ]
												lcCmd=lcCmd+[AND (begintime between ?ltSearchF and ?ltSearchT ]
												lcCmd=lcCmd+[OR endtime between ?ltSearchF and ?ltSearchT ]
												lcCmd=lcCmd+[OR ?ltSearchF between begintime and endtime ]
												lcCmd=lcCmd+[or ?ltSearchT between begintime and endtime)]
												IF SQLEXEC(gnConnHandle,lcCmd,'xDocCon')<1
													=sqlerror()
												ELSE
													llDocConflict=IIF(RECCOUNT('xDocCon')>0,.T.,.F.)
												ENDIF
											ENDIF
											IF llPatConflict=.F. AND llDocConflict=.F. and llEquipCon=.f.
												* Create Temporary records to show this slot as used in case someone else
												* tries to search this period
												*		=ctManageLocks(lnRoomid,lnDeptID,ltSearchFrom,ltSearchTo,lnLockID,DATETIME(),.t.)
												llSlotFound=.T.
												llInBlock=.f.
												IF EMPTY(ltEarlyStart)
													ltEarlyStart=ltSearchF
													ltEarlyEnd=ltSearchT
													lnEarlyRoomID=lnRoomID
													lcEarlyRoomName=RoomsToUse.RoomName
													lnEarlyDeptID=RoomsToUse.deptID
													llInBlock=.f.
												ELSE
													IF ltEarlyStart > ltSearchF
														ltEarlyStart=ltSearchF
														ltEarlyEnd=ltSearchT
														lnEarlyRoomID=lnRoomID
														lcEarlyRoomName=RoomsToUse.RoomName
														lnEarlyDeptID=RoomsToUse.deptID
														llInBlock=.f.
													ENDIF
												ENDIF
												ltInitialProcEnd=ltEarlyEnd
												llInBlock=.f.
											ENDIF  && Patient Conflict
										ENDIF  && RECCOUNT("curConflict") > 0
									ENDIF  && SQLEXEC < 1
								ENDIF  &&lnProcCtr > 1 AND ltSearchF < (ltInitialProcEnd+(lnOffSet*60))
								IF llSlotFound
									EXIT
								ENDIF
							ENDIF
						ENDSCAN   && End of Room Loop
						IF llSlotFound
							EXIT
						ENDIF
					ENDFOR  && End of InnerLoop Loop
					IF llSlotFound
						EXIT
					ENDIF
				ENDSCAN
				IF llSlotFound
					EXIT
				ENDIF
			ENDIF
		ENDFOR
		SELECT xcanidate
		m.RoomName=lcEarlyRoomName
		m.RoomID=lnEarlyRoomID
		m.Begintime=ltEarlyStart
		m.EndTime=ltEarlyEnd
		m.isopen=.T.
		m.deptID=lnEarlyDeptID
		m.procid=lnEarlyProcID
		m.procdesc=lcEarlyProcDesc
		m.inblock=llInBlock
		m.blockid=IIF(VARTYPE(lnBlockID)="U",0,lnBlockID)
		INSERT INTO xcanidate FROM MEMVAR
		llSlotFound=.F.
		llInBlock=.f.
		
		lnProcCtr=lnProcCtr+1
	ENDSCAN
	SELECT xcanidate
	***************************************************************************
	* Create an array that the calling form will use to load the results      *
	* in the bblistview control                                               *
	***************************************************************************
	SELECT TRANSFORM(Begintime),TRANSFORM(EndTime),RoomName,procdesc, ;
		ALLTRIM(STR(procid)),ALLTRIM(STR(RoomID)),ALLTRIM(STR(deptID)), ;
		IIF(inblock=.t.,'1','0'), ;
		blockid ;
		FROM xcanidate ;
		INTO ARRAY laSlots
ENDIF
********************************************************
* Hide Progress Meter on Calling Form				   *
********************************************************
ctFindSlot.oXPBar.VISIBLE= .F.

return