FUNCTION EnterSupplier()
local bpop_ret
  screen shortrestore dsa
  vloadif(dpath|"new_supp.vw")
  order change physical
  order sort now dictionary "suppname" fields "[Name]" ascending
  screen print 19 10 fgi bgi (format("Choose Supplier or {Esc} to enter new","M45"))
  bpop_ret = bpopdb("new_supp",6,"","[Name]","L35","[Supplier_Code]","L6","[New_Code]",8,10,18,54,"Choose Supplier",0)
  if bpop_ret = 0
    newcode = ptstr
    suppcode = [Supplier_Code]
    suppname = [Name]
    screen clear box 1 1 sch scw 0 0 no-border
    repaint off
    progress(fgp,bgp," Calculating possible Product Code ",0)
  elseif bpop_ret = -1
    screen clear box 1 1 sch scw 0 0 no-border
    repaint off
    messbox(" Enter new Supplier? (y/n) ",1,1,1)
    if ptstr == "y"
      NewSupplier()
      newcode = [New_Code]
      suppcode = [Supplier_Code]
    else
      return (-1)
    end if
  end if
' if present {Enter} will return [Supplier_Code] or {Esc} will branch
' to entry screen for new SUPPLIER record
END FUNCTION ' EnterSupplier()


FUNCTION NewSupplier()
local  newsuppcode
  while true
    screen clear box 1 1 sch scw 0 0 no-border
    repaint off
    while true
      x = fentrybox(" Enter new Supplier Code ",6,"*3AU*3#","")
      if x = -1
        continue while
      elseif x = 0
        exit while
      end if
    end while
    newsuppcode = ptstr
    progress(fgp,bgp," Checking for existing Supplier code ",0)
    data find "[Supplier_Code]" equal newsuppcode options ""
    if cerror                               '   if none - then exit
      exit while
    else
      screen clear box 1 1 sch scw 0 0 no-border
      messbox("˙Supplier Code already used˙",0,0,1)
      continue while
    end if
  end while

  order change physical
  data goto record last
  prodref = [Product_Reference]
  prodref = value(prodref) + 1
  prodref = right(("000"|str(prodref)),3)
  newcode = left(newsuppcode,3)|prodref

  data enter blank
  lock-record
    [Supplier_Code] = newsuppcode
    [New_Code] = newcode
    [Product_Reference] = prodref
  write-record
  repaint on
  repaint
  data update only-one
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
END FUNCTION ' NewSupplier()


FUNCTION EnterDetails()
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  vloadif(dpath|"prodent1.vw")
  data enter blank
  while true
    while true
      x = fentrybox(" Enter PRODUCT_MRC ",30,"",prodmrc)
      if x = 0
        exit while
      end if
    end while
    prodmrc = ptstr

    while true
      x = fentrybox(" Enter Square Metre List Cuts ",8,"*8{[1234567890.]}",smlc)
      if x = 0
        exit while
      end if
    end while
    smlc = ptstr

    while true
      x = fentrybox(" Enter Square Metre List Rolls ",8,"*8{[1234567890.]}",smlr)
      if x = 0
        exit while
      end if
    end while
    smlr = ptstr

    while true
      x = fentrybox(" Enter Supplier's Discount ",5,"*5{#}",str(discount))
      if x = 0
        exit while
      end if
    end while
    discount = value(ptstr)

    effecdate = date2(@if(effecdate="",today,effecdate))
    while true
      x = fentrybox(" Enter Effective Date ",10,"##\/##\/####",effecdate)
      if x = 0
        exit while
      end if
    end while
    effecdate = ptstr

    lock-record
      [Product_Code]  = prodcode
      [Supplier_Code] = suppcode
      [Product_MRC]   = prodmrc
      [Prev_SMLC]     = smlc
      [SM_List_Cuts]  = smlc
      [Prev_SMLR]     = smlr
      [SM_List_Rolls] = smlr
      [Discount_%]    = discount
      [Effect_Date]   = effecdate
      [Item_Type]     = $itemtype
      [Initial_Code]  = left(prodcode,1)
    write-record
    repaint on
    repaint
    data update only-one
    messbox(" Are these details correct? (y/n) ",1,1,1)
    if ptstr == "y"
      lock-record
        [Updated_On]  = today
      write-record
      smlc = [SM_List_Cuts]
      smlr = [SM_List_Rolls]
      screen clear box 1 1 sch scw 0 0 no-border
      repaint off
      exit while
    end if
  end while

  if $itemtype = "A"                   ' check for record in STK_ANCL.DB
    vloadif(dpath|"stk_ancl.vws")
    data find "[Product_Code]" equal prodcode options ""
    if cerror                               '   if none - then return
      messboxwait(" Contact DC for new entry in STK_ANCL file ",0,0,1)
'       data enter lock
'         [Product_Code]      = prodcode
'         [Product_MRC]       = prodmrc
'         [PhysicalBalance]   = 0
'       write-record
    end if
  end if
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
END FUNCTION
