'PRCH_PRC - updates Product prices - BOSS menu ONLY!!!!! because it allows access to Stock prices

'  insert code to ask if Disc% is to be updated
'  reviews all stock/selling prices before creating new
'	database or printing price lists

external   vloadif() vunloadif() messbox() fentrybox() sch scw cpath dpath	messboxwait()
external   bpopdb() navrecs() progress() fgp bgp pagerec() scr dsa fgs bgs popuplist()
external   chkdate() userid Background() $menu

public     ptstr prodcode suppcode ptval nrindex #rec suppname

global     x EnterSupplier() ShowProducts() RollorCut1st() EnterROLL() EnterCUT()
global     change() er1 er2 ec
global     currSMLC           ' current SMLC price
global     currSMLR           ' current SMLR price
global     prevSMLC           ' previous SMLC price
global     prevSMLR           ' previous SMLR price
global     prevupdate         ' date of previous update
global     nrrecs y1 y2 y3 proddes
global     effectdate ReturnToMenu() Delete() Update()


MAIN
single-step off
	file unload all
  	Background()

' message "$menu) is:"&str($menu)

  	while true								  ' choose supplier

    		x = EnterSupplier()
    		if x = -1
      		exit while
    		end if
' message "suppname is:"&str(suppname)

		x=RollorCut1st()

    		ShowProducts()

  	end while

  	ReturnToMenu()

END MAIN


FUNCTION RollorCut1st()
	er1="EnterÿCutsÿ1st"
	er2="EnterÿRollsÿ1st"
    	x=popuplist(11,45,13,er1&er2,"",1,0)				'message "ptstr is:"&str(ptstr)
	ec=ptstr
' message "ec is:"&str(ec)
END FUNCTION ' RollorCut1st()


FUNCTION change()
	prevSMLC = [SM_List_Cuts]
  	prevSMLR = [SM_List_Rolls]
  	proddes = [Product_Supplier]
  	prevupdate = [Effect_Date]

' message "ec is:"&str(ec)
  	while true
		if ec=er1
			EnterCUT()
			EnterROLL()
		else
			EnterROLL()
			EnterCUT()
		end if

  ' check that SMLC > SMLR
    		y1 = value(currSMLR)               'message "SMLR is"&str(y1)
    		y2 = value(currSMLC)               'message "SMLC is"&str(y2)
    		y3 = y2 - y1                       'message "Diff is"&str(y3)

    		if y3 < 0
      		x=messbox(" Roll price is greater than Cut price - Correct? (y/n)",1,1,0)
			if x = -1
      			return (-1)
    			end if
        		if ptstr == "n"
          		continue while
       		end if
    		end if

    		x=messbox("SqMtr Cut price is:"&format(value(currSMLC),"2r$")&" SqMtr Roll price is:"&format(value(currSMLR),"2r$")&"-"&"- Correct? (y/n)",1,1,0)
		if x = -1
    			return (-1)
		end if
    		if ptstr == "y"
      		screen clear box 1 1 sch scw 0 0 no-border
      		exit while
    		end if
  	end while

  	lock-record
    		[Prev_SMLR] = prevSMLR
    		[Prev_SMLC] = prevSMLC
    		[SM_List_Rolls] = currSMLR
    		[SM_List_Cuts] = currSMLC
    		[Effect_Date] = effectdate
    		[Last_Update] = prevupdate
    		[Updated_On] = today
    		[Updated_By] = userid
  	write-record
  	repaint on
  	repaint
END FUNCTION ' change()


FUNCTION EnterCUT()
	while true
    		x = fentrybox(" New SM Cut price for"&proddes&" (enter dec. point) ",6,"*6{[-1234567890.]}","")
    		if x = 0
    			currSMLC = ptstr
    			if value(prevSMLC) > value(currSMLC)
        			messbox(" New price is lower than old price - Correct? (y/n)",1,1,1)
         			if ptstr == "y"
         				exit while
         			end if
         			continue while
    			end if
    			exit while
    		else
    			exit function
    		end if
	end while
END FUNCTION ' EnterCUT()


FUNCTION EnterROLL()
    		while true
      		x = fentrybox(" New SM ROLL price for"&proddes&" (enter dec. point) ",6,"*6{[-1234567890.]}","")
      		if x = 0
        			currSMLR = ptstr
        			if value(prevSMLR) > value(currSMLR)
          			messbox(" New price is lower than old price - Correct? (y/n)",1,1,1)
          			if ptstr == "y"
            				exit while
          			end if
          			continue while
        			end if
        			exit while
      		else
        			exit function
      		end if
    		end while
END FUNCTION ' EnterROLL()


