'CHKPRICE - looks up price for any item; used by Shop Menu
' 26/04/96 - shows Colours & Widths

external  messbox() fentrybox() chkdate() dpath vloadif() remove() ipath
external  progress() vunloadif() sch scw shopmask messboxwait()
external  fgp bgp navrecs() userid scr increment() PrintReport()
external  bpopdb() chkstr() delstr() psa addidxrec() dsa makeidx() strtoary()
external  lpath bge popuplist() nr5 nr6 fdp bbd wraptext()
external  delidxrec() getidxrecs() entryline() messline()
external  strcount() prpath findcolpop() bgs fgs

public    $itemtype ptstr from_date jobnr plist[1,1]
public    ptval ptary[1] codes[1] #ordwidth prodcode desMRC $ccw

global    $ tmax x lx $meas #feet i z h #inch #metres #conv msg1 custname $branch
global    idxname dt t1 t2 t3 ListString() recs k $popstr strtrow #nritems
global    mr sym blen l c c2 r2 dc lc pad sc pl pc rec drows PG TR
global    uistrcnt() refresh() udelstr()

global     $rollnr prodMRC #prodrec #currliststck #bline
global     #prevliststck #prec #newliststck $type $len
global     y1 y2 y3 deladdr1 s_shwreq y
global     $backing $mess1 $smlc $smlr $prev_C
global     $prev_R $effecdate $disc  prodSUPP  suppcode $newcolor a1
global     #ordlength #deflen $resvn maxwidth refcode a2 a3 a4 a5
global     custorderdate #unitcost #reqncost $auth
global     priceauthority $color $colorstr
global     currentorder ordref specterm purchorderdate  $price_R $price_C delquot
global     mess suppname $comment orderby consecnr
global     l1 l2 r1 c3  c1 ShowPrice() $mess2
global     strtcol keyf keyb
global     Title_A() Title_B() upd_new
global     jobidx #reqnrec $unit $delterms $priceterms
global     endcol ReturnToMenu()
global     #jobrec #reqnrecs S_save #recnr $instruct f1 f2 f3
global     ques FindPrice() j x1 x2 SearchRange() FindSupplier()


MAIN
single-step off
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
'   quiet off

  while true
    keyf = 7
    keyb = 0
    prodcode = ""
    refcode = ""

    screen clear box 1 1 sch scw 0 0 no-border
    repaint off
    y1="Supplier's˙ranges"
    y2="˙˙˙Item˙types"
    x = popuplist(9,32,14,y1&y2,"Find prices by:",1,0)
    if x = 0
      if ptstr == y1
        x = SearchRange()                     ' 2=no price
      else
        x = FindPrice()                       ' 2=no price
      end if
    elseif x = -1
      ReturnToMenu()                  ' return direct to menu
    end if

  end while
END MAIN


