'REQALL_J - allocate REQUSN's - similar to REQALLCN but called from
'           ENT_REQN & only allocates requsn's from current job ("allocn.idx")

' @L1044   - should the effective amount to check against be [BAR] not [Balance]

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

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

public     $dateout ua1

global     LoadScreens() ShowReqns() $unitcost $selected RemoveSimilar()
global     #needed #new_bal Titles() #avail #unresvd uaridx allocrec nrdates
global     #old_bal ReturnToMenu() x $uar $reqncost CancelResvns()
global     $width desMRC prodMRC #old_bar #new_bar Reset_BL() Reset_BR()
global     i AllocateSimilar() refresh() colSf colSb S_full $itemtype
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() RemoveAllocn() ordernr
global     #bline #tline #listcount poplist[1] $S_windows #rec UpdGdsOut()
global     namelist[1,6] linenr j $str_list #lcol NewTotal() StockStatus()
global     uistrcnt() udelstr() n recval y FindRoll() #recs #length navrecs()
global     sim_ccw z m $allocn #split s_reqpop $recs $reclist $duedate y_tot

global     UpdateAppt() BuildList() dateout[1,1] cdel CheckDelivered()
global	 refcode origview #dueout



MAIN
' message "REQALL_J"
  single-step off
'   quiet off
  repaint 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

  uaridx = "allocn.idx"         ' message "uaridx is:"&str(uaridx)

  x = LoadScreens()           ' load REQUSN & UAR views
  if x = -3
    ReturnToMenu()                        ' unload screens
    exit main
  end if

  error off
  order change index "current.idx"
  if records = 0
    messbox(" No requisitions for"&jobnr|" ",0,0,1)
    ReturnToMenu()                        ' unload screens
  end if

  data query execute "uar_jobJ.dfq" index uaridx  ' Product_Code order
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'   [Item_Type] = "C" or
'   [Item_Type] = "S"
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
    messbox(" None unallocated - review anyway? (y/n) ",1,0,1)
    if ptstr == "n"
      ReturnToMenu()                        ' unload screens
    end if
  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 ReturnToMenu()
  error off
  screen save 1 1 sch scw $S_windows
  repaint off
  while true
    window close
    if cerror
      exit while
    end if
  end while
  file unload all
' check whether ALL req'ns have been ALLOCATED, if so change [Stock_Status]
' to "C" and then run AllReceived()
END FUNCTION


FUNCTION StockStatus()
  vloadif(dpath|"chk_stat.vw")
  order change key "[Job_Nr]"
  data find "[Job_Nr]" equal jobnr options ""
  lock-record
    [Stock_Status]="P"
  write-record
END FUNCTION ' StockStatus()


FUNCTION AllReceived()
local  tmax x
  error off
  vloadif(dpath|"chk_recd.vw")
  order change key "[Job_Nr]"
  data find "[Job_Nr]" equal jobnr options ""
  x=[Tmax]
  if x = 1  'message "Incomplete bespoke!"
    lock-record
      [Recd_Status]="P"
    write-record
  else      'message "Any bespoke received"
    lock-record
      [Recd_Status]="C"
    write-record
' check for complete order status
    if [Slots_Rem]=0
      if [Stock_Status]="C"
        if [Order_Status]="P"
          lock-record
            [Order_Status]="S"
          write-record
' message "Sanction process to be carried out when all goods-in have been done"
          execute "sanction.rf3" in-memory    ' update APPTDATE
        end if
      end if
    end if
  end if
END FUNCTION ' AllReceived()


