<%
dim affcategories
dim categorycount
dim categoryrates(2,100)
'***********************************************************
' Calculate commission for an order
' Uses Total order
' Product rates
' categoryrates
' VP-ASP 6.50 Feb 4, 2003
' Master and normal commision. Force flag is used by shopthanks to
' force calculation so it can be stored in the orders table
' Oct 2, 2004     use shopopendatabaseP
'*************************************************************
Sub shopaffcommission (dbcorders, objrs, affid, commrate, commission, calculated, forceflag)
dim totalamount, totalshipping, processed, totaltax
totalamount=0
totalshipping=0
totaltax=0
commission=0
' Get commission from orders record. It may or may not exists
commission=objrs("commission")
If isnull(commission) then
  commission=0
end if  
calculated=true
if isnull( objrs("orderamount")) then
   exit sub
end if
totalamount=objrs("orderamount")
totalshipping=objrs("oshipcost")
totaltax=objrs("otax")
processed=objrs("oprocessed")
' in shopthanks we always want to calculate commission
' They set forceflag=true
If forceflag=False then
  If getconfig("affCommissionIncludesAllOrders")="No" then
     if processed=0 then
        calculated=false
        commission=0
        exit sub
     end if
  end if
end if
' if commission is already in orders record, no need to recalculate
If forceflag=false and commission>0 then
      calculated=true
      exit sub
end if   
'VP-ASP 6.50 - updated logic
If getconfig("affCommissionIncludesShipping")="No" then
    Dim taxrate
    Dim taxincl
    Dim shipexcl
    if getconfig("xtaxincludedinprice") = "Yes" Then
        taxrate=totaltax/(totalamount-totaltax)
        taxincl = 1 + taxrate
       
        shipexcl = totalshipping/taxincl
        totalamount = totalamount - shipexcl - totaltax

        if totalamount<0 then
           totalamount=0
        end if
    else
   totalamount=totalamount-totalshipping
   totalamount=totalamount-totaltax
   if totalamount<0 then
       totalamount=0
   end if
end if
end If
If Getconfig("affcommissioncategory")="Yes" then
   calculatecategoryCommission dbcorders, objrs, commission
   exit sub
end if
If Getconfig("affcommissionProduct")="Yes" then
   calculateProductCommission dbcorders, objrs, commission
   exit sub
end if
'debugwrite "tot=" & totalamount & " rate=" & commrate 
if commrate>1 then
         commrate=commrate/100.00
end if
commission=totalamount*commrate
end sub

Sub CalculatecategoryCommission (dbcorders,objrs, totcommission)
'*****************************************************************
' affcommissioncategories has a list as 
' affcommissioncategories="1,2,3,6=.20;4,5=.10"
'****************************************************************
dim dbc, amount, commission, orderid, catalogid, rs, unitprice, quantity
Affcategories=getconfig("affcommissioncategories")
if affcategories="" then exit sub
'
shopopendatabaseP dbc                 ' Oct 2 fix
dim i, categoryid
If categorycount=0 then
   parsecategories
end if
orderid=objrs("orderid")
sql="SELECT * from oitems where orderid=" & orderid
set rs=dbcorders.execute(sql)
do while not rs.eof
   unitprice=rs("unitprice")
   quantity=rs("numitems")
   catalogid=rs("catalogid")
   GetProductcategory dbc, catalogid, categoryid
   amount=quantity*unitprice
   commission=0
   GetproductCommission categoryid,amount,  commission
   totcommission=totcommission+commission
   rs.movenext
loop
closerecordset rs
shopclosedatabase dbc
'debugwrite "total commission=" & totcommission
end sub

Sub GetproductCommission (categoryid, amount, commission)
'debugwrite "cat=" & categoryid & " amount=" & amount
dim commrate
commission=0
dim i
if categoryid=""  then
   exit sub
else
   categoryid=clng(categoryid)   
end if   
for i = 0 to categorycount-1
 '  debugwrite "matching cat=" & categoryid & " table=" & categoryrates(0,i)
   if categoryid=categoryrates(0,i) then
      commrate=categoryrates(1,i)
      commission=commrate*amount
  '    debugwrite "cat=" & categoryid & "amount=" & amount & "commrate=" & commrate & "commission=" & commission
      exit sub
   end if
next      
end sub

