'CHG_COLS - add/remove colours

external   messbox() fentrybox() dpath vloadif() vunloadif() sch scw bbd
external   fgp bgp scr chkstr() delstr() psa strcount() ipath bpopdb()
external   strtoary() colpopup() cpath fdp prpath messboxwait()
external   lpath bge popuplist() rbd wraptext() Background()

public     ptstr ptval ptary[1] dsa

global     EnterColour() DeleteColour() CheckColour() $backing ChangeColour() Title_A()
global     CheckDupe() ShowBox() $unsort SortColour() $newsort n ChooseStock()
global     y2 x prodcode $itemtype prodMRC $mess1 desMRC $newcolor $color y $colorstr i
global     y1 y3 keyf keyb $prodend #prodrec s_shwscn f1 f2 f3


MAIN
  	single-step off
  	file unload all
	Background()
  	prodcode = ""
  	keyf = 7
  	keyb = 0
  	$prodend ="A"
  	while true
	    	x = ChooseStock()							'L37
    		if x = -1
	     	exit while
    		end if
  	end while
	Background()
  	file unload all
  	transfer cpath|"pm_menu.psl" in-memory
END MAIN


FUNCTION ChooseStock()
local z #deflen $wrongprod f1 f2 f3 nr_reqns nr_index
  	Title_A()
  	repaint off
  	ptval=0
  	while true
	    	prodcode = ""
    		x=inchar                         'message "x) is:"&str(x)
	    	if x=316                         ' F2 - Stock Carpet - IT = "A"
     		while true
	     	   	$prodend ="A"
	     	   	vloadif(dpath|"prodsel"|$prodend|".vw")
     	   		order change index ipath|"stckcarp.idx"
	     	   	y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72")
     	   		screen print 21 5 fgp bbd y2
	        		x=bpopdb("prodsel"|$prodend,4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0)
		        	if x = -1
     			     Title_A()                    ' message "prodsel|$prodend is:"&str("prodsel"|$prodend)
		     	     exit while
	        		end if
		        	prodcode = ptstr
     		   	screen shortrestore dsa
        			ChangeColour()
		        	Title_A()                    ' message "prodsel|$prodend is:"&str("prodsel"|$prodend)
     	 	end while
	    	elseif x=317                 ' F3 - Bespoke Carpet - IT = "B"
     		while true
        			$prodend = "B"
        			vloadif(dpath|"prodsel"|$prodend|".vw")
	        		order change index ipath|"bespcarp.idx"
     	   		y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72")
        			screen print 21 5 fgp bbd y2
        			x = bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0)
	        		if x = -1
     	     		Title_A()                    ' message "prodsel|$prodend is:"&str("prodsel"|$prodend)
          			exit while
        			end if
	        		prodcode = ptstr
