<%
ShopCheckAdmin "shopa_reports.asp"
'***********************************************************
' Version 4.00 Nov 17, 2001
' Sales Reports
'*************************************************************
Dim dbtable
Dim fields(10)
Dim CapFields(10)
dim fieldcount
Dim File
Dim ScriptResponder
Dim Dbc
dim Action
dim fromdate
dim todate
dim datedelim
Dim rs
Dim Limit
Dim Month
Dim Year
'dim database
scriptresponder="shopa_formatorder.asp"
mypagesize=GetSess("ReportLimit")
mypage=request("Page")
if mypage<>"" then
sql=GetSess("Sqlquery") ' on recursive calls we stored sql in sessikon variable
fromdate=GetSess("Fromdate")
todate=GetSess("Todate")
WriteReport
else
GetInput
If Action = "" or Serror<>"" Then
DisplayForm
Else
GenerateSQL
WriteReport
end if
End If
'********************************
Sub GetInput
Serror=""
dbtable="Orders"
limit=request("Limit")
if limit="" then
limit=100
end if
SetSess "ReportLimit",limit
mypagesize=limit
action=""
GetActionValues
If action<> "" then
GetDateValues
end if
end sub
'
Sub GetActionValues
action=request("summary")
if action<>"" then
action="SUMMARY"
else
action=request("Details")
if action<>"" then
action="DETAILS"
end if
end if
end Sub
'
Sub GetDateValues
dim datevalue
fromdate=request("fromdate")
todate=request("todate")
If fromdate<>"" then
if todate="" then
todate=date()
end if
ValidateDates
exit sub
end if
' Try month
Month=Request("month")
Year=Request("Year")
If month>"0" then
FormatMonth
exit sub
end if
If Year>"0" then
FormatYear
exit sub
end if
' Try Radio Buttons
datevalue=request("DateSelect")
datevalue=ucase(datevalue)
'debugwrite "datevalue=" & datevalue
if datevalue="" then
Serror=langReportDate
exit sub
end if
If datevalue="TODAY" then
fromdate=date()
todate=date()
exit sub
end if
If datevalue="YESTERDAY" then
fromdate=dateadd("d",-1, date())
todate=fromdate
exit sub
end if
end sub
Sub FormatMonth
If lcase(getconfig("xenvironment"))="chillisoft" then
formatmonthchilli
exit sub
end if
month=cint(month)
if Year="0" then
Year=Datepart("yyyy",date())
else
Year=clng(year)
end if
fromdate= month & "/" & Year
month=month+1
if month = 13 then
month=1
Year=Year+1
end if
Todate= month & "/" & Year
fromdate=cdate(fromdate)
todate=cdate(todate)
todate = dateadd("d",-1, todate)
end sub
'
Sub formatYear
If lcase(getconfig("xenvironment"))="chillisoft" then
formatyearchilli
exit sub
end if
Year=clng(year)
month=1
fromdate= month & "/" & Year
Year=Year+1
Todate= month & "/" & Year
fromdate=cdate(fromdate)
todate=cdate(todate)
todate=dateadd("d",-1,todate)
end sub
'
Sub ValidateDates
If not Isdate(fromdate) then
Serror="
" & LangReportInvalidDate & fromdate
end if
If not Isdate(todate) then
Serror="
" & LangReportInvalidDate & todate
end if
end sub
Sub GenerateSQL
dim datesql
Dim newsql
mypage=1 ' first time through
Sql="select * from orders where "
datesql = " odate>= " & DateDelimit(fromdate)
datesql = datesql & " AND odate<= " & datedelimit(todate)
sql = sql & datesql
newSql= replace (SQL, ".", "/")
Sql=NewSql
SetSess "Fromdate",fromdate
SetSess "todate",Todate
if Getconfig("xdebug")="Yes" then
debugwrite sql
end if
end sub
'
Sub WriteReport
' Generate table
AdminPageHeader
OpenOrderDB dbc
ShopOpenRecordSet SQL,RS, mypagesize, mypage
Response.write "
" & ReportinfoFont & LangReport01 & fromdate & " to " & todate & "
" & reportinfofontend
if rs.eof then
Response.write "" & Getconfig("xfont") & "
" & LangReportNoSales & ""
else
If Action="SUMMARY" then
ProduceSummary
else
ProduceDetail
end if
end if
AdMinPageTrailer
end sub
'
Sub ProduceSummary
dim count
dim total
dim nopayment
count=0
total=0
nopayment=0
While Not rs.EOF
count=count+1
if not isnull(rs("orderamount")) then
total=total+rs("orderamount")
end if
rs.movenext
wend
rs.close
set rs=nothing
shopclosedatabase dbc
response.write "" & reportinfofont
Response.write "
" & LangReportTotalsales & shopformatcurrency(total,2)
Response.write "
" & LangReportNumSales & count
response.write ReportinfofontEnd & "
"
end sub
'
Sub ProduceDetail
dim count
dim total
dim nopayment
count=0
total=0
nopayment=0
FormatTableStart
limit=clng(mypagesize)
While Not rs.EOF and count" & reportinfofont
Response.write "
" & LangReportTotalSales & shopformatcurrency(total,2)
Response.write "
" & LangReportNumSales & count
response.write ReportinfofontEnd & ""
end sub
Sub FormatRow
dim i
dim fieldvalue
response.write ReportDetailRow
for i = 0 to fieldcount
fieldvalue=rs(fields(i))
if fields(i)="ORDERAMOUNT" then
fieldvalue=shopformatcurrency(fieldvalue,Getconfig("xdecimalpoint"))
end if
If fields(i)="ORDERID" then
my_link=scriptresponder & "?oid=" & rs("orderid") & "&idfield=" & "orderid"
fieldvalue="" & rs("orderid") & ""
end if
response.write ReportDetailColumn & fieldvalue & ReportDetailColumnEnd
next
response.write ReportRowEnd
end sub
'
'
Sub Displayform
AdminPageHeader
if sError<> "" then
response.write "
" & Getconfig("xfont") & "" & SError & ""
Serror=""
end if
%>
<%=Getconfig("xfont")%><%=LangReport03%>
<%
AdminPageTrailer
end sub
Sub FormattableStart
dim i
Fields(0)="ORDERID"
Fields(1)="ORDERAMOUNT"
Fields(2)="Odate"
Fields(3)="ofirstname"
Fields(4)="olastname"
Fields(5)="oaddress"
Fields(6)="oCity"
Fields(7)="ostate"
Fields(8)="ocountry"
fieldcount=8
CapFields(0)=LangProductOrderNumber
CapFields(1)=LangProductTotal
CapFields(2)=LangStatusDate
CapFields(3)=LangCustFirstName
CapFields(4)=LangCustLastName
CapFields(5)=LangCustAddress
CapFields(6)=LangCustCity
capFields(7)=LangCustState
capFields(8)=LangCustCountry
response.write REportTableDEf
response.write ReportHeadRow
for i = 0 to fieldcount
response.write ReportHeadColumn & capfields(i) & ReportHeadColumnEnd
next
response.write ReportRowEnd
end sub
Sub FormatTableEnd
response.write ReportTableEnd
end sub
%>