<%
'*******************************************************
' VP-ASP 6.50 Points subroutines
' Add end of order checks
' Aug 16,2004 xpointsequalcurrency=Yes
' Sept 18, 2004 support split products database
'*******************************************************
'*********************************************************
' Assign points to order 
' only assign points to customer if they meet valid order requirement
'*******************************************
Sub Generatepoints (orderconn, orderid)
dim customerid, pointstotal, rc, orderrs, msg, rcpoints
If getconfig("xpoints")<>"Yes" then exit sub
CheckusingPoints rcpoints
If rcpoints=0 then
   pointstotal=0
   GetProductpoints orderconn, orderid, pointstotal, customerid
   If pointstotal>0 then
     InternalOpenOrder myconn, OrderRs, orderid
     ValidatePurchase OrderRS, rc
     Closerecordset orderRS
     If rc=0 then
      Addcustomerpoints customerid, pointstotal
      msg=""
     else
       msg=getlang("langpointsremaining") & " " & pointstotal
     end if  
     AddOrderPoints orderconn, orderid, pointstotal, msg
   end if  
end if   
end sub

sub PointsDecrementCustomer  (orderconn, orderid)
dim customerid, pointstotal
pointstotal=0
GetProductpoints orderconn, orderid, pointstotal, customerid
If pointstotal>0 then
   Decrementcustomerpoints customerid, pointstotal
end if
end sub
'*************************************************************
' Get product points
'**************************************************************
Sub GetProductPoints( orderconn, orderid, pointstotal, customerid)  
dim rc, amount, coupondiscount,numItems
dim ProductRS, productdbc
Dim strSQL
dim orderRS
dim productcatalogid, prodpoints, prodquantity, prodpointsredeem
dim prodprice
dim sql
pointstotal=0
sql = "select * from orders where orderid=" & orderid
Set rsorder = orderconn.Execute(SQL)
customerid=rsorder("ocustomerid")   
'VP-ASP 6.00 - needs to take into account coupon discount when calculating points
coupondiscount = rsorder("coupondiscount")
shopopendatabasep productdbc

'VP-ASP 6.00 - needs to take into account coupon discount when calculating points
if coupondiscount > 0 then
	strSQL = "select count(*) as numitems from oitems where orderid = " & orderid
	Set ProductRS = orderconn.Execute(strSQL)   ' 
	numItems = productrs("numitems")
	closerecordset productrs

	coupondiscount = cint(coupondiscount) / cint(numItems)
end if

strSQL = "select * FROM oitems where orderid = " & orderid
Set ProductRS = orderconn.Execute(strSQL)   ' 
Do While Not ProductRS.EOF
     Productcatalogid=productrs("catalogid")
     prodquantity=productrs("numitems")
     prodprice=productrs("unitprice")
	'VP-ASP 6.00 - needs to take into account coupon discount when calculating points
	 if coupondiscount > 0 then
	 	prodprice = prodprice - coupondiscount
	 end if
	 
     If getconfig("xpointsequalcurrency")="Yes" then
       prodpoints=prodprice
     else  
        Getpoints productdbc, Productcatalogid, prodpoints, prodpointsredeem
     end if
     if getconfig("xdebug")="Yes" then    
       debugwrite "catalogid=" & productcatalogid & " points=" & prodpoints
     end if  
     prodpoints=prodpoints*prodquantity
     pointstotal=pointstotal+prodpoints
     ProductRS.MoveNext
Loop
closerecordset productrs
Closerecordset rsorder
shopclosedatabase productdbc
If getconfig("xpointsequalcurrency")="Yes" then
  pointstotal=round(pointstotal,0)
end if   
end sub

'*********************************************************
' Get points for one product
'*********************************************************
sub Getpoints (productdbc, Productcatalogid, prodpoints, prodpointstobuy)
prodpoints=0
prodpointstobuy=0
dim psql, rs, pointsfield
pointsfield="points"
psql="select * from products where catalogid=" & productcatalogid
set rs=productdbc.execute(psql)
if not rs.eof then
   prodpoints=rs(pointsfield)
   if isnull(prodpoints) then
      prodpoints=0 
   end if
   prodpointstobuy=rs("pointstobuy")
   if isnull(prodpointstobuy) then
      prodpointstobuy=0 
   end if
end if
closerecordset rs
If not isnumeric(prodpoints) then
   prodpoints=0
end if
prodpoints=clng(prodpoints)
end sub
'
'****************************************************
' add points to customer record
'******************************************************
Sub AddCustomerPoints (customerid, pointstotal)
dim custdbc, sql, pointsremaining, custpointstotal, rs
Opencustomerdb custdbc
Sql="select * from customers where contactid=" & customerid
set rs=custdbc.execute(sql)
If rs.eof then
    Closerecordset rs
    shopclosedatabase custdbc
    exit sub
end if
pointsremaining=rs("pointsremaining")
custpointstotal=rs("pointstotal")
If isnull(pointsremaining) then
   pointsremaining=0
end if       
If isnull(custpointstotal) then
   custpointstotal=0
end if       
closerecordset rs
custpointstotal=custpointstotal+pointstotal
pointsremaining=pointsremaining+pointstotal
sql="update customers set pointstotal=" & custpointstotal
sql=sql & ",pointsremaining=" & pointsremaining
sql=sql &  " where contactid=" & customerid
'debugwrite sql
custdbc.execute(sql)
shopclosedatabase custdbc
end sub
'*******************************************************
' remove points from customer record
'********************************************************
Sub DecrementCustomerPoints (customerid, pointstotal)
dim custdbc, sql, pointsremaining, rs
Opencustomerdb custdbc
Sql="select * from customers where contactid=" & customerid
set rs=custdbc.execute(sql)
If rs.eof then
    Closerecordset rs
    shopclosedatabase custdbc
    exit sub