' message "L74 ptstr is:"&str(ptstr)
     	   		screen shortrestore dsa
        			x=ChangeColour()					'L201
				Background()
        			x=Title_A()
	      	end while
	    	elseif x = 318                ' F4 - Stock Ancl - IT = "A"
     		while true
	     	$prodend = "A"
        vloadif(dpath|"prodsel"|$prodend|".vw")
        order change index ipath|"stckancl.idx"
        y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72")
        screen print 21 5 fgp bbd y2
        x = bpopdb("prodsel"|$prodend,4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0)
        if x = -1
          Title_A()                    ' message "prodsel|$prodend is:"&str("prodsel"|$prodend)
          exit while
        end if
        prodcode = ptstr
        screen shortrestore dsa
        ChangeColour()
        Title_A()
      end while

	    	elseif x = 319                     ' F5 - Bespoke Ancl - IT = "J"
     		while true
		        	$prodend = "B"
        			vloadif(dpath|"prodsel"|$prodend|".vw")
		        	order change index ipath|"bespancl.idx"  ' message "F5 - prodcode is:"&str(prodcode)
        			y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72")
			     screen print 21 5 fgp bbd y2
        			x=bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0)
        			if x = -1
	          		Title_A()                    ' message "prodsel|$prodend is:"&str("prodsel"|$prodend)
	     	     	exit while
        			end if
     		   	prodcode = ptstr
		        	screen shortrestore dsa
     		   	ChangeColour()
        			Title_A()
	      	end while
    		elseif x = 320                 ' F6 - Vinyl - IT = "V or W"
	     	while true
	     	   	$prodend = "B"
     	   		vloadif(dpath|"prodsel"|$prodend|".vw")
	     	   	order change index ipath|"vinyl.idx"   ' bpop must show MRC ??????????????
     	   		y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72")
	        		screen print 21 5 fgp bbd y2
		        	x = bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0)
     		   	if x = -1
          			Title_A()                    ' message "prodsel|$prodend is:"&str("prodsel"|$prodend)
		          	exit while
		          end if
     	   		prodcode = ptstr
	     	     screen shortrestore dsa
     	     	ChangeColour()
	        		Title_A()
      		end while

    		elseif x = 321                     ' F7 - Tiles - IT = "S or T"
     while true
        $prodend = "B"
        vloadif(dpath|"prodsel"|$prodend|".vw")
        x = popuplist(20,59,25,"Stock Bespoke","",1,0)
        if ptstr = "Stock"
          order change index ipath|"stk_tile.idx"  ' bpop must show MRC ??????????????
        else
          order change index ipath|"bsp_tile.idx"  ' bpop must show MRC ??????????????
        end if
        y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72")
        screen print 21 5 fgp bbd y2
        x = bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0)
        if x = -1
          Title_A()                    ' message "prodsel|$prodend is:"&str("prodsel"|$prodend)
          exit while
        end if
        prodcode = ptstr
        screen shortrestore dsa
        ChangeColour()
        Title_A()
      end while

    		elseif x = 322                     ' F8 - Fitting - IT = "F"
     		while true
        			$prodend = "A"
        			vloadif(dpath|"prodsel"|$prodend|".vw")
        			order change index ipath|"labour.idx" ' bpop must show MRC ??????????????
        			y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72")
        			screen print 21 5 fgp bbd y2
        			x = bpopdb("prodsel"|$prodend,4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0)
        			if x = -1
          			Title_A()                    ' message "prodsel|$prodend is:"&str("prodsel"|$prodend)
          			exit while
        			end if
        			prodcode = ptstr                ' message "F8 - prodcode is:"&str(prodcode)
        			screen shortrestore dsa
        			ChangeColour()
        			Title_A()
		     end while
	    	elseif x = 315
     		continue while
		elseif x = 323                     ' F9 - reservations
     		continue while
    		elseif x = 324                     ' F10
		     continue while
    		elseif x = 763                     ' Esc
     		screen clear box 22 1 sch scw 0 0 no-border
		     return (-1)
    		end if
  	end while
END FUNCTION 'ChooseStock()


FUNCTION  Title_A()
  	vunloadif("prodsel"|$prodend|".vw")
  	y2 = format("Select product type or {Esc} to exit","M72")
  	screen print 21 5 fgp bbd y2
'   screen save 5 5 21 77 s_shwreq
  	repaint off
  	f1 = format("    F2   ³     F3    ³     F4    ³     F5    ³     F6    ³     F7    ³    F8   ","L80")
  	f2 = format("  Stock  ³  Bespoke  ³   Stock   ³  Bespoke  ³   Vinyls  ³   Tiles   ³  Labour ","L80")
  	f3 = format("  Carpet ³   Carpet  ³  Ancll'y  ³  Ancll'y  ³           ³           ³         ","L80")
  	screen print 22 1 keyf keyb f1
  	screen print 23 1 keyf keyb f2
  	screen print 24 1 keyf keyb f3
END FUNCTION   'Title_A()


FUNCTION ChangeColour()
local z $mess1 $mess2 #deflen $wrongprod f1 f2 f3 nr_reqns nr_index y1 y2 y3
  	prodcode = ptstr
  	prodMRC   = [Product_MRC]
  	$itemtype = [Item_Type]
  	screen shortrestore dsa
  	screen print 7 45 15 1 "’"|prodcode|"’"
  	screen save 1 1 sch scw s_shwscn
  	while true					    ' choose ADD/DELETE
	    	y1="’’Add’Colour’"
    		y2="’Check’Colour"
	    	y3="Delete’Colour"
    		x=popuplist(7,19,11,y1&y2&y3,"",1,0)
    		if x = 0
     		if ptstr == y1
        			x=EnterColour()  ' returns - (0) Success; (-1) Unable to add
        			if x = 0
          			while true
            				x=colpopup(7,56,19,[Colours],"",1,0,14,11,0,15)
            				if x = -1
							Background()
