'CLR_STCK - clears out all zero/nearly zero stock and de-activates record

external   messbox() fentrybox() vloadif() dpath sch scw navrecs() fgp bgp
external   userid increment() vunloadif() cpath delidxrec() getidxrecs()
external   progress() spath remove() messboxwait() Background() makeidx()
external   addidxrec()

public     ptstr maxlen ptval #recnr jobnr $ccwidx

global     x ListStock() DeleteStock() Titles() $rollnr #writeoff $ccwcode
global     CreateWriteOffReqn() refcode prodcode desMRC prodMRC $width i
global     ReturnToMenu() $comment CheckRequsn() #carp_recnr #currrec #recs
global     DeleteAll()


MAIN
  clear public
  single-step off
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
'   quiet off
  file unload all
  error off
  while true
    window close
    if cerror
      exit while
    end if
  end while

  messbox(" Have you made all required remnants? (y/n) ",1,1,1)
  if ptstr == "n"
    ReturnToMenu()
  end if
  remove("not_woff.idx")
  makeidx("stk_carp","not_woff.idx","0",1)
'   order change index "current.idx"

'   while true
    while true
      Background()
      x = fentrybox(" Max length of carpet to list - {Esc} exits ",2,"",".5")
      if x = -1
        ReturnToMenu()
      else
        maxlen = value(ptstr)
        exit while
      end if
    end while
    vloadif(dpath|"products.vws")
    vloadif(dpath|"clr_stck.vw")
    x = ListStock()
    ReturnToMenu()
'   end while
END MAIN


FUNCTION ListStock()
  progress(fgp,bgp," Please wait ... finding stock ",0)
  data query execute "clr_stck.dfq" index "clr_stck.idx"
  ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
  ' ³ QUERY is:  [PhysicalBalance] < maxlen and not (deleted)
  ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
    messbox(" No rolls less than"&str(maxlen)|"m in Stock ",0,0,1)
    return (-1)                         ' close files, return to menu
  end if

  window split horizontal 20
  data goto window 2
  vloadif(dpath|"uar_desc.vw")
  data goto window 1
  window link "[Product_Code]" "uar_desc.vw" "[Product_Code]"

  while ptval <> {Esc}
    repaint on
    repaint
    Titles()
    ptval = navrecs()

    if ptval = {D} or ptval = {d}
      repaint off
      x = DeleteStock()               ' 1=show message re unfitted
      if x = 0                         ' no more
        return (1)
      elseif x = 1                     ' deleted
        continue while
      elseif x = -1
        vloadif(dpath|"clr_stck.vw")
      end if

    elseif ptval = {A} or ptval = {a}
      repaint off
      x = DeleteAll()
      if x = 0                         ' no more
        return (1)
      elseif x = 1 ' no more
        continue while
      elseif x = -1
        vloadif(dpath|"clr_stck.vw")
      end if

    end if

  end while

  return (-1)
END FUNCTION 'ListStock()


FUNCTION DeleteAll()
  messbox(" Delete all possible rolls? ("|fixed(records,0)|") ",1,1,1)
  if ptstr == "n"
    return (1)
  end if
  #recs = records
'   for i = 1 to #recs
  while record <= records
    Titles()
    x = DeleteStock()               ' 1=do NOT show message re unfitted
' message "DeleteStock (1=w/off; 2=NOT w/off; 0=no more) is:"&str(x)
    if x = 0                         ' no more
      return (1)
    elseif x = 2                       'carpet not w/off
      x = addidxrec("not_woff.idx",precord,7)
      data goto record next
    elseif x = 1                       'carpet w/off
    end if
    repaint on
    repaint
  end while
  Background()
  return (0)
END FUNCTION 'DeleteAll()


FUNCTION DeleteStock()
local y
' x=apinfo(ap_filep)         'message "Screen is:"&str(x)
  #currrec = record
  repaint off
  prodcode = [Product_Code]
  desMRC   = [Description_MRC]
  $width   = [Width]
  $rollnr  = [RollNr]
  #writeoff = round([PhysicalBalance],2)
  $comment  = [Comments]

' message "prodcode is:"&str(prodcode)
  vloadif(dpath|"products.vws")
  error off
  prodMRC = filelookup([products.Product_Code],[Product_MRC],prodcode)
  if cerror
    messbox(" Product not found in PRODUCTS file ",0,0,1)
    return (-1)
  end if

  x = CheckRequsn()            ' x=0 NO uncut req's; x=1 req's still to cut
