<% Dim quandbc const quantitypricetable="quantitydiscounts" const maxQuantityFields=5 Sub CalculateUserPrice (Price, quantity, discountPrice, aArray, ArrayIndex) '************************************************************************* ' 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 ' Handles quantity based discounting ' Version 4.50 Sept 1, 2002 '*************************************************************************** dim categoryid, catalogid, salescode, scrtitem if getconfig("xquantityPrices")<>"Yes" then exit sub ' scrtItem = GetSess("CartCount") ShopOpenDatabase quandbc catalogid=aArray(cProductid, Arrayindex) categoryid=aArray(cCategory, Arrayindex) if catalogid="" or categoryid="" then HandleGroupDiscount price,discountprice,quantity,rc,scrtitem, aArray, ArrayIndex else LookupQuantityProduct catalogid,categoryid, price,discountprice, quantity, rc if rc>0 then HandleGroupDiscount price,discountprice,quantity,rc,scrtitem, aArray, ArrayIndex end if end if shopclosedatabase quandbc end sub '***************************************** ' Group Sales Discount '******************************************* Sub HandleGroupDiscount (price,discountprice,quantity,rc,scrtitem, aArray, ArrayIndex) dim tdiscountprice If getconfig("xProductGroupDiscount")<>"Yes" then exit sub dim salescode salescode=TRIM(aArray(cGroupDiscount,Arrayindex)) if salescode="" then exit sub dim lookupsql, lookuprs, oldprice, newprice,lngquantity,minquantity,fieldname,maxquantity,pricename,discpercent,discount,dualreprice dim i,k lookupsql="select * from " & quantitypricetable & " where groupfordiscount='" & salescode & "'" Set lookuprs=quandbc.execute(lookupsql) if lookuprs.eof then rc=4 lookuprs.close set lookuprs=nothing exit sub end if '************************************************** 'Getting/Setting Discounts '*************************************************** lngquantity=0 for i=1 to ArrayIndex 'deterimining eligability if aArray(cGroupDiscount,i)=salescode then if i=ArrayIndex then lngquantity=lngquantity+quantity else lngquantity=lngquantity+aArray(cQuantity,i) end if end if next minquantity=lookuprs("minquantity") If lngquantitymaxquantity then exit sub If lngquantity<= maxquantity then pricename="discount" & i discpercent=lookuprs(pricename) exit for end if next If discpercent>=1 then discount=discpercent else discount=Price*discpercent end if 'debugwrite "discountpercent=" & discpercent DiscountPrice=Price-discount DiscountPrice=formatnumber(Discountprice,getconfig("xdecimalpoint")) for i=1 to ArrayIndex if aArray(cGroupDiscount,i)=salescode then oldprice=aArray(cOriginalPrice,i) If discpercent>=1 then Discount=discpercent else discount=OldPrice*discpercent end if TDiscountPrice=oldPrice-discount TDiscountPrice=formatnumber(tDiscountprice,getconfig("xdecimalpoint")) 'debugwrite "Tdiscountprice=" & Tdiscountprice aArray(cUnitPrice,i)=TDiscountPrice if getconfig("XdualPrice")="Yes" then Convertcurrency TdiscountPrice, dualreprice aArray(cDualPrice,i) = dualreprice end if end if next Closerecordset lookuprs End Sub '*********************************************************** 'See if we can find it by catalogid '************************************************************ Sub LookupQuantityProduct (catalogid, categoryid, Price,discountprice, quantity, rc) dim lookupsql, lookuprs, oldprice, newprice Dim Discountamount,DiscountPercent lookupsql="select * from " & quantitypricetable lookupsql = lookupsql & " where catalogid=" & catalogid lookupsql = lookupsql & " or categoryid=" & categoryid 'debugwrite "lookupsql=" & lookupsql Set lookuprs=quandbc.execute(lookupsql) if lookuprs.eof then rc=4 lookuprs.close set lookuprs=nothing exit sub end if GetQuantityDiscount lookuprs, price, discountprice, quantity lookuprs.close set lookuprs=nothing rc=0 end sub '************************************************************** ' we have a record now apply the discount '************************************************************** Sub GetQuantityDiscount (rs, price, discountprice, quantity) dim discpercent, fieldname, pricename, maxquantity, minquantity, i dim lngquantity, discount lngquantity=clng(quantity) minquantity=rs("Minquantity") If lngquantity=1 then discount=discpercent else discount=Price*discpercent end if 'debugwrite "discountpercent=" & discpercent DiscountPrice=Price-discount DiscountPrice=formatnumber(Discountprice,getconfig("xdecimalpoint")) exit for end if next 'debugwrite "Discountprice=" & discountprice end sub %>