'AUTOPRC - auto version of RTL1_PRC for daily running on BRANDY

external   fentrybox() dpath vloadif() navrecs() messbox() sch scw fgp bgp
external   progress() bgs fgs scr remove() vkeybox() vunloadif() vloadexcif()
external   chkfname() PrintReport() userid

public	   ptstr ptval $lastdate $muc

global     x ReturnToMenu() $oldprice np i ChangePrice()
global     #markupA #markupB #break prod_MRC $newprice #smlc #smlr
global     #rollredn storepath ChangeUpdate()


MAIN
  single-step off
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  np = 3         ' nr of "M" types - currently 3 (14/01/97)
  #break = 3.5
'   #markupA = 1.66
'   #markupB = 2

  vloadexcif(dpath|"products.vws")
  progress(fgp,bgp," Please wait ... preparing list for price changes ",0)

  for i = 1 to np
    ChangePrice(i)
  end for

  ChangeUpdate()			' change date in "rtl_chg.dat" and

'   ReturnToMenu()                       ' e) - Close files

END MAIN


FUNCTION ChangeUpdate()
' change date of current price list
  x = date2(today)
  remove(dpath|"rtl_chg.dat")
  fopen dpath|"rtl_chg.dat" as 1
  fwrite 1 from x
  fclose 1
  vloadif(dpath|"products.vws")
  order change key "[Product_Code]"
  data find "[Product_Code]" equal "Z/999999" options ""
  lock-record
    [Product_MRC] = "ZZZZZZ"&"updated"&userid&today
  write-record
  vunloadif("products.vws")
END FUNCTION ' ChangeUpdate()


FUNCTION ChangePrice(mr)
local i
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  if mr = 1                            ' MANUAL price
    return (0)
  end if

  case mr
    when 2
      #markupA=1.68
      #markupB = 2
    when 3
      #markupA = 1.82
      #markupB = 2
  end case
  $muc = "M"|str(mr)
  progress(fgp,bgp," Please wait ... finding products ",0)
  vloadif(dpath|"rtl1_prc.vw")
  order change key [Product_Code]
  data query execute "chg_prc3" index "chg_prc1.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ [Markup_Code] = $muc						 ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
    message "No bespoke carpets in Products"
    ReturnToMenu()
  end if

'   progress(fgp,bgp," Updating M"|str(mr)&"prices ....."&format(str(records),"R4")&"records to process ",0)
  progress(fgp,bgp," Updating M"|str(mr)&"prices ....."&format(str(records),"R4")&"records to process ",0)
  for i = 1 to records			'  1) calculate SMLC net cost
    x = format(str(records-i),"R4")
    screen print 12 44 15 9 x
    #smlc = [SM_List_Cuts]*(100 - [Discount_%])/100
    if #smlc > #break
      #smlc = #smlc * #markupA
    elseif #smlc <= #break
      #smlc = #smlc * #markupB
    end if 				'message "#smlc is:"&str(#smlc)

    #smlr = [SM_List_Rolls]*(100 - [Discount_%])/100
    if #smlr > #break			'message "#smlr is:"&str(#smlr)
      #smlr = #smlr * #markupA
    elseif #smlr <= #break
      #smlr = #smlr * #markupB
    end if                              'message "#smlr is:"&str(#smlr)

' U1 codes are 'straight' and U2 are /1.196

    lock-record
      [Retail_Cuts_Metres] = #smlc
      [Retail_Rolls_Metres] = #smlr
      [Retail_Cuts_Yards] = #smlc/1.196
      [Retail_Rolls_Yards] = #smlr/1.196
      [Updated_On] = today
    write-record
    data goto record next
  end for
END FUNCTION ' ChangePrice(mr)


FUNCTION ReturnToMenu()
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  file unload all
  transfer "pm_menu.psl" in-memory
END FUNCTION ' ReturnToMenu()