<%option explicit%> <% shopcheckadmin "shopa_displayorders.asp" setsess "currenturl","shopa_rma.asp" '************************************************ ' VP-ASP 6.50 ' Form RMA ' Allow merchant to change status, email customer ' input rmaid=xx ' Nov 23, 2006 HK Created ' Dec 6, 2006 Remove arrayemailist '************************************************ Dim sAction, oid, myconn dim my_to, my_toaddress,my_system,my_from,my_fromaddress,my_subject,mailtype dim mailer, my_attachment dim body dim rmaid, rmars dim trackingemail, trackingname, trackingcomment, trackingtemplate dim trackingview dim merchantactions(50), statuslist, actioncount 'VP-ASP 6.50 - removed and put into shopmail.asp 'dim arrayemaillinkscount 'dim arrayemaillinks(50,2) dim currentvalues(10), currentvaluecount dim rc, actionvalue, rmatemplate dim updateflag rmaid=request("rmaid") if rmaid > "" then if not isnumeric(rmaid) then shoperror "rmaid must be numeric" end if else shoperror "RMA not found" end if Openorderdb myconn GetRMARecordset myconn, rmaid, rmars, rc ' GET RMA Details in shoprmasuubs If rc>0 then shopclosedatabase myconn shoperror "RMA not found" else Setuprmavalues rmars 'in shoprmasubs oid=rmaorderid end if sAction=Request("Action") Serror="" adminPageHeader statuslist=getconfig("xrmamerchantactions") If statuslist="" then actioncount=0 else parserecord statuslist,merchantactions,actioncount,"," end if If sAction = "" Then DisplayForm() Else ValidateData() if sError = "" Then PerformRequiredActions Showrmadetails else DisplayForm end if end if ShopCloseDatabase myconn gethelp adminpagetrailer ' Sub DisplayForm() generatedisplayheader getlang("langrma") & " Merchant response" Generatedisplaybodyheader if sError > "" then shopwriteerror "" & sError & "" end if response.write "" & vbcrlf Response.write "" GenerateDisplayBodyFooter ShowRmaDetails End Sub '***************************************************************************** ' generate a set of links then display the actual rma '**************************************************************************** Sub ShowRmaDetails GenerateDisplayHeaderFlat GenerateDisplayBodyHeader GenerateLinks ' links to other files GenerateDisplayBodyFooter ' generatedisplayheader getlang("langrma") Generatedisplaybodyheader FormatRmaMerchant rmars ' format rma recordin shoprmasubs.asp GenerateDisplayBodyFooter end sub '*************************************************************************** ' There are two portions. Left side are action boxes ' Right side are input text boxes '************************************************************************** Sub DisplayRmaoptions response.write "" & vbcrlf response.write "" & vbcrlf response.write "" & vbcrlf response.write "

" DisplayRmAActions Response.write "

" DisplayRmaTextboxes Response.write "

" & vbcrlf end sub Sub DisplayRmaActions currentvaluecount=0 Response.write "" & vbcrlf DisplayCheckbox "actionvalue","email","Email Customer", currentvalues, currentvaluecount If getconfig("xgiftcertificates")="Yes" then DisplayCheckbox "actionvalue","gift","Send Gift certificate to customer", currentvalues, currentvaluecount end if If getconfig("xtracking")="Yes" then DisplayCheckbox "actionvalue","track","Add message to tracking", currentvalues, currentvaluecount end if DisplayCheckbox "actionvalue","update","Update RMA only", currentvalues, currentvaluecount Response.write "

" & vbcrlf end sub sub DisplayCheckbox (fieldname, fieldvalue, caption, currentvalues, currentvaluecount) dim i, checkvalue, selected for i =0 to currentvaluecount-1 checkvalue=currentvalues(i) if fieldvalue<>"" and checkvalue=fieldvalue then selected=" checked" else selected="" end if next response.write "" & vbcrlf response.write "" & vbcrlf response.write "" & caption & "" & vbcrlf response.write "" & vbcrlf end sub '****************************************************************************** ' actual form the merchant can enter ' Their action ' refund amount ' name and email address '***************************************************************************** Sub DisplayRmaTextboxes Response.write "" & vbcrlf Response.write "" & vbcrlf CreateCustRow getlang("LangYourName"),"rmamerchantname",rmamerchantname, "" If isnull(rmamerchantemail) then rmamerchantemail=getconfig("xemail") end if CreateCustRow getlang("LangYourEmail"),"rmamerchantemail",rmamerchantemail, getconfig("xemailaddress") if rmatemplate="" then rmatemplate=getconfig("xrmacustomerfrommerchanttemplate") end if CreateCustRow getlang("LangProductTemplate"),"rmatemplate",rmatemplate, "" CreateCustRow "Refund Amount","rmarefundamount",rmarefundamount, "" response.write "" & vbcrlf response.write "" & vbcrlf response.write "" & vbcrlf response.write "" & vbcrlf response.write "

