'RSVSTK_S - (SHOP menu) reserves stock for Sales Order; voided after 7 days

external   fentrybox() sch scw vloadif() dpath messline() ipath fgp bbd
external   messbox() userid dsa popuplist() bpopdb() bgp strcount()
external   mess3() navrecs() cpath $menu progress() entryline()
external   colpopup() findcolpop() vunloadif() resref spath remove()
external   increment() #maxleft #minleft messboxwait()

public     ptstr ptval ptary[1] $stock psa $ccwcode

global     ReturnToMenu() prodcode FindRolls() ChooseColour() ChooseWidth()
global     $backing desMRC #ordwidth prodMRC $comment x y2 $cust maxwidth
global     prodtype Reservation() Titles() $rollnr #nritems strtcol i
global     CheckResvn() CancelResvn() $popcol $itemtype $ccwidx
global     LoadScreens() LengthMessage() $refnr #stk_recs
global     $chckmeas #ordlen #lowerlen #upperlen #midlen $ccw
global     #rem y1 #balance #minrsvn y ChooseStock() strtrow $popstr z


MAIN
single-step off
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  #minrsvn = .2
  clear $stock

  data goto window 1                    ' close all windows
  file unload all

  while true
    error off
    while true
      window close
      if cerror
        exit while
      end if
    end while

    x = ChooseStock()
    if x = -1
        exit while
    end if
    $stock = left(prodcode|"ÿ"|desMRC|"ÿ"|"Y"|"ÿ"|str(#ordwidth)|repeat("ÿ",36),36)
'     $stock = left(prodcode|"ÿ"|desMRC|"ÿ"|"Y"|"ÿ"|str(fixed(#ordwidth,2))|repeat("ÿ",36),36)

    x = FindRolls()			' Line 471
    if x = 1                            '
      continue while
    elseif x = -1
      continue while
    end if

    x = LoadScreens()
    if x = 1                            '
      continue while
    elseif x = -1
      continue while
    end if

    x = Reservation()
    if x = -1
      continue while
    end if

  end while

  ReturnToMenu()

END MAIN


FUNCTION FindRolls()		
  repaint off
  vloadif(dpath|"colours.vws")		'
  error off

  $ccwcode = filelookup([Colours.CodeColourWidth],[Colours.CCW_Code],$stock)
  if cerror
    messbox(" No stock held ",0,0,1)
    return (1)

  else
    $ccwidx = $ccwcode|".idx"
    if file(spath|$ccwidx) = 0           ' index not found
      progress(fgp,bgp," Rebuilding index file for"&prodcode&prodMRC,0)
      vloadif(dpath|"stk_carp.vws")
      data query execute "find_CCW.dfq" index spath|$ccwidx
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ [CCW_Code] = $ccwcode                                              ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
      if cerror
        screen shortrestore psa
        messbox(" No stock held ",0,0,1)
        return (1)
      end if
    end if
  end if

  vunloadif("stk_carp.vws")
  vloadif(dpath|"stk_rolC.vw")
  order change index spath|$ccwidx
  return (0)
END FUNCTION '  FindRolls()


FUNCTION LoadScreens()
  vloadif(dpath|"stk_rolC.vw")
  error off
  if file(spath|$ccwidx) = 0
    $ccwcode = "findroll"
    $ccwidx = $ccwcode|".idx"
    vloadif(dpath|"stk_rolC.vw")
    remove(spath|"findroll.idx")
    data query execute "findroll.dfq" index spath|$ccwidx
    if cerror
      messbox(" No stock held ",0,0,1)
      return (1)
    end if
  end if
  order change index spath|$ccwidx
  #stk_recs = records
  window split vertical 38
  data goto window 2
  vloadif(dpath|"os_rsvnD.vw")
  data goto window 1
  error off
  window link "[RollReserve]" "os_rsvnD.vw" "[RollReserve]"
  if cerror
    messboxwait("Window link `[RollReserve] os_rsvnD.vw [RollReserve]' - FAILED",0,0,1)
  end if
END FUNCTION ' LoadScreens()


FUNCTION ChooseStock()
local z $mess1 $mess2 #deflen $wrongprod f1 f2 f3 nr_reqns nr_index
  prodcode = ""
  vloadif(dpath|"prodselA.vw")
  order change index ipath|"stckcarp.idx"
  screen clear box 1 1 sch scw 0 0 no-border
  y2 = format(" Scroll & {Enter} to select - {Esc} to leave ","M72")
  screen print 21 5 fgp bbd y2
  x = bpopdb("prodselA",4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0)
  if x = -1
    screen clear box 21 5 21 5+72 0 0 no-border
    return (-1)
  end if
  prodcode = ptstr
  prodMRC   = [Product_MRC]
  $backing  = [Backing]
  $itemtype = [Item_Type]
  screen shortrestore dsa
  screen print 7 45 15 1 "ÿ"|prodcode|"ÿ"

  while true                      ' start selection of widths colours etc
    x = ChooseColour()
    if x = -1
      return (-1)
    elseif x = 2                  ' new colour
      continue while
    end if
    x = ChooseWidth()
    if x = -1
      continue while
    end if
    return (0)
  end while

END FUNCTION ' ChooseStock()


FUNCTION Titles()
local mlen st hlen
  mlen = max(61,len(" "|prodMRC&"-"&desMRC|" "))
  if mlen <= 61
    st = 14
  else
    st = 14-((mlen-61)/2)
  end if
  hlen = "M"|str(mlen)

  screen print 5 st 15 4 (format(right(" "|prodMRC&"-"&desMRC|" ",mlen),hlen))
  screen print 6 st 15 4 (format($backing&"- Width:"&#ordwidth,"M61"))
  screen print 7 st 15 1 (format("      Carpet In Stock        Existing Reservations","L61"))
  screen print 8 st 15 1 (format("   Roll   Actual Unrsv'd  Length    Reference ","L61"))
  screen print 20 st 15 1 (format("{R}eserve   -   {C}ancel reservation   -   {Esc}","M61"))
  if #stk_recs > 6
    screen print 21 st 15 1 (format(" "|chr(24)&chr(25)&"- view more stock ","M61"))
  end if
END FUNCTION 'Titles()


FUNCTION LengthMessage()
' show max & min lengths that can be reserved
'  #lowerlen = #rem - 6
message "#lowerlen) is:"&str(#lowerlen)
  #upperlen = #rem
  #midlen = #lowerlen + 4.4
  $chckmeas = @if([ChckMeas]="*","has","has NOT")
  if #lowerlen <= 0
    #lowerlen = 0
    y1 = "Lengths from"&str(#midlen)&"to"&str(#upperlen)
    if #upperlen <= #minleft
      #midlen = 0
      y1 = "Lengths only upto"&str(#upperlen)
      if #upperlen <= #maxleft
        #midlen = 0
        y1 = "Lengths only upto"&format(str(#upperlen),"2r")
      end if
    end if
  else
    y1 = "Lengths to"&str(format(#lowerlen,"2r"))&"or from"&str(#midlen)&"to"&str(#upperlen)
  end if

  y2 = "It"&$chckmeas&"been check measured OK? (y/n)"
  screen print 20 14 15 1 (format(y1,"M61"))
  screen print 21 14 15 1 (format(y2,"M61"))
END FUNCTION ' LengthMessage()


FUNCTION CheckResvn()
local k $resref $m4 z

  #balance = [BAR]

  if #balance < #minrsvn                '   screen shortrestore scr_wait
    messbox(" Insufficient to reserve ",0,0,1)
    return (-1)
  end if

  #rem   = #balance

  #lowerlen = #balance - 6
message "#lowerlen) is:"&str(#lowerlen)

  LengthMessage()

  while "yn" !! k
    locate  21 62 1
    k=inchar
    k = lower(chr(k))
  end while
  if k = "n"
    return (-1)
  end if

' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Enter & check Length                                               ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  while true
    while true
      x = entryline(" Enter length required ",5,"","",21,14,61)
      if x = 0
        #ordlen = value(ptstr)
        if #ordlen = 0
          continue while
        end if
        exit while
      elseif x = -1
        return (-1)
      end if
    end while

    if #ordlen > #lowerlen
      if #ordlen >= #midlen
        if #ordlen <= #upperlen        ' PASS
          exit while
        end if
'         messbox(" Cannot leave between"&str(#midlen-#ordlen)|"m &"&str(#upperlen-#ordlen)|"m on roll ",0,0,1)
        messbox(" Cannot reserve"&fixed(#ordlen,2)|"m -insufficient/incorrect balance ",0,0,1)
        continue while
      end if
      messbox(" Cannot reserve"&fixed(#ordlen,2)|"m -insufficient/incorrect balance ",0,0,1)
'       messbox(" Cannot leave between"&str(#midlen-#ordlen)|"m &"&str(#upperlen-#ordlen)|"m on roll ",0,0,1)
      continue while
    else
      exit while
    end if
  end while
' message "STOP"
  while true
    x = entryline("Enter Customer's name",18,"","",21,14,57)
    if x = 0				' ask for Customer's name
      if ptstr = ""
        continue while
      end if
      $cust = proper(ptstr)
      exit while
    end if
  end while

  screen clear box 21 1 22 scw 0 0 no-border
  repaint off
  vloadif(dpath|"requsn.vws")
' ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
' º Enter Reservation reference:                                       º
' ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
  while true
    x = entryline(" Enter Reservation reference ",6,resref,"",20,14,61)
    if x = -1
      messline(" Abandon this reservation? (y/n) ",1,1,1,20,14,61)
      if ptstr == "y"
        vloadif(dpath|"stk_rolc.vw")
        repaint off
        return (-1)
      else
        continue while
      end if
    end if
    $resref = ptstr|"-00"

    order change key "[Reference_Nr]"  ' search in [Reference_Nr] for resref
    data find "[Reference_Nr]" equal $resref options ""
    if cerror                               '   if none - then return
      exit while
    else
      messline(" Reference already used - enter again ",0,0,1,20,14,61)
      continue while
    end if

    z=len(" Reserve"&fixed(#ordlen,2)|"m for"&$cust|"? (y/n) ")
' message "z is:"&str(z)
    messline(" Reserve"&fixed(#ordlen,2)|"m for"&$cust|"? (y/n) ",1,1,1,20,14,61)
    if ptstr == "Y"
      exit while
    else
      continue while
    end if
  end while

' ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
' º Create new record in  REQUSN                                       º
' ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
  $comment = left(userid|"/"|$cust,25)
  window zoom
  data enter lock
    [Reference_Nr]       = $resref
    [Product_Code]       = prodcode
    [Description_MRC]    = desMRC
    [Product_MRC]        = prodMRC
    [Width]              = #ordwidth
    [Length_Quantity]    = #ordlen
    [Comment]            = $comment
    [Date_Reserved]      = today
    [Created/Changed_By] = userid
    [Status]             = "R"
    [Branch]             = left($resref,1)
    [RollNr]            = $rollnr
    [Reserved]           = "R"
    [RollReserve]        = "R"|$rollnr
    [CCW_Code]           = $ccwcode
    [R_Backing]          = $backing
    [Item_Type]          = $itemtype
  write-record
  window zoom

  vloadif(dpath|"stk_rolc.vw")		' message "reducing BAR"
  $rollnr = [RollNr]
' message "$rollnr for [BAR] is:"&str($rollnr)
  lock-record
    [BAR] = [BAR] - #ordlen
  write-record
END FUNCTION ' CheckResvn()


FUNCTION Reservation()
' show UAR/ROLMEET1-type screen with all carpets for particular ColourCodeWidth
' allow reservation of any length but with note that this may not be allocated
' because <.6 or <5m remains.
  ptval = 0
  repaint on
  repaint
  Titles()
  while true
    ptval = navrecs()

    if ptval = {C} or ptval = {c}
      x = CancelResvn()
      if x = 0
        repaint on
        repaint
        Titles()
      end if

    elseif ptval = {R} or ptval = {r}
      $rollnr = [RollNr]              ' message "$rollnr for [BAR] is:"&str($rollnr)
      x = CheckResvn()			' enter length to choose
      repaint on
      repaint
      Titles()

    elseif ptval = {Esc}
      repaint off
      vunloadif("os_rsvnd.vw")
      vunloadif("stk_rolc.vw")
'       screen clear box 1 1 sch scw 0 0 no-border
      return (-1)
    end if
  end while
END FUNCTION ' Reservation()


FUNCTION ReturnToMenu()
'   data goto window 1
  file unload all
  error off
  while true
    window close
    if cerror
      exit while
    end if
  end while
  transfer "pm_menu.psl" in-memory
END FUNCTION ' ReturnToMenu()


FUNCTION ChooseWidth()
  while true 			  ' start WIDTH section
    while true
      if [Widths_Available] ! "V"
        maxwidth = right([Widths_Available],5)
        x = entryline(" This carpet is available in any width upto"&maxwidth|"m",5,"","",21,5,72)
        if x = 0
          #ordwidth = value(ptstr)
          if #ordwidth > value(maxwidth)
            messline(" Width cannot be greater than"&maxwidth|"m",0,0,1,21,5,72)
            continue while
          elseif #ordwidth = ""
            continue while
          end if
          exit while
        end if
      end if
      screen print 21 5 fgp bgp y2
      screen shortrestore dsa
      strcount([Widths_Available])
      #nritems = ptval
      strtrow = 17 - #nritems

      screen clear box 21 5 22 77 0 0 no-border
      y2 = format(" Select Width and press {Enter} - {Esc} to enter new colour","M72")
      screen print 21 5 fgp bbd y2

      while true
        $popstr = [Widths_Available]
        exit while
      end while
      x = colpopup(strtrow,68,19,$popstr,"",1,0,4,0,0,7)
      if x = 0
        #ordwidth = ptstr
        screen shortrestore dsa
        exit while
      end if
    end while
    exit while
  end while				' end of WIDTH section
END FUNCTION ' ChooseWidth()


FUNCTION ChooseColour()
      while true
        $popstr = [Colours]
        x = strcount($popstr)
        if x = -1
' message "No colours listed"
          return (-1)
        else
          #nritems = ptval
        end if
        strtcol = 0
        for i = 1 to #nritems
          y = GROUP($popstr,i)
          x = len(GROUP($popstr,i))
          if x > strtcol
            strtcol = x
          end if
        end for
        strtcol = 72 - strtcol
        screen clear box 21 5 22 77 0 0 no-border
          y2 = format(" Select colour and press {Enter} - {Esc} to enter new colour ","M72")
          screen print 21 5 fgp bbd y2

          $popcol = colpopup(7,strtcol,18,[Colours],"",1,0,14,11,0,7)

          screen clear box 1 56 1 80 0 0 no-border
          if $popcol = 0
            desMRC = ptstr
            exit while
          elseif $popcol = -1
' message "No colours chosen"
            return (-1)
          end if
        end while
END FUNCTION ' ChooseColour()


FUNCTION CancelResvn()
  repaint off
  $rollnr = [RollNr]
  data goto window 2
  vloadif(dpath|"can_rsvn.vw")

  while true
    order change key "[RollNr]"
    while record <= records
      data find "[RollNr]" equal $rollnr options "f"
      if cerror                               '   if none - then return
        vloadif(dpath|"os_rsvnD.vw")
        data goto window 1
        keys Up, Down
        return (0)
      end if

      if [Reserved] <> "R"
        data goto record next
        continue while
      end if
      #ordlen = [Length_Quantity]
      $refnr  = left([Reference_Nr],6)
      $cust   = mid([Comment],8,20)
' message "$refnr is:"&str($refnr)
' message "$cust is:"&str($cust)
      z=len("Ref: for"&$cust|"/"|format(str(#ordlen),"2r")|" {Esc} for next")
' message "z) is:"&str(z)
      x = entryline(" Ref: for"&$cust|"/"|format(str(#ordlen),"2r")|"- {Esc} for next ",6,resref,"",20,14,61)
      if x = -1
        data goto record next
        continue while
      else
        if ptstr <> $refnr
          x = messline(" Incorrect reference! ",0,0,1,20,14,61)
          continue while
        else
          if $menu <> "boss"		' is userid correct
            if userid <> left([Comment],6)
              messbox(" You can ONLY cancel your OWN reservations! Contact Head office ",0,0,1)
              vloadif(dpath|"os_rsvnD.vw")
              data goto window 1
              keys Up, Down
              return (-1)
            end if
          end if
          lock-record             ' cancel requisition & delete record
            [Comment]             = "Reserv'n canc'd"
            [Date_Status_Changed] = today
            [Created/Changed_By]  = userid
            [Status]              = "D"
            [RollNr]             = "NA"
            [Reserved]            = "D"
            [RollReserve]         = ""
          write-record
          data delete record
          vloadif(dpath|"stk_rolc.vw")
          lock-record
            [BAR] = [BAR] + value(#ordlen)
          write-record
          exit while
        end if
      end if
    end while
    exit while
  end while
  vloadif(dpath|"os_rsvnD.vw")
  data goto window 1
  keys Up, Down
  return (0)
END FUNCTION ' CancelResvn()