'ADJ_ANCL - creates "Z" req'ns when a STK_ANCL item is adjusted
'           Needs to be + or -.

external   messbox() fentrybox() dpath vloadif() sch scw workers chkstr()
external   vunloadif() scr userid increment() rollmask mess4() messboxwait()
external   popuplist() pagerec() PrintReport() exception() bpopdb() mess3()
external   Background()

public     ptstr ptval dsa

global     $unitcost #new_bal #old_bal ReturnToMenu() #new_BAR $meas
global     prodcode #width desMRC prodMRC refcode x m4 $comp
global     CreateWriteOffReqn() $backing a5 ReduceBalance() $diff
global     a1 a2 a3 a4 #diff $mess cat #replen #old_BAR $wo
global     #unitcost $smlr $disc #reqncost cr #new_PHYS #old_PHYS
global     NewBalance() ChooseAncl()


MAIN
single-step off
'   quiet off
  Background()
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  error off
  #replen = 1
  while true
    cr = 0                          ' flag to show whether Res'v'ns have been cancelled
    x = ChooseAncl()                ' show unallocated REQUSN's to move and select REQUSN.
    if x = -1
      exit while
    end if
  end while

  ReturnToMenu()                        ' unload screens

END MAIN


FUNCTION ChooseAncl()
local y1
  while true
    vloadif(dpath|"products.vws")
    vloadif(dpath|"adj_ancl.vw")
    data query execute "not_del.dfq" index "not_del.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'   not (deleted)
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    order sort now dictionary "stk_ancl.idx" fields "[Product_MRC]" ascending
    repaint off
    y1 = format(" Choose Product and press {Enter} ","M38")
    screen print 7 21 15 1 y1
    screen print 20 21 15 1 (format(" {Enter} views orders - {Esc} exits ","M38"))
    x = bpopdb("adj_ancl",6,"","[Product_MRC]","l35","[PhysicalBalance]","L6","[PhysicalBalance]",8,21,19,58,"",0)
    if x = 0
      Background()
      prodMRC   = [Product_MRC]
      prodcode  = [Product_Code]
      #old_PHYS = [PhysicalBalance]   'message "#old_PHYS is:"&str(#old_PHYS)
      $smlr = filelookup([products.Product_Code],[products.SM_List_Rolls],prodcode)
      $disc = filelookup([products.Product_Code],[products.Discount_%],prodcode)
      a1 = format("","M46") 'message "len(a1)) is:"&str(len(a1))
      a2 = format([Product_MRC],"M46")
      a3 = format("Balance shown in stock:"&fixed(#old_PHYS,2)&[UnitDesc],"M46")
      m4 = " Correct item? (y/n) "
      x = mess3(a1,a2,a3,m4)
      if x = 0
        if ptstr == "y"
          NewBalance()
        else
          continue while
        end if
      else
        message "MESS4 failed in SHRTMEAS - inform David Guyan"
        return (-1)                        ' unload screens
      end if
    elseif x = -1
      screen clear box 1 1 sch scw 0 0 no-border
      repaint off
      return (-1)
    end if
  end while
END FUNCTION ' EnterRolls()


FUNCTION NewBalance()
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Enter check length recorded  & confirm length                      ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  while true
    x = fentrybox(" Enter quantity measured/counted - {Esc} to exit ",5,"","")
    if x = 0
      #new_PHYS = value(ptstr)
      x = messbox(" Confirm quantity/length of"&fixed(#new_PHYS,2)&[UnitDesc]|" ? (y/n)",1,1,1)
      if ptstr == "n"
        continue while
      end if
    else
      return (0)
    end if
    #diff = #old_PHYS - #new_PHYS
    if #diff < 0
      $comp = "GREATER"
      x = messbox(" Confirm check measure was"&$comp|"? (y/n)",1,1,1)
      if ptstr == "n"
        continue while
      end if
      a5 = "Balance INCREASED by"
    elseif #diff > 0   ' check showed shorter
      $comp = "LESS"
      x = messbox("  Confirm check measure was"&$comp|"? (y/n)",1,1,1)
      if ptstr == "n"
        continue while
      end if
      a5 = "Balance REDUCED by"
    elseif #diff = 0
      a5 = "No change"
    end if
    #new_bal = #old_bal - #diff
    exit while
  end while

  x = CreateWriteOffReqn()
  if x = 0
    ReduceBalance()
    return (1)
  end if
END FUNCTION ' NewBalance()


FUNCTION ReduceBalance()
  vloadif(dpath|"adj_ancl.vw")
  order change key "[Product_Code]"
  data find "[Product_Code]" equal prodcode options "gw"
  if cerror
    messbox(" Product not found - re-enter ",0,0,1)
    ReturnToMenu()
  else
    lock-record
      [PhysicalBalance] = value(#new_PHYS)
    write-record
  end if
END FUNCTION


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)|"-CM"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Confirm entry of check measure                                     ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    a1 = format([Product_MRC],"M30")
    a2 = format("Counted/meas'd: "|format(str(#new_PHYS),"2R")|[UnitDesc],"M30")
    a3 = format("On:"&date2(today),"M30")
    a4 = @if(#diff=0,"No change",format(a5&fixed(abs(#diff),2),"M30"))
    m4 = " Correct? (y/n) "
    scr = scr + 1
    x = mess4(a1,a2,a3,a4,m4,"")
    scr = scr - 1
    if x = 0
      if ptstr == "n"
        return (-1)
      end if
    else
      message "MESS4 failed in SHRTMEAS - inform David Guyan"
      ReturnToMenu()                        ' unload screens
    end if
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³  Calculate req'n cost                                              ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
' message "$smlr is:"&str($smlr)
' message "$disc is:"&str($disc)
    #unitcost = $smlr*(1-($disc/100))
' message "#diff is:"&str(#diff)
' message "#unitcost is:"&str(#unitcost)
    #reqncost = value(#diff)*1*value(#unitcost)
' message "#reqncost is:"&str(#reqncost)
    while true
      x = fentrybox(" Enter reason ",25,"","")
      if x = -1
        continue while
      end if
      $meas = ptstr
      exit while
    end while
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Create req'n                                                       ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    vloadif(dpath|"requsn.vws")
    data enter lock
      [Reference_Nr]       = refcode 	' assign [Reference_Nr] to record
      [Job_Nr]             = left(refcode,6)
      [Product_Code]       = prodcode
      [Description_MRC]    = ""
      [Product_MRC]        = prodMRC
      [Width]              = 1
      [Length_Quantity]    = #diff
      [Quant_OS]           = 0
      [Cost]               = fixed(#reqncost,2)
      [Cost_OS]            = 0
      [Comment]            = $meas
      [Date_Requisitioned] = today
      [Created/Changed_By] = userid
      [Status]             = "F"
'       [RollNr]             = "00000/00"
      [Item_Type]          = "C"
      [Branch]             = "Z"
    write-record

    if abs(#diff) > #replen
      $mess = "Diff on CHCKMEAS was"&fixed(abs(#diff),2)|"m"&$comp&"("|$meas|"/"|userid|")"
      cat = "STOCK"
      x = exception(userid,today,time24,cat,$mess)
      vunloadif(dpath|"unread1.vw")
    end if
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Mark RollNr with "*" to show it has been check measured
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    vloadif(dpath|"STK_CARP.vws")
    if #new_PHYS<10
      lock-record
        [ChckMeas] = "*"
      write-record
    end if
    return (0)
  end while
END FUNCTION ' CreateReqn()


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