'ROLLALLN - allocate all o/s req'ns for specific roll

external   navrecs() messbox() dpath vloadif() sch scw $menu progress()
external   scr fgp bgp bgs fgs userid fgi bgi psa dsa spath fentrybox()
external   arytostr() remove() messline() #maxleft #minleft rollmask
external   popuplist() delstr() makeidx() jobnr strcount() messboxwait()

public     ptstr ptval ptary[1] codes[1] $escape resvn[1,1] $rollnr prodcode
public     $ccw $ccwcode

global     LoadScreens() ShowReqns() $unitcost $selected CheckRollNr()
global     #needed #new_bal Titles() #avail #unresvd
global     #old_bal ReturnToMenu() x $uar $reqncost
global     $width desMRC prodMRC #old_bar #new_bar
global     Reset_BL() Reset_BR() CancelResvns()
global     uaridx allocrec RemoveAllocn_B()
global     i AllocateSimilar() refresh() colSf colSb S_full
global     c k dc lc sc recs c2 r2 l blen pl mr pc sym pg rec tr nr
global     plist[1,3] drows lnr reqnpopup()
global     #bline #tline #listcount poplist[1] $S_windows
global     namelist[1,6] linenr j $str_list #lcol NewTotal()
global     uistrcnt() udelstr() n recval y FindRoll() #recs
global     sim_ccw z m $allocn #split s_reqpop $recs $reclist $duedate


MAIN
  single-step off
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
'   quiet off
  file unload all
  error off
  #lcol  = 5
  #bline = 18
  #tline = 6
  #split = 52

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

  while true
    x = CheckRollNr()                     ' checks for RollNr
    if x = 0
      exit while
    elseif x = -1
      ReturnToMenu()                        ' unload screens
    end if
  end while

  progress(15,10," Please wait ... looking for unallocated requisitions ",0)
  uaridx = "allocn.idx"         ' message "uaridx is:"&str(uaridx)
  x = LoadScreens()           ' load REQUSN & UAR views
  if x = -3
    ReturnToMenu()                        ' unload screens
    exit main
  end if
  repaint off
  error off

  while true
    x = ShowReqns()      ' show unallocated REQUSN's to move and select REQUSN.
    if x = -3                   ' no unallocated REQUSN's left
      ReturnToMenu()                        ' unload screens
      exit main
    elseif x = -1               ' {Esc} pressed
      $escape = -1
      lock module $escape
      ReturnToMenu()                        ' unload screens
      exit main
    end if
  end while
END MAIN


FUNCTION ShowReqns()
local $puar
  ptval=0
  data query execute "UAR_ROLL.dfq" index uaridx
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³[RollNr] = "00000/00" and not(deleted)                               ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
    messbox(" No unallocated requisitions - returning to Menu ",0,0,1)
    return (-3)
  else
    window link "[CCW_Code]" "rolmetDJ.vw" "[CCW_Code]"
  end if

  repaint on
  repaint
  Titles()
  while true
    ptval = navrecs()
    if ptval = {R} or ptval = {r}
      x = RemoveAllocn_B()
      repaint on
      repaint
      Titles()
      if x = -1
        continue while
      end if

    elseif ptval = {V} or ptval = {v}  ' make ALL carpets active
      repaint off
      data goto window 2
      $ccwcode = [CCW_Code]
      vloadif(dpath|"rolmet_a.vw")
      order change index spath|$ccwcode|".idx"
      data goto record record-number 1
      while record <= records
        lock-record
          [Active] = "Y"
        write-record
        data goto record next
      end while
      vloadif(dpath|"rolmetDJ.vw")
      data goto window 1
      smartpoke $_key {Up}
      repaint on
      repaint
      Titles()
      continue while			

    elseif ptval = {A} or ptval = {a}
      #needed = [Length_Quantity]
      jobnr = [Job_Nr]
      allocrec = record
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Check that it has not been allocated                               ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
      if [RollNr]<>"00000/00"
        continue while			
      end if
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Check that there is carpet available                               ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
      repaint off
      data goto window 2
      if tablemax([Balance]) < #needed
        messbox(" Insufficient stock for req'n - contact Head Office",0,0,1)
        data goto window 1
        smartpoke $_key {Up}
        repaint on
        repaint
        Titles()
        continue while			
      elseif tablecount([Balance]) = 0
        messbox(" Insufficient stock for req'n - contact Head Office",0,0,1)
        data goto window 1
        smartpoke $_key {Up}
        repaint on
        repaint
        Titles()
        continue while			
      end if

      #avail = [Balance]
      #unresvd = [BAR]

' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Check for reservations                                             ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
      data goto window 1
'       CheckReservations()
      vloadif(dpath|"UAR_BOSS.vw")

' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Check BAR is sufficient for requsn                                 ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Get details of requisition & set up windows                        ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
      prodcode = [Product_Code]
      desMRC = [Description_MRC]
      prodMRC = [Product_MRC]
      $width = [Width]
      $reqncost = [Cost]
      $unitcost = value($reqncost)/value(#needed) ' cost per lineal run
      $uar = record
      $puar = precord

' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Set up popuplist()                                                 ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
      screen save 1 1 sch scw S_full
'       $ccw = [CodeColourWidth]
      $ccw = [CCW_Code]
      x = AllocateSimilar()
      vloadif(dpath|"rolmetDJ.vw")
      if x = -1
        data goto window 1
        data goto record first
        repaint on
        repaint
        Titles()
        continue while			
      end if

' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Set up windows                                                     ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
      Reset_BR()             ' ? not needed with pops
'     order change index "qnow2.idx"
      order change index uaridx
      data goto record record-number allocrec
      repaint on
      repaint
      Titles()

    elseif ptval = {Esc}               ' check for other unalloc'd req'ns for this shop
      return (-1)
    end if
  end while
  return (-1)
END FUNCTION ' ShowReqns()


FUNCTION Reset_BL()
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Set up windows with Bright in Left(Req'ns) window                  ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  data goto window 1
  vloadif(dpath|"UAR_BOSS.vw")

  order change index uaridx
  data goto window 2
  vloadif(dpath|"rolmetDJ.vw")
  data goto window 1
  error off
  window link "[CCW_Code]" "rolmetDJ.vw" "[CCW_Code]"
'   window link "[CodeColourWidth]" "rolmetDJ.vw" "[CodeColourWidth]"
END FUNCTION ' Reset_BL


FUNCTION Reset_BR()
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Set up windows with Bright in Right(Carpets) window                ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  data goto window 1
  vloadif(dpath|"UAR_BOSS.vw")

  order change index uaridx
  data goto window 2
  vloadif(dpath|"rolmetDJ.vw")
  data goto window 1
  error off
  window link "[CCW_Code]" "rolmetDJ.vw" "[CCW_Code]"
'   window link "[CodeColourWidth]" "rolmetDJ.vw" "[CodeColourWidth]"
END FUNCTION ' Reset_BR


FUNCTION LoadScreens()
  window split vertical #split
  vloadif(dpath|"UAR_BOSS.vw")
  if cerror
'     message "File not loaded - UAR_BOSS"
    return (-3)
  end if
  data goto window 2
  vloadif(dpath|"rolmetDJ.vw")
  if cerror
'     message "File not loaded - rolmetDJ"
    return (-3)
  end if
  data goto window 1
  window split horizontal 20
  data goto window 3
  vloadif(dpath|"UAR_DESC.vw")
  data goto window 1

' repaint on
' repaint

  order change key "[CCW_Code]"
  data query execute "rollalln.dfq" index "rollalln.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'    [CCW_Code] = $ccwcode and [Status] = "I"
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
    messbox(" No unallocated requisitions - returning to Menu ",0,0,1)
    return (-3)
  end if

  data goto window 2
  window link "[Product_Code]" "UAR_DESC.vw" "[Product_Code]"

  data goto window 1
  error off
END FUNCTION ' LoadScreens()


FUNCTION ReturnToMenu()
  error off
  screen save 1 1 sch scw $S_windows
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  while true
    window close
    if cerror
      exit while
    end if
  end while
  file unload all
  transfer "pm_menu.psl" in-memory
END FUNCTION


FUNCTION Titles()
  screen print 3 4 15 1 (format("ALLOCATIONS from Roll Nr"&$rollnr|"ÿ","M73"))
  screen print 4 4 15 1 (format("                  UNALLOCATED                      STOCK HELD ","L73"))
  screen print 5 4 15 1 (format("   Roll Nr  Job Nr        Colour         Needed   Balance  BAR  Roll","L73"))
  screen print 19 4 15 1 (format(" ","M73"))
  screen print 20 4 15 1 (format("  ","L21"))
  screen print 20 53 15 1 (format("  ","L24"))
  screen print 21 4 15 1 (format(" {A}llocate - {R}emove Alloc'n - Acti{V}ate ALL Rolls - {Esc} to exit ","M73"))
END FUNCTION 'Titles()


FUNCTION CheckReservations()		' in Window 1 - UAR_BOSS.vw
  vloadif(dpath|"requsn.vws")
  order change key "[Job_Nr]"		' find any o/s reservations and deal
  data find "[Job_Nr]" equal jobnr options ""
  if cerror				' no reservations found
    return (0)
  end if
  data query execute "job_reqn.dfq" index "o.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' [Job_Nr] = jobnr
' and
' not(deleted)
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
    return (0)
  end if
'   order change key "[RollNr]"
  data query execute "chk_rsvn.dfq" index "os_rsvns"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ [Reserved] = "R"    '(R)eserved / (D)ormant
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
    return (0)
  else					' show reservations in navrec()
    vloadif(dpath|"chk_rsvn.vw")
    ptval=0
    while ptval <> {Esc}
      ptval = navrecs()
      if ptval = {C} or ptval = {c}
        lock-record                   ' cancel requisition & delete record
'         [Comment]            = "Reserv'n canc'd" ' leave userid & customer
          [Date_Reserved]      = today
          [Created/Changed_By] = userid
          [Status]             = "D"
          [RollNr]            = "NA"
          [Reserved]           = "D"
        write-record
        data delete record
        vloadif(dpath|"UAR_BOSS.vw")
        continue while
      elseif ptval = {V} or ptval = {v}  ' verify? change fields in REQUSN
' confirm - length - Colour - pordmrc

      end if
    end while
  end if
END FUNCTION 'CheckReservations()


FUNCTION CancelResvns()    		
local i m y y1 z j $resref #resdel $resname $resauth
' return to - vloadif(dpath|"stk_carp.vws")
  vloadif(dpath|"requsn.vws")
  order change key "[RollReserve]"
  data query execute "cancrsvn.dfq" index "cancrsvn.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ QUERY is:  [RollReserve] = "R"|$rollnr                             ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror                               '   if none - then return
    vloadif(dpath|"stk_carp.vws")
    return (-1)
  end if

  redimension ptary[records]
  for i = 1 to records
    y = [Job_Nr]|"ÿÿ"|date2([Date_Reserved])|"ÿÿ"|format([Comment],"L20")|"ÿ"|format(str([Length_Quantity]),"2r")|"m"
'     ylen = len(y)
    y1 = ""
    for j = 1 to len(y)
      z = mid(y,j,1)
      if z = " "
        z = "ÿ"
      end if
      y1 = y1|z
    end for
    ptary[i] = y1
    data goto record next
  end for

  x = arytostr(records)
  if x = 0
    m = ptstr
  end if

  while true
    z = 15 - records
' message "z is:"&str(z)
    x = popuplist(z,17,17,m,"Choose Reservation to delete",1,0)
    if x = -1
      vloadif(dpath|"stk_carp.vws")
      return (-1)
    end if
    y1 = ""
    for j = 1 to len(ptstr)
      z = mid(ptstr,j,1)
      if z = "ÿ"       			' change to SOFT space
        z = " "
      end if
      y1 = y1|z
    end for
    ptstr = y1

' message "y1 is:"&str(y1)

    $resref = left(ptstr,6)
    #resdel = mid(ptstr,39,5)
    $resname = mid(ptstr,26,14)
    $resauth = mid(ptstr,19,6)

    screen shortrestore dsa
    messline(" Delete reservation of"|str(#resdel)|"m for"&trim($resname)|"? (y/n) ",1,0,1,21,6,71)
    if ptstr == "y"
      messline(" Confirm you have informed"&$resauth|"? (y/n) ",1,0,1,21,6,71)
      if ptstr == "y"

        if #new_bar + value(#resdel) < 0  ' check that there will be sufficient after this cancellation
'      message "#new_bar is:"&str(#new_bar)
'      message "#resdel is:"&str(#resdel)
          y = value(#new_bar + value(#resdel))
          x = messline(" This deletion will not provide sufficient - delete anyway? (y/n) ",1,0,1,21,6,71)
          if ptstr == "n"
            continue while
          end if
        end if

        order change key "[Job_Nr]"
        data find "[Job_Nr]" equal $resref options ""
        lock-record                   ' cancel requisition & delete record
          [Comment]            = "Resv'n canc'd"
          [Date_Status_Changed]= today
          [Created/Changed_By] = userid
          [Status]             = "D"
          [Reserved]           = "D"
          [RollNr]            = "NA"	' ????????
          [RollReserve]        = ""
        write-record
        data delete record

  ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
  ' ³  Increase [BAR] by amount of cancelled reservation              ³
  ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
        vloadif(dpath|"stk_carp.vws")
        #new_bal = [BAR] + value(#resdel)	 'message "#res_bal) is:"&str(#res_bal)
        lock-record
          [BAR] = #new_bal
        write-record
        exit while
      else
        vloadif(dpath|"stk_carp.vws")
        return (-1)
      end if
    else
      vloadif(dpath|"stk_carp.vws")
      return (-1)
    end if
  end while
  vloadif(dpath|"stk_carp.vws")
END FUNCTION ' CancelResvns()


FUNCTION  AllocateSimilar()
  sim_ccw = ""
  data goto record first

  for i = 1 to records
    if [CCW_Code] = $ccw        ' message "Matches!"
'     if [CodeColourWidth] = $ccw        ' message "Matches!"
      if [RollNr] = "00000/00"
        sim_ccw = sim_ccw&str(record)    ' message "sim_ccw is:"&str(sim_ccw)
      end if
    end if
    data goto record next
  end for

  x = strcount(sim_ccw)
  if x = 0
    #listcount = ptval
  end if

  if #listcount > 1
    redimension poplist[#listcount]
    redimension namelist[#listcount,6]

    for n = 1 to #listcount
      z = value(group(sim_ccw,n))        ' message "z is:"&str(z)
      data goto record record-number z
      if [RollNr] = "00000/00"
        namelist[n,1] = precord
        namelist[n,2] = [Description_MRC]
        namelist[n,3] = [Length_Quantity]
        namelist[n,4] = [RollNr]
'         namelist[n,5] = [Product_Code]
        namelist[n,5] = [Job_Nr]
        namelist[n,6] = "A"
      end if
    end for

    redimension ptary[#listcount]
    while true                       ' message "$area_list is:"&str($area_list)
      for n = 1 to #listcount
        poplist[n] = @if(namelist[n,4]="00000/00","ÿÿÿÿÿÿ",namelist[n,4])|"ÿ"|namelist[n,5]|"ÿ"|left(namelist[n,2]|"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ",20)|"ÿ"|right("ÿÿÿÿÿÿ"|format(str(namelist[n,3]),"2r"),6)
        ptary[n]   = poplist[n]
      end for
      x = arytostr(#listcount)    ' message "x is:"&str(x) ' message ptstr
      $str_list = ptstr

      screen clear box #tline #lcol #bline #split-1 0 0 no-border
      screen print 21 4 15 1 (format(" ","M73"))
      x = reqnpopup(#tline,#lcol,#bline-1,$str_list,"",0,1,linenr)  ' message "x is:"&str(x)
      $selected = ptstr

      screen shortrestore dsa
      screen save #tline #lcol #bline-1 #split s_reqpop
      if x = 0
        x = FindRoll()
        if x = 0         	       ' in window 2 - "rolmeetB.vw"
          #new_bal = value(#old_bal) - value(#needed) ' reduce balance by "REQUSN.Length_Quantity"
          #new_bar = value(#old_bar) - value(#needed) ' reduce balance by "REQUSN.Length_Quantity"
          lock-record
            [Balance] = #new_bal
            [BAR]     = #new_bar
          write-record                   'If OK - assign Roll Nr to REQUSN record.
          data goto window 1
          x = strcount($selected)
          if x = 0
            #recs = ptval
          end if
          x = remove("rollnrs.idx")                ' create temp index for allocation
          x = makeidx("requsn","rollnrs.idx",str($reclist),1)
          order change index "rollnrs.idx"
          $duedate = upper(mid(addmonths(date1(today),0),4,3))|"ÿ"|right(addmonths(date1(today),0),2)
          for i = 1 to records
            lock-record
              [Status]             = "A"
              [RollNr]            = $rollnr
              [Date_Allocated]     = today
              [DueDate]            = $duedate
              [Date_Requisitioned] = today
              [Created/Changed_By] = userid
            write-record                   'If OK - assign Roll Nr to REQUSN record.
            data goto record next
          end for
          $reclist = ""
          order change index "allocn.idx"
          return (0)

        elseif x = -1
          messbox(" Cannot allocate from available rolls - retry? (y/n) ",1,0,1)
          if ptstr == "y"
            $reclist = ""
            continue while
          else
            $reclist = ""
            return (-1)
          end if

        elseif x = -2
          messbox(" Cannot allocate from available rolls - retry? (y/n) ",1,0,1)
          if ptstr == "y"
            $reclist = ""
            continue while
          else
            $reclist = ""
            return (-1)
          end if
        end if

      elseif x = -1
        x = messline(" Abandon this allocation? (y/n) ",1,1,1,21,25,30)
        $reclist = ""
        if ptstr == "y"
          return (-1)
        end if
      end if
    end while

  else                                 ' allocating only one
    data goto record record-number value(sim_ccw)
    while true                       ' message "$area_list is:"&str($area_list)
      screen save #tline #lcol #bline #split s_reqpop
      x = FindRoll()
      if x = 0
        #new_bal = value(#old_bal) - value(#needed) ' reduce balance by "REQUSN.Length_Quantity"
        #new_bar = value(#old_bar) - value(#needed) ' reduce balance by "REQUSN.Length_Quantity"
        lock-record
          [Balance] = #new_bal
          [BAR]     = #new_bar
        write-record                   'If OK - assign Roll Nr to REQUSN record.
        data goto window 1             ' in UAR_BOSS.vw
        $duedate = upper(mid(addmonths(date1(today),0),4,3))|"ÿ"|right(addmonths(date1(today),0),2)
        lock-record
          [Status]             = "A"
          [RollNr]            = $rollnr
          [Date_Allocated]     = today
          [DueDate]            = $duedate
          [Date_Requisitioned] = today
          [Created/Changed_By] = userid
        write-record                   'If OK - assign Roll Nr to REQUSN record.
        return (0)

        elseif x = -2
          messbox(" Cannot allocate from available rolls - retry? (y/n) ",1,0,1)
          if ptstr == "y"
            $reclist = ""
            continue while
          else
            $reclist = ""
            return (-1)
          end if

      elseif x = -1
        x = messline(" Abandon this allocation? (y/n) ",1,1,1,21,7,69)
        if ptstr == "y"
          return (-1)
        end if
      end if
    end while
  end if
END FUNCTION '  AllocateSimilar()


FUNCTION refresh(z,r1,c1,r2,c2,pad,b1,b2)
local x t
  screen clear box r1 c1 r2+1 c2+pad b1 b2
  drows = 0
  for x=0 to pl-1
    t = rec-z+x+1
    if t > recs
      exit for
    else
      if t > 0
        screen print x+1+r1 lc b1 b2 plist[t,2]
        drows=drows+1
        if plist[t,1]=1
          screen print x+1+r1 sc b1 b2 sym
        end if
      end if
    end if
  end for
end function  'refresh()


FUNCTION uistrcnt(sl)
local i s lo hi c
s=20
while exact(group(sl,s),NULL)=FALSE
     s=s+20
end while
hi = s
lo = 1
while lo <= hi
     i = int((lo+hi)/2)
     c = group(sl,i)
     if c = NULL
          hi = i-1
     else
          lo = i+1
     end if
end while
while (exact(group(sl,i),NULL)=TRUE and i>0)
     i=i-1
end while
return (i)
END FUNCTION  'uistrcnt()


FUNCTION udelstr(s,sl)
local t i n f
f=0
i=0
n=NULL
ptstr = NULL
while TRUE
     i=i+1
     t = group(sl,i)
     if exact(t,NULL)=TRUE
          exit while
     elseif t = s
          f=1
     else
          n=n&t
     end if
end while
if f = 1
     ptstr = trim(n)
     return (0)
end if
ptstr = sl
return (-1)
END FUNCTION  'udelstr()


FUNCTION reqnpopup(r1,c1,br,list,msg,num,mnu,linenr)
local t hml hm cnum mscn pad padc ret
  colSf = fgp
  colSb = bgp
  recval = 0
  #needed = 0
  if exact(trim(list),NULL)=FALSE
    recs = uistrcnt(list)
    if recs = 0
      return (-3)
    end if
  else
    return (-2)
  end if

  redimension plist[recs,5]
  smartpeek $_l1 hml

  if br-r1<1
     return (-4)
  elseif br+1 > scrheight
     mr=scrheight-1
     msg = ""
  else
     mr=br
  end if
  if br >= hml
     mnu = 0
  end if

  screen save hml 1 hml scrwidth mscn
  if recs > scrheight
     if mnu = 1
          screen clear box hml 1 hml scrwidth 0 0 no-border
          screen print hml 1 bgi bgs "Building list..."
     end if
  end if
  ptstr=NULL
  if mnu = 1
     hm =  case num (0,"Enter = select/unselect   F10 = done   Esc = exit") \
                    (1,"Enter = select   Esc = exit      (select: 1 item)") \
                    else "Enter = select/unselect   F10 = done   Esc = exit  " & \
                         "   (select up to:" & str(num) & "items)"
  else
     hm = NULL
  end if
  sym = spsymmap(37)
  cnum=0
  blen=0
  l=blen
  for c=1 to recs
    plist[c,2]=group(list,c)
    plist[c,4]="S"                    ' changes to "A" before first addn
    l=len(plist[c,2])
    plist[c,1]=0
    if l>blen
      blen=l
    end if
    plist[c,5]=namelist[c,1]
  end for
  c2=c1+blen+2
  r2=r1+recs
  if r2>mr
     r2=mr
  end if
  dc=(c2-c1)
  lc=c1+1
  pad = case num (1,1) else 2
  sc=c1+pad-1
  pl=(r2-r1)
  padc = repeat(chr(32),pad)
  for i = 1 to recs
     pc = 1
     plist[i,2]=padc|format(plist[i,2],"l",dc-1)
     plist[i,3] = i
     if i = pl
          pc=pc+1
     end if
  end for
  if recs > scrheight
    screen shortrestore mscn
  end if
  screen save r1 c1 r2+2 c2+pad psa
  screen clear box r1 c1 r2+1 c2+pad 15 0 no-border
  pc=1
  for c=1 to pl
     screen print c+r1 lc 15 0 plist[c,2]
  end for
  if msg > null
     screen print r2+2 c1 fgi bgi str(format(left(msg,dc+pad+1),"M"|str(dc+pad+1)))
  end if
  if mnu = 1
     screen clear box hml 1 hml scrwidth fgs bgs no-border
     screen print hml 1 fgs bgs (format(hm,"L"|str(scrwidth)))
  end if

  c=1
  rec=1
  screen print r1+c lc fgi bgi plist[rec,2]
  drows = pl

' screen print r1+c lc fgp bgp plist[rec,2]
  screen print r1+c lc 15 0 plist[rec,2]

     while true
       if c = pl
         screen print r1+c lc fgi bgi plist[rec,2]
         exit while
       elseif c = linenr+1
         screen print r1+c lc fgi bgi plist[rec,2]
         exit while
       else
         if c = pl
'            screen scroll up r1+1 lc r2 (c2+case num (1,0) else 1) fgp bgp 1
           screen scroll up r1+1 lc r2 (c2+case num (1,0) else 1) 15 0 1
         end if
         c= case c (pl,c) else (c+1)
         rec=rec+1
         continue while
       end if
     end while

  while TRUE
    k=inchar
    screen print r1+c lc 15 0 plist[rec,2]
    if plist[rec,1]=1
      screen print r1+c sc 15 0 sym
    end if
    if k={Down}
      if rec=recs
        if recs<=pl
          rec=1
          c=1
        else
          beep
        end if
          else
               if c = pl
'                     screen scroll up r1+1 lc r2 (c2+case num (1,0) else 1) fgp bgp 1
                    screen scroll up r1+1 lc r2 (c2+case num (1,0) else 1) 15 0 1
               end if
               c= case c (pl,c) else (c+1)
               rec=rec+1
          end if
     elseif k={Up}
          if rec=1
               if recs <= pl
                    rec = recs
                    c = pl
               else
                    beep
               end if
          else
               if c = 1
'                     screen scroll down r1+1 lc r2 (c2+case num (1,0) else 1) fgp bgp 1
                    screen scroll down r1+1 lc r2 (c2+case num (1,0) else 1) 15 0 1
               end if
               c= case c (1,c) else (c-1)
               rec=rec-1
          end if
     elseif k={Home}
          if c>1
               if rec =(rec-c)+1
                    rec = 1
               else
                    rec =(rec-c)+1
               end if
               c=1
          else
               rec=1
               c=1
          end if
     elseif k={^Home}
          if rec = c
               rec = 1
               c=1
          else
               rec = 1
               c=1
               refresh(c,r1,c1,r2,c2,pad,colSf,colSb)
          end if
     elseif k={End}
          if rec < recs and c < pl
               if drows < pl
                    rec = recs-pl+1
                    refresh(c,r1,c1,r2,c2,pad,colSf,colSb)
                    rec = recs
                    c = pl
               else
                    if rec+(pl-c) < recs
                         rec = rec+(pl-c)
                         c = pl
                    else
                         rec = recs
                         c = pl
                    end if
               end if
          end if
     elseif k={^End}
          rec = recs-pl+1
          c = 1
          refresh(c,r1,c1,r2,c2,pad,colSf,colSb)
          c = pl
          rec = recs
     elseif k={PgDn}
          if rec = recs and c = pl
               beep
          elseif c <= pl
               if rec = recs or rec+pl >= recs
                    rec = recs-pl+1
                    c = 1
                    refresh(c,r1,c1,r2,c2,pad,colSf,colSb)
                    c = pl
                    rec = recs
               else
                    rec = rec+pl
                    refresh(c,r1,c1,r2,c2,pad,colSf,colSb)
               end if
          end if
     elseif k={PgUp}
          if rec = 1 and c = 1
               beep
          else
               if recs > pl
                    if (rec-pl)-c <= 1
                         c = rec-pl
                         if c < 1
                              c = 1
                         end if
                         rec = 1
                         refresh(c,r1,c1,r2,c2,pad,colSf,colSb)
                         rec = c
                    else
                         rec=(rec-pl)
                         refresh(c,r1,c1,r2,c2,pad,colSf,colSb)
                    end if
               else
                    if rec > 1
                         rec=1
                         c=1
                    end if
               end if
          end if
     elseif k={Enter}
          screen print r1+c lc fgi bgi plist[rec,2]
          if plist[rec,1] = 1
               if udelstr(trim(plist[rec,2]),ret) = 0
                    ret = ptstr
               end if
               plist[rec,1] = 0
               cnum=cnum-1
          else
               if cnum = num and not(num=0)
                    beep
               else
                    ret=trim(ret&plist[rec,2])
                    plist[rec,1] = 1
                    cnum=cnum+1
               end if
          end if
          if rec < recs
               smartpoke $_key {Down}
          end if

          IF plist[rec,4] = "A"
            plist[rec,4] = "S"
          elseif plist[rec,4] = "S"
            plist[rec,4] = "A"
          end if

          NewTotal()
          if #needed = 0
            screen print 21 25 15 1 "No requisitions to allocate"
          else
            y = "Total to allocate is:"&fixed(#needed,2)|"m"
            screen print 19 25 14 1 y
          end if
     elseif k={Esc}
               ret=null
               exit while
     elseif k={F10}
         for c=recs to 1 step -1
              if plist[c,1]=1
                   ret=ret & trim(plist[c,2])
              end if
         end for
         exit while
     end if
  if k<> {Enter}
     screen print r1+c lc fgi bgi plist[rec,2]
  end if
     if plist[rec,1]=1
          screen print r1+c sc fgi bgi sym
     end if
end while
screen save r1 c1 r2+2 c2+1+pad dsa
screen shortrestore mscn
screen shortrestore psa
nr = c
clear c k dc lc sc recs c2 r2 l blen pl mr pc sym pg i rec tr drows
redimension  plist[1,3]
if trim(ret) = NULL
     ptstr = NULL
     return (-1)
else
     ptstr = trim(ret)
     ptval = nr
     return (0)
end if
END FUNCTION  'reqnpopup()


FUNCTION NewTotal()
  recval = left(right(plist[rec,2],6),5)      ' message "recval before calc is:"&str(recval)
  $recs  = str(plist[rec,5])
  n = len(recval)
  clear x
  for i = 1 to n
    if mid(recval,i,1) = "ÿ"
      continue for
    end if
    x = x|mid(recval,i,1)
  end for
  recval = value(x)
  if plist[rec,4] = "A"
    #needed = #needed + value(recval)
    $reclist= $reclist&$recs
  else
    #needed  = #needed - value(recval)
    delstr($recs,$reclist)
    $reclist = ptstr
  end if
END FUNCTION  'NewTotal()


FUNCTION FindRoll()
local alln_nrs bal_aval remainder $active
  $allocn = "N"
  data goto window 2
  $ccwcode = [CCW_Code]
  vloadif(dpath|"rolmet_a.vw")
  order change index spath|$ccwcode|".idx"
  order sort now dictionary "z" fields "[Balance]" ascending
  screen shortrestore s_reqpop
  data goto record record-number 1     'message "#needed is:"&str(#needed)
  while record <= records              'message "record is:"&str(record)
    remainder = 0
    $active  = [Active]
    #old_bar = [BAR]
    #old_bal = [Balance]
    if #old_bar < #needed              ' if #old_bal < #needed
      data goto record next
      continue while
    end if
    remainder = #old_bar - #needed     ' remainder = #old_bal - #needed

    if remainder < #maxleft and remainder > #minleft
      data goto record next
      continue while
    end if

    if $active = "N"
'       messboxwait(" Allocations not permitted from this roll - see DG ",0,0,1)
      data goto record next
      continue while
    end if

    $rollnr = [RollNr]
    messline(" Confirm allocation of"&fixed(#needed,2)|"m from"&fixed(#old_bal,2)|"m of ROLL"&$rollnr|"? (y/n) ",1,1,1,21,7,69)
    if ptstr == "y"
      $allocn = "Y"
      return (0)
    else
      data goto record next
    end if
    data goto record next
  end while
'   messboxwait(" Cannot allocate from any of these rolls ",0,0,1)
  return (-2)
END FUNCTION 'FindRoll()


FUNCTION RemoveAllocn_B()
local $reqnnr
  repaint off
  $rollnr = [RollNr]
  #needed = [Length_Quantity]

  data goto window 2
  vloadif(dpath|"rolmet_a.vw")
  order change key "[RollNr]"
  data find "[RollNr]" equal $rollnr options ""
  if cerror                               '   if none - then return
    return (0)
  end if

  #new_bal = [Balance]
  #new_bar = [BAR]
  #new_bal = value(#new_bal) + value(#needed) ' increase balance by "REQUSN.Length_Quantity"
  #new_bar = value(#new_bar) + value(#needed) ' increase balance by "REQUSN.Length_Quantity"
  lock-record
    [Balance] = #new_bal
    [BAR]     = #new_bar
  write-record                   'If OK - assign Roll Nr to REQUSN record.
  vloadif(dpath|"rolmetdj.vw")
  data goto window 1
  lock-record
    [Status] = "I"
    [RollNr] = "00000/00"
    [Date_Requisitioned] = today
    [Created/Changed_By] = userid
    [Date_Allocated]     = blank
    [DueDate]            = ""
  write-record                   'If OK - assign Roll Nr to REQUSN record.
END FUNCTION ' RemoveAllocn()


FUNCTION CheckRollNr()                     ' checks for JobNr - if not found
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  while true
    x = fentrybox(" Roll Nr allocate requisitions for - {Esc} to exit ",8,rollmask,"")
    if x = -1
      ReturnToMenu()
    elseif x = 0
      exit while
    end if
  end while
  $rollnr = ptstr

  vloadif(dpath|"chk_roll.vw")
  order change key "[RollNr]"
  data find "[RollNr]" equal $rollnr options ""
  if cerror                               '   if none - then return
    messbox(" Roll Nr not found - re-enter ",0,0,1)
    return (1)
  else
    $ccwcode = [CCW_Code]
    return (0)
  end if
END FUNCTION 'CheckRollNr()