'PROD_ENT - simplifies entry of [Product_Code]

external   vloadif() vunloadif() messbox() fentrybox() sch scw cpath dpath
external   bpopdb() progress() fgp bgp scr popuplist() fgi bgi remove()
external   progtag() ipath messboxwait()

public     ptstr prodcode suppcode $itemtype dsa

global     CheckUnique() EnterCode() x EnterSupplier() EnterDetails() Prefix()
global     NewSupplier() prodmrc smlc smlr check prodref discount effecdate
global     $prefix FindNr() $newnr newcode $title suppname
global     mess1


MAIN
quiet off
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  single-step off
  smartpoke $_ins 0

  effecdate = ""
  prodmrc = ""
  smlc = ""
  smlr = ""
  prodcode = ""
  discount = 0

  while true
    x = Prefix()                        ' message "$prefix is:"&str($prefix)
    if x = -1
      exit while
    end if

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

    FindNr()                            'message "prodcode is:"&str(prodcode)

    x = EnterCode()
    if x = -1
      exit while
    end if
  end while

'   execute "bldindex.rf3" in-memory

  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  file unload all
  smartpoke $_ins 1
  transfer cpath|"pm_menu.psl" in-memory
END MAIN


FUNCTION FindNr()
  repaint off
  vloadif(dpath|"prodent2.vw")
  order change key "[Supplier_Code]"
  data query execute "suppcod2.dfq" index "x.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³[Supplier_Code] = suppcode                                          ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
    prodcode = right($prefix,1)|"/"|right(newcode,3)|"100"
    exit function
  else
' message "newcode is:"&str(newcode)
' message "codenr is:"&str([codenr])
' x=filemax([codenr])
' message "filemax is:"&str(x)
    $newnr = filemax([codenr])
' message "$newnr is:"&str($newnr)
    $newnr = value($newnr) + 1
' message "$newnr is:"&str($newnr)
    $newnr = right(("000"|str($newnr)),3)
' message "$newnr is:"&str($newnr)
    prodcode = right($prefix,1)|"/"|right(newcode,3)|right(str($newnr),3)
' message "prodcode is:"&str(prodcode)
  end if
END FUNCTION 'FindNr()


FUNCTION Prefix()
local a1 a2 a3 a4 a5 a6 a7 a8 a9 mess
  a1="StockÿCarpet"
  a2="StockÿAncillary"
  a3="StockÿTiles"
  a4="StockÿVinyl"
  a5="BespokeÿCarpet"
  a6="BespokeÿAncillary"
  a7="BespokeÿTiles"
  a8="BespokeÿVinyl"
  a9="Fitting"
  mess = a1&a2&a3&a4&a5&a6&a7&a8&a9
  x = popuplist(8,55,18,mess,"Choose Type",1,0)
  if x = 0
    if ptstr = a1
      $prefix = "CA"
      $title = ptstr
      $itemtype = "C"

    elseif ptstr = a2
      $prefix = "AN"
      $title = ptstr
      $itemtype = "A"

    elseif ptstr = a3
      $prefix = "SA"
      $title = ptstr
      $itemtype = "S"

    elseif ptstr = a4
      $prefix = "VA"
      $title = ptstr
      $itemtype = "V"

    elseif ptstr = a5
      $prefix = "BB"
      $title = ptstr
      $itemtype = "B"

    elseif ptstr = a6
      $prefix = "JJ"
      $title = ptstr
      $itemtype = "J"

    elseif ptstr = a7
      $prefix = "TB"
      $title = ptstr
      $itemtype = "T"

    elseif ptstr = a8
      $prefix = "WB"
      $title = ptstr
      $itemtype = "W"

    elseif ptstr = a9
      $prefix = "FL"
      $title = ptstr
      $itemtype = "F"

    end if
  elseif x = -1
    return (-1)
  end if
END FUNCTION ' Prefix()


FUNCTION EnterCode()
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  while true
' message "prodcode) is:"&str(prodcode)
'     $newnr = value($newnr) + 1
'     $newnr = right(("000"|str($newnr)),3)
'     prodcode = right($prefix,1)|"/"|right(newcode,3)|right(str($newnr),3)
    check = ""

    mess1 = "Enter New Code for"&suppname&"or {Esc} "
'     lmess = len(mess1)
'     lm = "M"|lmess|chr
' message "lm is:"&str(lm)
    screen print 7 20 15 4 (format($title,"M42"))
    x = fentrybox(mess1,8,"AU\/*6#",prodcode)
    screen clear box 1 1 sch scw 0 0 no-border
    repaint off
    if x = 0
      prodcode = ptstr
      CheckUnique()
      if check = "Y"              ' i.e. it already exists
        messbox("ÿProduct Code already usedÿ",0,0,1)
        continue while               ' loop round to try another number
      else
        EnterDetails()
      end if
    elseif x = -1
      return (-1)
    end if
  end while
END FUNCTION


FUNCTION CheckUnique()  ' check code does not exist in PRODUCTS.vws
  repaint off
  order change key "[Product_Code]"
  data query execute "uniqcode.dfq" index "x.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ [Product_Code] = prodcode                                          ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
    exit function       ' if not found, proceed with suggested code
  else
    check = "Y"
  end if
END FUNCTION


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
message "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