FUNCTION ShowReqns()
local $puar
  	ptval=0
  	order change physical          ' query unallocated REQUSN's in UAR_B_J
  	if file(uaridx) = 1
    		order change index uaridx
    		window link "[CCW_Code]" "rolmetDJ.vw" "[CCW_Code]"
  	else
    		order change key "[Item_Type]"
    		data query execute "UAR_ITEM" index "x.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³[Item_Type] = "C"                                                   ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    		if cerror
      		messbox(" No unallocated requisitions - returning to Menu ",0,0,1)
      		return (-3)
    		end if
    		order sort now dictionary "qnow1" fields "[Product_Code;Description_MRC]" ascending
    		data query execute "UAR_ROLL" index "qnow2"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³[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
  	end if

  	repaint on
  	repaint
  	Titles()
  	while true
    		ptval = navrecs()

    		if ptval = {R} or ptval = {r}
	  		cdel = CheckDelivered()     'cdel = due out but NOT del'd
'   			if cdel > 0
'     				messbox("ÿDelivered or scheduled for delivery; go to Diary to `un'deliver? ",1,0,1)
'     				if ptstr == "y"
'       				Background()
'       				file unload all
'       				execute "alt_appt.rf3" in-memory
'     				end if
'     				return (1)

  			if cdel = -1
    				messboxwait(" Cutting Ticket already printed - cannot update ",0,0,1)
        			continue while
  			end if

      		x = RemoveAllocn()
      		repaint on
      		repaint
      		Titles()
      		if x = -1
        			continue while
      		end if

    		elseif ptval = {A} or ptval = {a}
	  		cdel = CheckDelivered()     'cdel = due out but NOT del'd
'   			if cdel > 0
'     				messbox("ÿDelivered or scheduled for delivery; go to Diary to `un'deliver? ",1,0,1)
'     				if ptstr == "y"
'       				Background()
'       				file unload all
'       				execute "alt_appt.rf3" in-memory
'     				end if
'     				return (1)
  			if cdel = -1
    				messboxwait(" Cutting Ticket already printed - cannot update ",0,0,1)
        			continue while
  			end if


			$itemtype = [Item_Type]
      		#needed = [Length_Quantity]
      		jobnr = [Job_Nr]
      		allocrec = record
      		if [RollNr]<>"00000/00"          'Check that it has not been allocated
        			continue while			
      		end if
      		repaint off
      		data goto window 2
      		if tablemax([Balance]) < #needed  'Check that there is carpet available
        			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]
      		data goto window 1
'       CheckReservations()
      		vloadif(dpath|"UAR_B_J.vw")
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ 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
      		$ccwcode = [CCW_Code]
      		x = AllocateSimilar()
      		if x = 0
        			vloadif(dpath|"rolmetDJ.vw")
      		elseif x = -1
        			data goto window 1
        			vloadif(dpath|"UAR_b_J.vw")
        			data goto record first
        			repaint on
        			repaint
        			Titles()
        			continue while			
      		end if

' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Set up windows                                                     ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
      		Reset_BR()             ' ? not needed with pops
      		order change index uaridx
      		data goto record first
      		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()

'   cdel = CheckDelivered()     'cdel = due out but NOT del'd
'   if cdel > 0
'     messbox("ÿDelivered or scheduled for delivery; go to Diary to `un'deliver? ",1,0,1)
'     if ptstr == "y"
'       Background()
'       file unload all
'       execute "alt_appt.rf3" in-memory
'     end if
'     return (1)
'   elseif cdel = -1
'     messboxwait(" Cutting Ticket already printed - cannot update ",0,0,1)
'     return (1)
'   end if


FUNCTION  CheckDelivered()  ' check for amount scheduled but NOT delivered
  	refcode = [Reference_Nr]
  	origview=apinfo(ap_filex)            'message "origview is:"&str(origview)
  	repaint off
  	vloadif(dpath|"chckdeld.vw")
  	order change key "[Requsn_Nr]"
	data find "[Requsn_Nr]" equal refcode options ""
    	if cerror                               '   if none - then return
