'PURORD01 - enter Purchase Order ("X" only ie ancillaries & stock carpets)
'	    v1.10 suppcode not entered; incorrect date - fixed

' modified to accept multipart orders - 050299

external   vunloadif() vloadif() messbox() sch scw dpath dsa psa ipath
external   increment() bpopdb() chkdate() fgp bgp popuplist() fgi bgi scr
external   nr5 userid chkstr() lpath wraptext() bge strtoary()
external   Exception() bbd prpath entryline() messline() strcount() colpopup()
external   findcolpop() keybox() remove()

public     ptstr ptval ptary[1]

global     LoadFiles() EnterDetails() ReturnToMenu() suppname CreateOrder()
global     consecnr prodcode x suppcode prodMRC $itemtype prodSUPP desMRC
global     #ordwidth maxwidth EnterNewOrder() #ordlength backing
global     specterm delquot orderby ordref purchorderdate $comment #unitcost
global     OrderedBy() $color i #smlr #disc $unsort SortColour() $newsort n
global     CheckDupe() $newcolor y $colorstr EnterColour() ShowBox() f1 f2 f3
global     #curr_smlr ChooseStock() clearvar() #prodrec keyf keyb list
global     Entries() $mess1 $backing ChooseColour() ChooseWidth() #curr_disc
global     #nritems strtrow $popstr strtcol $popcol $mess2 #deflen #reqncost
global     $unit nextnr varcode
global     $delterms endcol $choice cl1 cl2 curr_nr mess r1 r2 c1 c2
global     orderdate telnr accnr contact y1 y2 y3 y4 y5 $new_ord y6
global     nextext #extnr oldsupp NewOrder()


MAIN
single-step off
' quiet off
  $new_ord = "N"
  keyf = 7
  keyb = 0
  #ordlength = 25
  $delterms   = "2/3ÿdays 7ÿdays 7-10ÿdaysÿ 14ÿdays Other"
  varcode = "VAR002"         ' Supplier Code for various suppliers

  LoadFiles()

  while true
    screen clear box 1 1 sch scw 0 0 no-border
    repaint off

    fopen dpath|"x_purch.dat" as 1
    fread 1 into curr_nr
    fclose 1
    nextnr = value(curr_nr) + 1
    #extnr = 0

    x = EnterDetails()
    if x = 0
    elseif x = -1
      exit while
    end if
  end while

  ReturnToMenu()

END MAIN


