<%
Sub CalculateTax (subtotal, total, shippingcost, tax)
'****************************************************************
' This routine calculates tax fo VP-ASP
' Inputs are
' Code for State  xtaxstatename, xtaxstaterates
'  Code for country  xtaxcountryname, xtaxcountryrates
' Code by product  xtaxbyproduct
' VP-ASP 5.00 add EU Taxes and VAT check
' April 20, 2003
'****************************************************************
dim taxdone,taxprice
Tax=0
taxdone=false
If getconfig("xtaxincludeshipping")="Yes" then 
   taxprice=subtotal+shippingcost
else   
  taxprice=subtotal
end if  
If getconfig("xtaxexcludeproducts")<>"" then
   taxCalculatenewsubtotal taxprice
   If getconfig("xtaxincludeshipping")="Yes"  then
      taxprice=taxprice+shippingcost
   end if   
end if   
'debugwrite "taxprice=" & taxprice
TaxbyState taxprice, tax, taxdone
if taxdone=True then exit sub
Taxbycountry taxprice, tax, taxdone
if taxdone=true then exit sub
TaxbyProduct taxprice, tax, taxdone
if taxdone=True then exit sub
TaxforEU taxprice, tax, taxdone
end sub
'
' Handle By State/Province
Sub TaxbyState (price, tax, taxdone)
dim state, words(100),wordcount, staterates, i
dim rates(100),ratecount, rate
If getconfig("xtaxStatename")="" then
   exit sub
end if
staterates=getconfig("xtaxstaterates")
if staterates="" then exit sub
parserecord getconfig("xtaxstatename"),words,wordcount,","
state=ucase(Getsess("state"))
for i = 0 to wordcount-1
  if ucase(words(i))=state then
       parserecord staterates, rates,ratecount, ","
      if  i> ratecount then exit sub
      rate=rates(i)            ' get rate
      rate=csng(rate)          ' convert to number
      tax=rate*price           ' tax
      taxdone=true             'finished 
      exit sub
   end if
next   
end sub
'
Sub TaxbyCountry (price, tax, taxdone)
dim country, words(100),wordcount, countryrates, i
dim rates(100),ratecount, rate
If getconfig("xtaxcountryname")="" then
   exit sub
end if
countryrates=getconfig("xtaxcountryrates")
if countryrates="" then exit sub
parserecord getconfig("xtaxcountryname"),words,wordcount,","
country=ucase(Getsess("country"))
for i = 0 to wordcount-1
  if ucase(words(i))=country then
     parserecord countryrates, rates,ratecount, ","
      if  i> ratecount then exit sub
      rate=rates(i)            ' get rate
      rate=csng(rate)          ' convert to number
      tax=rate*price           ' tax
      taxdone=true             'finished 
      exit sub
   end if
next   
end sub
'
Sub TaxbyProduct (iprice, tax, taxdone)
dim taxfield
taxfield=getconfig("xtaxbyproduct")
if taxfield="" then exit sub
Dim productname, quantity, price, taxdbc
dim scartitem, arrcart, productid, productcode, taxforitem
dim taxamount
Dim i
dim productql
dim rsitem  
'
ShopOpenDatabase taxDbc
scartItem = Session("CartCount")         ' number of products
arrCart = Session("CartArray")
For i = 1 to scartItem
    productid=arrCart(cProductid,i)
    productcode=arrCart(cProductCode,i)
    productname= arrCart(cProductname,i)
    quantity=arrCart(cQuantity,i)
    Price=arrCart(cUnitPrice, i)
    productql="select * from products where catalogid=" & productid
    Set rsItem = taxdbc.execute(Productql)
    taxforitem=0
    If Not rsItem.EOF Then
       if not isnull(rsitem(taxfield)) then
          taxamount=rsitem(taxfield)
          taxamount=csng(taxamount)
          TaxforItem=Quantity*Price*taxamount   
       end if   
    end if
    Tax=Tax+TaxForItem   
    closeRecordset rsitem
Next
ShopCloseDatabase taxdbc
taxdone=true
end sub
'
sub TaxforEU (taxprice, tax, taxdone)
'****************************************************************
' This routine calculates tax foe EU countries
' If the order is for anyone in the country list above, set tax at 17.5%
' Inputs are
'****************************************************************
dim xcountryname, xtaxrate
If Getconfig("xTaxEu")<>"Yes" then exit sub
taxdone=true
' No tax if valid vat number
If getsess("vatnumber")<>"" then exit sub
xcountryname=getconfig("xtaxeucountries")
xtaxrate=getconfig("xtaxeurate")
dim country, words(100),wordcount,i
parserecord xcountryname,words,wordcount,","
' the country is  avalid EU country do the tax rate
country=ucase(Getsess("country"))
for i = 0 to wordcount-1
  if words(i)=country then
      tax=xtaxrate*taxprice      
      exit sub
   end if
next   
end sub
'********************************************************
' Exclude some products such as gift certificates
'********************************************************
Sub TaxCalculatenewsubtotal (newsubtotal)
Dim scartItem, giftproductid
Dim arrCart
Dim i
Dim ProdQuantity, prodprice
dim foundproduct, productid
dim products(100), productcount
parserecord getconfig("xtaxexcludeproducts"),products,productcount,","
For i=0 to productcount-1
  Products(i)=clng(products(i))
next  
scartItem = Session("cartcount")
arrCart = Session("cartarray")
newsubtotal=0
' go through all products and add up the quantities
For i = 1 to scartItem
  productid=arrCart(cProductid,i)
  if isnumeric(productid) then
     productid=clng(productid)
  else 
     productid=0
  end if      
  ProdQuantity= arrCart(cQuantity,i)
  ProdPrice= arrCart(cUnitPrice,i)
  foundproduct=taxFindproduct(productid, products, productcount)
  if foundproduct=false then        
    Newsubtotal=newsubtotal + ProdQuantity* ProdPrice
  end if  
Next
'debugwrite "newsubtotal="& newsubtotal
end sub
Function TaxFindProduct (productid, products, productcount)
dim i
for i = 0 to productcount-1
  if productid=products(i) then
     taxfindproduct=true
     exit function
  end if
next
taxfindproduct=false     
end function
%>