'       x = messbox(" Job Nr not found - confirm as"&jobnr|"? (y/n) - {Esc} to exit ",1,0,0)
'       if x = 0
'   	data query execute "chkdeld1.dfq" index "deld_1.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'   [Requsn_Nr]=refcode
'   and
'   not (deleted)
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
'   	if cerror

		messboxwait("L344\ Record not found in GOODSOUT file ",0,0,1)
    		vunloadif("chckdeld.vw")
    		vloadif(dpath|origview)
    		return (0)
  	end if
  	if [CPL_Ref]<>blank
    		vunloadif("chckdeld.vw")
    		vloadif(dpath|origview)
    		return (-1)
  	else
    		#dueout = round(filesum([QuantOut]),2) '
    		vunloadif("chckdeld.vw")
    		vloadif(dpath|origview)
    		return (#dueout)
  	end if
END FUNCTION 'CheckDelivered()


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

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


FUNCTION Reset_BR()
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Set up windows with Bright in Right(Carpets) window                ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  data goto window 1
  vloadif(dpath|"UAR_B_J.vw")
  order change index uaridx
  data goto window 2
  vloadif(dpath|"rolmetDJ.vw")
  repaint on
  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_B_J.vw")
  if cerror
    return (-3)
  end if
  data goto window 2
  vloadif(dpath|"rolmetDJ.vw")
  if cerror
    return (-3)
  end if
  data goto window 1
  window split horizontal 20
  data goto window 3
  vloadif(dpath|"UAR_DESC.vw")
  data goto window 2
  window link "[Product_Code]" "UAR_DESC.vw" "[Product_Code]"
  data goto window 1
  error off
END FUNCTION ' LoadScreens()


FUNCTION Titles()
'   screen print 3 4 15 1 (format("REQUISITIONS for"&jobnr,"M75"))
'   screen print 4 4 15 1 (format("                  UNALLOCATED                      STOCK HELD ","L75"))
'   screen print 5 4 15 1 (format("   Roll Nr  Product       Colour         Needed   Balance  BAR  Roll","L75"))
'   screen print 19 4 15 1 (format(" ","M75"))
'   screen print 20 4 15 1 (format("  ","L21"))
'   screen print 20 53 15 1 (format("  ","L26"))
'   screen print 21 4 15 1 (format(" {A}llocate - {R}emove Allocation - {Esc} to exit ","M75"))
' single-step on

  	screen print 3 4 15 1 (format("REQUISITIONS","M78"))
  	screen print 4 4 15 1 (format("                  UNALLOCATED                        STOCK HELD ","L78"))
  	screen print 5 4 15 1 (format("   Roll Nr  Job Nr        Colour         Needed   Balance  BAR  Roll","L78"))
  	screen print 19 4 15 1 (format(" ","M78"))
  	screen print 20 4 15 1 (format("  ","L20"))
  	screen print 20 53 15 1 (format("  ","L29"))
  	screen print 21 4 15 1 (format(" {A}llocate - {R}emove Allocation - {Esc} to exit ","M78"))
  	screen print 22 4 10 1 (format(" Batch Nrs (if any) shown on Right Hand side ","M78"))
END FUNCTION 'Titles()


FUNCTION CheckReservations()		' in Window 1 - UAR_B_J.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_B_J.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

    $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
          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] = $ccwcode        ' 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,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"))
      y_tot = "Total to allocate is:"
      x = reqnpopup(#tline,#lcol,#bline-1,$str_list,"",0,1,linenr,y_tot)  ' message "x is:"&str(x)
      $selected = ptstr                'message "$selected is:"&str($selected)
      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 = strcount($reclist)
          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
            ordernr = [Reference_Nr]   ' message "ordernr is:"&str(ordernr)
            x = UpdGdsOut($rollnr,ordernr,0) ' message "x) is:"&str(x)
            if x = 1
              $reclist = ""
            end if
            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"
          StockStatus()
          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 = ""
            vloadif(dpath|"rolmetDJ.vw")
            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"
          vloadif(dpath|"rolmetDJ.vw")
          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"
'         window zoom
        lock-record
          [Balance] = #new_bal
          [BAR]     = #new_bar
        write-record                   'If OK - assign Roll Nr to REQUSN record.
'         window zoom
        data goto window 1             ' in UAR_B_J.vw
        $duedate = upper(mid(addmonths(date1(today),0),4,3))|"ÿ"|right(addmonths(date1(today),0),2)
        ordernr = [Reference_Nr]
        x = UpdGdsOut($rollnr,ordernr,0) 'message "x) is:"&str(x)
' message "If this return from UPDGDS is 1, then it is returning w/o writing"&str(X)
        if x = 1
          $reclist = ""
'           return (-1)
        end if

        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.
        order change physical
        order change index "allocn.idx"
        StockStatus()
        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 = ""
          vloadif(dpath|"rolmetDJ.vw")
          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,y_tot)
