<%option explicit%>
<%
ShopCheckAdmin "shopa_productreport.asp"
'***********************************************************
' VP-ASP Product/Supplier Report
' Supplier Reports
' inputs are table, database
' Version 4.00
' Nov 17, 2001
'*************************************************************
dim allflag
Dim Capfields(10)
dim fieldcount
Dim File
Dim ScriptResponder
Dim Dbc
'Dim orderdbc
dim Action
dim fromdate
dim todate
dim datedelim
Dim rs
Dim Limit
Dim Month
Dim Year, productdbc
Dim affid, affdbc, orders
Dim affsql, affrs
Dim suppliername, affcommrate, unitprice,supplierid, prevsupplier, commissionrate
Dim ordercount
dim orderamount
Dim GrandTotalAmount, GrandTotalOrders
Dim totalorders, totalamount, Totallogins, count
dim giftcatalogid
dim fieldvalue
totalorders=0
totalamount=0
'dim database
SetSess "CurrentURL","shopa_productreport.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=""
allflag=""
limit=request("Limit")
if limit="" then
limit=100
end if
SetSess "ReportLimit",limit
mypagesize=limit
action=""
GetActionValues
If action<> "" then
GetDateValues
Validatedates
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
allflag=request("Selectall")
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="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
If fromdate="" and todate="" then
Serror=LangReportDate
end if
end sub
'
Sub GenerateSQL
dim datesql,strsql, whereok
Dim newsql
dim fromdatex, todatex
mypage=1 ' first time through
whereok=" and "
strsql="select oitems.supplierid, oitems.catalogid, oitems.unitprice, sum(oitems.numitems) as sumofnumitems "
strsql=strsql & " from orders,oitems "
strsql=strsql & " where orders.orderid = oitems.orderid "
if fromdate<>"" and todate<>"" then
datesql = " orders.odate>= " & datedelimit(fromdate)
datesql = datesql & " and orders.odate<= " & datedelimit(todate)
strsql=strsql & whereok & datesql
whereok=" and "
end if
If Getsess("Supplierid")<>"" then
strsql=strsql & whereok & " oitems.supplierid=" & Getsess("Supplierid")
end if
strsql=strsql & " GROUP BY oitems.supplierid, oitems.catalogid, oitems.unitprice "
strsql=strsql & " ORDER BY oitems.supplierid"
sql=strsql
SetSess "Fromdate",fromdate
SetSess "todate",Todate
'debugwrite sql
end sub
'
Sub WriteReport
' Generate table
dim infomsg
AdminPageHeader
'debugwrite sql
' dbc must be the connection we are looping through
ShopOpenOtherDB dbc, getconfig("xorderdb")
Shopopendatabase productdbc
ShopOpenRecordSet SQL,RS, mypagesize, mypage
If Fromdate<>"" Then
Infomsg=Infomsg & fromdate & " - " & todate & "
"
end if
Response.write Infomsg
if rs.eof then
Response.write getconfig("Xfont") & "
" & LangReportNoSales & ""
else
If Action="SUMMARY" then
ProduceSummary
else
ProduceDetail
end if
end if
Shopclosedatabase Productdbc
ShopClosedatabase dbc
AdMinPageTrailer
end sub
'
Sub ProduceSummary
dim total, count
count=0
totalorders=0
totalamount=0
totallogins=0
GrandTotalAmount=0
GrandTotalOrders=0
Prevsupplier=""
While Not rs.EOF
GetOrderDetails
If PrevSupplier<>supplierid then
If count>0 and allflag<>"ALL" then
WriteSupplierTotals
end if
If allflag<>"ALL" then
GetSupplierInfo
FormatSupplier
end if
prevsupplier=supplierid
Grandtotalorders=GrandTotalorders+totalorders
grandtotalamount=grandtotalamount+totalamount
totalorders=0
totalamount=0
end if
count=count+1
TotalOrders=Totalorders+Ordercount
Totalamount=Totalamount+Orderamount
rs.movenext
wend
Grandtotalorders=GrandTotalorders+totalorders
grandtotalamount=grandtotalamount+totalamount
If allflag<>"ALL" Then
WriteSupplierTotals
end if
WriteGrandTotals
rs.close
set rs=nothing
end sub
Sub Formatsupplier
dim my_link
dim name
name=ReportInfoFont & suppliername & " " & LangSupplierNumber & " " & supplierid & ""
If Getsess("Supplerid")="" and supplierid<>0 then
scriptresponder="shopa_Supplieraccount.asp?id=" & supplierid
my_link=scriptresponder
Response.write "
" & name & ""
else
Response.write "
" & name
end if
end sub
Sub WriteSupplierTotals
response.write ReportInfoFont
Response.write "
" & LangReportTotalsales & shopformatcurrency(totalamount,2)
Response.write "
" & LangReportNumSales & totalOrders
response.write ReportInfoFontEnd
end sub
Sub WriteGrandTotals
response.write "" & getconfig("Xfont") & "Grand Totals"
Response.write "
" & LangReportTotalsales & shopformatcurrency(Grandtotalamount,2)
Response.write "
" & LangReportNumSales & GrandtotalOrders
response.write ReportInfoFontEnd & "
"
end sub
Sub GetOrderDetails
Dim fromdatex, todatex
ordercount=rs("SumOfNumItems")
unitprice=rs("unitprice")
orderamount=ordercount*Unitprice
lngcatalogid=rs("Catalogid")
supplierid=rs("Supplierid")
if isnull(supplierid) then
supplierid=0
end if
affsql="select * from products where catalogid=" & lngcatalogid
set affrs=productdbc.execute(affsql)
If affrs.eof then
strcname=""
else
strcname=affrs("cname")
end if
affrs.close
set affrs=nothing
end sub
'
Sub GetSupplierInfo
If supplierid=0 then
suppliername=""
commissionrate=0
exit sub
end if
dim supsql, suprs
supsql="Select * from suppliers where supplierid=" & supplierid
'debugwrite supsql
set Suprs=dbc.execute(supsql)
if not suprs.eof then
suppliername=suprs("name")
if isnull(suppliername) then
suppliername=suprs("firstname") & " " & suprs("lastname")
end if
commissionrate=suprs("commissionrate")
else
suppliername=""
end if
suprs.close
set suprs=nothing
end sub
'
'
Sub ProduceDetail
dim count
dim total
dim nopayment
count=0
total=0
limit=clng(mypagesize)
giftcatalogid=getconfig("xgiftproductid")
If giftcatalogid<>"" then
giftcatalogid=clng(giftCatalogid)
end if
prevsupplier=""
Formattablestart
GrandTotalAmount=0
GrandTotalOrders=0
While Not rs.EOF and count"
FormatAffid
fieldvalue=shopformatcurrency(Unitprice, getconfig("xdecimalpoint"))
Writecolumn fieldvalue
Writecolumn ordercount
fieldvalue=shopformatcurrency(orderamount,getconfig("xdecimalpoint"))
Writecolumn fieldvalue
WriteColumn strcname
response.write ""
end sub
Sub FormatAffid
dim my_link
If lngcatalogid=giftcatalogid then
fieldvalue=langGiftCertificate
writecolumn fieldvalue
exit sub
end if
scriptresponder="shopa_editrecord.asp?table=products&idfield=catalogid"
my_link=scriptresponder & "&which=" & lngcatalogid
fieldvalue="" & lngcatalogid & ""
writecolumn fieldvalue
end sub
Sub FormatCommission
dim commissionrate
commissionrate=affcommrate
if isnull(commissionrate) then
commissionrate=0
else
if commissionrate>1 then
commissionrate=commissionrate/100.00
end if
end if
fieldvalue=commissionrate*Orderamount
fieldvalue=shopformatcurrency(fieldvalue,getconfig("xdecimalpoint"))
Writecolumn fieldvalue
end sub
Sub WriteColumn (fieldvalue)
response.write ReportDEtailColumn & fieldvalue & ReportDEtailColumnEnd
end sub
Sub DisplayForm
AdminPageHeader
if sError<> "" then
response.write "
" & SError & ""
Serror=""
end if
%>
<%
AdminPageTrailer
end sub
Sub FormattableStart
dim i
if prevsupplier="" then exit sub
Capfields(0)="Catalogid"
Capfields(1)=LangProductUnitPrice
CapFields(2)=LangProductQuantity
CapFields(3)=LangProductTotal
CapFields(4)=LangProductName
fieldcount=4
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
%>