FUNCTION EnterDetails()
local pprc
  prodcode = ""
  while true
    screen clear box 1 1 sch scw 0 0 no-border
    list = "1Carpet 1Ancillaries 1Tiles 1Vinyl"
    x = keybox(list,"Stock Orders")
    if x = -1
      return (-1)
    else
      $choice = ptstr
    end if
    x = ChooseStock()
    if x = -1
      continue while
    end if
    repaint off
    #disc      = [Discount_%]
    #curr_smlr = [SM_List_Rolls]
    prodSUPP   = [Product_Supplier]
    $itemtype  = [Item_Type]
    suppcode   = [Supplier_Code]
    prodMRC    = [Product_MRC]
    backing    = [Backing]
    $unit      = [Unit_Desc]
    prodsupp   = [Product_Supplier]

    vloadif(dpath|"supplier.vws")
    if suppcode = varcode
      order change index "suppname"
      y2 = format(" Choose supplier - {Esc} to leave ","M72")
      screen print 21 5 fgp bbd y2
      x = bpopdb("supplier",6,"","[Name]","l35","[Supplier_Code]","L6","[Supplier_Code]",7,5,20,40,"",0)
      screen shortrestore dsa
      if x = 0
        repaint off
        suppcode = [Supplier_Code]
        suppname = [Name]
        telnr    = [Telephone]
        accnr    = [Account_Nr]
        contact  = [Contact_Name]
      elseif x = -1
        screen clear box 7 5 20 42 0 0 no-border
        continue while
      end if
    else
      suppname = filelookup([Supplier_Code],[Name],suppcode)
      while true
        y1 = "Confirm Supplier is"&suppname&"?"
        pprc = len(y1)/2+2+40
        y2 = format(" Confirm Supplier is"&suppname&"?","M72")
        screen print 21 5 fgp bbd y2
        x = popuplist(20,pprc,24,"Yes No","",1,0)
        if x = 0
          if ptstr = "No"
            if $new_ord = "Y"      'message "Cannot use existing nr on change of Supplier"
              increment(dpath|"x_purch.dat",1)
              $new_ord = "N"
              fopen dpath|"x_purch.dat" as 1
              fread 1 into curr_nr
              fclose 1
              nextnr = value(curr_nr) + 1
              x = remove("extnr.dat")
            end if
            y2 = format("","M72")
            screen print 21 5 fgp bbd y2
            while true
              order change index "suppname"
              x = bpopdb("supplier",6,"","[Name]","l35","[Supplier_Code]","L6","[Supplier_Code]",7,5,20,42,"",0)
              screen shortrestore dsa
              if x = 0
                repaint off
                suppcode = [Supplier_Code]
                suppname = [Name]
                telnr    = [Telephone]
                accnr    = [Account_Nr]
                contact  = [Contact_Name]
                exit while
              elseif x = -1
                screen clear box 7 5 20 42 0 0 no-border
                return (-1)
              end if
            end while
            continue while
          else
            telnr   = filelookup([Supplier_Code],[Telephone],suppcode)
            accnr   = filelookup([Supplier_Code],[Account_Nr],suppcode)
            contact = filelookup([Supplier_Code],[Contact_Name],suppcode)
            exit while
          end if
        else
          continue while
        end if
      end while
      vunloadif("supplier.vws")
    end if

    if contact = blank
      contact = "No contact name"
    else
      contact = " Contact"&contact
    end if

    #extnr = #extnr + 1                ' message "#extnr is:"&str(#extnr)
    nextext = "X"|right("00000"|str(nextnr),5)|"-"|right("00"|str(#extnr),2)

    r1 = 7
    r2 = r1+6
    c1 = 1
    c2 = c1+41
    cl1 = 15
    cl2 = 10
    screen clear box 7 5 20 42 0 0 no-border
    screen clear box r1 c1 r2 c2 cl1 cl2
    y1 = format(suppname,"M39")
    y2 = format(left(contact,35),"M39")
    y3 = format(left(telnr&"- A/c:"&accnr,40),"M39")
    y5 = format("Desc'n:"&prodsupp,"M39")
    y4 = format("Our Order Nr will be:"&nextext,"M39")
    screen print r1+1 c1+2 cl1 cl2 y1
    screen print r1+2 c1+2 cl1 cl2 y2
    screen print r1+3 c1+2 cl1 cl2 y3
    screen print r1+4 c1+2 cl1 cl2 y5
    screen print r1+5 c1+2 cl1 cl2 y4

    while true
      purchorderdate = date2(today)
      x = entryline(" Enter Date of Order or {Esc} to abort ",10,"##\/##\/####",purchorderdate,21,5,72)
      if x = 0
        purchorderdate = ptstr
        if chkdate(purchorderdate,1) = -1
          messbox(" Incorrect date - re-enter ",0,0,1)
          continue while
        end if
        exit while
      elseif x = -1
        exit while
      end if
    end while
    if x = -1
      continue while
    end if

    while true
      $mess2 = case $itemtype ("A","Enter Quantity required or {Esc} to abort")\
      ("B","Enter Length required or {Esc} to abort")\
      ("C","Enter Length required or {Esc} to abort")\
      ("S","Enter Quantity required or {Esc} to abort")\
      ("T","Enter Quantity required or {Esc} to abort")\
      ("V","Enter Quantity required or {Esc} to abort")\
      ("W","Enter Quantity required or {Esc} to abort")
      x = entryline($mess2,5,nr5,25,21,5,72)
      if x = 0
        if ptstr = ""
          continue while
        end if
        #ordlength = value(ptstr)
        exit while
      elseif x = -1
        #extnr = #extnr - 1
        exit while
      end if
    end while
    if x = -1
      continue while
    end if

  while true
    x = entryline(" Quoted price ",8,"",fixed(#curr_smlr,2),21,5,72)
    if x = 0
      #smlr = value(ptstr)
      if round(#smlr,2)<>round(#curr_smlr,2)
        messline(" Confirm quoted price is"&currency(#smlr)|"? (y/n) ",1,0,1,21,5,72)
        if ptstr == "Y"
          if userid<>"DAVIDG"
            mess = "STOCK-"&fixed(#ordlength,2)|"m of"&prodcode&"ordered at"&currency(#smlr)&"from"&suppcode|". Roll price is"&currency(#curr_smlr)
            x = Exception(userid,today,time24,"P_PRICE",mess)
          end if
          exit while
        else
          continue while
        end if
      end if
      exit while
    else
      continue while
    end if
  end while				' end of COST section

  #curr_disc = #disc
  while true
    x = entryline(" Discount from"&suppname,8,"",fixed(#curr_disc,2),21,5,72)
    #disc = value(ptstr)
    if #disc<>#curr_disc
      messline(" Confirm discount is"&fixed(#disc,2)|"%? (y/n) ",1,0,1,21,5,72)
      if ptstr == "Y"
        if userid<>"DAVIDG"            ' message "userid not DG"
          mess = "DISCOUNT-"&fixed(#ordlength,2)|"m of"&prodcode&"ordered at"&currency(#disc)&"from"&suppcode|". Usual discount is"&currency(#curr_disc)
          x = Exception(userid,today,time24,"P_PRICE",mess)
        end if
        exit while
      else
        continue while
      end if
    end if
    exit while
  end while				' end of COST section

  #unitcost = #smlr*(1-(#disc/100))
  #reqncost = value(#ordlength)*value(#ordwidth)*value(#unitcost)

  vunloadif("products.vws")
  vloadif(dpath|"ent_pord.vw")

  x = EnterNewOrder()
  if x = -1
    exit while
  elseif x = 0
    continue while
  elseif x = 1
    continue while
  end if
end while
END FUNCTION 'EnterDetails()


FUNCTION NewOrder()
' reset order nrs for new supplier
  #extnr = 1
  increment(dpath|"x_purch.dat",1)
  $new_ord = "N"
  fopen dpath|"x_purch.dat" as 1
  fread 1 into curr_nr
  fclose 1
  nextnr = value(curr_nr) + 1
  #extnr = 0
  nextext = "X"|right("00000"|str(nextnr),5)|"-"|right("00"|str(#extnr),2)
END FUNCTION 'NewOrder()


FUNCTION EnterNewOrder()
local #nrrolls
  ordref = ""
  specterm = ""

  while true
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³  Enter quoted delivery                                             ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    while true
      $popstr = $delterms
      x = strcount($popstr)
      if x = 0
        #nritems = ptval
      end if
      strtrow = 21 - 2 - #nritems
       endcol = 0
      for i = 1 to #nritems
        y = GROUP($popstr,i)
        x = len(GROUP($popstr,i))
        if x > endcol
          endcol = x
        end if
      end for
      strtcol = 5

      while true
        if ASC(delquot) = 0
          $popcol = colpopup(strtrow,strtcol,20,$popstr,"",1,0,11,13,0,7)
        else
          $popcol = findcolpop(strtrow,strtcol,20,$popstr,"",delquot,1,0,11,13,0,7)
          if $popcol = -5
            $popcol = colpopup(strtrow,strtcol,20,$popstr,"",1,0,11,13,0,7)
          end if
        end if
        if $popcol = 0
          exit while
        end if
      end while

      if ptstr = "Other"
        screen shortrestore dsa
        while true
          x = entryline(" Delivery quoted ",20,"","",21,5,72)
          if x = 0
            delquot = ptstr
            exit while
          end if
        end while
      else
        delquot = ptstr
      end if
      screen shortrestore dsa
      exit while
    end while		

  ' ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
  ' º  Enter comments re Purchase                                        º
  ' ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
    while true
      x = entryline(" Any comments on Purchase Order ",36,"AU*35{X}","None",21,5,72)
      if x = 0
        $comment = ptstr
        exit while
      end if
    end while

  ' ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
  ' º  Enter Special Terms                                               º
  ' ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
    while true
      x = entryline(" Special terms? ",20,"","None",21,5,72)
      if x = 0
        specterm = ptstr
        exit while
      end if
    end while

  ' ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
  ' º  Supplier's reference                                              º
  ' ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
    while true
      x = entryline(format(left(suppname,28)|"'s ref:","M36"),20,"*20{XU}","",21,5,72)
      if x = 0
        ordref = ptstr
        if ordref = ""
          messbox(" Must enter Supplier's reference! ",0,0,1)
          continue while
        else
          exit while
        end if
      end if
    end while

    screen clear box r1 c1 r2 c2 cl1 cl2
    y1 = format(suppname,"M39")
    y2 = format(left(contact,35),"M39")
    y3 = format(left(telnr&"- A/c:"&accnr,40),"M39")
    y4 = format("Our Order Nr will be:"&nextext,"M39")
    y5 = format("Order Ref:-"&ordref,"M38")
    screen print r1+1 c1+2 cl1 cl2 y1
    screen print r1+2 c1+2 cl1 cl2 y2
    screen print r1+3 c1+2 cl1 cl2 y3
    screen print r1+4 c1+2 cl1 cl2 y4
    screen print r1+5 c1+2 fgi bgi y5

    y2 = format("","M72")
    screen print 21 5 fgp bbd y2
    screen clear box 22 5 22 77 0 0 no-border

    OrderedBy()

    x = messline("Confirm"&fixed(#ordlength,2)&$unit&"ordered on"&purchorderdate|"? (y/n) ",1,0,1,21,5,72)
    if ptstr == "y"
      repaint off
      exit while
    elseif ptstr == "n"
      repaint off
      #extnr = #extnr - 1
      return (1)
    end if
  end while

  vloadif(dpath|"ent_pord.vw")
  if $choice == "C"
    while true
      x = entryline(" Enter total number of rolls to order ",3,"",1,21,5,72)
      if x = -1
        continue while
      end if
      #nrrolls = value(ptstr)
      messline(" Confirm"&str(#nrrolls)&"rolls to order? (y/n) ",1,1,1,21,5,72)
'  x = messline("Confirm"&fixed(#ordlength,2)&$unit&"ordered on"&purchorderdate|"? (y/n) ",1,0,1,21,5,72)
      if ptstr == "Y"
        exit while
      else
        continue while
      end if
    end while
  else
    #nrrolls = 1
  end if

  CreateOrder()

  if #nrrolls > 1
    for i = 1 to #nrrolls-1
      #extnr = #extnr + 1                ' message "#extnr is:"&str(#extnr)
      nextext = "X"|right("00000"|str(nextnr),5)|"-"|right("00"|str(#extnr),2)
      CreateOrder()
    end for
  end if

  $new_ord = "Y"                       ' set flag to increment order nrs
  vunloadif("ent_pord.vw")
  return (0)
END FUNCTION ' EnterNewOrder()


FUNCTION  CreateOrder()
' ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
' º create PURCHORD record and make all assignments                    º
' ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
  data enter lock
    [Supp_Code]       = suppcode
    [Supplier_Code]   = suppcode
    [Width]           = #ordwidth
    [Length_Quantity] = #ordlength
    [Balance_OS]      = #ordlength
    [Order_Reference] = ordref
    [Ordered_By]      = orderby
    [Date_Ordered]    = purchorderdate
    [Product_Code]    = prodcode
    [Order_Nr]        = nextext
    [Delivery_Quoted] = delquot
    [Comments]        = $comment
    [Special_Terms]   = specterm
    [Last_Update]     = today
    [Updated_By]      = userid
    [Carpet_Color]    = desMRC
    [Unit_Cost]       = #unitcost
    [Order_Cost]      = #reqncost
    [Order_Status]    = "P"
  write-record
END FUNCTION  'CreateOrder()


FUNCTION OrderedBy()
local $save_screen $username
while true
  repaint off
  vloadif(dpath|"userid.vw")
  screen save 1 1 sch scw $save_screen
  $username = userid
  order change physical
  order sort now dictionary "x" fields "[author]" ascending
  x = bpopdb("userid",6,"fp"&$username,"[Name]","L20","[author]","L0","[greeting]",14,16,20,38,"",1)
  if x = -1
    messbox(" Must Select! ",0,0,1)
  else
    orderby = [author]
    screen shortrestore dsa
    repaint off
    vunloadif("userid.vw")
    exit while
  end if
end while
END FUNCTION 'OrderedBy()


FUNCTION  EnterColour()
local $fldlen $usedlen i
  $fldlen = dbfldinfo("[Colours]",2)
  $usedlen = str(len([Colours]))
  while true
    x = entryline(" Enter New Colour Description - {Esc} to abandon ",20,"*20x","",21,5,72)
    if x = 0
      $color = proper(ptstr)
      if len(ptstr) > (value($fldlen) - value($usedlen))
        return (-1)   ' !!!!!!!!!!!!!!!! TEST ONLY
      end if
      scr = scr - 2
      x = messline("Confirm new colour"&chr(34)|$color|chr(34)&"? (y/n)",1,1,1,21,5,72)
      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 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
      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
  SortColour()
  vloadif(dpath|"prodselA.vw")
' NEW!!!

  lock-record
    [Colours] = $newsort
  write-record
  return (0)
END FUNCTION ' EnterColour()


FUNCTION SortColour()
  vloadif("temp_skl.vws")
  if precords <> 0
    data query execute "delete"
    vunloadif("temp_skl.vws")
    data utilities purge "temp_skl"
  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)             ' message "x is:"&str(x)
  vloadif("temp_SKL.vws")
  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"
  return $newsort
END FUNCTION ' SortColour()


FUNCTION clearvar()
 clear  suppcode
 clear  #ordlength
 clear  ordref
 clear  orderby
 clear  purchorderdate
 clear  consecnr
 clear  delquot
 clear  $comment
 clear  specterm
 clear  desMRC
 clear  prodMRC
 clear  desMRC
 clear  $itemtype
 clear  #ordwidth
END FUNCTION ' clearvar()


FUNCTION Entries()
' get variables from PRODSELA.VW
  $itemtype  = [Item_Type]
  prodMRC    = [Product_MRC]
  if $itemtype = "B" or $itemtype = "C"
    $mess1 = "("|$backing|")"
  else
    $backing = "N/A"
    $mess1 = ""
  end if

  #smlr      = [SM_List_Rolls]
  #disc      = [Discount_%]
  prodSUPP   = [Product_Supplier]
  suppcode   = [Supplier_Code]
  if $new_ord = "Y" and suppcode <> oldsupp
    NewOrder()
  end if

  while true                      ' start selection of widths colours etc
    x = ChooseColour()
    if x = -1
      return (-1)
    elseif x = 2                  ' new colour
      continue while
    end if

    x = ChooseWidth()
    if x = -1
      return (-1)
    end if
    return (0)
  end while
END FUNCTION ' Entries()


FUNCTION ChooseWidth()
  while true 			  ' start WIDTH section
    if $itemtype = "A"
      #ordwidth = value([Widths_Available])
      exit while
    elseif $itemtype = "F"
      #ordwidth = value([Widths_Available])
      exit while
    elseif $itemtype = "S"
      #ordwidth = value([Widths_Available])
      exit while
    elseif $itemtype = "T"
      #ordwidth = value([Widths_Available])
      exit while
    else
'     ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
'     º Enter & check width                                           º
'     ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
      while true
        if [Widths_Available] ! "V"
          maxwidth = right([Widths_Available],5)
          x = entryline(" This carpet is available in any width upto"&maxwidth|"m",5,"","",21,5,72)
          if x = 0
            #ordwidth = value(ptstr)
            if #ordwidth > value(maxwidth)
              messline(" Width cannot be greater than"&maxwidth|"m",0,0,1,21,5,72)
              continue while
            elseif #ordwidth = ""
              continue while
            end if
            exit while
          end if
        end if
        screen print 21 5 fgp bgp y2
        screen shortrestore dsa

        strcount([Widths_Available])
        #nritems = ptval
        strtrow = 19 - #nritems

        screen clear box 21 5 22 77 0 0 no-border
        y2 = format(" Select Width and press {Enter} - {Esc} to enter new colour","M72")
        screen print 21 5 fgp bbd y2

        while true
            $popstr = [Widths_Available]
            exit while
        end while
        x = colpopup(strtrow,68,20,$popstr,"",1,0,4,0,0,7)
        if x = 0
          #ordwidth = ptstr
          screen shortrestore dsa
          exit while
        end if
      end while
      exit while
    end if
  end while				' end of WIDTH section
END FUNCTION ' ChooseWidth()


FUNCTION ChooseColour()
  while true 			' start COLOURS section
    case $itemtype
      when "A"
        desMRC = "N/A"
        exit while
      when "F"
        desMRC = "N/A"
        exit while
      otherwise               ' Check colours & add if necessary
        while true
          $popstr = [Colours]
          x = strcount($popstr)
          if x = -1
            x = EnterColour()  ' returns - (0) Success; (1) Unable to add
            if x = 1
              ShowBox()
              exit function
            elseif x = -1
              return (-1)
            elseif x = 0
              desMRC = $newcolor
              return (2)       ' new colour
            end if
            desMRC = $newcolor
            continue while
          else
            #nritems = ptval
          end if

          strtcol = 0
          for i = 1 to #nritems
            y = GROUP($popstr,i)
            x = len(GROUP($popstr,i))
            if x > strtcol
              strtcol = x
            end if
          end for
          strtcol = 72 - strtcol

          screen clear box 21 5 22 77 0 0 no-border
          y2 = format(" Select colour and press {Enter} - {Esc} to enter new colour ","M72")
          screen print 21 5 fgp bbd y2

          if ASC(desMRC) = 0
            $popcol = colpopup(7,strtcol,19,[Colours],"",1,0,14,11,0,7)
          else
            $popcol = findcolpop(7,strtcol,19,[Colours],"",desMRC,1,0,14,11,0,7)
            if $popcol = -5
              $popcol = colpopup(7,strtcol,19,[Colours],"",1,0,14,11,0,7)
            end if
          end if

          screen clear box 1 56 1 80 0 0 no-border
          if $popcol = 0
            desMRC = ptstr
            exit while
          elseif $popcol = -1
            screen shortrestore dsa
            $popcol = EnterColour()  ' returns - (0) Success; (1) Unable to add
            if $popcol = 1
              ShowBox()
              exit function
            elseif $popcol = -1
              continue while           '               return (-1)
            elseif $popcol = 0
              desMRC = $newcolor
              return (2)
            end if
            desMRC = $newcolor
            exit while
          elseif $popcol = -2
            $popcol = EnterColour()  ' returns - (0) Success; (1) Unable to add
            if $popcol = 1
              ShowBox()
              exit function
            elseif $popcol = -1
              exit while
            elseif $popcol = 0
              exit while
            end if
            desMRC = $newcolor
            exit while
          end if
        end while
    end case
    exit while
  end while		          ' end of Colour check
END FUNCTION ' ChooseColour()


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()


FUNCTION ReturnToMenu()
  if $new_ord ="Y"
    increment(dpath|"x_purch.dat",1)
  end if
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  file unload all
  transfer "pm_menu.psl" in-memory
END FUNCTION


FUNCTION LoadFiles()
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  vloadif(dpath|"ent_pord.vw")
  vloadif(dpath|"products.vws")
END FUNCTION


FUNCTION ChooseStock()
local z $mess1 $mess2 #deflen $wrongprod f1 f2 f3 nr_reqns nr_index
  while true
    screen clear box 1 1 sch scw 0 0 no-border
    repaint off
    prodcode = ""

    if $choice == "C"
      oldsupp = suppcode
      clearvar()
      vloadif(dpath|"prodselA.vw")
      order change index ipath|"stckcarp.idx"
      y2 = format(" Scroll & {Enter} to select - {Esc} to leave ","M72")
      screen print 21 5 fgp bbd y2
      x = bpopdb("prodselA",4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0)
      if x = -1
        screen clear box 21 5 21 5+72 0 0 no-border
        return (-1)
      end if
      #prodrec = record
      prodcode = ptstr
      $backing = [Backing]
      screen shortrestore dsa
      screen print 7 45 15 1 "ÿ"|prodcode|"ÿ"

      x = Entries()
      if x = -1
        screen clear box 5 5 22 77 0 0 no-border
        repaint off
        continue while
      elseif x = 0
        return (0)
      end if

    elseif $choice == "A"              '   elseif ptstr = "Ancillaries"
      clearvar()
      vloadif(dpath|"prodselA.vw")
      order change index ipath|"stckancl.idx" ' message "F3 - prodcode is:"&str(prodcode)
      y2 = format(" Scroll & {Enter} to select - {Esc} to leave ","M72")
      screen print 21 5 fgp bbd y2
      x = bpopdb("prodselA",4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0)
      if x = -1
        screen clear box 21 5 21 5+72 0 0 no-border
        return (-1)
      end if
      #prodrec = record
      prodcode = ptstr
      $backing = [Backing]
      screen shortrestore dsa
      screen print 7 45 15 1 "ÿ"|prodcode|"ÿ"

      x = Entries()
      if x = -1
        screen clear box 5 5 22 77 0 0 no-border
        repaint off
        continue while
      elseif x = 0
        return (0)
      end if

    elseif $choice == "V"              '     elseif ptstr = "Vinyl"
      clearvar()
      vloadif(dpath|"prodselA.vw")
      order change index ipath|"vinyl.idx"   ' ' message "F6 - prodcode is:"&str(prodcode)
      y2 = format(" Scroll & {Enter} to select - {Esc} to leave ","M72")
      screen print 21 5 fgp bbd y2
      x = bpopdb("prodselA",4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0)
      if x = -1
        screen clear box 21 5 21 5+72 0 0 no-border
        return (-1)
      end if
      #prodrec = record
      prodcode = ptstr
      $backing = [Backing]
      screen shortrestore dsa
      screen print 7 45 15 1 "ÿ"|prodcode|"ÿ"

      x = Entries()
      if x = -1
        screen clear box 5 5 22 77 0 0 no-border
        repaint off
        continue while
      elseif x = 0
        return (0)
      end if

    elseif $choice == "T"              '     elseif ptstr = "Tiles"
      clearvar()
      vloadif(dpath|"prodselA.vw")
      screen shortrestore dsa
      x = popuplist(10,58,25,"Stock Bespoke","",1,0)
      if x = -1
        return (-1)
      end if
      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
      screen clear box 1 1 sch scw 0 0 no-border
      y2 = format(" Scroll & {Enter} to select - {Esc} to leave ","M72")
      screen print 21 5 fgp bbd y2
      x = bpopdb("prodselA",4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0)
      if x = -1
        screen clear box 21 5 21 5+72 0 0 no-border
        return (-1)
      end if
      #prodrec = record
      prodcode = ptstr
      $backing = [Backing]
      screen shortrestore dsa
      screen print 7 45 15 1 "ÿ"|prodcode|"ÿ"

      x = Entries()
      if x = -1
        screen clear box 5 5 22 77 0 0 no-border
        repaint off
        continue while
      elseif x = 0
        return (0)
      end if
    end if
  end while

  data goto record last
  return (0)
END FUNCTION ' ChooseStock()