Sub ParseCategories
dim words(10), wordcount, i, tempcount, catlist(5)
parserecord affcategories, words, wordcount,";"
for i = 0 to wordcount-1
    parserecord  words(i),catlist,tempcount,"="
    If tempcount<>2 then
        response.write " invalid category list " & words(i)
        exit sub
    end if    
' pass list and commission rate    
    processcategorylist catlist(0), catlist(1)
next
'for i = 0 to categorycount-1
'   debugwrite "cat=" & categoryrates(0,i)  & " rate=" &  categoryrates(1,i) 
'next     
end sub
sub ProcessCategoryList (catlist, commrate)
' list is 3,4,6
dim words(100), wordcount, i
parserecord catlist, words,wordcount,","
for i = 0 to wordcount-1
   categoryrates(0,categorycount)=clng(Words(i))
   categoryrates(1,categorycount)=commrate
   categorycount=categorycount+1
next       
end sub

Sub GetProductcategory (dbc, catalogid, categoryid)
dim psql, prs
psql="select * from products where catalogid=" & catalogid
set prs=dbc.execute(psql)
if not prs.eof then
   categoryid=prs("ccategory")
else
   categoryid=""
end if
closerecordset prs      
end sub
'
Sub calculateProductCommission (dbcorders,objrs, totcommission)
dim orderid, sql, rs, unitprice,quantity, catalogid
dim commission
commission=0
dim affcommissionfield
affcommissionfield=getconfig("AffCommissionproductfield")
If affcommissionfield="" then exit sub
shopopendatabaseP dbc             ' Oct 2 fix
orderid=objrs("orderid")
sql="SELECT * from oitems where orderid=" & orderid
set rs=dbcorders.execute(sql)
do while not rs.eof
   unitprice=rs("unitprice")
   quantity=rs("numitems")
   catalogid=rs("catalogid")
   GetProductcommissionField dbc, catalogid, affcommissionfield, commission
    If commission>=1 then
      commission=commission*quantity
   else
       commission=commission*quantity*unitprice
   end if
   totcommission=totcommission+commission      
   rs.movenext
loop
closerecordset rs
shopclosedatabase dbc
'debugwrite "total commission=" & totcommission
end sub
'*********************************************************************
' Get commission from product field
'********************************************************************
sub  GetProductcommissionField (dbc, catalogid, fieldname, commission)
dim psql, prs, tcom
psql="select * from products where catalogid=" & catalogid
set prs=dbc.execute(psql)
if not prs.eof then
   tcom=prs(fieldname)
   if not isnull(tcom) then 
      if isnumeric(tcom) then
         tcom=csng(tcom)
         commission=tcom
      end if
   end if
end if         
closerecordset prs      
end sub
Sub shopaffcommissionMaster (dbcorders, objrs, affid, commrate, commission, calculated, forceflag)
dim totalamount, totalshipping, processed, totaltax
totalamount=0
totalshipping=0
totaltax=0
commission=0
' Get commission from orders record. It may or may not exists
If isnull(commission) then
  commission=0
end if  
calculated=true
if isnull( objrs("orderamount")) then
   exit sub
end if
totalamount=objrs("orderamount")
totalshipping=objrs("oshipcost")
totaltax=objrs("otax")
processed=objrs("oprocessed")
if commrate>1 then
    commrate=commrate/100.00
end if
' in shopthanks we always want to calculate commission
' They set forceflag=true
If forceflag=False then
  If getconfig("affCommissionIncludesAllOrders")="No" then
     if processed=0 then
        calculated=false
        commission=0
        exit sub
     end if
  end if
end if
' if commission is already in orders record, no need to recalculate
If forceflag=false and commission>0 then
      getMasterCommission commission, commrate
      calculated=true
      exit sub
end if   
If getconfig("affCommissionIncludesShipping")="No" then
   totalamount=totalamount-totalshipping
   totalamount=totalamount-totaltax
   if totalamount<0 then
       totalamount=0
   end if
end if
If Getconfig("affcommissioncategory")="Yes" then
   calculatecategoryCommission dbcorders, objrs, commission
   getMasterCommission commission, commrate
   exit sub
end if
If Getconfig("affcommissionProduct")="Yes" then
   calculateProductCommission dbcorders, objrs, commission
   getMasterCommission commission, commrate
   exit sub
end if
'debugwrite "tot=" & totalamount & " rate=" & commrate 
commission=totalamount*commrate
end sub
' For masters. the commission is a percentage of the
' sub affiliates
Sub  GetMasterCommission (commission, commrate)
  commission=commission*commrate
end sub
%>