' IMM_BKGS - lists imminent bookings for shops (to include Reservations)

'copied from MTHLYORD - monthly orders (from VARIATIONS) report

external   vkeybox() sch scw progress() messbox() vloadif() base $menu addidxrec() makeidx()
external   vunloadif() dpath fentrybox() chkdate() areas greeting cpath remove() userid
external   PrintReport() popuplist() fgp bgp ChooseBranches()
external   _SWIP_Crystal() Xreppath X_path strcount()

public     ptstr indate monthend fullmonth briefmonth enddate $base $basenames #basenames ptval
public     choice $shop_name $shop $phonenr

global     x ReturnToMenu() i custcode
global     s1 s2 s3 s4 s5 s6 s7 $place leftjob p
'  ChooseBranches()
'  PickShop() ChooseShop()


MAIN
  single-step off
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  file unload all
										' userid="CSYMDS"
										' message "userid being used:"&userid
	while true
		screen clear box 1 1 sch scw 0 0 no-border
 	     x = popuplist(12,33,13,"Imminent˙Ftgs˙for˙Shop Group˙reservations","",1,0)
		if x=-1
			exit while
		end if
		if ptstr = "Imminent˙Ftgs˙for˙Shop"		' message "own"		'search 30 days ahead for USERID reservations
' message "Set to select the next 7 days"	
		     vloadif("oldpurch.vws")				' load file
		     $base = filelookup([author],[Base],userid)		' message "$base is:"&str($base)
	     	vunloadif("oldpurch.vws")				' unload file' message "$base is:"&str($base)
			enddate=date2(days(today)+7)				'message "enddate is:"&str(enddate)
			x=remove("immbkg1.idx")			'message "remove is:"&str(x)
		     vloadif(dpath|"appntmnt.vws")
			x=makeidx("appntmnt","immbkg1.idx","0",1)	'message "makeidx is:"&str(x)
		     order change key "[Date]"
			data find "[Date]" equal enddate options ""
			data goto record previous
		 	progress(15,10," Building file of appointments from"&date2(today)&"to"&date2(enddate)&" ",0)
			while days([Date])>days(today)
 			     x = addidxrec("immbkg1.idx",precord,7)    'message "x is:"&str(x)
				data goto record previous
			end while
			order change index "immbkg1.idx"		' set number of days selected
			data query execute "shops3.dfq" index "first.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŋ
' left([Job_Nr],1)=$base
' ĀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŲ
			if cerror
				messbox(" No data found ",0,0,1)
				continue while
			end if
 			if ptstr == "y"
		     if x = 0
		     elseif x = -1
			     return (-1)
		     end if
' 		else
'     continue while
' 		end if
			
			end if
     		vunloadif("appntmnt.vws")
	     	vloadif(dpath|"imm_bkg3.vw")
			order change index "first.idx"
			order sort now dictionary "second.idx" fields "[Date;Job_Nr]" ascending

			remove(dpath|"X_immbg2.*")
			data query execute "not_del.dfq" Smart4 dpath|"X_immbg2" fields "[Date|Customer_Code]"
			if cerror
				messbox(" No data found ",0,0,1)
				continue while
' 				exit while
			end if
		
		     vloadif(dpath|"immbkg4.vw")
			remove(X_path|"X_immbg1.*")
			data query execute "not_del.dfq" Smart4 X_path|"X_immbg1" fields "[Date|Home_Tel]"
			if cerror
				messbox(" No data found ",0,0,1)
				continue while
' 				exit while
			end if
			vunloadif("X_immbkg.vws")
			vunloadif("customer.vws")
			vunloadif("imm_bkg3.vw")
			vunloadif("imm_bkg2.vw")					'   ClearHardSpaces()
			_SWIP_Crystal(Xreppath|"X_immbg1","P",0,1,"")


		elseif ptstr = "Group˙reservations"		' compile list of all with same [BASE]
			$basenames=""
		     vloadif("oldpurch.vws")				' load file
		     $base = filelookup([author],[Base],userid)		' message "$base is:"&str($base)
	     	data query execute "samebase.dfq" index "samebase.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŋ
' [Base] = $base
' ĀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŲ
			if cerror
				messbox(" No data found ",0,0,1)
				continue while
' 				exit while
			end if
			remove("basenames.dfq")
			fopen "basenames.dfq" as 1
			for i=1 to records-1
				$basenames=$basenames&[author]
				fwrite 1 from "[Job_Nr]="|chr(34)|[author]|chr(34)
				fwrite 1 from "or"
				data goto record next
			end for	
			data goto record next
			fwrite 1 from "[Job_Nr]="|chr(34)|[author]|chr(34)
			$basenames=$basenames&[author]
			fclose 1

' message "Set to select the next 15 days"

			enddate=date2(days(today)+15)				'message "enddate is:"&str(enddate)
			x=remove("immbkg1.idx")			'message "remove is:"&str(x)
	     	vloadif(dpath|"imm_bkg2.vw")
			x=makeidx("appntmnt","immbkg1.idx","0",1)	'message "makeidx is:"&str(x)
		     order change key "[Date]"
			data find "[Date]" equal enddate options ""
			data goto record previous
		 	progress(15,10," Building file of appointments from"&date2(today)&"to"&date2(enddate)&" ",0)
			while days([Date])>days(today)
	 		     x = addidxrec("immbkg1.idx",precord,7)    'message "x is:"&str(x)
				data goto record previous
			end while
			order change index "immbkg1.idx"
			data query execute "basenames.dfq" INDEX "first.idx"
			if cerror
				messbox(" No data found ",0,0,1)
				continue while
' 				exit while
			end if
			data query execute "imm_bkg3.dfq" INDEX "second.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŋ
' left([Fitter_Code],3)<>"EST"
'and
' right([Nickname],3)<>"EST"
' ĀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŲ
			if cerror
				messbox(" No data found ",0,0,1)
				continue while
' 				exit while
			end if
			order sort now dictionary "fifth.idx" fields "[Date;Job_Nr]" ascending
			vunloadif("oldpurch.vws")				' load file
			order change index "fifth.idx"
			remove(X_path|"X_immbkg.*")
			data query execute "not_del.dfq" Smart4 X_path|"X_immbkg" fields "[Date;Job_Nr;Notes;dateto;Nickname]"
			vunloadif("X_immbkg.vws")
			vunloadif("imm_bkg2.vw")
'   ClearHardSpaces()
			_SWIP_Crystal(Xreppath|"X_immbkg","P",0,1,"")
	     end if
	end while
	
	ReturnToMenu()

END MAIN


FUNCTION ReturnToMenu()
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  file unload all
  transfer cpath|"pm_menu.psl" in-memory
END FUNCTION ' ReturnToMenu()


