<% Sub CalculateTax (subtotal, total, shippingcost, tax,pst) '**************************************************************** ' VP-ASP 6.50 ' Summary: This routine calculates tax fo VP-ASP ' Modifications ' Nov 8, 2006 HK country and state rewritten to use new shopstates ' and shopcountries tables '**************************************************************** dim taxdbc, rc dim taxdone,taxprice Tax=0 taxdone=false TaxCheckcustomerexcept taxdbc, rc ' is customer exempt If rc=0 then ' yes then no tax exit sub end if '***************************************************************************** ' the tax price can include shipping or discounts '**************************************************************************** If getconfig("xtaxincludeshipping")="Yes" then taxprice=subtotal+shippingcost else If getconfig("xtaxincludediscount")="No" then taxprice=total Else taxprice=subtotal End If end if '********************************************************************************** ' some products are tax free, so we need to recalculate the real product total '********************************************************************************** If getconfig("xtaxexcludeproducts")<>"" or getconfig("xtaxexcludeproductsdb")<>"" or getconfig("xtaxfreeproducts")="Yes" then taxCalculatenewsubtotal taxprice If getconfig("xtaxincludeshipping")="Yes" then taxprice=taxprice+shippingcost end if end if 'debugwrite "taxprice=" & taxprice '********************************************************************************* ' We know the value to tax but need to find the tax rate ' It could be tax by state or by country or by product ' If one of those matches, then no further calculation occurs '******************************************************************************** shopopendatabase taxdbc ' open up database if UCASE(getsess("country")) = "CA" then TaxbyCanada taxprice, tax, taxdone, taxdbc, pst if taxdone=True then shopclosedatabase taxdbc exit sub end if end if ' Most common is tax by state TaxbyState taxprice, tax, taxdone, taxdbc if taxdone=True then shopclosedatabase taxdbc exit sub end if ' Taxbycountry taxprice, tax, taxdone, taxdbc if taxdone=true then shopclosedatabase taxdbc exit sub end if ' TaxbyProduct taxprice, tax, taxdone, taxdbc if taxdone=true then shopclosedatabase taxdbc exit sub end if TaxforEU taxprice, tax, taxdone,taxdbc shopclosedatabase taxdbc end sub '******************************************************************************** ' first get state. Some tax by shipping state and others by the ordering state ' Handle By State/Province '****************************************************************************** Sub TaxbyState (price, tax, taxdone, taxdbc) dim state, taxsql, taxrs dim xfactor, xnet, rate If getconfig("xtaxshippingstate")="Yes" then state=getsess("shipstate") if state="" then state=getsess("state") end if else state=getsess("state") end if taxsql="select * from shopstates where stateabbrev='" & state & "'" taxsql=taxsql & " and (statetaxrate <> 0 and statetaxrate is not null)" set taxrs=taxdbc.execute(taxsql) if not taxrs.eof then ' this state taxes ' debugwrite taxsql rate=taxrs("statetaxrate") ' get rate rate=csng(rate) ' convert to number ' if atx included in price this adjusts the tax value if getconfig("xtaxincludedinprice") = "Yes" then xfactor = (rate * 100) + 100 xnet = (price/xfactor) * 100 tax = price - xnet else tax=rate*price end if taxdone=true 'finished end if closerecordset taxrs ' close tax recordset end sub ' '******************************************************************************** ' see if this country has a tax rate ' if yes calculate tax '****************************************************************************** Sub TaxbyCountry (price, tax, taxdone, taxdbc) dim taxsql, taxrs, country dim xfactor, xnet, rate country=ucase(Getsess("country")) taxsql="select * from shopcountries where country='" & country & "'" taxsql=taxsql & " and (countrytaxrate <> 0 and countrytaxrate is not null)" 'debugwrite taxsql set taxrs=taxdbc.execute(taxsql) if not taxrs.eof then ' this state taxes rate=taxrs("countrytaxrate") ' get rate rate=csng(rate) ' convert to number ' if atx included in price this adjusts the tax value if getconfig("xtaxincludedinprice") = "Yes" then xfactor = (rate * 100) + 100 xnet = (price/xfactor) * 100 tax = price - xnet else tax=rate*price end if taxdone=true 'finished end if closerecordset taxrs ' close tax recordset end sub ' '************************************************************************** ' We are now looking at tax by individual product '************************************************************************* Sub TaxbyProduct (iprice, tax, taxdone, taxdbc) dim taxfield, useproductdbc, productdbc taxfield=getconfig("xtaxbyproduct") if taxfield="" then exit sub Dim productname, quantity, price dim scartitem, arrcart, productid, productcode, taxforitem dim taxamount Dim i dim productql dim rsitem if getconfig("xproductdb")<>"" then shopopendatabasep productdbc useproductdbc=true else useproductdbc=false end if ' '************************************************************************** ' go through each item in the cart ' get catalogid and see if it is taxable '************************************************************************** scartItem = getsess("CartCount") ' number of products arrCart = getsessa("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 If useproductdbc=false then Set rsItem = taxdbc.execute(Productql) else Set rsItem = productdbcc.execute(Productql) end if 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 if useproductdbc=true then ShopCloseDatabase productdbc end if taxdone=true end sub ' '************************************************************************* ' The last calculation is same as tax by country ' except that with a valid vat number, it could be tax exempt '*********************************************************************** sub TaxforEU (taxprice, tax, taxdone, taxdbc) '**************************************************************** ' 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 dim xfactor, xnet If Getconfig("xTaxEu")<>"Yes" then exit sub taxdone=true ' No tax if valid vat number If getsess("vatnumbertax")<>"" then exit sub ' treat it as a normal country TaxbyCountry taxprice, tax, taxdone, taxdbc end sub '******************************************************** ' Exclude some products such as gift certificates '******************************************************** Sub TaxCalculatenewsubtotal (newsubtotal) Dim scartItem, giftproductid, taxDbc Dim arrCart Dim i Dim ProdQuantity, prodprice dim foundproduct, productid dim products(100), productcount dim dbfield dbfield=getconfig("xtaxexcludeproductsdb") if getconfig("xtaxexcludeproductsdb")<>"" or getconfig("xtaxfreeproducts")="Yes" then ShopOpenDatabaseP taxDbc end if If getconfig("xtaxexcludeproducts")<>"" then parserecord getconfig("xtaxexcludeproducts"),products,productcount,"," For i=0 to productcount-1 Products(i)=clng(products(i)) next else productcount=0 end if scartItem = getsess("cartcount") arrCart = getsessa("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=false if productcount>0 then foundproduct=taxFindproduct(productid, products, productcount) end if if foundproduct=false then if dbfield<>"" or getconfig("xtaxfreeproducts")="Yes" then foundproduct=taxFindProductdb(productid, taxdbc, dbfield) end if end if if foundproduct=false then Newsubtotal=newsubtotal + ProdQuantity* ProdPrice end if Next 'debugwrite "newsubtotal="& newsubtotal 'VP-ASP 6.50 - remove discount from total before calculating tax if getsess("discount") <> "" then if isNumeric(getsess("discount")) then newsubtotal = newsubtotal - getSess("discount") end if end if if getsess("coupondiscount") <> "" then if isNumeric(getsess("coupondiscount")) then newsubtotal = newsubtotal - GetSess("coupondiscount") end if end if if dbfield<>"" then ShopCloseDatabase taxdbc end if 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 '****************************************************************** ' Find product in database ' if field in taxexemptfieldd is not null it is taxexempt ' or in 6.50 it can be marked taxfree in the product record '******************************************************************** Function TaxFindProductDB (productid, taxDbc, taxfield) dim productsql, rsItem, taxvalue, found found=false productsql="select * from products where catalogid=" & productid Set rsItem = taxdbc.execute(Productsql) If Not rsItem.EOF Then If taxfield<>"" then taxvalue=rsitem(taxfield) if not isnull(taxvalue) then found=true end if end if 'VP-ASP 6.50.1 - fix check for tax free products if getconfig("Xtaxfreeproducts")="Yes" then taxvalue=rsitem("taxfree") If taxvalue Then found = True End if end if end if closerecordset rsitem TaxFindProductdb=found end function '**************************************************************************** ' see if this customer is taxexmpt ' set rc=0 if yes ' If using split databases then open customerdb '************************************************************************** Sub TaxCheckcustomerexcept (taxdbc, rc) dim custdbc, custsql, custrs if getsess("CustomerID")= "" then exit sub ' no customer OpenCustomerDB custdbc ' yes open custsql = "select taxexempt from customers where contactid = " & getsess("CustomerID") set custrs = custdbc.execute(custsql) if not custrs.eof then if lcase(custrs("taxexempt")) = "yes" OR lcase(custrs("taxexempt")) = "true" then rc=0 else rc=4 end if end if closerecordset custrs shopclosedatabase custdbc end sub '******************************************************************************** ' Canadian Tax Handling '****************************************************************************** Sub TaxbyCanada(price, tax, taxdone, taxdbc, pst) dim castate, cataxsql, cataxrs dim caxfactor, caxnet, carate, capst If getconfig("xtaxshippingstate")="Yes" then castate=getsess("shipstate") if castate="" then castate=getsess("state") end if else castate=getsess("state") end if cataxsql="select * from shopstates where stateabbrev='" & castate & "'" cataxsql=cataxsql & " and (statetaxrate <> 0 and statetaxrate is not null)" set cataxrs=taxdbc.execute(cataxsql) if not cataxrs.eof then ' this state taxes carate=cataxrs("statetaxrate") ' get rate carate=csng(carate) ' convert to number capst=cataxrs("statecanadapst") if capst > "" then capst=csng(capst) ' convert to number end if if capst > "" then 'VP-ASP 6.50.1 - special cases for tax if getconfig("xtaxincludedinprice") = "Yes" then if lcase(castate) = "qc" OR lcase(castate) = "pe" then caxfactor = (capst * 100) + 100 caxnet = (price/caxfactor) * 100 capst = price - caxnet caxfactor = (carate * 100) + 100 caxnet = ((price + capst)/caxfactor) * 100 tax = (price + capst) - caxnet else caxfactor = (carate * 100) + 100 caxnet = (price/caxfactor) * 100 tax = price - caxnet caxfactor = (capst * 100) + 100 caxnet = (price/caxfactor) * 100 capst = price - caxnet end if else if lcase(castate) = "qc" OR lcase(castate) = "pe" then pst=capst*price tax=carate*(price + pst) else tax=carate*price pst=capst*price end if end if else ' if atx included in price this adjusts the tax value if getconfig("xtaxincludedinprice") = "Yes" then caxfactor = (carate * 100) + 100 caxnet = (price/caxfactor) * 100 tax = price - caxnet else tax=carate*price end if end if taxdone=true 'finished end if closerecordset cataxrs ' close tax recordset end sub %>