'REQALLCN - BOSS level to allocate REQUSN's - all o/s req'ns shown
' Jul 06  - modified for CDGN allocations
' 271210A JUL

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

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

global     LoadScreens() ShowReqns() $unitcost $selected $itemtype ordernr
global     #needed #new_bal Titles() #avail #unresvd nrdates
global     #old_bal ReturnToMenu() x $uar $reqncost
'  FaxCtgRepCdgn()
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
global     UpdGdsOut()

global     UpdateAppt() BuildList() dateout[1,1] ua1 $locn


MAIN
  	autohelp off
  	single-step off
	Background()
  	quiet on
  	file unload all
  	error off
  	progress(fgp,bgp," Searching for unallocated requisitions ",0)
  	#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
  	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

  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
    end if

    if ptval = {A} or ptval = {a}
'       progress(15,10," Please wait ... finding stock to allocate from ",0)
      #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 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()
' 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(" Stock in GREEN is held at Cadogan Carpets ","M75"))
  	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_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
    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] = $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         	       ' OK to allocate (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.

' message "Changing Roll Nr in GOODSOUT - L.485 in REQALLCN "
            ordernr = [Reference_Nr]
            UpdGdsOut($rollnr,ordernr)

            data goto record next
          end for
          $reclist = ""
          order change index "allocn.idx"
          return (0)

        elseif x = 2  ' CADOGAN carpet to allocate (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.

message "Changing Roll Nr in GOODSOUT - L.528 in REQALLCN "
            ordernr = [Reference_Nr]
            UpdGdsOut($rollnr,ordernr)
message "Create Report to send to Cadogan"
'             FaxCtgRepCdgn()	' fax Cutting Report to CDGN

message "Create STK_BESP 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"
            vloadif(dpath|"UAR_BOSS.vw")
            $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"
          vloadif(dpath|"UAR_BOSS.vw")
          return (-1)
        else
          vloadif(dpath|"UAR_BOSS.vw")
          $reclist = ""
          continue while
        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.

' message "Changing Roll Nr in GOODSOUT - L.538 in REQALLCN "
    ordernr = [Reference_Nr]
    UpdGdsOut($rollnr,ordernr)
        return (0)

      elseif x = -1
        x = messline(" Abandon this allocation? (y/n) ",1,1,1,21,7,69)

        $reclist = ""
        if ptstr == "y"
          vloadif(dpath|"UAR_BOSS.vw")
          return (-1)
        else
          vloadif(dpath|"UAR_BOSS.vw")
          $reclist = ""
          continue while
        end if

'         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 RemoveAllocn_B()
local $reqnnr
  repaint off
  $rollnr = [RollNr]
  #needed = [Length_Quantity]

' change balance & Active(y/n) on STK_CARP
' screen clear box #tline #split+1 #bline #split+23 0 0 no-border

  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")
' repaint on
' repaint
  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.

' message "Changing Roll Nr in GOODSOUT - L.1047 in REQALLCN "
    ordernr = [Reference_Nr]
    UpdGdsOut("00000/00",ordernr)

END FUNCTION ' RemoveAllocn()


FUNCTION LoadScreens()
  vloadif(dpath|"requsn.vws")
  order change key "[RollNr]"
  data query execute "UAR_ROLL.dfq" index "x.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³[RollNr] = "00000/00" and not(deleted)                               ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
    messbox(" No unallocated requisitions - returning to Menu ",0,0,1)
    return (-3)
  end if

  data query execute "uar_jobJ.dfq" index uaridx
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'   [Item_Type] = "C" or
'   [Item_Type] = "V" or
'   [Item_Type] = "S"
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
    messbox(" No unallocated requisitions - returning to Menu ",0,0,1)
    return (-3)
  end if

  window split vertical #split
  vloadif(dpath|"UAR_BOSS.vw")
'   order change index "x.idx"
  order change index uaridx
  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
  data goto window 2
  window link "[Product_Code]" "UAR_DESC.vw" "[Product_Code]"
  data goto window 1
  window link "[CCW_Code]" "rolmetDJ.vw" "[CCW_Code]"
  error off
END FUNCTION ' LoadScreens()


' FUNCTION UpdGdsOut(roll,reqnnr)
' local origview
'   origview=apinfo(ap_filex)
'   vloadif(dpath|"goodsout.vws")
'   order change key "[Requsn_Nr]"
'   data find "[Requsn_Nr]" equal reqnnr options ""
'   if cerror                               '   if none - then return
'     vloadif(dpath|origview)
'     return (1)
'   else
'     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
'   end if
'   vloadif(dpath|origview)
'   return (0)
' END FUNCTION 'UpdGdsOut()


FUNCTION UpdGdsOut(roll,reqnnr)
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 [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
      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)
  strcount($list)
  nrdates = ptval
  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()


FUNCTION FindRoll()
local alln_nrs bal_aval remainder
' local origview
'   origview=apinfo(ap_filex)           'message "origview is:"&str(origview)
  $itemtype = [Item_Type]
  $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

  while record <= records
    remainder = 0
    #old_bar = [BAR]
    #old_bal = [Balance]
    if #old_bal < #needed
      data goto record next
      continue while
    end if
    remainder = #old_bal - #needed

'     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
    $locn   = [Location]
    $rollnr = [RollNr]
    if $itemtype = "C"
      if $locn="CDGN"
        messboxwait(" WARNING - this carpet is held at Cadogan Carpets ",0,0,1)
      end if
      if remainder < #maxleft and remainder > #minleft
        messline(" WARNING - balance on"&$rollnr&"will be between 0.6 and 5 metres ",0,0,1,21,4,73)
      end if
    end if
    screen shortrestore psa
    messline(" Confirm allocation of"&fixed(#needed,2)|"m from"&fixed(#old_bal,2)|"m of ROLL"&$rollnr|"? (y/n) ",1,1,1,21,4,73)
    if ptstr == "y"
      $allocn = "Y"
      if $locn="CDGN"
        return (2)
      else
        return (0)
      end if
    else
      data goto record next
    end if
  end while
  return (-1)
END FUNCTION 'FindRoll()