end if
pointsremaining=rs("pointsremaining")
If isnull(pointsremaining) then
   pointsremaining=0
end if       
closerecordset rs
pointsremaining=pointsremaining-pointstotal
sql="update customers set pointsremaining=" & pointsremaining
sql=sql & " where contactid=" & customerid
custdbc.execute(sql)
end sub

'************************************************************
' Get number of points for a customer
'*************************************************************
Sub GetCustomerpoints (customerid, pointstotal, pointsremaining)
dim custdbc, sql, rs
pointstotal=0
pointsremaining=0
Opencustomerdb custdbc
Sql="select * from customers where contactid=" & customerid
set rs=custdbc.execute(sql)
If rs.eof then
    Closerecordset rs
    shopclosedatabase custdbc
    exit sub
end if
pointstotal=rs("pointstotal")
pointsremaining=rs("pointsremaining")
If isnull(pointstotal) then
   pointstotal=0
   pointsremaining=0
end if       
closerecordset rs
shopclosedatabase custdbc
end sub

'***************************************************
' Display customer points
'**************************************************
Sub PointsDisplay (customerid)
If getconfig("xpoints")<>"Yes" then exit sub
dim pointstotal, pointsremaining
GetCustomerpoints customerid, pointstotal, pointsremaining
response.write ReportTableDef
response.write ReportHeadRow 
Response.write ReportHeadColumn & getlang("LangPointsTotal") & ReportHeadColumnEnd
Response.write ReportHeadColumn & getlang("LangPointsRemaining") & ReportHeadColumnEnd
response.write ReportRowEnd
response.write ReportDetailRow
response.write ReportDetailColumn & "<p class=""ar"">" & pointstotal & "</p>" & ReportDetailcolumnEnd 
response.write ReportDetailColumn & "<p class=""ar"">" &  pointsremaining & "</p>" & ReportDetailcolumnEnd 
response.write "</tr>"
response.write "</table>"
end sub

Sub AddOrderPoints (orderconn, orderid, pointstotal,msg)
dim sql
sql="update orders set opoints=" & pointstotal
If msg<>"" then 
   sql=sql & ",other1='" & msg & "'"
end if   
sql=sql &  " where orderid=" & orderid
'debugwrite sql
orderconn.execute(sql)
end sub

'******************************************************
' See if customer can order from points
'*******************************************************
Sub PointsVerifyOrder
dim cartcount, dbc, prodpoints, prodpointstobuy, pointsremaining
dim arrcart, prodid,i
If Getconfig("xpointsredeem")="No" then exit sub
If getsess("PointsOrder")<>"Yes" then exit sub
if getsess("pointsremaining")="" then exit sub
pointsremaining=getsess("pointsremaining")
pointsremaining=clng(pointsremaining)
cartcount = GetSess("CartCount")
If cartcount> 1 then
   Shoperror "Points can be redeemed for only one product at a time"
end if
shopopendatabase dbc
arrCart = GetSessA("CartArray")
' go through all products
i = 1 
prodid=arrCart(cProductid,i)
Getpoints dbc, Prodid, prodpoints, prodpointstobuy
shopclosedatabase dbc
If prodpointstobuy=0 then
   Shoperror "Product cannot be bought with points"
end if   
If pointsremaining<prodpointstobuy then
   Shoperror "Product requires " & prodpointstobuy & " and you have " & pointsremaining
end if   
end sub

Sub HandlePointsOrder
dim cartcount, dbc, prodpoints, prodpointsredeem
dim orderconn, orderid, arrcart, ordertotal
dim prodprice,prodquantity, pointsremaining,i, strsql
If Getconfig("xpointsredeem")="No" then exit sub
If getsess("PointsOrder")<>"Yes" then exit sub
if getsess("pointsremaining")="" then exit sub
pointsremaining=getsess("pointsremaining")
pointsremaining=clng(pointsremaining)
openorderdb orderconn
orderid=getsess("Oid")
PointsDecrementCustomer  orderconn, orderid
i=1
arrCart = GetSessA("CartArray")
ProdPrice=arrCart(cUnitPrice, i)
Prodquantity=arrCart(cQuantity,i)
Prodprice=Prodprice*Prodquantity
ordertotal=getsess("ordertotal")
ordertotal=ordertotal-prodprice
If ordertotal<0 then
   ordertotal=0
end if
setsess "ordertotal",ordertotal
Strsql="Update orders set orderamount=" & ordertotal
strsql=strsql & ",giftcertificate='" & getlang("Langpoints") &"'" & " where orderid=" & getsess("oid")
debugwrite strsql
orderconn.execute(Strsql)
shopclosedatabase orderconn
end sub
'********************************************************
' if points are used for gift certificate or coupon.
' dont give points
'*********************************************************
Sub Checkusingpoints (rc)
rc=0
dim coupon, gift, pos
dim langpoints
langpoints=trim(getlang("langpoints"))
langpoints=lcase(langpoints)
coupon=getsess("coupon")
If coupon<>"" then 
  pos=instr(lcase(coupon),langpoints)
  if pos>0 then
     rc=4
     exit sub
  end if
end if
gift=GetSess("Giftcertificate")
if gift="" then exit sub
pos=instr(lcase(gift),langpoints)
if pos>0 then
    rc=4
   exit sub
end if
end sub
%>