<%option explicit%>
<%
const rmaallowupdates="No"
setsess "currenturl","shoprma.asp"
'************************************************
' VP-ASP 6.50 Return Merchnadise Auuthorization.
' Verify order and order item oid=, item=
' Validate it belongs to this customer
' If the RMA exists just display it
' otherwise
' Generate a form
' Send mail to both merchant and customer
' optionally add a record to the tracking table
' Update shoprma table
' If rm
' Nov 22, 2006 HK Created
''************************************************
dim customerid
Dim sAction, oid, myconn, itemid
dim my_to, my_toaddress,my_system,my_from,my_fromaddress,my_subject,mailtype
dim mailer, my_attachment, emailformat
dim body
dim trackingemail, trackingname, trackingcomment, trackingtemplate
dim radioarray(10), radiocount, radiovalues(10), captioncount
dim orderdate
dim rma, rmaid, existingrma
'
CustCheckAdmin customerid ' verify customer is logged in
If getconfig("Xrmaallowed")<>"Yes" Then
shoperror getlang("LangCustNotAllowed") ' rmas not allowed
end if
'
'*****************************************************************************
' main program logic here
'****************************************************************************
ShopPageHeader
if getconfig("xbreadcrumbs") = "Yes" then
response.write "" & vbCrLf
end if
Response.Write "" & getlang("langrma") & "
" & vbCrLf
Openorderdb myconn ' Open order database
InitializeProgram ' verify all input values
If Serror<>"" Then ' was there an error
DisplayRmaerrors ' there were errors
else
ProcessRma ' display form for customer or process form
end if
shopclosedatabase myconn ' close database
shoppagetrailer ' put out html footer
'********************************************************************
' verify orderid and itemid
' For existing RMA we do not allow duplications
'********************************************************************
Sub InitializeProgram
dim rc
existingrma=false ' assume no existing rma
Oid=request("oid") ' get orderid
itemid=request("itemid") ' get itemid
If not isnumeric(oid) then
serror=serror & getlang("LangOrderNone") & "
"
else
If itemid<>"" then
If not isnumeric(itemid) then
serror=serror & getlang("LangOrderNone") & "
"
end if
end if
end if
' if there were no errors in above checks
If serror="" then
locateorder oid, customerid ' see if this order belongs to this customer
If serror="" then
LocateExistingRma rc ' see if existing rma
If rc=0 then ' rc=0 means existing rma
existingrma=true
else
VerifyReturndates ' verify we can create rma based on dates
end if
end if
end if
end sub
'***********************************************************************************
' basic validation of input has been done
' If we have not processed anything then put ourt a form
' if the person has selected an option then do the updating and emailing
'**********************************************************************************
Sub ProcessRMA
sAction=Request("Action") ' was form button pressed
If sAction="" then
sAction=Request("Action.x")
end if
Serror=""
If sAction = "" Then
If existingRma=true then
Formatexistingrma ' format it
If rmaAllowupdates="Yes" then
DisplayForm
end if
else
DisplayForm ' first time, display form
end if
Else
ValidateData() ' validate form data
if sError = "" Then
CreateRMARecord ' create RMA record
UpdateTrackingRecord ' create tracking record
SendTrackingEmail ' send emails to merchant
else
DisplayForm ' display the form again
end if
end if
Writeinfo ' write information message
end sub
'
'************************************************************************
' make sure this order belongs to this customer
'***********************************************************************
Sub LocateOrder (oid, cid)
dim strsql, orders
strsql = "select * from orders where orderid=" & oid & " AND ocustomerid=" & cid
set Orders=myconn.execute(strsql)
If Orders.eof then
serror=serror & getlang("LangOrderNone") & "
"
else
rmacustomeremail=orders("oemail") ' default customer email
rmacustomername=orders("ofirstname") & " " & Orders("olastname")
orderdate=orders("odate") ' get order date
end if
closerecordset orders
end sub
'
'************************************************************************
' now display form so customer can actually submit an RMA
' name, email address, request and comment
'***********************************************************************
Sub DisplayForm()
If sError <> "" Then shopwriteerror sError
shopwriteheaderpic getlang("LangTrackingPrompt"), "images/icons/mail.gif"
Response.Write("")
End Sub
'*********************************************************************************
' from form we get orderid, itemid
Sub ValidateData()
RmaGetFormvalues ' in shoprmasubs.asp form values
if rmacustomername="" then ' name is required
sError = sError & getlang("LangYourName") & " " & getlang("Langcustrequired") & "
"
end if
If rmacustomeremail="" then ' email is required
sError = sError & getlang("LangLoginEmail") & " " & getlang("Langcustrequired") & "
"
end if
If rmacustomercomment="" then
sError = sError & getlang("LangOrderComments") & " " & getlang("Langcustrequired") & "
"
end if
If rmacustomeraction="" then
sError = sError & getlang("langrmaaction") & " " & getlang("Langcustrequired") & "
" & vbcrlf
end if
end sub
'********************************************************************************
' RMA has been created
'*******************************************************************************
'
Sub WriteInfo
Response.write "" & getlang("langcommoncontinue") & "
" & vbcrlf
If getconfig("xtracking")="Yes" and getconfig("xtrackingcustomerwrite")="Yes" then
Response.write "" & getlang("Langtracking") & "
" & vbcrlf
end if
end sub
'
'*******************************************************************************
' send confirmation both to merchant and customer
'******************************************************************************
Sub SendTrackingEmail
ShopRMAEmailToMerchant myconn, oid, rmaid
ShopRMAEmailToCustomer myconn, oid, rmaid
end sub
'
'******************************************************************************
' take Rma request and add to tracking table
'******************************************************************************
Sub UpdateTrackingRecord
dim sql, trackview
If getconfig("xtracking")="No" then exit sub
trackview=1
trackingname=replace(rmacustomername,"'","''")
trackingcomment=replace(rmacustomercomment,"'","''")
trackingcomment=getlang("LangRMA") & " " & rma & " " & getlang("langproductorderNumber") & " " & oid & " " & trackingcomment
stremail=replace(rmacustomeremail,"'","")
sql="insert into ordertracking (orderid, trackdate, tracktime,trackcomment, trackname,trackview, trackemail) values ("
sql= sql & oid & "," & datedelimit(date())
sql= sql & "," & timedelimit(time())
sql = sql & "," & "'" & trackingcomment & "'"
sql = sql & "," & "'" & trackingname & "'"
sql = sql & "," & trackview
sql = sql & "," & "'" & stremail & "'"
sql=sql & ")"
myconn.execute(sql)
end sub
'*******************************************************************************
' if merchant allows rma options, generate radio buttons for these
'*******************************************************************************
Sub WriteRmaOptions
dim currentvalue, selectname, firstfield, optionlist, captionlist
selectname="rmacustomeraction"
currentvalue=rmacustomeraction
firstfield=""
optionlist=getconfig("xrmacustomeractions")
captionlist=getconfig("xrmacustomeractionscaptions")
if optionlist="" then exit sub
parserecord optionlist, radiovalues, radiocount,","
parserecord captionlist, radioarray, captioncount,","
Response.write tableRow & "
"
Createradiolist selectname,currentvalue,radiovalues, radiocount, radioarray
Response.write tablecolumnend & tablerowend
end sub
'********************************************************************************
' the following function provided by hk programming
'********************************************************************************
function CreateRadioList (fieldname, fieldvalue, listarray, listcount, captions)
dim i, selected
dim radiovalue, radiotext, caption
%>
")
end function
'******************************************************************************
' global return period and product specific return periods
' There is cannot be returned
' If global return period is 0 or product return period is 0
' goods cannot be returned
'******************************************************************************
sub VerifyReturndates
dim storedays, intdays, conn, storedate
dim i, cartcount, cartarray, productid, productarray, productarraycount, rc
dim itemrs, itemsql, mininame
storedays=getconfig("xrmareturndays") ' number of days from order date to
if storedays<>"" and isnumeric(storedays) then
storedate=clng(storedays)+orderdate
intdays = DateDiff("d", date(), storedate)
If intdays<0 then
Serror=serror & getlang("langrmareturnerror") & " " & storedate & "
"
exit sub
end if
end if
shopopendatabase conn
' Go through all products that are in array and check rma days
itemsql="Select * from oitems where orderid=" & oid
set itemrs=myconn.execute(itemsql)
do while not itemrs.eof
productid=itemrs("catalogid")
mininame=itemrs("itemname")
CheckProductrma conn, productid, mininame, rc
itemrs.movenext
loop
shopclosedatabase conn
end sub
'*****************************************************************************
' certain items cannot be returned such as items not in database
' Exceed return date
' gift certificates and projects are examples of items not in database
'*****************************************************************************
Sub CheckProductrma (conn, catalogid, mininame, rc)
dim sql, rs, storedate, rmadays, intdays
rc=4
if clng(catalogid)=clng(getconfig("xgiftproductid")) then
Serror = serror & Getlang("langgiftcertificates") & "
" & Getlang("langrmacannotbereturned") & "
"
exit sub
end if
if clng(catalogid)=clng(getconfig("xprojectcatalogid")) then
Serror = serror & mininame & "
" & Getlang("langrmacannotbereturned") & "
"
exit sub
end if
sql="select * from products where catalogid=" & catalogid
'debugwrite sql
set rs=conn.execute(sql)
if rs.eof then
closerecordset rs
rc=0
exit sub
end if
rmadays=rs("rmadays")
if isnull(rmadays) then
rc=0
exit sub
end if
If rmadays=0 then
Serror = serror & mininame & "
" & Getlang("langrmacannotbereturned") & "
"
exit sub
end if
storedate=clng(rmadays)+orderdate
intdays = DateDiff("d", date(), storedate)
'debugwrite "intdays=" & intdays
If intdays<0 then
Serror=serror & mininame & "
" & Getlang("langrmacannotbereturned") & " " & storedate & "
"
exit sub
end if
rc=0
end sub
Sub Displayrmaerrors
shopwriteerror serror
serror=""
end sub
'****************************************************************************
' create rma record and insert it into database
' first put fields into database
' then use the rmaid to generate the ramid to make it unique
' update the created record with the actual rma
'****************************************************************************
Sub CreateRMARecord
dim fieldnames, fieldvalues, rs
dim sql
If itemid<>"" then
RmaGetProductname myconn, itemid, rmaproductname
end if
Createfieldnum fieldnames, fieldvalues, "rmacreationdate",datedelimit(date)
Createfieldnum fieldnames, fieldvalues, "rmaorderid",oid
Createfieldnum fieldnames, fieldvalues, "rmaitemid",itemid
Createfieldtext fieldnames, fieldvalues, "rmaproductname",rmaproductname
Createfieldtext fieldnames, fieldvalues, "rmacustomername",rmacustomername
Createfieldtext fieldnames, fieldvalues, "rmacustomeremail",rmacustomeremail
Createfieldtext fieldnames, fieldvalues, "rmacustomeraction",rmacustomeraction
Createfieldtext fieldnames, fieldvalues, "rmacustomercomment",rmacustomercomment
Createfieldnum fieldnames, fieldvalues, "rmacustomerid",customerid
sql="insert into shoprma (" & fieldnames & ") "
sql=sql & " values (" & fieldvalues & ")"
'debugwrite sql
myconn.execute(sql)
sql="select max(rmaid) from shoprma where rmaorderid=" & oid
set rs=myconn.execute(sql)
if not rs.eof then
rmaid=rs(0)
end if
closerecordset rs
rma=getconfig("xrmaprefix") & "-" & oid & "-" & rmaid
sql="update shoprma set rma='" & rma & "'" & " where rmaid=" & rmaid
myconn.execute sql
end sub
Sub Createfieldnum (fieldnames, fieldvalues, fieldname, fieldvalue)
if fieldvalue="" then exit sub
if fieldnames<>"" then
fieldnames=fieldnames & ","
fieldvalues=fieldvalues & ","
end if
fieldnames=fieldnames & fieldname
fieldvalues=fieldvalues & fieldvalue
end sub
Sub Createfieldtext (fieldnames, fieldvalues, fieldname, fieldvalue)
dim tempvalue
tempvalue=fieldvalue
if fieldvalue="" then exit sub
tempvalue=replace(tempvalue,"'","''")
if fieldnames<>"" then
fieldnames=fieldnames & ","
fieldvalues=fieldvalues & ","
end if
fieldnames=fieldnames & fieldname
fieldvalues=fieldvalues & "'" & tempvalue & "'"
end sub
'*************************************************************************
' see if rma already exists
' If it does then format it but do not allow duplicates
'
'************************************************************************
Sub LocateExistingRma (rc)
dim rs, sql, tempid, rmaitemid
dim found
rc=4
if itemid<>"" then
itemid=clng(itemid)
end if
sql="select * from shoprma where rmaorderid=" & oid
set rs=myconn.execute(sql)
do while not rs.eof
rmaitemid=rs("rmaitemid") ' is there an item
if isnull(rmaitemid) then rmaitemid=0
if itemid="" then
If rmaitemid=0 then
rmaid=rs("rmaid") ' existing record
closerecordset rs
rc=0 ' found existing
exit sub
end if
else
if itemid=rmaitemid then
rc=0
rmaid=rs("rmaid") ' existing record
closerecordset rs
exit sub
end if
end if
rs.movenext
loop
closerecordset rs
rc=4 ' nothing found
end sub
'*************************************************************************
' formatting is done via templates
' tmp_c=rmacustomerformat.htm
' continue back to shopstatus
' or allow customer to write a tracking message
'*************************************************************************
Sub FormatexistingRma
dim rc, rmars
GetRmaRecordset myconn, rmaid, rmars, rc ' get this rma record
FormatRmaCustomer rmars ' in shoprmasubs.asp
closerecordset rmars
end sub
%>
|