<%
'*************************************************************************
' Version 4.50 VP-ASP  Nov 12, 2002
' Customer based pricing
' after a price has been read from the database
' This routine is called by GetProduct to determine whether
' there is a specific price for  acustomer
' March 22 add CustomerPrice Fields logic
'***************************************************************************
dim custdbc
const customerpricetable="customerprices"
Sub ShopCustomerPrices (objrs, catalogid, categoryid, ioprice, newprice,discount)
'****************************************************************
' obtain the correct price for the customer
' first lookup specific product
' if not found lookup specific category
'*****************************************************************
dim customerid, rc 
if getconfig("xcustomerPrices")<>"Yes" then exit sub
if getconfig("Xcustomerpricefields")<>"" then
    CustomerPricesinRecord objrs, catalogid, categoryid, ioprice, newprice,discount
    exit sub
end if    
ShopOpenDatabase custdbc
discount=0
newprice=ioprice
customerid=GetSess("Customerid")
if customerid="" then
    exit sub
end if  
LookupCustomerProduct catalogid, customerid, newprice,discount, rc
if rc= 0 then
     exit sub
end if
LookupCustomerCategory categoryid, customerid, NewPrice,discount, rc
if rc=0 then
   exit sub
end if
LookupCustomerOnly customerid, NewPrice,discount, rc
if rc=0 then
   exit sub
end if
shopclosedatabase custdbc   
end sub
'
Sub LookupCustomerProduct (catalogid, customerid, Price,discount, rc)
dim lookupsql, lookuprs, oldprice, newprice
Dim Discountamount,DiscountPercent
lookupsql="select * from " & customerpricetable 
lookupsql = lookupsql & " where customerid=" & customerid 
lookupsql = lookupsql & " and catalogid=" & catalogid
Set lookuprs=custdbc.execute(lookupsql)

if lookuprs.eof then
    rc=4
    lookuprs.close
    set lookuprs=nothing
    exit sub
end if
discountamount=lookuprs("discountamount")
discountpercent=lookuprs("discountpercent")
ApplyCustomerPrice Price, discountamount, discountPercent, discount
lookuprs.close
set lookuprs=nothing
shopclosedatabase custdbc
end sub

Sub ApplyCustomerprice (price, amount, percent, discount)
dim newprice
If not isnull(amount) and amount>0 then
   Newprice=price-amount
   discount=newprice/price
   discount=1-discount
   discount=discount*100    
   price=newprice
   exit sub
end if   
If not isnull(percent) then
    discount=percent
    if percent>1 then
       percent=percent/100
    end if
   Newprice=price- (Price*percent)
   NewPrice=formatnumber(NewPrice,getconfig("xdecimalpoint"))
   price=Newprice
end if
'debugwrite "newprice=" & newprice
end sub

Sub LookupCustomerCategory (categoryid, customerid, Price,discount, rc)
Dim Discountamount,DiscountPercent
dim lookupsql, lookuprs, discountper, newprice
lookupsql="select * from " & customerpricetable 
lookupsql = lookupsql & " where customerid=" & customerid 
lookupsql = lookupsql & " and categoryid=" & categoryid
set lookuprs=custdbc.execute(lookupsql)
if lookuprs.eof then
    rc=4
    lookuprs.close
    set lookuprs=nothing
    exit sub
end if
Discountamount=lookuprs("Discountamount")
DiscountPercent=lookuprs("Discountpercent")
if getconfig("xdebug")="Yes" then
  debugwrite "Price=" & price &  " discountPercent=" & discountpercent
end if  
ApplycustomerPrice Price, discountamount, discountPercent, discount
lookuprs.close
set lookuprs=nothing
shopclosedatabase custdbc
rc=0
end sub

Sub LookupCustomerOnly (customerid, Price,discount, rc)
Dim Discountamount,DiscountPercent
dim lookupsql, lookuprs, discountper, newprice
lookupsql="select * from " & customerpricetable 
lookupsql = lookupsql & " where customerid=" & customerid 
lookupsql = lookupsql & " and categoryid=0 and catalogid=0"
Set lookuprs=custdbc.execute(lookupsql)
if lookuprs.eof then
    rc=4
    lookuprs.close
    set lookuprs=nothing
    exit sub
end if
Discountamount=lookuprs("Discountamount")
DiscountPercent=lookuprs("Discountpercent")
if getconfig("xdebug")="Yes" then
  debugwrite "Price=" & price &  " discountPercent=" & discountpercent
end if  
ApplycustomerPrice Price, discountamount, discountPercent, discount
lookuprs.close
set lookuprs=nothing
shopclosedatabase custdbc
rc=0
end sub
'****************************************************************
' contact id field determines which customer price field to use
' objrs is the current record in products table
' Uses xcustomerpricefields
' xcustomepricesindexes
'*****************************************************************
sub  CustomerPricesinRecord (objrs, catalogid, categoryid, ioprice, newprice,discount)
dim fields(50),fieldcount, customerpricefields, customerpricetypes
dim types(50), typecount, customertype, ctype, pricefield
dim donumerictest, i, xdebug
on error goto 0
xdebug=getconfig("xdebug")

if getsess("customertype")="" then exit sub
customerpricefields=getconfig("Xcustomerpricefields")
customerpricetypes=getconfig("Xcustomerpricetypes")
customertype=getsess("customertype")
If isnumeric(customertype) then
  customertype=clng(customertype)
  donumerictest=true
else
  donumerictest=false
  customertype=ucase(customertype)
end if
If xdebug="Yes" then  
  debugwrite "Pricefields=" & customerpricefields
  debugwrite "Types=" & customerpricetypes
  debugwrite "Customer type=" & getsess("customertype")  
end if  
if customerpricefields="" then exit sub
if customerpricetypes="" then exit sub
parserecord customerpricefields, fields,fieldcount,","
parserecord customerpricetypes, types,typecount,","
for i = 0 to typecount-1
  ctype=types(i)
  if donumerictest=true then
     if isnumeric(ctype) then
        ctype=clng(ctype)
        'debugwrite "comparing2 ctype=" & ctype & " against " & customertype 
        if customertype=ctype then
            pricefield=fields(i)
            SetCustomerPricefield objrs, pricefield, newprice
            exit sub
        else
         '  debugwrite "did not match " & ctype & " ct=" & customertype
        end if 
      end if     
    else
       ' debugwrite "comparing2 ctype=" & ctype & " against " & customertype 
        if customertype=ucase(ctype) then
            pricefield=fields(i)
            SetCustomerPricefield objrs, pricefield, newprice
            exit sub
         end if
     end if     
next
end sub
Sub SetCustomerpricefield (objrs, fieldname, price)
dim tprice
tprice=objrs(fieldname)
if isnull(tprice) then exit sub
price=tprice
end sub
%>