' message "L158 CheckRequsn is:"&str(x)
  if x = 0
    repaint off
    #carp_recnr = record
    order change physical
    x = delidxrec("clr_stck.idx",#carp_recnr,1)   'message "x is:"&str(x)
    x = getidxrecs("clr_stck.idx",2)         '
    if ptval = 0
      messbox(" No more to delete ",0,0,1)
      return (0)
    end if
  else
    messboxwait(" Cannot delete cuts/req'ns still to process",0,0,1)
    vloadif(dpath|"clr_stck.vw")
    order change index "clr_stck.idx"
    return (2)
  end if

'   vloadif(dpath|"clr_stck.vw")
  if #writeoff > 0    		' create reqn to clear balance if > 0
    messbox(" Delete Roll Nr"&$rollnr|" and write off"&str(#writeoff)|"m? (y/n) ",1,1,1)
    if ptstr == "n"
      return (2)
    end if
    x = CreateWriteOffReqn()
'     if x = 1
'       return (1)
'     end if
  end if

  vloadif(dpath|"clr_stck.vw")
  lock-record     			' clear balance from STK_CARP
    [Active]          = "N"
    [RollNr]          = $rollnr
    [PhysicalBalance] = 0
    [Balance]         = 0
    [BAR]             = 0
'   [Balance_Value]   = 0
    [Comments]        = right($comment&"DELETED",35)
  write-record
  if not(deleted)
    data delete record
  end if
  #recnr = record
  $ccwcode = [CCW_Code]
  $ccwidx = $ccwcode|".idx"

  vloadif(dpath|"stk_carp.vws")
  order change index spath|$ccwidx
  data find "[RollNr]" equal $rollnr options ""
  #carp_recnr = record                 ' message "$ccwidx is:"&str(spath|$ccwidx)
  x = delidxrec(spath|$ccwidx,#carp_recnr,1)   'message "x is:"&str(x)
  x = getidxrecs(spath|$ccwidx,2)         'message "ptval is:"&str(ptval)
  if ptval = 0
    messbox(" No more of this CodeColourWidth in Stock - removing index ",0,1,1)
    remove(spath|$ccwidx)
  end if

  vloadif(dpath|"clr_stck.vw")
  order change physical
  x = delidxrec("clr_stck.idx",#recnr,1)   'message "x is:"&str(x)
  x = getidxrecs("clr_stck.idx",2)         'message "ptval is:"&str(ptval)
  if ptval = 0
    messbox(" No more to delete ",0,0,1)
    return (-1)
  end if
  order change index "clr_stck.idx"
  return (1)                  ' continue
END FUNCTION ' DeleteStock()


FUNCTION CreateWriteOffReqn()
local a1 a2 a3 a4
  while true
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Generate reference nr                                              ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    increment(dpath|"dog_ends.dat",1)
    refcode = "Z"|right("00000"|str(ptval),5)|"-WO"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Create req'n                                                       ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    vloadif(dpath|"requsn.vws")
    window zoom
    data enter lock
      [Reference_Nr]       = refcode 	' assign [Reference_Nr] to record
      [Product_Code]       = prodcode
      [Description_MRC]    = desMRC
      [Product_MRC]        = prodMRC
      [Width]              = $width
      [Length_Quantity]    = value(format(#writeoff,"2r"))
      [Quant_OS]           = 0
      [Comment]            = "Balance cleared"&date2(today)
      [Date_Requisitioned] = today
      [Created/Changed_By] = userid
      [Status]             = "F"
      [RollNr]            = $rollnr
      [Item_Type]          = "C"
      [CCW_Code]           = $ccwcode
    write-record
    window zoom
    return (0)
  end while
END FUNCTION ' CreateReqn()


FUNCTION Titles()
local y1 y2 y3
  y3 = format("Stock Carpets for Deletion"&"("|str(records)&"rolls) ","M50")
  y2 = format(" {D}elete one - Delete {A}ll - {Esc} to finish ","M50")
  screen print 5 15 fgp bgp y3
  screen print 19 15 fgp bgp y2
  screen print 20 15 fgp bgp (format("ÿ","M9"))
  screen print 20 54 fgp bgp (format("ÿ","M11"))
END FUNCTION  'Titles()


FUNCTION ReturnToMenu()
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  error off
  window close
  file unload all
  transfer cpath|"pm_menu.psl" in-memory
END FUNCTION ' ReturnToMenu()


FUNCTION CheckRequsn()
local l
  vloadif(dpath|"clrstck2.vw")
  order change key "[RollNr]"
  while record <= records
    data find "[RollNr]" equal $rollnr options ""
    if cerror                               '   if none - then return
      exit while
    else
      if val([Quant_OS])<>0
'look in GOODSOUT for any uncut deliveries
' x=apinfo(ap_filep)         'message "Screen is:"&str(x)
        vloadif(dpath|"goodsout.vw")
        order change key "[RollNr]"
        while record <= records
          data find "[RollNr]" equal $rollnr options ""
          if cerror                               '   if none - then return
            exit while
          else
'check that it has a CPL_ref
            if len([CPL_Ref])=0
              messboxwait(" Undelivered req'ns still needed from this Roll ",0,0,1)
              return (1)
            end if
          end if
        end while
        vloadif(dpath|"clrstck2.vw")
      end if
      data goto record next
    end if
  end while
  return (0)
END FUNCTION ' CheckRequsn()