'RSVSTKBX - same as RSVSTK_B but no ReturnToMenu

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 S_prods $rollnr

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


MAIN
single-step off
'   quiet 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
    while true
      screen clear box 1 1 sch scw 0 0 no-border
      repaint off
      x = popuplist(8,36,13,"Carpet Tiles","",1,0)
      if x = -1
        exit while
      else
        $choice = upper(left(ptstr,1))
      end if
      x = ChooseStock()
      if x = -1
          exit while
      end if

      $stock = left(prodcode|"ÿ"|desMRC|"ÿ"|"Y"|"ÿ"|str(#ordwidth)|repeat("ÿ",36),36)
' message "L55/$stock is:"&str($stock)
      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 while
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)
    screen clear box 1 1 sch scw 0 0 no-border
    repaint off
    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)
        screen clear box 1 1 sch scw 0 0 no-border
        repaint off
        return (1)
      end if
    end if
  end if
  vunloadif("stk_carp.vws")
  vloadif(dpath|"stk_rolC.vw")
  order change index spath|$ccwidx
  #stk_recs = records
  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
  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 Titles()
local mlen st hlen
  mlen = max(61,len(" "|prodMRC&"-"&desMRC|" "))
  if mlen <= 61
    st = 12
  else
    st = 12-((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()
  #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 21 12 15 1 (format(y1,"M61"))
  screen print 22 12 15 1 (format(y2,"M61"))
END FUNCTION ' LengthMessage()


FUNCTION CheckResvn()
local k $resref $m4
  #balance = [BAR]
  if #balance < #minrsvn                '   screen shortrestore scr_wait
    messbox(" Insufficient to reserve ",0,0,1)
    return (-1)
  end if
  #rem   = #balance
  #lowerlen = #balance - 5
  LengthMessage()
  while "yn" !! k
    locate  22 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,"","",22,12,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 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)
      continue while
    else
      exit while
    end if
  end while
  while true
    x = entryline("Enter Customer's name",22,"","",22,12,61)
    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 22 1 23 scw 0 0 no-border
  repaint off
  vloadif(dpath|"requsn.vws")
' ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
' º Enter Reservation reference:                                       º
' ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
  while true
    x = entryline(" Enter Reservation reference ",6,resref,"",21,12,61)
    if x = -1
      messline(" Abandon this reservation? (y/n) ",1,1,1,21,12,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,21,12,61)
      continue while
    end if

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

  screen clear box 22 1 23 scw 0 0 no-border
' ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
' º Create new record in  REQUSN                                       º
' ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
  $comment = left(userid|"/"|$cust,25) ' message "$ccwcode is:"&str($ccwcode)
  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]
  lock-record
    [BAR] = [BAR] - #ordlen
  write-record
END FUNCTION ' CheckResvn()


FUNCTION CancelResvn()
  repaint off
  $rollnr = [RollNr]                   'message "$rollnr is:"&str($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
        messboxwait(" Cannot find Roll Nr"&$rollnr|" ",0,0,1)
        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)
      x = entryline(" Ref: for"&$cust|"/"|format(str(#ordlen),"2r")|"- {Esc} for next ",6,resref,"",21,12,61)
      if x = -1
        data goto record next
        continue while
      else
        if ptstr <> $refnr
          x = messline(" Incorrect reference! ",0,0,1,21,12,61)
          continue while
        else
          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
  screen clear box 22 1 23 scw 0 0 no-border
  vloadif(dpath|"os_rsvnD.vw")
  data goto window 1
  keys Up, Down
  return (0)
END FUNCTION ' CancelResvn()


FUNCTION Reservation()
  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")
      return (-1)
    end if
  end while
END FUNCTION ' Reservation()


FUNCTION ReturnToMenu()
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  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,67,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 if
  end while				' end of WIDTH section
END FUNCTION ' ChooseWidth()


FUNCTION ChooseColour()
  while true
    $popstr = [Colours]
    x = strcount($popstr)
    if x = -1
      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
      return (-1)
    end if
  end while
END FUNCTION ' ChooseColour()


FUNCTION ChooseStock()
local  $mess1 $mess2 #deflen $wrongprod f1 f2 f3 nr_reqns nr_index
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  if $choice == "C"
    prodcode = ""
    vloadif(dpath|"prodselA.vw")
    order change index ipath|"stckcarp.idx"
    screen clear box 1 1 sch scw 0 0 no-border
    repaint off
    y2 = format(" Scroll & {Enter} to select - {Esc} to leave ","M72")
    screen print 21 5 fgp bbd y2
    if #prodrec = 0
      y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72")
      screen print 21 5 fgp bbd y2
      x = bpopdb("prodselA",4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0)
    else
      data goto record record-number #prodrec
      y2 = format(" Scroll or press {F3} to search - {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)
    end if
    if x = -1
      screen clear box 21 5 21 5+72 0 0 no-border
      return (-1)
    end if
    #prodrec = record
    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 = 1                  ' no colour
        messboxwait(" No stock held ",0,0,1)
        screen clear box 1 1 sch scw 0 0 no-border
        repaint off
        return (1)
      elseif x = 2                  ' new colour
        continue while
      end if
      x = ChooseWidth()
      if x = -1
        continue while
      end if
      return (0)
    end while

  elseif $choice == "T"              '     elseif ptstr = "Tiles"
    prodcode = ""
    vloadif(dpath|"prodselA.vw")
    order change index ipath|"stk_tile.idx"  ' message "F7 - prodcode is:"&str(prodcode)
    screen clear box 1 1 sch scw 0 0 no-border
    repaint off
    y2 = format(" Scroll & {Enter} to select - {Esc} to leave ","M72")
    screen print 21 5 fgp bbd y2
    if #prodrec = 0
      y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72")
      screen print 21 5 fgp bbd y2
      x = bpopdb("prodselA",4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0)
    else
      data goto record record-number #prodrec
      y2 = format(" Scroll or press {F3} to search - {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)
    end if
    if x = -1
      screen clear box 21 5 21 5+72 0 0 no-border
      return (-1)
    end if
    prodcode = ptstr
    #prodrec = record
    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
        screen clear box 1 1 sch scw 0 0 no-border
        repaint off
        return (1)
      elseif x = 1                  ' no colour
        messboxwait(" No stock held ",0,0,1)
        screen clear box 1 1 sch scw 0 0 no-border
        repaint off
        return (1)
      elseif x = 2                  ' new colour
        screen clear box 1 1 sch scw 0 0 no-border
        repaint off
        return (1)
      end if
      #ordwidth = "1.00"
      screen save 7 40 20 80 S_prods
      return (0)
    end while
  end if
END FUNCTION ' ChooseStock()