FUNCTION EnterSupplier()
local bpop_ret y1
	vloadif(dpath|"supplier.vws")
    	data query execute "not_del.dfq" index "act_supp.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' not (deleted)
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
	order sort now dictionary "suppname" fields "[Name]" ascending
  	repaint off
	#rec=1
  	while true
		data goto record record-number #rec
    		y1 = format(" Choose Supplier and press {Enter} ","M38")
    		screen print 7 31 15 1 y1
    		screen print 8 31 15 1 (format(" {Enter} views products - {Esc} exits ","M38"))
    		x = bpopdb("supplier",6,"","[Name]","l35","[Supplier_Code]","L6","[Supplier_Code]",9,31,19,68,"",0)
    		if x = 0
      		exit while
    		elseif x = -1
			#rec=record
      		screen clear box 1 1 sch scw 0 0 no-border
      		return (-1)
    		end if
  	end while
  	screen clear box 1 1 sch scw 0 0 no-border
	#rec=record
 	suppcode = ptstr
  	suppname = [Name]
END FUNCTION


FUNCTION ShowProducts()
local i
	while true
    		x = fentrybox(" Enter date of Price List ",10,"##\/##\/####",today)
    		if x = 0
      		effectdate = ptstr
        		if chkdate(effectdate,1) = -1
	  			messbox(" Incorrect date - re-enter ",0,0,1)
	  			continue while
			end if
      		exit while
    		else
      		message "FENTRY Error:"&str(x)
    		end if
  	end while

  	Background()

' find Products from suppcode
  	vloadif(dpath|"chngprc2.vw")
  	order change physical
  	nrrecs = precords

  	Background()
  	progress(fgp,bgp," Sorting "|str(nrrecs)|" records ... please wait ",0)
  	order change key "[Supplier_Code]"
    	data query execute "chngprc4.dfq" index "chngprc2.idx"
' ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
' º [Supplier_Code] = suppcode                                         º
' '   and
'   left([Product_Code],1)<>"A"
' '   and
'   not (deleted)
' ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
    	if cerror
      	messbox(" No records for this Supplier ",0,0,1)
      	exit function
    	end if

    	data query execute "chngprc3.dfq" index "chngprc3.idx"
' ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
' [Temporary]<>"Y"
' and
' [V]<>"V"
' and
' not (deleted)
' ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
    	if cerror
      	messbox(" No records for this Supplier ",0,0,1)
      	exit function
    	end if
	order sort execute dictionary "chngprc1.dfs" index "chngprc4.idx"
  	nrindex = records
	repaint on
  	repaint
	if $menu="boss"
		screen print 2 1 14 1 (format(suppname,"M100"))
		screen print 3 1 15 1 (format(" {D}elete   -   {U}pdate   -   {C}hange price   -   {Esc} to exit ","M100"))
	else
		screen print 2 1 14 1 (format(suppname,"M100"))
		screen print 3 1 15 1 (format("   {C}hange price  -  {Esc} to exit ","M100"))
	end if
	screen print 4 1 15 1 (format("  Code       Product Name                   SM Cut  SM Roll Bckg  Effective   Widths available","L100"))

	ptval=0
  	while ptval <> {Esc}

		if $menu="boss"
			screen print 2 1 14 1 (format(suppname,"M100"))
			screen print 3 1 15 1 (format(" {D}elete   -   {U}pdate   -   {C}hange price   -   {Esc} to exit ","M100"))
		else
			screen print 2 1 14 1 (format(suppname,"M100"))
			screen print 3 1 15 1 (format("   {C}hange price  -  {Esc} to exit ","M100"))
		end if
		screen print 4 1 15 1 (format("  Code       Product Name                   SM Cut  SM Roll Bckg  Effective   Widths available","L100"))
    		ptval = navrecs()
    		if ptval = {C} or ptval = {c}
      		Change()
    		elseif ptval = {D} or ptval = {d}
      		Delete()
    		elseif ptval = {U} or ptval = {u}
			if not (deleted)
      			Update()
			else
				messboxwait(" Record deleted - cannot update ",0,0,1)
			end if
    		elseif ptval = {Esc}
      		messbox(" Finished with this Supplier (y/n) ",1,0,1)
        		if ptstr ! "y"
          		screen clear box 1 1 sch scw 0 0 no-border
          repaint off
          exit function
         end if
      ptval = {^Home}
    end if
  end while
END FUNCTION


FUNCTION Update()
local  #prec
	if $menu<>"boss"
		return (0)
	end if
  	#prec = precord
	vloadif(dpath|"dg_produ.vw")
  	data goto record record-number #prec
  	lock-record
    		reply on nothing to 3015
    		repaint on
    		data update only-one
    		repaint off
  	write-record
  	lock-record
		[Updated_On]=today
		[Updated_By]=userid
  	write-record
  	data goto view "chngprc2.vw"
  	repaint on
  	repaint
END FUNCTION ' Update()


FUNCTION Delete()
local  y1 y2 y3 proddes prevSMLC
	if $menu<>"boss"
		return (0)
	else
' 		if not (deleted)
			data delete record
' 		end if
	end if
  	repaint on
  	repaint
END FUNCTION ' Update()


FUNCTION ReturnToMenu()
  Background()
  vunloadif("chngprc2.vw")
  vunloadif("supplier.vws")
  transfer cpath|"pm_menu.psl" in-memory
END FUNCTION ' ReturnToMenu()