<%option explicit%>
<%
ShopCheckAdmin "shopa_productreport.asp"
'***********************************************************
' VP-ASP 6.50 Product/Supplier Report
' Supplier Reports
' inputs are table, database
' Version 6.50
' Jan 21, 2004
'*************************************************************
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")
AdminPageHeader
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
gethelp
Else
GenerateSQL
WriteReport
end if
End If
AdminPageTrailer
'********************************
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=" " & getlang("LangReportInvalidDate") & fromdate
end if
If not Isdate(todate) then
Serror=" " & getlang("LangReportInvalidDate") & todate
end if
If fromdate="" and todate="" then
Serror=getlang("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
'debugwrite sql
' dbc must be the connection we are looping through
ShopOpenOtherDB dbc, getconfig("xorderdb")
ShopopendatabaseP productdbc
ShopOpenRecordSet SQL,RS, mypagesize, mypage
GenerateDisplayHeader getlang("langreport02")
GenerateDisplayBodyHeader
'VP-ASP 6.09 - for print friendly reports
response.write "
<%
end if
'Response.write Infomsg
if rs.eof then
shopwriteheader " " & getlang("LangReportNoSales")
else
If Action="SUMMARY" then
ProduceSummary
else
ProduceDetail
end if
end if
GenerateDisplayBodyFooter
Shopclosedatabase Productdbc
ShopClosedatabase dbc
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 & " " & getlang("LangSupplierNumber") & " " & supplierid & ""
name=suppliername & " " & getlang("LangSupplierNumber") & " " & supplierid & ""
If Getsess("Supplerid")="" and supplierid<>0 then
scriptresponder="shopa_supplieraccount.asp?id=" & supplierid
my_link=scriptresponder
Response.write "
" & name & ""
end if
end sub
Sub WriteSupplierTotals
'response.write ReportInfoFont
Response.write " " & getlang("LangReportTotalsales") & ": " & shopformatcurrency(totalamount,getconfig("xdecimalpoint"))
Response.write " " & getlang("LangReportNumSales") & ": " & totalOrders & " "
'response.write ReportInfoFontEnd
end sub
Sub WriteGrandTotals%>
<%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")
if affrs("highercatalogid") > "" then
affsql="select cname from products where catalogid=" & affrs("highercatalogid")
set affrs=productdbc.execute(affsql)
If not affrs.eof then
strcname = affrs("cname") & " - " & strcname
end if
end if
end if
affrs.close
set affrs=nothing
end sub
'
Sub GetSupplierInfo
dim suppdbc
shopopendatabase suppdbc
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=suppdbc.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
shopclosedatabase suppdbc
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=getlang("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
GenerateDisplayHeader "Supplier Report"
GenerateDisplayBodyHeader
if sError<> "" then
shopwriteerror SError
Serror=""
end if
%>
"
GenerateDisplayBodyFooter
end sub
Sub FormattableStart
dim i
if prevsupplier="" then exit sub
Capfields(0)="catalogid"
Capfields(1)=getlang("LangProductUnitPrice")
CapFields(2)=getlang("LangProductQuantity")
CapFields(3)=getlang("LangProductTotal")
CapFields(4)=getlang("LangProductName")
fieldcount=4
response.write ReportTableDef
response.write "
"
for i = 0 to fieldcount
response.write ReportHeadColumn & capfields(i) & ReportHeadColumnEnd
next
response.write ReportRowEnd
end sub
Sub FormatTableEnd
response.write ReportTableEnd
end sub
%>