FUNCTION ShowPrice()
local #rcm #rcy #rrm #rry #price a1 a2 $price #rcmp #rcyp #rrmp #rryp
  $popstr = [Colours]
  if len($popstr)=0
    $popstr = "No˙colours˙listed"
  end if
  strtrow = 1
  screen print 1 1 15 12 "˙This may NOT be a full list of colours - check manufacturer's details˙"
  x = ListString(2,1,18,$popstr,"",1,0,14,11,0,7,"Colours")

  $popstr = [Widths_Available]
  strcount([Widths_Available])
  #nritems = ptval
  strtrow = 19 - #nritems
  x = ListString(strtrow,28,20,$popstr,"",1,0,10,5,0,7,"Widths")

  prodMRC    = [Product_MRC]
  repaint off
  #RCMP = [Retail_Cuts_Metres]
  #RCYP = [Retail_Cuts_Yards]
  #RRMP = [Retail_Rolls_Metres]
  #RRYP = [Retail_Rolls_Yards]

  if [Unit_Desc] = "Units"                          ' check whether in Units
    #price = #RCMP
    y1 = format(" Retail price is:"&currency(#price)&"- press any key ","M72")
  else
    x = popuplist(20,12,24,"Metres Yards","",1,0)   ' ask metres/rolls
    a1 = lower(left(ptstr,1))
    $len = ptstr
    x = popuplist(20,12,24,"Cuts Rolls","",1,0)     ' ask cuts/rolls
    a2 = lower(left(ptstr,1))
    $type = left(ptstr,len(ptstr)-1)     'message "$type is:"&str($type)
    $price = "#r"|a2|a1                  'message "$price is:"&str($price)
    #price = case $price ("#rcm",#RCMP)("#rcy",#RCYP)("#rrm",#RRMP)("#rry",#RRYP)

    if #price = 0
      y1 = format(" No"&$type&"price in"&$len&"listed for this item - press any key ","M72")
    else
      y1 = format($type|" retail price for"&$len|":"&currency(#price)&"- press any key ","M72")
    end if
  end if
  screen print 21 5 14 1 y1
  inchar
  screen clear box 1 1 sch scw 0 0 no-border
'   repaint off
END FUNCTION ' ShowPrice()


FUNCTION SearchRange()
  while true
    x = FindSupplier()
    if x = -1
      return (-1)
    else
      vloadif(dpath|"findprcA.vw")
      order change index prpath|"PR"|suppcode|".idx"
      while true
        screen clear box 22 1 24 scw 0 0 no-border
        vloadif(dpath|"findprcA.vw")
        if records = 0
          messboxwait(" No products listed from"&suppname,0,0,1)
          screen clear box 1 1 sch scw 0 0 no-border
          return (-1)
'           continue while
        else
' screen out temp codes
          data query execute "srchrnge.dfq" index "srchrnge.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
'  [Temporary]="N"
'  and
'  NOT(deleted)
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
          y2 = format(chr(24)&chr(25)&"to find & press {Enter} - {Esc} to change category or Supplier ","M72")
          screen print 21 5 fgp bbd y2
          x = bpopdb("findprcA",4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0)
          if x = -1
            screen clear box 1 1 sch scw 0 0 no-border
            repaint off
            vunloadif("findprcA.vw")
            exit while
          end if
          prodcode = ptstr
          screen shortrestore dsa
          x = ShowPrice()
          Title_B()
        end if
      end while
    end if
  end while
END FUNCTION ' SearchRange()


FUNCTION  Title_A()
  y2 = format("Select category to price or {Esc} to exit","M72")
  screen print 21 5 fgp bbd y2
  repaint off
  f1 = format("    F2   ³     F3    ³     F4    ³     F5    ³     F6    ³     F7    ³    F8   ","L80")
  f2 = format("  Stock  ³  Bespoke  ³   Stock   ³  Bespoke  ³   Vinyls  ³   Tiles   ³  Labour ","L80")
  f3 = format("  Carpet ³   Carpet  ³  Ancll'y  ³  Ancll'y  ³           ³           ³         ","L80")
  screen print 22 1 keyf keyb f1
  screen print 23 1 keyf keyb f2
  screen print 24 1 keyf keyb f3
END FUNCTION   'Title_A()


FUNCTION  Title_B()
  y2 = format("Select product or {Esc} to change category","M72")
  screen print 21 5 fgp bbd y2
  repaint off
END FUNCTION   'Title_B()


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


FUNCTION FindPrice()
local z $mess1 $mess2 #deflen $wrongprod f1 f2 f3 nr_reqns nr_index
  repaint off
  ptval=0
  while true
    Title_A()
    prodcode = ""
    x = inchar
    if x = 316                     ' F2 - Stock Carpet - IT = "A"
      while true
        screen clear box 22 1 24 scw 0 0 no-border
        vloadif(dpath|"findprcA.vw")
        order change index ipath|"stckcarp.idx"
        if prodcode = ""
          y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72")
          screen print 21 5 fgp bbd y2
          x = bpopdb("findprcA",4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0)
        else
          data goto record record-number #prodrec
          y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72")
          screen print 21 5 fgp bbd y2
          x = bpopdb("findprcA",4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0)
        end if
        if x = -1
          vunloadif("findprcA.vw")
          exit while
        end if
        #prodrec = record              'message "#prodrec is:"&str(#prodrec)
        prodcode = ptstr
        screen shortrestore dsa
        ShowPrice()
        Title_B()
      end while
      continue while

    elseif x = 317                 ' F3 - Bespoke Carpet - IT = "B"
      while true
        screen clear box 22 1 24 scw 0 0 no-border
        vloadif(dpath|"findprcB.vw")
        order change index ipath|"bespcarp.idx"   ' message "F3 - prodcode is:"&str(prodcode)
        if prodcode = ""
          y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72")
          screen print 21 5 fgp bbd y2
          x = bpopdb("findprcB",4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0)
        else
          data goto record record-number #prodrec
          y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72")
          screen print 21 5 fgp bbd y2
          x = bpopdb("findprcB",4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0)
        end if
        if x = -1
          vunloadif("findprcB.vw")
          exit while
        end if
        #prodrec = record
        prodcode = ptstr
        screen shortrestore dsa
        ShowPrice()
        Title_B()
      end while
      continue while

    elseif x = 318                ' F4 - Stock Ancl - IT = "A"
      while true
        screen clear box 22 1 24 scw 0 0 no-border
        vloadif(dpath|"findprcA.vw")
        order change index ipath|"stckancl.idx"
        if prodcode = ""
          y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72")
          screen print 21 5 fgp bbd y2
          x = bpopdb("findprcA",4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0)
        else
          data goto record record-number #prodrec
          y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72")
          screen print 21 5 fgp bbd y2
          x = bpopdb("findprcA",4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0)
        end if
        if x = -1
          vunloadif("findprcA.vw")
          exit while
        end if
        #prodrec = record              'message "#prodrec is:"&str(#prodrec)
        prodcode = ptstr
        screen shortrestore dsa
        ShowPrice()
        Title_B()
      end while
      continue while

    elseif x = 319                     ' F5 - Bespoke Ancl - IT = "J"
      while true
        screen clear box 22 1 24 scw 0 0 no-border
        vloadif(dpath|"findprcB.vw")
        order change index ipath|"bespancl.idx"
        if prodcode = ""
          y2 = format(" Scroll or press {F3} to search - {Esc} to change category ","M72")
          screen print 21 5 fgp bbd y2
          x = bpopdb("findprcB",4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0)
        else
          data goto record record-number #prodrec
          y2 = format(" Scroll or press {F3} to search - {Esc} to change category ","M72")
          screen print 21 5 fgp bbd y2
          x = bpopdb("findprcB",4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0)
        end if
        if x = -1
          vunloadif("findprcB.vw")
          exit while
        end if
        #prodrec = record
        prodcode = ptstr
        screen shortrestore dsa
        ShowPrice()
        Title_B()
      end while
      continue while

    elseif x = 320                 ' F6 - Vinyl - IT = "V or W"
      while true
        screen clear box 22 1 24 scw 0 0 no-border
        vloadif(dpath|"findprcB.vw")
        order change index ipath|"vinyl.idx"   ' bpop must show MRC ??????????????

        if prodcode = ""
          y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72")
          screen print 21 5 fgp bbd y2
          x = bpopdb("findprcB",4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0)
        else
          data goto record record-number #prodrec
          y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72")
          screen print 21 5 fgp bbd y2
          x = bpopdb("findprcB",4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0)
        end if
        if x = -1
          vunloadif("findprcB.vw")
          exit while
        end if
        #prodrec = record
        prodcode = ptstr
        screen shortrestore dsa
        ShowPrice()
        Title_B()
      end while
      continue while

    elseif x = 321                     ' F7 - Tiles - IT = "S or T"
      while true
        screen clear box 22 1 24 scw 0 0 no-border
        vloadif(dpath|"findprcB.vw")
        x = popuplist(20,59,25,"Stock Bespoke","",1,0)
        if ptstr = "Stock"
          order change index ipath|"stk_tile.idx"  ' bpop must show MRC ??????????????
        else
          order change index ipath|"bsp_tile.idx"  ' bpop must show MRC ??????????????
        end if
        if prodcode = ""
          y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72")
          screen print 21 5 fgp bbd y2
          x = bpopdb("findprcB",4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0)
        else
          data goto record record-number #prodrec
          y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72")
          screen print 21 5 fgp bbd y2
          x = bpopdb("findprcB",4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0)
        end if
        if x = -1
          vunloadif("findprcB.vw")
          exit while
        end if
        #prodrec = record
        prodcode = ptstr
        screen shortrestore dsa
        ShowPrice()
        Title_B()
      end while
      continue while

    elseif x = 322                     ' F8 - Fitting - IT = "F"
      while true
        screen clear box 22 1 24 scw 0 0 no-border
        vloadif(dpath|"findprcA.vw")
        order change index ipath|"labour.idx" ' bpop must show MRC ??????????????

        if prodcode = ""
          y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72")
          screen print 21 5 fgp bbd y2
          x = bpopdb("findprcA",4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0)
        else
          data goto record record-number #prodrec
          y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72")
          screen print 21 5 fgp bbd y2
          x = bpopdb("findprcA",4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0)
        end if
        if x = -1
          vunloadif("findprcA.vw")
          exit while
        end if
        #prodrec = record              'message "#prodrec is:"&str(#prodrec)
        prodcode = ptstr
        screen shortrestore dsa
        ShowPrice()
        Title_B()
      end while
      continue while
    elseif x = 315                     ' F1 - blank key - loops around
      continue while
    elseif x = 323                     ' F9 - blank key - loops around
      continue while
    elseif x = 763                     ' Esc
      screen clear box 22 1 sch scw 0 0 no-border
      return (-1)
    end if
  end while
END FUNCTION ' FindPrice()


FUNCTION FindSupplier()
  vloadif(dpath|"supplier.vws")
  order change physical
  order sort now dictionary "suppname" fields "[Name]" ascending
  repaint off
  while true
    y1 = format(" Choose Supplier and press {Enter} ","M38")
    screen print 7 21 15 1 y1
    screen print 20 21 15 1 (format(" {Enter} views orders - {Esc} exits ","M38"))
    x = bpopdb("supplier",6,"","[Name]","l35","[Supplier_Code]","L6","[Supplier_Code]",8,21,19,58,"",0)
    if x = 0
      exit while
    elseif x = -1
      screen clear box 1 1 sch scw 0 0 no-border
      return (-1)
    end if
  end while
  suppcode = ptstr
  suppname = [Name]
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
END FUNCTION 'FindSupplier()


FUNCTION ListString(r1,c1,br,list,msg,num,mnu,colSf,colSb,colIf,colIb,hdr)
local t hml hm cnum mscn pad padc ret
  if exact(trim(list),NULL)=FALSE
    recs = uistrcnt(list)
    if recs = 0
      return (-3)
    end if
  else
    return (-2)
  end if

  redimension plist[recs,3]
  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 colIb 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(28)
  cnum=0
  blen=0
  l=blen
  for c=1 to recs
    plist[c,2]=group(list,c)
    l=len(plist[c,2])
    plist[c,1]=0
    if l>blen
      blen=l
    end if
  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 colSf colSb
  if len(hdr)>0
    screen print r1 c1+1 colSf colSb hdr
  end if
  pc=1
  for c=1 to pl
    screen print c+r1 lc colSf colSb plist[c,2]
  end for
END FUNCTION  'ListString()

function uistrcnt(sl)
local i s lo hi c
'-------------------------------------
'sl   = string group
'i    = counter for group() function
's    = string counter increment
'lo   = low search record
'hi   = high search record
'c    = temporary equation to find NULL
'-------------------------------------
'returns  count of strings in string
'         group
'-------------------------------------
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
'-------------------------------------
's    = string to check
'sl   = string group
't    = targeted string to check
'i    = counter for group() function
'n    = new string group
'f    = list changed flag
'-------------------------------------
'returns:  success =  list less item
'          failure =  original list
'-------------------------------------
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 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()