" & "Merchant Action" & vbcrlf response.write "	" GenerateSelectNV merchantactions,rmamerchantaction,"rmamerchantaction", actioncount, Getlang("langcommonselect") Response.write "
" & "Merchant Response" & "	" & rmamerchantcomment & "
" & "Private Notes" & "	" & rmamerchantnotes & "

" & vbcrlf end sub Sub ValidateData() actionvalue=request.form("actionvalue") rmatemplate=request.form("rmatemplate") if actionvalue="" then sError = sError & "Action" & " " & getlang("Langcustrequired") & "
" end if RmaGetFormvalues ' in shoprmasubs If rmamerchantaction=getlang("langcommonselect") then sError = sError & "Merchant Action" & " " & getlang("Langcustrequired") & "
" end if If rmamerchantname="" then sError = sError & getlang("LangYourName") & getlang("Langcustrequired") & "
" end if If rmamerchantcomment="" then sError = sError & "Merchant Response" & getlang("Langcustrequired") & "
" end if If rmatemplate="" then sError = sError & getlang("LangExdNoTemplate") & "
" else ValidateTemplate rmatemplate end if If rmarefundamount<>"" then if not isnumeric(rmarefundamount) then sError = sError & "Refund amount is not numeric" & "
" end if end if end sub ' Sub WriteInfo 'VP-ASP 6.09 -removed page=1 from below URL to stop errors if shopa_displayorders.asp hasn't been previously visited %>

<%=getlang("langcommoncontinue")%>

<% end sub ' Sub SendTrackingEmail If trackingemail<>"Yes" Then exit sub ShopTrackingEmailToCustomer myconn, oid, trackingname end sub ' Sub UpdateTrackingRecord dim sql trackingview=1 trackingname=replace(rmamerchantname,"'","''") trackingcomment=replace(rmamerchantcomment,"'","''") 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 & "," & trackingview sql = sql & "," & "'" & rmamerchantemail & "'" sql=sql & ")" 'debugwrite sql myconn.execute(sql) end sub Sub PerformRequiredActions dim actions(10),actioncount, i, action dim certificate parserecord actionvalue, actions, actioncount,"," RmaUpdateMerchant ' update record based on form values For i=0 to actioncount-1 action=lcase(actions(i)) select case action case "email" RMAEmailToCustomerFromMerchant myconn, rmaid case "gift" RmaCreategiftcertificate myconn, rmaid, certificate ' in shoprmasubs.asp RMAMailGiftCertificate certificate ' in shoprmasubs shopwriteheader "Gift Certificate created and mailed" case "update" Shopwriteheader "Record updated" case "track" UpdateTrackingRecord shopwriteheader "Tracking record created" case else response.write "unknown action " & action end select next 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 RMAUpdateMerchant dim fieldnames, fieldvalues, rs dim sql fieldnames="" Updatefieldnum fieldnames, "rmamerchantdate",datedelimit(date) updatefieldtext fieldnames, "rmamerchantname",rmamerchantname updatefieldtext fieldnames, "rmamerchantemail",rmamerchantemail updatefieldtext fieldnames, "rmamerchantaction",rmamerchantaction updatefieldtext fieldnames, "rmamerchantcomment",rmamerchantcomment updatefieldtext fieldnames, "rmamerchantnotes",rmamerchantnotes updatefieldnum fieldnames, "rmarefundamount",rmarefundamount sql="Update shoprma set " & fieldnames sql=sql & " where rmaid=" & rmaid 'debugwrite sql myconn.execute(sql) end sub Sub UpdateFieldnum (fieldnames, fieldname, fieldvalue) dim tempvalue tempvalue=fieldvalue if fieldvalue="" then tempvalue="NULL" end if if fieldnames<>"" then fieldnames=fieldnames & "," end if fieldnames=fieldnames & fieldname & "=" fieldnames=fieldnames & tempvalue end sub Sub Updatefieldtext (fieldnames, fieldname, fieldvalue) dim tempvalue tempvalue=fieldvalue if fieldnames<>"" then fieldnames=fieldnames & "," end if ' if fieldvalue="" then tempvalue="NULL" fieldnames=fieldnames & fieldname & "=" & tempvalue exit sub else tempvalue=replace(tempvalue,"'","''") end if fieldnames=fieldnames & fieldname & "=" fieldnames=fieldnames & "'" & tempvalue & "'" end sub Sub GenerateLinks %> <%If getconfig("xtracking")="Yes" then%> <%end if%>

RMA List

<%=getlang("langcommonedit")%>

<%=getlang("langTracking")%>

<% end sub '*********************************************************************** ' See if template really exists '********************************************************************** sub Validatetemplate (filename) dim fso, myfile, whichfile whichfile=server.mappath(filename) Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(whichfile) Then else serror=serror & "File not found" & "
" end if set fso=nothing end sub %>