local t hml hm cnum mscn pad padc ret y_tot1
  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_tot1 = y_tot&fixed(#needed,2)|"m"
        screen print 19 25 14 1 y_tot1
      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
    $rollnr  = [RollNr]
    $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
    if $itemtype = "C"
      if remainder < #maxleft and remainder > #minleft
        data goto record next
        continue while
      end if
    end if

    if $active = "N"
      messboxwait(" No allocations allowed yet from Roll Nr"&$rollnr&"- contact Office ",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"
'       vloadif(dpath|"rolmetDJ.vw")
      return (0)
    end if
    data goto record next
  end while
  return (-2)
END FUNCTION 'FindRoll()


FUNCTION RemoveAllocn()
local $reqnnr #new_BAR #new_bal
' warning re balance left may be .6-5 and cannot be re-allocated
  messboxwait(" If you remove this allocation, it may be taken by someone else ",0,0,1)
' check for Balance .6-5
  repaint off
  if $rollnr = "00000/00"
    return (0)
  end if

  $rollnr = [RollNr]                  ' message "$rollnr) is:"&str($rollnr)
  #length = [Length_Quantity]
  #rec    = record

  x = RemoveSimilar()
  if x = 0
    return (0)
  end if

' return to main screen showing all reqn's just unallocated
  vloadif(dpath|"uar_b_j.vw")          ' remove rollnr
  data goto record first
END FUNCTION 'RemoveAllocn()


FUNCTION  RemoveSimilar()
local popx
  	sim_ccw = ""
  	data goto record first
  	for i = 1 to records
    		if [RollNr] = $rollnr
      		sim_ccw = sim_ccw&str(record)    ' message "sim_ccw is:"&str(sim_ccw)
    		end if
    		data goto record next
  	end for
  	x = strcount(sim_ccw)
  	if x = 0
    		#listcount = ptval
  	end if
  	if #listcount > 1                    ' removing several
   		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] = $rollnr
        			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,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] = 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"))
      		y_tot = "Total to unallocate is:"
      		popx = reqnpopup(#tline,#lcol,#bline-1,$str_list,"",0,1,linenr,y_tot)  ' message "x is:"&str(x)
      		$selected = ptstr
      		screen shortrestore dsa
      		screen save #tline #lcol #bline-1 #split s_reqpop
      		if popx = -1
        			$reclist = ""
        			data goto record first
        			return (-1)
      		else
        			vloadif(dpath|"chg_alln.vw")
        			order change key "[RollNr]"
        			data find "[RollNr]" equal $rollnr options ""
        			if cerror                               '   if none - then return
          			x = messboxwait(" Roll Nr not found - re-allocate this req'n ",0,0,1)
          			vloadif(dpath|"uar_b_j.vw")
          			data goto record first
          			return (0)
        			end if
        			#old_BAR = [BAR]
        			#old_bal = [Balance]
        			if #needed < #maxleft and #needed > #minleft  ' check that total can be added back
          			messbox(" Cannot leave between 0.6m and 5.0m on roll - retry? (y/n) ",1,0,1)
          			if ptstr == "y"
            				$reclist = ""
            				continue while
          			else
            				$reclist = ""
            				vloadif(dpath|"uar_b_j.vw")
            				data goto record first
            				return (0)
          			end if
        			else                           ' CAN remove
          			#new_bal = value(#old_bal) + value(#needed) ' increase balance by "REQUSN.Length_Quantity"
          			#new_bar = value(#old_bar) + value(#needed) ' increase balance by "REQUSN.Length_Quantity"
          			lock-record
            				[Balance] = #new_bal
            				[BAR]     = #new_bar
            				if [Active] = "N"
              					[Active] = "Y"
            				end if
          			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 = strcount($reclist)       ' message "$reclist is:"&str($reclist)
          			if x = 0
            				#recs = ptval
          			end if
          			x=remove("rollnrs.idx")                ' create temp index for allocation
          			x=makeidx("requsn","rollnrs.idx",str($reclist),1)
          			vloadif(dpath|"uar_b_j.vw")
          			order change index "rollnrs.idx"
' message "Changing Roll Nr in GOODSOUT - L.1268 in REQALL_J "
          			ordernr = [Reference_Nr]
          			x=UpdGdsOut("00000/00",ordernr,1)
          			if x = 1
            				$reclist = ""
'             return (-1)
          			end if
          			for i = 1 to records
            				lock-record
              					[Status]             = "I"
              					[RollNr]            = "00000/00"
              					[Date_Allocated]     = blank
              					[DueDate]            = blank
              					[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"
          			data goto window 2
          			repaint on
          			data goto window 1
          			data goto record first
          			return (0)
        			end if
      		end if
    		end while
  	else                                 ' removing only one
    		vloadif(dpath|"chg_alln.vw")
    		order change key "[RollNr]"
    		data find "[RollNr]" equal $rollnr options ""
    		if cerror                               '   if none - then return
      		x=messboxwait(" Roll Nr not found - re-allocate this req'n ",0,0,1)
      		vloadif(dpath|"uar_b_j.vw")
      		data goto record first
      		return (0)
    		end if
    		#new_BAR = [BAR] + #length
    		#new_bal = [Balance] + #length

    		if #new_bal < #maxleft and #new_bal > #minleft
      		messboxwait(" Cannot leave balance between 0.6m and 5.0m on roll ",0,0,1)
      		vloadif(dpath|"uar_b_j.vw")
      		data goto record first
      		return (0)
    		end if
    		messbox(" Remove allocation of"&fixed(#length,2)|"m from Roll Nr"&$rollnr|"? (y/n) ",1,1,1)
    		if ptstr == "n"
      		vloadif(dpath|"uar_b_j.vw")
      		data goto record first
      		return (0)
    		end if
    		lock-record
      		[BAR]     = #new_BAR
      		[Balance] = #new_bal
      		if [Active] = "N"
        			[Active] = "Y"
      		end if
    		write-record
  ' change balance & Active(y/n) on STK_CARP
    		vloadif(dpath|"uar_b_j.vw")          ' remove rollnr
    		data goto record record-number #rec
' message "Changing Roll Nr in GOODSOUT - L.1333 in REQALL_J "
    		ordernr = [Reference_Nr]
    		x=UpdGdsOut("00000/00",ordernr,1)
    		if x = 1
      		$reclist = ""
    		end if
    		lock-record
      		[Status]             = "I"
      		[RollNr]            = "00000/00"
      		[Date_Allocated]     = blank
      		[DueDate]            = blank
      		[Date_Requisitioned] = today
      		[Created/Changed_By] = userid
    		write-record
  	end if
  	order change physical
  	order change index "allocn.idx"
  	data goto record first
  	return (0)
END FUNCTION 'RemoveSimilar()


FUNCTION Navrecs()
'1.5 02/26/91 MS / changed to take advantage of hiding the "Project Suspended"
'                  message during the {Home} and {End} movements
local x bot psmode
  screen save scrheight 1 scrheight scrwidth bot
  smartpeek $_spndmes psmode
  if psmode = 1
    smartpoke $_spndmes 0
  end if
  while TRUE
    x = inchar
    if x = {Down}
      data goto record next
    elseif x = {Up}
      data goto record previous
    elseif x = {PgDn}
      data goto page next
    elseif x = {PgUp}
      data goto page previous
    elseif x = {^End}
      data goto record last
    elseif x = {^Home}
      data goto record first
    elseif x = {Home}
      data goto record first
      screen shortrestore bot
    elseif x = {End}
      data goto record last
      screen shortrestore bot
    else
      exit while
    end if
  end while
  if psmode = 1
     smartpoke $_spndmes 1
  end if
  return (x)
end function   'navrecs()


FUNCTION UpdGdsOut(roll,reqnnr,ar)  ' ar=0 for ADDING RollNr; ar=1 for REMOVING
local origview
  repaint off
  origview=apinfo(ap_filex)
  vloadif(dpath|"goodsout.vws")
  jobnr = left(reqnnr,6)               ' message "jobnr is:"&str(jobnr)
  order change key "[Job_Nr]"
  data query execute "job_reqn.dfq" index "gds_reqn.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ QUERY is:  [Job_Nr] = jobnr                                        ³
' ³ and
' ³ not (deleted)                                                      ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror                               '   if none - then return
    vloadif(dpath|origview)
    return (1)
  end if

  data find "[Requsn_Nr]" equal reqnnr options ""
  if cerror                               '   if none - then return
    vloadif(dpath|origview)
    return (1)
  else
    while true
      if ar = 0
        if [RollNr] == "BESPOK" or [RollNr] == "00000/00"
          lock-record
            [RollNr] = roll
          write-record
        else
          messboxwait("Already allocated as"&[RollNr]|"ÿ- inform Office ",0,0,1)
          vloadif(dpath|origview)
          return (1)
        end if
      elseif ar=1
        roll = case [Itemtype] ("C","00000/00")("S","00000/00")("V","00000/00")("B","BESPOK")("J","BESPOK")("O","BESPOK")("T","BESPOK")("W","BESPOK")
        lock-record
          [RollNr] = roll
        write-record
      end if

      if record = records
        exit while
      end if
      data goto record next
      data find "[Requsn_Nr]" equal reqnnr options ""
      if cerror
        exit while
      end if
    end while
  end if

  UpdateAppt()

  vloadif(dpath|origview)
  return (0)
END FUNCTION 'UpdGdsOut()


FUNCTION ChkDeliveries()
  BuildList()
  repaint off
  for i = 1 to nrdates
    order change index "gds_reqn.idx"
    $dateout=dateout[i,1]
    data query execute "chk_delv.dfq" index "chk_delv.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ date2([Date_Out])=$dateout
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    if cerror
      continue for
    else
' for each date find if
      if filesum([QuantOut],[RollNr]="BESPOK" or [RollNr]="00000/00")>0
        dateout[i,2]=1                       'message "Deliveries o/s!!"
      else
        dateout[i,2]=0                       'message "Deliveries ready"
      end if
    end if
  end for
END FUNCTION 'ChkDeliveries()


FUNCTION BuildList()
local y $do $list
  $list = ""
  order sort now dictionary "dateout.idx" fields "[Date_Out]" ascending
  for i = 1 to records
    $do = date2([Date_Out])
    if chkstr($do,$list) = -1            ' NOT in list
      $list = $list&$do
    end if
    data goto record next
  end for
' message "dates to check:"&str($list)
  x=strcount($list)                    'message "x is:"&str(x)
' message "ptval is:"&str(ptval)
  nrdates = ptval                      'message "nrdates is:"&str(nrdates)
  redimension dateout[nrdates,2]
  for i = 1 to nrdates
    dateout[i,1]=group($list,i)        'message "dateout[i,1] is:"&str(dateout[i,1])
  end for
END FUNCTION ' BuildList()


FUNCTION UpdateAppt()
local cd ua2 l
  cd = ChkDeliveries()
  for i = 1 to nrdates
    ua2 = dateout[i,2]                 'message "0=Ready; 1=Not in:"&str(ua2)
    if ua2 = 1
      continue for
    else
      ua1 = dateout[i,1]               'message "checking dateout :"&str(ua1)
      vloadif(dpath|"appntmnt.vws")
      order change key "[Job_Nr]"
      while true
        data find "[Job_Nr]" equal jobnr options ""
        if cerror                               '   if none - then return
          exit while
        else
          if date2([Date]) = ua1
            if [Status] = "O"
              lock-record
                [Status]="D"
              write-record
            end if
            data goto record next
          else
            data goto record next
          end if
        end if
      end while
      vunloadif("appntmnt.vws")

      vloadif(dpath|"apptdate.vws")
      order change physical
      data query execute "upd_appt.dfq" index "upd_appt.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ date2([Date])=ua1
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
      data goto record first
      for l = 1 to records
        for k = 1 to 7
          if indirect("[A"|str(k)|"]") = jobnr
            if indirect("[B"|str(k)|"]")="O"
              lock-record
                dbput("[B"|str(k)|"]","D")
              write-record
              data goto record next
            end if
          end if
        end for
        data goto record next
      end for
    end if
  end for
END FUNCTION 'UpdateAppt()