'CHCKMEAS - creates "Z" req'ns when a carpet is check-measured
'           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()

public     ptstr ptval $rollnr dsa $faxees

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


MAIN
single-step off
quiet off

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

  ReturnToMenu()                        ' unload screens

END MAIN


FUNCTION EnterRolls()
  while true
    x = fentrybox(" Enter Roll Nr to adjust - {Esc} to finish ",8,rollmask,"")
    if x = 0
      $rollnr = ptstr
      vloadif(dpath|"products.vws")
      vloadif(dpath|"STK_CARP.vws")
      order change key "[RollNr]"
      data find "[RollNr]" equal $rollnr options "gw"
      if cerror
        messbox(" Roll Nr not found - re-enter ",0,0,1)
        return (0)
      else
        #old_BAR = [BAR]               'message "#old_BAR is:"&str(#old_BAR)
        #old_PHYS= [PhysicalBalance]   'message "#old_PHYS is:"&str(#old_PHYS)
        #old_bal = [Balance]           'message "#old_bal is:"&str(#old_bal)
        prodcode = [Product_Code]
        desMRC   = [Description_MRC]
        #width   = [Width]

        $backing = filelookup([products.Product_Code],[products.Backing],prodcode)
        prodMRC  = filelookup([products.Product_Code],[products.Product_MRC],prodcode)
        $smlr = filelookup([products.Product_Code],[products.SM_List_Rolls],prodcode)
        $disc = filelookup([products.Product_Code],[products.Discount_%],prodcode)

        a1 = format("Code:"&prodcode&left(prodMRC,30),"M46") 'message "len(a1)) is:"&str(len(a1))
        a2 = format(desMRC&"("|$backing|")","M46")
        a3 = format("Balance shown in stock:"&fixed(#old_PHYS,2)|"m","M46")
        a4 = format("(after resvn's:"&fixed(#old_BAR,2)|"m)","M46")
        m4 = " Correct Roll? (y/n) "
        x = mess4(a1,a2,a3,a4,m4,"")
        if x = 0
          if ptstr == "y"
            vunloadif("PRODUCTS.vws")
            NewBalance()
          else
            continue while
          end if
        else
          message "MESS4 failed in SHRTMEAS - inform David Guyan"
          return (-1)                        ' unload screens
        end if
      end if
    elseif x = -1
      return (-1)
    else
      message "FENTRY Error:"&str(x)
      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 length measured or {Esc} to exit ",5,"","")
    if x = 0
      #new_PHYS = value(ptstr)
      if #new_PHYS > [Stock_Delivered]
        messboxwait(" Measurement is greater than delivered length - contact Office ",0,0,1)
        continue while
      end if
      x = messbox(" Confirm measured length of"&fixed(#new_PHYS,2)|"m ? (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 = "LONGER"
      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 = "SHORTER"
      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

' check if #diff greater than BAR
    #new_BAR = #old_BAR - #diff
    #new_bal = #old_bal - #diff

' message "#new_BAR is:"&str(#new_BAR)
    if #new_BAR < 0
      x = ShowResvns()	
      messbox(" Write-off is more than BAR, deleting reservations - continue? (y/n)",1,1,1)
      if ptstr == "n"
        continue while
      else
        #new_BAR = #new_bal
        CancelResvns()	
      end if
    end if
    exit while
  end while

' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Enter name of person who measured carpet                           ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
'   screen shortrestore dsa
  while true
    x = popuplist(8,33,14,workers,"Measurer",1,0)
    if x = 0
      $meas = ptstr
      exit while
    elseif x = -1
      x = fentrybox(" Enter name of measurer ",6,"","")
      if x = 0
        $meas = ptstr
        exit while
      elseif x = -1
        continue while
      end if
    end if
  end while

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


FUNCTION ReduceBalance()
  vloadif(dpath|"STK_CARP.vws")
  order change key "[RollNr]"
  data find "[RollNr]" equal $rollnr options "gw"
  if cerror
    messbox(" Roll Nr not found - re-enter ",0,0,1)
    ReturnToMenu()
  else
    vloadif(dpath|"STK_CARP.vws")     ' message "#new_PHYS is:"&str(#new_PHYS)
    lock-record
      [PhysicalBalance] = value(#new_PHYS)
      [Balance] = value(#new_bal)
      [BAR]     = value(#new_BAR)
    write-record
  end if
END FUNCTION


FUNCTION ShowResvns()	
local $puar
  repaint off
  vloadif(dpath|"vu_resvn.vw")
  order change key "[RollNr]"
  data query execute "vu_rsvn1.dfq" index  "x.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'      [RollNr] = $rollnr
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
    messboxwait(" NO reservations found for this roll ",0,0,1)
    screen clear box 1 1 sch scw 0 0 no-border
    repaint off
    return (0)
  end if
  data query execute "vu_rsvn2.dfq" index  "showrsvn.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'      [Reserved] ! "R"
'        and
'      not (deleted)
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
    messboxwait(" NO reservations found for this roll ",0,0,1)
    screen clear box 1 1 sch scw 0 0 no-border
    repaint off
    return (0)
  end if
  repaint on
  repaint
  Titles()
  pagerec(1,0)
  if records > 9
    screen print 20 27 15 1 (format(" "|chr(24)&chr(25)&" more stock to view ","M27"))
  end if
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
END FUNCTION '  ShowResvns()	


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(left($rollnr&"-"&prodMRC,30),"M30")
    a2 = format("Length measured:- "|format(str(#new_PHYS),"2R")|"m","M30")
    a3 = format("On:"&date2(today)&"by"&$meas,"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                                              ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    #unitcost = $smlr*(1-($disc/100))
    #reqncost = value(#diff)*value(#width)*value(#unitcost)
    while true
      if #diff>1
        x = popuplist(8,33,13,"damaged wronglyÿcut other","",1,0)
        if ptstr = "other"
          x = fentrybox(" Enter reason ",13,"","")
          if x = -1
            continue while
          end if
          $meas = $meas&"-"&ptstr
          exit while
        end if
      else
        x = popuplist(8,33,13,"damaged wronglyÿcut minorÿdiff","",1,0)
        $meas = $meas&"-"&ptstr
        exit while
      end if
    end while
message "$meas is:"&str($meas)
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ 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]    = desMRC
      [Product_MRC]        = prodMRC
      [Width]              = #width
      [Length_Quantity]    = #diff
      [Quant_OS]           = 0
      [Cost]               = fixed(#reqncost,2)
      [Cost_OS]            = 0
      [Comment]            = "CM"&$meas
      [Date_Requisitioned] = today
      [Created/Changed_By] = userid
      [Status]             = "F"
      [RollNr]             = $rollnr
      [Item_Type]          = "C"
      [Branch]             = "Z"
    write-record

    if abs(#diff) > #replen
      $mess = "Diff on CHCKMEAS of"&$rollnr&"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")
    lock-record
      [ChckMeas] = "*"
    write-record
    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()


FUNCTION Titles()
  a2 = format($rollnr|"-"|left(prodMRC,28),"M35")
  a3 = format(left(desMRC,26)&"("|$backing|")","M35")
  screen print 6 24 15 1 a2
  screen print 7 24 15 1 a3
  screen print 8 24 15 1 (format("Reservations to be deleted","M35"))
  screen print 17 24 15 1 (format(" Press {Esc} to continue ","M35"))
END FUNCTION 'Titles()


FUNCTION CancelResvns()	
local i $f p1 p2 p3 p4 p5 p6
'(str,str,str,int,int,int)
  p1 = "canc_rsv.dfr"   ' p1 = report definition ("ord_stck.dfr")
  p2 = ""               ' p2 = title at top of choice popup ("LABEL")
  p3 = 1                ' p3 = printer to be used (1=HPIII_QC; 2=GEN_EPSN etc)
  p4 = 2                ' p4 = printer port to use (1,2 etc - network set to use 2=LASER; 3=LABEL)
  p5 = 1                ' p5 = choose VIEW/PRINT 1=PRINT; 2=VIEW; 3=CHOOSE
  p6 = 1                ' p6 = nr of copies

  $f = ""
  vloadif(dpath|"vu_resvn.vw")
  order change index "showrsvn.idx"
  for i = 1 to records
    $f = left([Comment],6)             ' message "$f) is:"&str($f)
    if chkstr($f,$faxees) = 0
      data goto record next
    else
      $faxees = $faxees&$f
      data goto record next
    end if
  end for
  PrintReport(p1,p2,p3,p4,p5,p6)
  data goto record first
  for i = 1 to records
    lock-record
      [Reserved]            = "D"
      [Date_Status_Changed] = date2(today)
      [Comment]             = "Del'd short ChckMeas"
      [Length_Quantity]     = 0
      [Status]              = "D"
      [RollReserve]         = "NA"
    write-record
    data goto record next
  end for
END FUNCTION 'CancelResvns()