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

' 21-11-13 - Markup codes changed - L48

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
      #markupA=1.75							'changed 21Nov13
      #markupB=2
    when 3
'       #markupA = 1.82
      #markupA = 1.92						'changed 21Nov13
      #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()