'               screen clear box 1 1 sch scw 0 0 no-border
              					exit while
            				end if
          			end while
        			elseif x = -2
          			ShowBox()
        			end if
				Background()
'         screen clear box 1 1 sch scw 0 0 no-border
        			repaint off
      		elseif ptstr == y2
        			x=CheckColour()         ' message "x is:"&str(x)
        			repaint off
      		elseif ptstr == y3
        			x=DeleteColour()
        			repaint off
      		end if
      		screen shortrestore S_shwscn
    		else
      		return (1)
    		end if
  	end while
END FUNCTION ' ChangeColour()


FUNCTION CheckColour()
local $all_cols
  	while true
    x = colpopup(7,56,19,[Colours],"{Esc} exits",1,0,14,11,0,15)
    if x = -1
      screen clear box 1 1 sch scw 0 0 no-border
      exit while
    elseif x = -2
      messboxwait(" No colours entered ",0,0,1)
      screen clear box 1 1 sch scw 0 0 no-border
      exit while
    end if
  end while
END FUNCTION ' CheckColour()


FUNCTION DeleteColour()
local $all_cols
  while true
    y2 = format(" "|chr(24)&chr(25)&"to find colour to DELETE - {Enter} to select - {Esc} to exit ","M72")
    screen print 21 5 fgp bgp y2
    x = colpopup(7,56,19,[Colours],"",1,0,14,11,0,15)
    if x = 0
      desMRC = ptstr
    else
  '     screen clear box 1 1 sch scw 0 0 no-border
      repaint off
      exit while
    end if

  '   screen clear box 1 1 sch scw 0 0 no-border
    messbox(" Delete colour:"&desMRC|"? (y/n) ",1,0,1)
    if ptstr == "n"
  '     screen clear box 1 1 sch scw 0 0 no-border
      repaint off
      exit while
    end if
    $all_cols = [Colours]          ' message "$all_cols is:"&str($all_cols)
    x = delstr(desMRC,$all_cols)   ' message "ptstr is:"&str(ptstr)
    if x <> 0
      messbox(" Deletion failed for"&desMRC|" ",0,1,1)
      exit while
    end if
    lock-record
      [Colours] = ptstr
    write-record
'     screen clear box 1 1 sch scw 0 0 no-border
    return (0)
  end while
END FUNCTION ' DeleteColour()


FUNCTION  EnterColour()
local $fldlen $usedlen
  	$fldlen=dbfldinfo("[Colours]",2)
  	$usedlen=str(len([Colours]))
  	while true
	    	x = fentrybox("      Enter Colour Description      ",20,"*20x","")
    		if x = 0
		     if ptstr = ""
     		   	continue while
	     	end if
		     $color=proper(ptstr)
		     if len(ptstr) > (value($fldlen) - value($usedlen))
			     return (-1)   ' !!!!!!!!!!!!!!!! TEST ONLY
		     end if
     		scr = scr - 2
     		x = messbox(" Add"&$color&"? (y/n)",1,1,1)
		     scr = scr + 2
		     if x = 0
			     if ptstr == "n"
				     continue while
			     else
			          x = CheckDupe($color)		'  0    OK
          			if x = 0 			' -1    maybe - show popup
				          exit while                  ' -2    DUPLICATE
          			elseif x = -1
            				scr = scr - 2
			               messbox(format($color&"- duplicated?","M36"),0,0,1)
				          y2 = format(" "|chr(24)&chr(25)&"to find - {Enter} to select colour - {Esc} if not listed ","M72")
'           screen print 20 5 fgp bgp y2
            				screen print 21 5 fgp bgp y2
            				screen shortrestore dsa
 				          x = popuplist(8,57,18,[Colours],"",1,0)
            				if x = -1			' {Esc} pressed
              					x = messbox(format(" Confirm "|$color&"(y/n)","M36"),1,1,1)
              					if ptstr == "y"
                					scr = scr + 2
                					exit while
              					else
                					continue while
              					end if
            				else                        ' Alternative selected
              					$newcolor = ptstr
              scr = scr + 2
              exit while
            end if
          elseif x = -2
            continue while
          end if
        end if
     end if
    	elseif x = -1
     screen clear box 1 1 sch scw 0 0 no-border
     repaint off
     return (-1)
    	end if
  	end while

  	y = strtoary($color)
  	$newcolor = ""
  	for i = 1 to ptval
	    	if i = 1
	     	$newcolor = ptary[i]                ' NB - space is Alt-255
	    	else
     		$newcolor = $newcolor|"’"|ptary[i]    ' NB - space is Alt-255
	    	end if
  	end for
' NEW!!!
  	$unsort = [Colours]&trim($newcolor)
  	repaint off
  	x=SortColour()									'L380
  	vloadif(dpath|"prodsel"|$prodend|".vw")
' NEW!!!
  	lock-record
    		[Colours]=$newsort
  	write-record
  	return (0)
END FUNCTION ' EnterColour()


FUNCTION SortColour()
  	x=vloadif("temp_skl.vws")
	if x=0
  		if precords <> 0
			data query execute "delete"
    			vunloadif("temp_skl.vws")
    			data utilities purge "temp_skl"
  		end if
	else
		messboxwait(" Cannot load Temporary file to update Colour - report 'L388' to Head Office/DC ",0,0,1)
		return (1)	
	end if
  		vloadif(dpath|"prodselA.vw")
  		x=strcount($unsort)              ' message "x is:"&str(x)
  		n=value(ptval)                         ''
  		repaint off
  		if value(n) = 0
    			return ($unsort)
  		end if
	  	x=strtoary($unsort)             '
  		x=vloadif("temp_skl.vws")		'message "x is:"&str(x)
    		if x = -1
			messboxwait(" Cannot load TEMP_SKL.db to update Colour - report 'L402' to Head Office/DC ",0,0,1)
			return (1)	
    		end if
	  	for x = 1 to n
    			data enter lock
			    	[Colour] = ptary[x]
		    	write-record
	  	end for
  		if n > 1
		    	order sort now dictionary "new" fields "[Colour]" ascending
		    	data goto record first
	  	end if
  		$newsort = ""
	  	for x = 1 to n
    			$newsort = $newsort&[Colour]
		    	data goto record next
  		end for                  '
	  	if precords = 1
    			data delete record
	  	else
    			data query execute "delete"
	  	end if
  		vunloadif("temp_skl.vws")
	  	data utilities purge "temp_skl"		'message "L211 $newsort is:"&str($newsort)
  	return $newsort
END FUNCTION ' SortColour()


FUNCTION CheckDupe($color)
  $colorstr = [Colours]
  x = chkstr($color,$colorstr) 		'message "x) is:"&str(x)
  if x = -1			        ' $color NOT found in $colorstr
    strtoary($color)
    for i = 1 to ptval
      y = ptary[i]
      if match($colorstr,y) <> 0	' one word exists in $colorstr
        return (-1)                     ' MAYBE !
      else
        return (0)			' NOT a duplicate
      end if
    end for
  elseif x = 0				' $color found in $colorstr
    screen shortrestore psa
    scr = scr - 2
    messbox(format($color&"is a duplicate!","M36"),0,0,1)
    scr = scr + 2
    return (-2)
  end if
END FUNCTION 'CheckDupe()


FUNCTION ShowBox()
local x  x1 x2 x3 x4 x5 x6
load lpath|"wraptext.rf3" in-memory
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  x1 = " Insufficient space in [Colours] field to add: "
  x2 = "’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’"
  x3 = $color
  x4 = "’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’"
  x5 = " Report Product Code"&prodcode&"to Supervisor   press {Esc} to continue"
  x = x1&x2&x3&x4&x5
  wraptext(8,15,15,65,fgp,bge,x,"M",1,0,1)
  unload "wraptext.rf3"
END FUNCTION ' ShowBox()