File: D:/web/vintagedoorknobs/financial-reports.asp
<%Option Explicit%>
<!--#include virtual="/dbfunctions.asp"-->
<%DisableCache%>
<%
' (SS,21/04/23) Financial reports (financial-reports.asp)
' (SS,05/05/23) First production release
' (SS,05/05/23) Prefixed includes above with / to work for HF (from outside root), also had to change file= to virtual=
' (SS,09/05/23) Version 2.00 officialal release
' (SS,10/05/23) Version 2.10 official release, Bootstrap 5 and extra features
' (SS,11/05/23) Version 2.20 official release, renamed Metric to Headline, added Headline for VDK
' (SS,12/05/23) Version 2.30 release, added size feature
' (SS,15/05/23) Version 2.40 release, added VAT correction for HyperFlight (not quite completed)
' (SS,14/06/23) Version 2.50 release, changes for CIRC: Rads Sold & Net Sales per (exc. clearance), All Orders, Delivery Income (all orders), New Delivery Income report, new Orders with Rads values
' (SS.14/06/23) Version 2.51 release, correction to Sub CreateHeadlineTempTables for CIRC to LEFT JOIN instead of INNER JOIN for pa.AttributeID = 1 (ProductType, not all items have a ProductType attribute)
' Discrepancy noticed when DeliveryIncome in new Delivery Income report was not adding up to the Delivery Income (all orders) in the headline report.
' (SS,15/06/23) Version 2.52 - Made "Delivery Income" report available to all (not just CIRC), also change to function GetSQLDeliveryIncome to use AddSQLvcAs for Delivery, i.e. remove VAT for HF
' (SS,27/06/23) Version 2.53 - Added authentication via key stored in cookie, need to email everybody the URL containing the key
' For CIRC - www.castironradiatorcentre.co.uk/financial-reports.asp?frkey=c650da266c0b64d9509c51b0537a488d01aba5d7
' For VDK - www.vintagedoorknobs.co.uk/financial-reports.asp?frkey=abf0ad1d99f6b042d83e3873f0cc1fc8b2d4d508
' To generate key use SELECT SHA1(website address + "~itp~jobs~gates-musk~147"
' e.g. SELECT SHA1(CONCAT('www.vintagedoorknobs.co.uk', '~itp~jobs~gates-musk~147'))
' https://dev.castironradiatorcentre.co.uk/financial-reports.asp?frkey=6f4212c45bd4c3d5d9383b67592227b39c783558
' (SS,26/09/23) Version 2.54 - Added Rad Orders with Paint and Valves (as %) to bottom of Headline report
' (SS,27/09/23) Version 2.55 - Added Orders without Rads and Valve Orders without Rads (as %) to bottom of Headline report
Dim NL
NL = Chr(13) + Chr(10)
' (SS,26/4/23)
Const FDEBUG_MODE = False
' (SS,6/5/23)
Const FCHECK_MODE = True
' period types
Const PT_MONTH = "Month"
Const PT_QUARTER = "Quarter"
Const PT_YEAR = "Year"
Const RN_HEADLINE = "Headline"
Const RN_SALES_NET = "Sales Net"
Const RN_SALES_QTY = "Sales Qty"
Const RN_PAINT_QTY = "Paint Qty"
Const RN_PAINT_SECTIONS = "Paint Sections"
Const RN_PAINT_COST = "Paint Cost"
Const RN_DELIVERY_INCOME = "Delivery Income" ' (SS,14/6/23)
' following used in check mode only
Const RN_SALES_ONLY = "Sales Only"
Const RN_REFUNDS_ONLY = "Refunds Only"
Const DF_CURRENCY = "Currency"
Const DF_INTEGER = "Integer"
Const DF_PERCENTAGE = "Percentage"
Const CATEGORY_ALL = "ALL"
Const SUBCATEGORY_ALL = "ALL"
' metric name indexes
Const MA_NAME = 0
Const MA_DISPLAY_FORMAT = 1
Const MA_COLOUR_GROUP = 2
Dim FDataArray ' holds data copied form SQL result
Dim FDataCrosstabArray ' holds all the data crosstabulated including header and totals
Dim FCrosstabColumnNameArray ' holds the name of all crosstabbed columns containing numeric data
Dim FPeriodListArray, FPeriodOptionList
Dim FStartTimer, FEndTimer
Dim oReport
'=== START ===
If AllowedAccess Then
Initialise
ShowPageHeader
ReportInitialise
ShowReportForm
ReportMain
ReportFinalise
Finalise ' in AppUtils.asp
ShowPageFooter
Else
Response.Write "<h2>Access denied<h2>"
End If
'=== END ===
' (SS,27/6/23)
Function AllowedAccess
Const KEY_NAME = "frkey"
Dim LCookieKey, LURLKey, LActualKey, LStrToHash, LRedirectURL
LURLKey = Trim(CleanRequestQueryString(KEY_NAME))
' check URL for key, if set the set the cookie to it and redirect back to this page without query string
If LURLKey <> "" Then
SetCookie KEY_NAME, LCase(LURLKey)
Response.Redirect "https://" & Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("URL")
End If
' check the key
LStrToHash = Request.ServerVariables("SERVER_NAME") & "~itp~jobs~gates-musk~147" ' website address e.g. www.castironradiatocentre.co.uk with an added salt
LActualKey = LCase(sha1HashString(LStrToHash))
LCookieKey = GetCookie(KEY_NAME)
'Response.Write "### Cookie Key:" & LCookieKey & "###" & BR
'Response.Write "### Str to Hash:" & LStrToHash & "###" & BR
'Response.Write "### Actual Key:" & LActualKey & "###" & BR
' return true if key in cookie matches actual key
AllowedAccess = LCookieKey = LActualKey
End Function
' (SS,27/6/23) following from https://gist.github.com/SethVandebrooke/ca3c21f6e4c9eeffae11dcc11f8a9370
function sha1HashString(str)
Dim hexStr, x, aBytes, sha1
aBytes = CreateObject("System.Text.UTF8Encoding").GetBytes_4(str)
set sha1 = CreateObject("System.Security.Cryptography.SHA1Managed")
sha1.Initialize()
aBytes = sha1.ComputeHash_2( (aBytes) )
for x=1 to lenb(aBytes)
hexStr= hex(ascb(midb( (aBytes),x,1)))
if len(hexStr)=1 then hexStr="0" & hexStr
sha1HashString=sha1HashString & hexStr
next
Set sha1 = Nothing ' (SS,27/6/23)
end function
Sub Initialise
FStartTimer = Timer
OpenDatabase ' (SS,26/5/07) now only one open is done, close is done in Finalise sub
End Sub
' (SS,9/4/19) returns time taken in seconds to 3 dp, called from ShowTimer
Function GetTimer
FEndTimer = Timer
GetTimer = FormatNumber(FEndTimer - FStartTimer, 3, True) & " secs"
End Function
Sub Finalise
CloseDatabase
FinaliseDBFunctions ' (SS,27/05/10)
End Sub
Sub ReportInitialise
Set oReport = New ReportDef
GetFormSettings
oReport.SetDefaults
End Sub
Function ReportFinalise
' destroy the object created in ReportInitialise
Set oReport = Nothing
End Function
Class ReportDef
Private FGroupBy, FPeriodType, FPeriodStart, FPeriodEnd
Private FReportName, FPeriodOrder, FPeriodRange, FShow, FBackground, FSize, FCategory, FSubcategory
Private FDataField, FDisplayFormat, FHasTotalRow, FHasColourGroups
Private FReportImplemented, FReportIsPaint, FReportIsDeliveryIncome
Private FLoopStart, FLoopEnd, FLoopStep
Private FHeadlineSQL
Private FShowGroupBy
Private FColourGroup, FPrevGroupName
Private FHeadlineArray
Private Sub Class_Initialize
FReportImplemented = False
FHeadlineSQL = ""
FColourGroup = 0
ReDim FHeadlineArray(2, -1)
End Sub
Public Property Get DataField
DataField = FDataField
End Property
Public Property Get DisplayFormat
DisplayFormat = FDisplayFormat
End Property
Public Property Get HasTotalRow
HasTotalRow = FHasTotalRow
End Property
Public Property Get GroupBy
GroupBy = FGroupBy
End Property
Public Property Let GroupBy(AValue)
FGroupBy = CleanSQLStr(AValue)
End Property
Public Property Get PeriodType
PeriodType = FPeriodType
End Property
Public Property Let PeriodType(AValue)
FPeriodType = CleanSQLStr(AValue)
End Property
Public Property Get PeriodStart
PeriodStart = FPeriodStart
End Property
Public Property Let PeriodStart(AValue)
FPeriodStart = CleanSQLStr(AValue)
End Property
Public Property Get PeriodEnd
PeriodEnd = FPeriodEnd
End Property
Public Property Let PeriodEnd(AValue)
FPeriodEnd = CleanSQLStr(AValue)
End Property
Public Property Get ReportName
ReportName = FReportName
End Property
Public Property Let ReportName(AValue)
FReportName = CleanSQLStr(AValue)
End Property
Public Property Get PeriodOrder
PeriodOrder = FPeriodOrder
End Property
Public Property Let PeriodOrder(AValue)
FPeriodOrder = CleanSQLStr(AValue)
End Property
Public Property Get PeriodRange
PeriodRange = FPeriodRange
End Property
Public Property Let PeriodRange(AValue)
FPeriodRange = CleanSQLStr(AValue)
End Property
Public Property Get Show
Show = FShow
End Property
Public Property Let Show(AValue)
FShow = CleanSQLStr(AValue)
End Property
Public Property Get Background
Background = FBackground
End Property
Public Property Let Background(AValue)
FBackground = CleanSQLStr(AValue)
End Property
Public Property Get Size
Size = FSize
End Property
Public Property Let Size(AValue)
FSize = CleanSQLStr(AValue)
End Property
Public Property Get Category
Category = FCategory
End Property
Public Property Let Category(AValue)
FCategory = CleanSQLStr(AValue)
End Property
Public Property Get Subcategory
Subcategory = FSubcategory
End Property
Public Property Let Subcategory(AValue)
FSubcategory = CleanSQLStr(AValue)
End Property
Public Sub Class_Terminate
' Response.Write "#=VarType:" & VarType(FDataCrosstabArray(5, 1)) & "=#"
Response.Write "<span class=""d-print-none""><small> (" & GetTimer & ")</small></span>"
End Sub
Public Sub SetDefaults
If FReportName = "" Then
FReportName = RN_HEADLINE
End If
If FGroupBy = "" Then FGroupBy = "Subcategory"
If FPeriodType = "" Then FPeriodType = PT_MONTH
If FPeriodOrder = "" Then FPeriodOrder = "Asc."
If FPeriodRange = "" Or (FPeriodType = "Year" And RangeIsSame) Then FPeriodRange = "Start to End"
If FBackground = "" Then FBackground = "Striped Coloured"
If FCategory = "" Or FGroupBy = "Category" Then FCategory = CATEGORY_ALL
If FSubcategory = "" Or FCategory = CATEGORY_ALL Or FGroupBy <> "Product" Then FSubcategory = SUBCATEGORY_ALL
FPeriodOptionList = GetPeriodOptionList(FPeriodType)
If Not PeriodIsValid(FPeriodStart) Then FPeriodStart = SetPeriodDefault(FPeriodType, True)
If Not PeriodIsValid(FPeriodEnd) Then FPeriodEnd = SetPeriodDefault(FPeriodType, False)
If FPeriodEnd < FPeriodStart Then FPeriodEnd = FPeriodStart ' ensure end isn't before start
' set report specific values
FHasTotalRow = True
FReportIsPaint = False
FReportIsDeliveryIncome = False ' (SS,14/6/23)
FShowGroupBy = False
FHasColourGroups = True
FDisplayFormat = DF_INTEGER
If FReportName = RN_SALES_NET Or ReportIsSalesOnly Or ReportIsRefundsOnly Then
FReportImplemented = True
FDataField = "NetSales"
FDisplayFormat = DF_CURRENCY
FShowGroupBy = True
ElseIf FReportName = RN_SALES_QTY Then
FReportImplemented = True
FDataField = "Qty"
FShowGroupBy = True
ElseIf FReportName = RN_PAINT_QTY Then
FReportImplemented = True
FReportIsPaint = True
FDataField = "Qty"
ElseIf FReportName = RN_PAINT_SECTIONS Then
FReportImplemented = True
FReportIsPaint = True
FDataField = "Sections"
ElseIf FReportName = RN_PAINT_COST Then
FReportImplemented = True
FReportIsPaint = True
FDataField = "PaintCost"
FDisplayFormat = DF_CURRENCY
ElseIf FReportName = RN_HEADLINE Then
FReportImplemented = True
FHasTotalRow = False
FDataField = "NetSales"
' FHasColourGroups = True
FDisplayFormat = DF_CURRENCY
' (SS,14/6/23)
ElseIf FReportName = RN_DELIVERY_INCOME Then
FReportImplemented = True
FReportIsDeliveryIncome = True
FDataField = "DeliveryIncome"
FDisplayFormat = DF_CURRENCY
End If
' if show not set or not applicable then default to value, placed here due to HasTotalRow
If FShow = "" Or (Not HasTotalRow And InStr(FShow, "%") > 0) Then FShow = "Value"
End Sub
Public Function ReportImplemented
ReportImplemented = FReportImplemented
End Function
Public Function ReportIs(AReportName)
ReportIs = FReportName = AReportName
End Function
Public Function ReportIsSalesNet
ReportIsSalesNet = ReportIs(RN_SALES_NET)
End Function
Public Function ReportIsSalesQty
ReportIsSalesQty = ReportIs(RN_SALES_QTY)
End Function
Public Function ReportIsSales
ReportIsSales = ReportIsSalesNet Or ReportIsSalesQty Or ReportIsSalesOnly Or ReportIsRefundsOnly
End Function
Public Function ReportIsSalesOnly
ReportIsSalesOnly = FReportName = RN_SALES_ONLY
End Function
Public Function ReportIsRefundsOnly
ReportIsRefundsOnly = FReportName = RN_REFUNDS_ONLY
End Function
Public Function ReportIsPaint
ReportIsPaint = FReportIsPaint
End Function
Public Function ReportIsHeadline
ReportIsHeadline = ReportIs(RN_HEADLINE)
End Function
' (SS,14/6/23)
Public Function ReportIsDeliveryIncome
ReportIsDeliveryIncome = FReportIsDeliveryIncome
End Function
Public Property Get PeriodTypeIsMonth
PeriodTypeIsMonth = FPeriodType = PT_MONTH
End Property
Public Property Get PeriodTypeIsQuarter
PeriodTypeIsQuarter = FPeriodType = PT_QUARTER
End Property
Public Property Get RangeIsSame
RangeIsSame = FPeriodRange = "Same"
End Property
Public Function ShowValue
ShowValue = InStr(1, FShow, "Value", vbTextCompare) > 0
End Function
Public Function ShowPercentage
' ShowPercentage = InStr(1, FShow, "Percentage", vbTextCompare) + InStr(1, FShow, "%", vbTextCompare) > 0
ShowPercentage = InStr(FShow, "%") > 0 And HasTotalRow
End Function
Public Function ShowDifference
ShowDifference = InStr(1, FShow, "Diff", vbTextCompare) > 0
End Function
Public Function PeriodColspan
Dim LResult
LResult = 0
If ShowValue Then LResult = LResult + 1
If ShowPercentage Then LResult = LResult + 1
If ShowDifference Then LResult = LResult + 1
PeriodColspan = LResult
End Function
Public Function GroupFieldCount
Dim LResult
LResult = 1
If ReportIsSales Then
If FGroupBy = "Subcategory" Then
LResult = LResult + 1
ElseIf FGroupBy = "Product" Then
LResult = LResult + 2
End If
End If
GroupFieldCount = LResult
End Function
Public Property Get GroupField1
Dim LResult
If ReportIsSales Then
LResult = "Category"
ElseIf ReportIsPaint Then
LResult = "Paint Finish"
ElseIf ReportIsHeadline Then
LResult = "Headline"
' (SS,14/6/23)
ElseIf ReportIsDeliveryIncome Then
LResult = "Delivery Agent"
Else
LResult = ""
End If
GroupField1 = LResult
End Property
Public Property Get GroupField2
Dim LResult
LResult = ""
If ReportIsSales Then
If FGroupBy = "Subcategory" Or FGroupBy = "Product" Then
LResult = "Subcategory"
End If
End If
GroupField2 = LResult
End Property
Public Property Get GroupField3
Dim LResult
LResult = ""
If ReportIsSales Then
If FGroupBy = "Product" Then
LResult = "Product"
End If
End If
GroupField3 = LResult
End Property
Public Sub StartColourGroup
FColourGroup = -1 ' -1 to ensure start from 0 due to NextColourGroup being called
FPrevGroupName = ""
End Sub
Public Sub NextColourGroup
FColourGroup = FColourGroup + 1
End Sub
Public Function PeriodOrderIsDescending
PeriodOrderIsDescending = FPeriodOrder = "Desc"
End Function
Public Function PeriodRangeIsStartToEnd
PeriodRangeIsStartToEnd = FPeriodRange = "Start to End"
End Function
Public Function PeriodRangeIsStartAndEnd
PeriodRangeIsStartAndEnd = FPeriodRange = "Start & End"
End Function
Public Function PeriodRangeIsSame
PeriodRangeIsSame = FPeriodRange = "Same"
End Function
Public Sub SetPeriodLoop
Dim LFieldCount
LFieldCount = UBound(FDataCrosstabArray, 1) + 1
If PeriodOrderIsDescending Then
FLoopStart = LFieldCount - 1
FLoopEnd = GroupFieldCount
FLoopStep = -1
Else
FLoopStart = GroupFieldCount
FLoopEnd = LFieldCount - 1
FLoopStep = 1
End If
End Sub
Public Property Get LoopStart
LoopStart = FLoopStart
End Property
Public Property Get LoopEnd
LoopEnd = FLoopEnd
End Property
Public Property Get LoopStep
LoopStep = FLoopStep
End Property
' row count excluding total row
Public Function RowCount
Dim LResult
LResult = UBound(FDataCrosstabArray, 2)
If HasTotalRow Then LResult = LResult - 1
RowCount = LResult
End Function
Public Function TotalRow
TotalRow = UBound(FDataCrosstabArray, 2) ' assumes last row is the total row
End Function
Function FormatDPX(ANumber, ADP)
Dim LResult
If IsNull(ANumber) Then
LResult = Null
Else
LResult = FormatNumber(ANumber, ADP, vbTrue, vbFalse, vbTrue)
End If
FormatDPX = LResult
End Function
' (SS,11/5/23) moved here from SetDisplayFormatGroup, may be called twice
Private Function HeadlineArrayIndexOf(AGroupName)
Dim i, LResult
LResult = -1
For i = 0 To UBound(FHeadlineArray, 2)
If FHeadlineArray(MA_NAME, i) = AGroupName Then
LResult = i
Exit For
End If
Next
HeadlineArrayIndexOf = LResult
End Function
Public Sub SetDisplayFormatGroup(AGroupName)
If ReportIsHeadline Then
Dim i
i = HeadlineArrayIndexOf(AGroupName)
' if not found then use the default
If i = -1 Then i = HeadlineArrayIndexOf("Default")
If i <> -1 Then
FDisplayFormat = FHeadlineArray(MA_DISPLAY_FORMAT, i)
FColourGroup = FHeadlineArray(MA_COLOUR_GROUP, i)
End If
Else
If AGroupName <> FPrevGroupName Then
NextColourGroup
End If
End If
FPrevGroupName = AGroupName
End Sub
Public Function CellValue(ARow, AColumn)
Dim LCellValue, LResult
LCellValue = FDataCrosstabArray(AColumn, ARow)
If IsNull(LCellValue) Then
LResult = ""
Else
LResult = FormatDPX(LCellValue, 0)
' prefix with pound sign if sales value
If FDisplayFormat = DF_CURRENCY Then
LResult = "£" & LResult
ElseIf FDisplayFormat = DF_PERCENTAGE Then
LResult = FormatDPX(LCellValue, 2) & "%"
End If
End If
CellValue = LResult
End Function
Public Function CellPercentage(ARow, AColumn)
Dim LCellValue, LResult, LTotal
LCellValue = FDataCrosstabArray(AColumn, ARow)
If HasTotalRow Then
If IsNull(LCellValue) Then
LResult = ""
Else
LTotal = FDataCrosstabArray(AColumn, TotalRow)
LCellValue = CDbl(LCellValue)
' Response.Write "##LCellValue:" & LCellValue & "###"
' Response.Write "##LTotal:" & LTotal & "###"
LResult = FormatDPX(LCellValue / LTotal * 100, 2) & "%"
End If
Else
LResult = "NA"
End If
CellPercentage = LResult
End Function
Public Function CellDifference(ARow, AColumn)
Dim LCellValue, LCellValuePrev, LResult, LTotal
LCellValue = FDataCrosstabArray(AColumn, ARow)
' if first column then return blank because nothing to compare with
If AColumn = GroupFieldCount Then
LResult = ""
Else
LCellValuePrev = FDataCrosstabArray(AColumn - 1, ARow)
' return blank if either are null
If IsNull(LCellValue) Or IsNull(LCellValuePrev) Then
LResult = ""
Else
LCellValue = CDbl(LCellValue)
LCellValuePrev = CDbl(LCellValuePrev)
If LCellValuePrev = 0 Then ' divide by zero will cause error, show infinity symbol
LResult = "∞"
Else
LResult = FormatDPX((LCellValue - LCellValuePrev) / LCellValuePrev * 100, 2) & "%"
End If
End If
End If
CellDifference = LResult
End Function
Public Function DateRangeForSQL(AField)
Dim LResult, LStartDate1, LEndDate1, LStartDate2, LEndDate2
LResult = ""
If PeriodRangeIsStartToEnd Or PeriodRangeIsStartAndEnd Then
GetPeriodDates FPeriodType, FPeriodStart, LStartDate1, LEndDate1
GetPeriodDates FPeriodType, FPeriodEnd, LStartDate2, LEndDate2
If PeriodRangeIsStartToEnd Then
'LResult = "(" & AField & " >= '" & LStartDate1 &"' AND " & AField & " <= '" & LEndDate1 & "')"
' (SS,2/5/23) replaced above with following to use BETWEEN
LResult = AField + " BETWEEN '" + LStartDate1 + "' AND '" + LEndDate2 + "'"
Else
LResult = "(" + AField + " BETWEEN '" + LStartDate1 + "' AND '" + LEndDate1 + "')" & " OR (" & AField + " BETWEEN '" + LStartDate2 + "' AND '" + LEndDate2 + "')"
End If
ElseIf PeriodRangeIsSame Then
Dim LSQL, LPeriodField, LCheckWidth
If PeriodTypeIsMonth Then
LPeriodField = "Month1"
LCheckWidth = 3
ElseIf PeriodTypeIsQuarter Then
LPeriodField = "Quarter1"
LCheckWidth = 2
End If
LSQL = "SELECT " + LPeriodField + ", MIN(CalendarDate) AS MinDate, MAX(CalendarDate) AS MaxDate FROM common.calendar " +_
"WHERE " + LPeriodField + " >= '" + FPeriodStart + "' AND " + LPeriodField + " <= '" + FPeriodEnd + "' AND " +_
"(RIGHT(" + LPeriodField + ", " & LCheckWidth & ") = '" + Right(FPeriodStart, LCheckWidth) + "' " +_
"OR RIGHT(" + LPeriodField + ", " & LCheckWidth & ") = '" + Right(FPeriodEnd, LCheckWidth) + "') " +_
"GROUP BY " + LPeriodField
OpenQuery(LSQL)
Do While Not EndOfQuery
If LResult <> "" Then LResult = LResult + " OR "
LStartDate1 = ISODate(GetQueryValue("MinDate"))
LEndDate1 = ISODate(GetQueryValue("MaxDate"))
LResult = LResult + "(" + AField + " BETWEEN '" + LStartDate1 + "' AND '" + LEndDate1 + "')"
NextQueryRecord
Loop
CloseQuery
End If
LResult = "(" + LResult + ")"
' Response.Write BR + "###" + LResult + "###" + BR
DateRangeForSQL = LResult
End Function
' returns dates in ISO format YYYY-MM-DD in AStartDate and AEndDate
Private Sub GetPeriodDates(APeriodType, APeriodValue, ByRef AStartDate, ByRef AEndDate)
Dim LResult
LResult = ""
If GetSQL2Values("SELECT MIN(CalendarDate) AS MinDate, MAX(CalendarDate) AS MaxDate FROM common.calendar WHERE " & CleanSQLStr(APeriodType) & "1 = """ & CleanSQLStr(APeriodValue) & """", AStartDate, AEndDate) Then
AStartDate = ISODate(AStartDate)
AEndDate = ISODate(AEndDate)
Else
ShowErrorMsg("Error in GetPeriodDates for " & APeriodType & ", " & APeriodValue)
End If
End Sub
Public Function PeriodSelect
PeriodSelect = "cc." & CleanSQLStr(FPeriodType) & "1 AS Period" ' e.g. cc.Month1 AS Period
End Function
Public Sub AddHeadlineSQL(AHeadlineName, ADisplayFormat, ASQL)
If FHeadlineSQL <> "" Then FHeadlineSQL = FHeadlineSQL + NL + "UNION ALL" + NL
ReDim Preserve FHeadlineArray(UBound(FHeadlineArray, 1), UBound(FHeadlineArray, 2) + 1)
Dim LHeadlineIndex
LHeadlineIndex = UBound(FHeadlineArray, 2)
' store metric name, format and colour group
FHeadlineArray(MA_NAME, LHeadlineIndex) = AHeadlineName
FHeadlineArray(MA_DISPLAY_FORMAT, LHeadlineIndex) = ADisplayFormat
FHeadlineArray(MA_COLOUR_GROUP, LHeadlineIndex) = FColourGroup
FHeadlineSQL = FHeadlineSQL + ASQL
End Sub
Public Property Get HeadlineSQL
HeadlineSQL = FHeadlineSQL
End Property
Public Property Get CategoryOptionList
Dim LResult, LValue
LResult = "<option value=""ALL"">ALL</option>" & NL
OpenQuery "SELECT DISTINCT c.Category FROM categories c INNER JOIN productcategories pc ON pc.Category = c.Category AND Main ORDER BY SortOrder, Category"
Do While Not EndOfQuery
LValue = GetQueryValue("Category")
LResult = LResult & "<option value=""" & LValue & """>" & LValue & "</option>" & NL
NextQueryRecord
Loop
CloseQuery
CategoryOptionList = LResult
End Property
Public Property Get SubcategoryOptionList
Dim LResult, LValue, LFound
LFound = False
LResult = "<option value=""ALL"">ALL</option>" & NL
OpenQuery "SELECT DISTINCT s.Subcategory FROM subcategories s INNER JOIN productcategories pc ON pc.Category = s.Category AND pc.Subcategory = s.Subcategory AND Main WHERE s.Category = '" & FCategory & "' ORDER BY SortOrder, Subcategory"
' Response.Write "###to find subcat:" & FSubcategory & "###" & BR
Do While Not EndOfQuery
LValue = GetQueryValue("Subcategory")
If LValue = FSubcategory Then LFound = True
LResult = LResult & "<option value=""" & LValue & """>" & LValue & "</option>" & NL
NextQueryRecord
Loop
CloseQuery
' if subcategory not in this list then select the default "ALL"
If Not LFound Then FSubcategory = SUBCATEGORY_ALL
SubcategoryOptionList = LResult
End Property
Public Property Get ShowGroupBy
ShowGroupBy = FShowGroupBy
End Property
Public Property Get ShowCategory
ShowCategory = ShowGroupBy And FGroupBy <> "Category"
End Property
Public Property Get ShowSubcategory
ShowSubcategory = ShowCategory And FGroupBy = "Product" And FCategory <> CATEGORY_ALL
End Property
Public Property Get HasColourGroups
HasColourGroups = FHasColourGroups
End Property
Public Property Get HasStripes
If ReportIsPaint And IsColoured Then
HasStripes = False
Else
HasStripes = InStr(FBackground, "Striped") > 0
End If
End Property
Public Property Get IsColoured
IsColoured = InStr(FBackground, "Coloured") > 0
End Property
Public Property Get IsWhite
IsWhite = InStr(FBackground, "White") > 0
End Property
Public Property Get IsBlack
IsBlack = InStr(FBackground, "Black") > 0
End Property
' ****
Public Property Get StripedTable
' ensure no stripes for paint report which has individual row colours
If ColourIsOn And ReportIsPaint Then
StripedTable = False
Else
StripedTable = True
End If
End Property
Public Property Get ColourGroupClass
Dim LResult, LColourGroups, LIndex
LResult = ""
If HasColourGroups Then
If ReportIsPaint Then
If FPrevGroupName = "Gunmetal Grey" Then
LResult = "gunmetal-grey"
ElseIf FPrevGroupName = "Matt Black" Then
LResult = "matt-black"
ElseIf FPrevGroupName = "Satin Black" Then
LResult = "satin-black"
ElseIf FPrevGroupName = "Cream White" Then
LResult = "cream-white"
ElseIf FPrevGroupName = "Linen White" Then
LResult = "linen-white"
ElseIf FPrevGroupName = "Antique Bronze" Then
LResult = "antique-bronze"
Else
LResult = "base-coat-only"
End If
Else
LColourGroups = Array("table-danger", "table-success", "table-primary", "table-info", "table-warning", "table-primary")
LIndex = FColourGroup mod (UBound(LColourGroups) + 1) ' ensures wraparound and avoids of subscript out range
LResult = LColourGroups(LIndex)
End If
End If
ColourGroupClass = LResult
End Property
End Class
Sub GetFormSettings
oReport.ReportName = CleanRequest("reportname")
oReport.PeriodType = CleanRequest("periodtype")
oReport.PeriodStart = CleanRequest("periodstart")
oReport.PeriodEnd = CleanRequest("periodend")
oReport.PeriodOrder = CleanRequest("periodorder")
oReport.PeriodRange = CleanRequest("periodrange")
oReport.Show = CleanRequest("show")
oReport.Background = CleanRequest("background")
oReport.Size = CleanRequest("size")
oReport.GroupBy = CleanRequest("groupby")
oReport.Category = CleanRequest("category")
oReport.Subcategory = CleanRequest("subcategory")
End Sub
Sub ReportMain
If Not oReport.ReportImplemented Then
Response.Write "Report '" + oReport.ReportName + "' does not exist" & BR & BR
Exit Sub
End If
Dim LSQL
If oReport.ReportIsSales Then
LSQL = GetSQLSales
ElseIf oReport.ReportIsPaint Then
LSQL = GetSQLPaint
ElseIf oReport.ReportIsDeliveryIncome Then
LSQL = GetSQLDeliveryIncome
ElseIf oReport.ReportIsHeadline Then
'LSQL = GetSQLHeadlineNetSales(1)
'LSQL = LSQL + NL + "UNION ALL" + NL
'LSQL = LSQL + GetSQLHeadlineNetSales(2)
Dim LHeadlineName
oReport.AddHeadlineSQL "Net Sales", DF_CURRENCY, GetSQLHeadlineNetSales
CreateHeadlineTempTables False
If IsCIRC Then
CreateHeadlineTempTables True
LHeadlineName = "Rads Sold"
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, QtyRads FROM tmp_headline_hasrad"
LHeadlineName = "Net Sales per Rad"
oReport.AddHeadlineSQL LHeadlineName, DF_CURRENCY, "SELECT '" + LHeadlineName + "' AS Headline, Period, NULL AS NetSalesPerRad FROM tmp_headline_hasrad"
' (SS,14/6/23)
LHeadlineName = "Rads Sold (exc. clearance)"
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, QtyRadsExc FROM tmp_headline_hasrad"
' (SS,14/6/23)
LHeadlineName = "Net Sales per Rad (exc. clearance)"
oReport.AddHeadlineSQL LHeadlineName, DF_CURRENCY, "SELECT '" + LHeadlineName + "' AS Headline, Period, NULL AS NetSalesPerRadExc FROM tmp_headline_hasrad"
oReport.NextColourGroup
LHeadlineName = "Delivery Income for Rad Orders"
oReport.AddHeadlineSQL LHeadlineName, DF_CURRENCY, "SELECT '" + LHeadlineName + "' AS Headline, Period, DeliveryIncome FROM tmp_headline_hasrad"
LHeadlineName = "Rad Orders"
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders FROM tmp_headline_hasrad"
LHeadlineName = "Delivery Income per Rad Order"
oReport.AddHeadlineSQL LHeadlineName, DF_CURRENCY, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(DeliveryIncome / Orders, 2) FROM tmp_headline_hasrad"
' (SS,14/6/23)
LHeadlineName = "All Orders"
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders FROM tmp_headline_all"
' (SS,14/6/23)
LHeadlineName = "Delivery Income (all orders)"
oReport.AddHeadlineSQL LHeadlineName, DF_CURRENCY, "SELECT '" + LHeadlineName + "' AS Headline, Period, DeliveryIncome FROM tmp_headline_all"
' (SS,14/6/23)
LHeadlineName = "Delivery Income per Order"
oReport.AddHeadlineSQL LHeadlineName, DF_CURRENCY, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(DeliveryIncome / Orders, 2) FROM tmp_headline_all"
oReport.NextColourGroup
LHeadlineName = "Rad Orders without Valves"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND((Rads - Valves) / Rads * 100, 2) AS Percentage FROM tmp_headline_hasrad"
LHeadlineName = "Rad Orders without Wall Stays"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND((Rads - WallStays) / Rads * 100, 2) AS Percentage FROM tmp_headline_hasrad"
LHeadlineName = "Rad Orders without Shrouds"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND((Rads - PipeShrouds) / Rads * 100, 2) AS Percentage FROM tmp_headline_hasrad"
LHeadlineName = "Rad Orders without Touch Up"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND((Rads - TouchUpPaint) / Rads * 100, 2) AS Percentage FROM tmp_headline_hasrad"
LHeadlineName = "Rad Orders without Paint"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND((Rads - PaintFinish) / Rads * 100, 2) AS Percentage FROM tmp_headline_hasrad"
LHeadlineName = "Rad Orders with Paint"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(PaintFinish / Rads * 100, 2) AS Percentage FROM tmp_headline_hasrad"
oReport.NextColourGroup
LHeadlineName = "Rads with Paint (exc. clearance)"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(QtyRadsExcWithPaint / QtyRadsExc * 100, 2) FROM tmp_headline_all"
LHeadlineName = "Valves per Rad (inc. clearance)"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(QtyValves / QtyRads * 100, 2) FROM tmp_headline_all"
LHeadlineName = "Manual Valves per Rad"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(QtyValvesManual / QtyRads * 100, 2) FROM tmp_headline_all"
LHeadlineName = "Thermostatic Valves per Rad"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(QtyValvesThermostatic / QtyRads * 100, 2) FROM tmp_headline_all"
LHeadlineName = "Wall Stays per Rad"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(QtyWallStays / QtyRads * 100, 2) FROM tmp_headline_all"
LHeadlineName = "Pipe Shrouds per Rad"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(QtyPipeShrouds / QtyRads * 100, 2) FROM tmp_headline_all"
' (SS,14/6/23)
oReport.NextColourGroup
LHeadlineName = "Orders with Rads: 1"
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders1RadExc FROM tmp_headline_hasrad"
LHeadlineName = "Orders with Rads: 2"
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders2RadsExc FROM tmp_headline_hasrad"
LHeadlineName = "Orders with Rads: 3"
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders3RadsExc FROM tmp_headline_hasrad"
LHeadlineName = "Orders with Rads: 4"
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders4RadsExc FROM tmp_headline_hasrad"
LHeadlineName = "Orders with Rads: 5+"
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders5PlusRadsExc FROM tmp_headline_hasrad"
LHeadlineName = "Orders with Rads (exc. clearance)"
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, OrdersRadsExc FROM tmp_headline_hasrad"
' (SS,26/9/23)
oReport.NextColourGroup
LHeadlineName = "1 Rad Orders with Paint"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(Orders1RadWithPaint / Orders1RadExc * 100, 2) FROM tmp_headline_hasrad"
LHeadlineName = "2 Rad Orders with Paint"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(Orders2RadsWithPaint / Orders2RadsExc * 100, 2) FROM tmp_headline_hasrad"
LHeadlineName = "3 Rad Orders with Paint"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(Orders3RadsWithPaint / Orders3RadsExc * 100, 2) FROM tmp_headline_hasrad"
LHeadlineName = "4 Rad Orders with Paint"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(Orders4RadsWithPaint / Orders4RadsExc * 100, 2) FROM tmp_headline_hasrad"
LHeadlineName = "5+ Rad Orders with Paint"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(Orders5PlusRadsWithPaint / Orders5PlusRadsExc * 100, 2) FROM tmp_headline_hasrad"
LHeadlineName = "Rad Orders with Paint (exc. clear.)"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(OrdersRadsWithPaint / OrdersRadsExc * 100, 2) FROM tmp_headline_hasrad"
' (SS,26/9/23)
oReport.NextColourGroup
LHeadlineName = "1 Rad Orders with Valves"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(Orders1RadWithValves / Orders1RadExc * 100, 2) FROM tmp_headline_hasrad"
LHeadlineName = "2 Rad Orders with Valves"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(Orders2RadsWithValves / Orders2RadsExc * 100, 2) FROM tmp_headline_hasrad"
LHeadlineName = "3 Rad Orders with Valves"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(Orders3RadsWithValves / Orders3RadsExc * 100, 2) FROM tmp_headline_hasrad"
LHeadlineName = "4 Rad Orders with Valves"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(Orders4RadsWithValves/ Orders4RadsExc * 100, 2) FROM tmp_headline_hasrad"
LHeadlineName = "5+ Rad Orders with Valves"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(Orders5PlusRadsWithValves / Orders5PlusRadsExc * 100, 2) FROM tmp_headline_hasrad"
LHeadlineName = "Rad Orders with Valves (exc. clear.)"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(OrdersRadsWithValves / OrdersRadsExc * 100, 2) FROM tmp_headline_hasrad"
' (SS,26/9/23)
oReport.NextColourGroup
LHeadlineName = "Orders without Rads (exc. clear.)"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(Orders0RadExc / (OrdersRadsExc + Orders0RadExc) * 100, 2) FROM tmp_headline_hasrad"
LHeadlineName = "Valve Orders without Rads"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(Orders0RadsWithValves / (OrdersRadsExc + Orders0RadExc) * 100, 2) FROM tmp_headline_hasrad"
Else
LHeadlineName = "No. of Orders"
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders FROM tmp_headline_all"
LHeadlineName = "Net Sales per Order"
oReport.AddHeadlineSQL LHeadlineName, DF_CURRENCY, "SELECT '" + LHeadlineName + "' AS Headline, Period, NULL AS NetSalesPerOrder FROM tmp_headline_all"
oReport.NextColourGroup
LHeadlineName = "Delivery Income"
oReport.AddHeadlineSQL LHeadlineName, DF_CURRENCY, "SELECT '" + LHeadlineName + "' AS Headline, Period, DeliveryIncome FROM tmp_headline_all"
LHeadlineName = "Delivery Income per Order"
oReport.AddHeadlineSQL LHeadlineName, DF_CURRENCY, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(DeliveryIncome / Orders, 2) FROM tmp_headline_all"
oReport.NextColourGroup
' "Default" is a special headline for adding these extra ones per category from sales, it allows the group colour and display format to be used when it can't be found in the array list
' the query remove the Vintage text for VDK and adds "(sold)", later removed sold from CONCAT(REPLACE(Category, 'Vintage ', ''), ' (sold)')
oReport.AddHeadlineSQL "Default", DF_INTEGER, "SELECT REPLACE(Category, 'Vintage ', '') AS Headline, Period, Qty FROM (" + GetSQLSales + ") a"
End If
LSQL = oReport.HeadlineSQL
ShowSQL LSQL
End If
CopySQLToArray LSQL
If IsDebug Then
ShowTableFromArray FDataArray
End If
CopySQLToCrosstabArray "Period", oReport.DataField
If IsDebug Then
ShowTableFromArray FDataCrosstabArray
End If
If oReport.HasTotalRow Then AddTotalsToCrosstabArray FDataCrosstabArray, FCrosstabColumnNameArray
' apply any additional calcs on crosstab data
If oReport.ReportIsHeadline Then
If IsCIRC Then
ApplyCrosstabDivCalc "Net Sales", "Rads Sold", "Net Sales per Rad"
ApplyCrosstabDivCalc "Net Sales", "Rads Sold (exc. clearance)", "Net Sales per Rad (exc. clearance)" ' (SS,14/6/23)
Else
ApplyCrosstabDivCalc "Net Sales", "No. of Orders", "Net Sales per Order"
End If
End If
ShowTableFromCrosstabArray FDataCrosstabArray, FCrosstabColumnNameArray
End Sub
' (SS,26/4/23)
Sub DebugMsg(AMessage)
If FDEBUG_MODE Then
Response.Write "=" & AMessage & BR
End If
End Sub
' (SS,26/4/23)
Function IsDebug
IsDebug = FDEBUG_MODE
End Function
Sub ShowErrorMsg(AMessage)
Response.Write BR & "Error!! " & AMessage & BR
End Sub
' (SS,21/4/23)
Dim FSQL
ClearSQL
Sub ClearSQL
FSQL = ""
End Sub
Sub AddSQL(ASQL)
If FSQL <> "" Then FSQL = FSQL & NL
FSQL = FSQL & ASQL
End Sub
' (SS,15/5/23) for HyperFlight does a VAT correction i.e. removal for following fields
' Delivery, Subtotal, Discount, od.PriceEach and replacing with VAT removed value
Sub AddSQLvc(ASQL)
AddSQLvcMain ASQL, False
End Sub
' Same as AddSQLvc but adds and "AS" e.g. AS Delivery
Sub AddSQLvcAs(ASQL)
AddSQLvcMain ASQL, True
End Sub
' (SS,15/5/23)
Sub AddSQLvcMain(ASQL, AUseAs)
If Not IsHF Then
AddSQL ASQL
Exit Sub
End If
Dim LSQL
LSQL = ASQL
LSQL = AddSQLvcSingle(LSQL, AUseAs, "Delivery")
'LSQL = AddSQLvcSingle(LSQL, AUseAs, "Subtotal")
'LSQL = AddSQLvcSingle(LSQL, AUseAs, "Discount")
LSQL = AddSQLvcSingle(LSQL, False, "od.PriceEach")
AddSQL LSQL
End Sub
' (SS,15/5/23) for HyperFlight does a VAT correction i.e. removal for following fields
' Delivery, Subtotal, Discount, od.PriceEach
' replacing with ROUND(Delivery / (1 + ROUND(((VATIncluded + VATDeducted) / (GrandTotal - VATIncluded)), 2)))
Function AddSQLvcSingle(ASQL, AUseAS, AField)
Dim LSQL
LSQL = ASQL
' if field exist then replace with new VAT corrected version
If InStr(LSQL,AField) > 0 Then
' prevents devide by zero for CREATE TEMPORARY TABLE following is used: IF(ROUND(GrandTotal - VATIncluded, 2) = 0
' WIth AUseAS, " AS Field" is added because there's query on a query referring to this field
Const LWITH = "(ROUND(FIELD_GOES_HERE / (1 + IF(ROUND(GrandTotal - VATIncluded, 2) = 0, 0, ROUND(((VATIncluded + VATDeducted) / (GrandTotal - VATIncluded)), 2)))))"
Dim LReplaceWith
LReplaceWith = ReplaceStr(LWITH, "FIELD_GOES_HERE", AField)
If AUseAS Then LReplaceWith = LReplaceWith + " AS " + AField
LSQL = ReplaceStr(LSQL, AField, LReplaceWith)
End If
AddSQLvcSingle = LSQL
End Function
Sub ShowSQL(ASQL)
If IsDebug Then
Response.Write BR & "###" & BR
Response.Write ConvertNewlinesToHTML(ASQL)
' Response.Write FSQL
Response.Write BR & "###" & BR
End If
End Sub
Function GetSQL
GetSQL = FSQL
End Function
' (SS,25/4/23)
Function AddIfTrue(ACondition, AReturnStr)
If ACondition Then
AddIfTrue = AReturnStr
Else
AddIfTrue = ""
End If
End Function
' (SS,21/4/23)
' (SS,11/5/23) modified for headline report where group is forced to be "Category" and only Qty figures are used
Function GetSQLSales
Dim LHasSubcategory, LHasProduct
LHasSubcategory = False
LHasProduct = False
If Not oReport.ReportIsHeadline Then
If oReport.GroupBy = "Subcategory" Then
LHasSubcategory = True
ElseIf oReport.GroupBy = "Product" Then
LHasProduct = True
LHasSubcategory = True
End If
End If
ClearSQL
Dim LWhere
LWhere = "o.PaymentReceived AND od.SubproductOrderDetailID IS NULL" ' "o.PaymentReceived" not really applicable for refunds but does not harm (convenient)
If oReport.ReportIsSalesQty Or oReport.ReportIsHeadline Then LWhere = LWhere + " AND Status <> 'CANCELLED'" ' i.e. Sales Qty, when ignore cancelled orders
' LWhere = LWhere + " AND " + oReport.DateRangeForSQL("DATE(DateTimePaid)")
LWhere = LWhere + " AND " + oReport.DateRangeForSQL("cc.CalendarDate")
If oReport.Category <> CATEGORY_ALL Then LWhere = LWhere + " AND pc.Category = '" + oReport.Category + "'"
If oReport.Subcategory <> SUBCATEGORY_ALL Then LWhere = LWhere + " AND pc.Subcategory = '" + oReport.Subcategory + "'"
Dim LGroupSelect, LGroupSelectA, LGroupSelectB
'LGroupSelect = pc.Category, " & AddIfTrue(LHasSubcategory, "pc.Subcategory, s.SortOrder AS SubcatSortOrder, ") & AddIfTrue(LHasProduct, "od.ProductCode, p.SortOrder AS ProductSortOrder, ") & "c.SortOrder AS CatSortOrder"
LGroupSelect = "pc.Category" + AddIfTrue(LHasSubcategory, ", pc.Subcategory") + AddIfTrue(LHasProduct, ", pc.ProductCode")
LGroupSelectA = ReplaceStr(LGroupSelect, "pc.", "a.")
LGroupSelectB = ReplaceStr(LGroupSelect, "pc.", "b.")
AddSQL "SELECT " + LGroupSelectA + ", Period, SUM(Qty) AS Qty, SUM(NetSales) AS NetSales"
' ###
' (SS,14/6/23) following was an experiment for HF, for setting an "UNASSIGNED" for blank, commented out for now and reverted back to above
' AddSQL "SELECT COALESCE(a.Category, 'UNASSIGNED') AS Category, Period, SUM(Qty) AS Qty, SUM(NetSales) AS NetSales"
AddSQL "FROM"
AddSQL "("
If oReport.ReportIsSalesNet Or oReport.ReportIsSalesQty Or oReport.ReportIsSalesOnly Or oReport.ReportIsHeadline Then
AddSQL "SELECT " + LGroupSelect + ", " + oReport.PeriodSelect + ", SUM(od.Qty) AS Qty, "
AddSQLvc "ROUND(SUM(od.Qty * od.PriceEach), 2) - ROUND(SUM(od.Qty * od.PriceEach * Discount/Subtotal * -1), 2) AS NetSales"
AddSQL "FROM orders o"
AddSQL "INNER JOIN orderdetails od ON od.OrderNo = o.OrderNo"
' AddSQL "INNER JOIN productcategories pc ON pc.ProductCode = od.ProductCode AND pc.Main"
AddSQL "LEFT JOIN productcategories pc ON pc.ProductCode = od.ProductCode AND (pc.Main OR pc.MAIN IS NULL)"
AddSQL "INNER JOIN common.Calendar cc ON cc.CalendarDate = DATE(DateTimePaid)"
AddSQL "WHERE " + LWhere
AddSQL "GROUP BY " + LGroupSelect + ", Period"
End If
If oReport.ReportIsSalesNet Or oReport.ReportIsRefundsOnly Then
If oReport.ReportIsSalesNet Then
AddSQL ""
AddSQL "UNION ALL"
AddSQL ""
End If
' AddSQL "SELECT " + LGroupSelect + ", " + oReport.PeriodSelect + ", SUM(od.Qty) AS Qty, "
'AddSQL "-ROUND(SUM(IF(GrandTotal = 0, RefundAmount, od.Qty * od.PriceEach * RefundAmount/GrandTotal)), 2) AS NetSales"
'AddSQL "-ROUND(SUM(IF(GrandTotal = 0, RefundAmount, od.Qty * od.PriceEach * RefundNet/GrandTotal)), 2) AS NetSales"
'AddSQL "-ROUND(SUM(IF(GrandTotal = 0, 0, od.Qty * od.PriceEach * RefundNet/(GrandTotal - VATIncluded))), 2) AS NetSales"
'AddSQL "-ROUND(SUM(IF(GrandTotal = 0, 0, od.Qty * od.PriceEach * (RefundNet - IF(o.Status = 'CANCELLED', Delivery, 0))/(GrandTotal - VATIncluded))), 2) AS NetSales"
'AddSQL "-ROUND(SUM(od.Qty * od.PriceEach * ((RefundNet - IF(o.Status = 'CANCELLED' AND RefundAmount = GrandTotal, Delivery, 0) ) / (GrandTotal - VATIncluded - Delivery))), 2) AS NetSales"
' AddSQL "-ROUND(SUM(od.Qty * od.PriceEach * ((RefundNet - IF(o.Status = 'CANCELLED' AND RefundAmount = GrandTotal, Delivery, 0) ) / (GrandTotal - VATIncluded - Delivery))), 2) AS NetSales"
' AddSQL "-ROUND(SUM(ROUND(od.Qty * od.Pri'ceEach, 2) - ROUND(SUM(od.Qty * od.PriceEach * Discount/Subtotal * -1), 2)) * ((RefundNet - IF(o.Status = 'CANCELLED' AND RefundAmount = GrandTotal, Delivery, 0)) / (GrandTotal - VATIncluded - Delivery)), 2) AS NetSales"
' AddSQL "-ROUND(SUM(od.Qty * od.PriceEach - od.Qty * od.PriceEach * Discount/Subtotal * -1) * ((RefundNet - IF(o.Status = 'CANCELLED' AND RefundAmount = GrandTotal, Delivery, 0)) / (GrandTotal - VATIncluded - Delivery)), 2) AS NetSales"
' (SS,6/5/23) had to change to do a query on a query due to unexpected behaviour giving incorrect result when using SUM in single query
' (SS,8/5/23) modified to use RefundNet if GrandTotal is 0 (due to divide by 0 was returning NULL without IF(GrandTotal = 0, RefundNet, ...)
AddSQL "SELECT " + LGroupSelectB + ", Period, 0 AS Qty, -SUM(NetRefunds) AS NetSales"
AddSQL "FROM"
AddSQL "("
AddSQL "SELECT " + LGroupSelect + ", " + oReport.PeriodSelect + ", r.RefundID, "
' AddSQL "ROUND((od.Qty * od.PriceEach - od.Qty * od.PriceEach * Discount/Subtotal * -1) * ((RefundNet - IF(o.Status = 'CANCELLED' AND RefundAmount = GrandTotal, Delivery, 0)) / (GrandTotal - VATIncluded - Delivery)), 2) AS NetRefunds"
AddSQLvc "IF(GrandTotal = 0, RefundNet, ROUND((od.Qty * od.PriceEach - od.Qty * od.PriceEach * Discount/Subtotal * -1) * ((RefundNet - IF(o.Status = 'CANCELLED' AND RefundAmount = GrandTotal, Delivery, 0)) / (GrandTotal - VATIncluded - Delivery)), 2)) AS NetRefunds"
AddSQL "FROM refunds r"
AddSQL "INNER JOIN orders o ON o.OrderNo = r.OrderNo"
AddSQL "INNER JOIN orderdetails od ON od.OrderNo = o.OrderNo"
' AddSQL "INNER JOIN productcategories pc ON pc.ProductCode = od.ProductCode AND pc.Main"
AddSQL "LEFT JOIN productcategories pc ON pc.ProductCode = od.ProductCode AND (pc.Main OR pc.Main IS NULL)"
AddSQL "INNER JOIN common.Calendar cc ON cc.CalendarDate = DATE(RefundDate)"
AddSQL "WHERE " + LWhere
AddSQL ") b"
AddSQL "GROUP BY " + LGroupSelectB + ", Period"
End If
AddSQL ") a"
AddSQL ""
' AddSQL "INNER JOIN categories c ON c.Category = a.Category"
AddSQL "LEFT JOIN categories c ON c.Category = a.Category"
If LHasSubcategory Then AddSQL "INNER JOIN subcategories s ON s.Category = a.Category AND s.Subcategory = a.Subcategory"
If LHasProduct Then AddSQL "INNER JOIN products p ON p.ProductCode = a.ProductCode"
AddSQL "GROUP BY " + LGroupSelectA + ", Period"
' AddSQL "ORDER BY CatSortOrder, SubcatSortOrder, Category, Subcategory, Period"
AddSQL "ORDER BY c.SortOrder, " & AddIfTrue(LHasSubcategory, "s.SortOrder, ") & AddIfTrue(LHasProduct, "p.SortOrder, ") & "Category, " & AddIfTrue(LHasSubcategory, "Subcategory, ") & AddIfTrue(LHasProduct, "ProductCode, ") & "Period"
ShowSQL GetSQL
GetSQLSales = GetSQL
End Function
' (SS,2/5/23)
Function GetSQLPaint
ClearSQL
Dim LWhere
LWhere = oReport.DateRangeForSQL("DATE(DateTimePaid)")
LWhere = LWhere + " AND PaymentReceived AND Status <> 'CANCELLED' AND od.SubproductOrderDetailID IS NULL"
LWhere = LWhere + " AND pa.AttributeValue = 'Radiator'"
LWhere = LWhere + " AND (o.Exchange = FALSE OR INSTR(o.ExchangeReason, 'Damaged in transit') > 0)"
AddSQL "SELECT PaintFinish AS `Paint Finish`, " + oReport.PeriodSelect + ", SUM(Qty) AS Qty, SUM(Sections) AS Sections, SUM(PaintCost) AS PaintCost FROM"
AddSQL "("
AddSQL "SELECT DatePaid, PaintFinish, SUM(Qty) AS Qty, SUM(Sections * Qty) AS Sections, SUM(Sections * Qty * PaintCost) AS PaintCost"
AddSQL "FROM"
AddSQL "("
AddSQL "SELECT o.OrderNo, DATE(DateTimePaid) AS DatePaid, Status, od.ProductCode, od.Qty, pa.AttributeValue,"
AddSQL "IF(odo1.OptionValue = 'Black Primer', 'Base Coat only', odo1.OptionValue) AS PaintFinish,"
AddSQL "odo2.OptionValue AS Sections,"
AddSQL "IF(odo1.OptionValue = 'Black Primer' OR odo1.OptionValue = 'Base Coat only', 0, ptc.PaintCost) AS PaintCost"
AddSQL "FROM orders o"
AddSQL "INNER JOIN orderdetails od ON od.OrderNo = o.OrderNo"
AddSQL "INNER JOIN product_attributes pa ON pa.ProductID = od.ProductID AND pa.AttributeID = 1"
AddSQL "INNER JOIN order_detail_options odo1 ON odo1.OrderDetailID = od.OrderDetailID AND odo1.OptionName = 'Paint Finish'"
AddSQL "INNER JOIN order_detail_options odo2 ON odo2.OrderDetailID = od.OrderDetailID AND odo2.OptionName = 'Sections'"
AddSQL "INNER JOIN paint_costs ptc ON o.DateTimeOrdered BETWEEN ptc.DateTimeStart AND ptc.DateTimeEnd"
AddSQL "WHERE " + LWhere
AddSQL "ORDER BY OrderNo"
AddSQL ") a"
AddSQL "GROUP BY DatePaid, PaintFinish"
AddSQL ") s"
AddSQL "INNER JOIN common.Calendar cc ON cc.CalendarDate = DatePaid"
AddSQL "GROUP BY PaintFinish, Period"
AddSQL "ORDER BY INSTR('Gunmetal Grey,Matt Black,Satin Black,Cream White,Linen White,Antique Bronze,Black Primer,Base Coat only', PaintFinish), Period"
ShowSQL GetSQL
GetSQLPaint = GetSQL
End Function
' (SS,14/6/23)
Function GetSQLDeliveryIncome
ClearSQL
Dim LWhere
LWhere = oReport.DateRangeForSQL("DATE(DateTimePaid)")
LWhere = LWhere + " AND PaymentReceived AND Status <> 'CANCELLED'"
LWhere = LWhere + " AND (o.Exchange = FALSE OR INSTR(o.ExchangeReason, 'Damaged in transit') > 0)"
AddSQL "SELECT DeliveryAgentName, " + oReport.PeriodSelect + ", ROUND(SUM(Delivery), 2) AS DeliveryIncome FROM"
AddSQL "("
AddSQL "SELECT OrderNo, DATE(DateTimePaid) AS DatePaid, IF(COALESCE(DeliveryAgentName, '') = '', 'UNASSIGNED', DeliveryAgentName) AS DeliveryAgentName, "
AddSQLvcAs "Delivery"
AddSQL "FROM orders o"
AddSQL "WHERE " + LWhere
AddSQL "ORDER BY OrderNo"
AddSQL ") a"
AddSQL "INNER JOIN common.Calendar cc ON cc.CalendarDate = DatePaid"
AddSQL "GROUP BY DeliveryAgentName, Period"
ShowSQL GetSQL
GetSQLDeliveryIncome = GetSQL
End Function
Function GetSQLHeadlineNetSales
ClearSQL
AddSQL "SELECT 'Net Sales' AS Headline, Period, SUM(NetSales) AS NetSales"
AddSQL "FROM"
AddSQL "("
AddSQL "SELECT " + oReport.PeriodSelect + ", "
'AddSQL "ROUND(SUM(od.Qty * od.PriceEach), 2) - ROUND(SUM(od.Qty * od.PriceEach * Discount/Subtotal * -1), 2) AS NetSales"
' AddSQL "ROUND(SUM(Subtotal + Discount), 2) AS NetSales"
' following gives the same result as above
AddSQLvc "ROUND(SUM(GrandTotal - VATIncluded - Delivery), 2) AS NetSales"
AddSQL "FROM orders o"
AddSQL "INNER JOIN common.Calendar cc ON cc.CalendarDate = DATE(DateTimePaid)"
AddSQL "WHERE o.PaymentReceived AND " + oReport.DateRangeForSQL("cc.CalendarDate")
AddSQL "GROUP BY Period"
AddSQL ""
AddSQL "UNION ALL"
AddSQL ""
AddSQL "SELECT Period, -SUM(NetRefunds) AS NetSales"
AddSQL "FROM"
AddSQL "("
AddSQL "SELECT RefundID, RefundDate, " + oReport.PeriodSelect + ", "
'# if order was cancelled and refund in full, then subtract delivery from refund net because it was deducted from net sales above
' AddSQL "-ROUND(SUM(RefundNet - IF(o.Status = 'CANCELLED', Delivery, 0)), 2) AS NetSales"
'AddSQL "-ROUND(SUM(RefundNet - IF(o.Status = 'CANCELLED' AND RefundAmount = GrandTotal, Delivery, 0)), 2) AS NetSales"
'AddSQL "ROUND((od.Qty * od.PriceEach - od.Qty * od.PriceEach * Discount/Subtotal * -1) * ((RefundNet - IF(o.Status = 'CANCELLED' AND RefundAmount = GrandTotal, Delivery, 0)) / (GrandTotal - VATIncluded - Delivery)), 2) AS NetRefunds"
AddSQLvc "ROUND(RefundNet - IF(o.Status = 'CANCELLED' AND RefundAmount = GrandTotal, Delivery, 0), 2) AS NetRefunds"
AddSQL "FROM refunds r"
AddSQL "INNER JOIN orders o ON o.OrderNo = r.OrderNo"
AddSQL "INNER JOIN common.Calendar cc ON cc.CalendarDate = DATE(RefundDate)"
AddSQL "WHERE o.PaymentReceived AND " + oReport.DateRangeForSQL("cc.CalendarDate")
AddSQL ") b"
AddSQL "INNER JOIN common.Calendar cc ON cc.CalendarDate = RefundDate"
AddSQL "GROUP BY Period"
AddSQL ") a"
AddSQL ""
AddSQL "GROUP BY Period"
ShowSQL GetSQL
GetSQLHeadlineNetSales = GetSQL
End Function
Sub CreateHeadlineTempTables(AHasRad)
Dim LTempTable
If AHasRad Then
LTempTable = "tmp_headline_hasrad"
Else
LTempTable = "tmp_headline_all"
End If
ExecuteQuery "DROP TEMPORARY TABLE IF EXISTS " & LTempTable
ClearSQL
AddSQL "CREATE TEMPORARY TABLE " & LTempTable
AddSQL "SELECT " + oReport.PeriodSelect + ", "
AddSQL "ROUND(SUM(DeliveryIncome), 2) AS DeliveryIncome, "
AddSQL "COUNT(*) AS Orders"
If IsCIRC Then
AddSQL ", "
AddSQL "SUM(HasRad) AS Rads, SUM(HasValve) AS Valves, "
AddSQL "SUM(HasValveThermostatic) AS ValvesThermostatic, SUM(HasValveManual) AS ValvesManual, "
AddSQL "SUM(HasWallStay) AS WallStays, SUM(HasPipeShroud) AS PipeShrouds, SUM(HasTouchUpPaint) AS TouchUpPaint, "
AddSQL "SUM(HasPaintFinish) AS PaintFinish, "
AddSQL "SUM(QtyRads) AS QtyRads, "
AddSQL "SUM(QtyRadsExc) AS QtyRadsExc, "
AddSQL "SUM(QtyRadsWithPaint) AS QtyRadsWithPaint, "
AddSQL "SUM(QtyRadsExcWithPaint) AS QtyRadsExcWithPaint, "
AddSQL "SUM(QtyValves) AS QtyValves, "
AddSQL "SUM(QtyValvesThermostatic) AS QtyValvesThermostatic, "
AddSQL "SUM(QtyValvesManual) AS QtyValvesManual, "
AddSQL "SUM(QtyWallStays) AS QtyWallStays, "
AddSQL "SUM(QtyPipeShrouds) AS QtyPipeShrouds, "
' (SS,14/6/23) to count how many orders with 1, 2, 3, 4, 5+ rads (excluding clearance)
AddSQL "SUM(Orders0RadExc) AS Orders0RadExc, " ' (SS,27/9/23)
AddSQL "SUM(Orders1RadExc) AS Orders1RadExc, "
AddSQL "SUM(Orders2RadsExc) AS Orders2RadsExc, "
AddSQL "SUM(Orders3RadsExc) AS Orders3RadsExc, "
AddSQL "SUM(Orders4RadsExc) AS Orders4RadsExc, "
AddSQL "SUM(Orders5PlusRadsExc) AS Orders5PlusRadsExc, "
AddSQL "SUM(OrdersRadsExc) AS OrdersRadsExc"
' (SS,26/9/23) to count 1, 2, 3, 4, 5+ rad orders with paint (excluding clearance)
AddSQL ", "
AddSQL "SUM(Orders1RadWithPaint) AS Orders1RadWithPaint, "
AddSQL "SUM(Orders2RadsWithPaint) AS Orders2RadsWithPaint, "
AddSQL "SUM(Orders3RadsWithPaint) AS Orders3RadsWithPaint, "
AddSQL "SUM(Orders4RadsWithPaint) AS Orders4RadsWithPaint, "
AddSQL "SUM(Orders5PlusRadsWithPaint) AS Orders5PlusRadsWithPaint, "
AddSQL "SUM(OrdersRadsWithPaint) AS OrdersRadsWithPaint"
' (SS,26/9/23) to count 0, 1, 2, 3, 4, 5+ rad orders with valves (excluding clearance)
AddSQL ", "
AddSQL "SUM(Orders0RadsWithValves) AS Orders0RadsWithValves, "
AddSQL "SUM(Orders1RadWithValves) AS Orders1RadWithValves, "
AddSQL "SUM(Orders2RadsWithValves) AS Orders2RadsWithValves, "
AddSQL "SUM(Orders3RadsWithValves) AS Orders3RadsWithValves, "
AddSQL "SUM(Orders4RadsWithValves) AS Orders4RadsWithValves, "
AddSQL "SUM(Orders5PlusRadsWithValves) AS Orders5PlusRadsWithValves, "
AddSQL "SUM(OrdersRadsWithValves) AS OrdersRadsWithValves"
End If
AddSQL "FROM"
AddSQL "("
AddSQL "SELECT OrderNo, DATE(DateTimePaid) AS DatePaid, "
AddSQL "MAX(Delivery) AS DeliveryIncome"
If IsCIRC Then
AddSQL ", "
AddSQL "MAX(HasRad) AS HasRad, MAX(HasValve) AS HasValve, "
AddSQL "MAX(HasValveThermostatic) AS HasValveThermostatic, MAX(HasValveManual) AS HasValveManual, "
AddSQL "MAX(HasWallStay) AS HasWallStay, "
AddSQL "MAX(HasPipeShroud) AS HasPipeShroud, "
AddSQL "MAX(HasTouchUpPaint) AS HasTouchUpPaint, "
AddSQL "MAX(HasPaintFinish) AS HasPaintFinish, "
AddSQL "SUM(QtyRads) AS QtyRads, "
AddSQL "SUM(QtyRadsExc) AS QtyRadsExc, "
AddSQL "SUM(QtyRadsWithPaint) AS QtyRadsWithPaint, "
AddSQL "SUM(QtyRadsExcWithPaint) AS QtyRadsExcWithPaint, "
AddSQL "SUM(QtyValves) AS QtyValves, "
AddSQL "SUM(QtyValvesThermostatic) AS QtyValvesThermostatic, "
AddSQL "SUM(QtyValvesManual) AS QtyValvesManual, "
AddSQL "SUM(QtyWallStays) AS QtyWallStays, "
AddSQL "SUM(QtyPipeShrouds) AS QtyPipeShrouds,"
' (SS,14/6/23) to count how many orders with 1, 2, 3, 4, 5+ rads (excluding clearance)
AddSQL "IF(SUM(QtyRadsExc) = 0, 1, 0) AS Orders0RadExc, " ' (SS,27/9/23)
AddSQL "IF(SUM(QtyRadsExc) = 1, 1, 0) AS Orders1RadExc, "
AddSQL "IF(SUM(QtyRadsExc) = 2, 1, 0) AS Orders2RadsExc, "
AddSQL "IF(SUM(QtyRadsExc) = 3, 1, 0) AS Orders3RadsExc, "
AddSQL "IF(SUM(QtyRadsExc) = 4, 1, 0) AS Orders4RadsExc, "
AddSQL "IF(SUM(QtyRadsExc) >= 5, 1, 0) AS Orders5PlusRadsExc, "
AddSQL "IF(SUM(QtyRadsExc) >= 1, 1, 0) AS OrdersRadsExc"
' (SS,26/9/23) to count 1, 2, 3, 4, 5+ rad orders with paint
AddSQL ", "
AddSQL "IF(SUM(QtyRadsExc) = 1, MAX(HasPaintFinish), 0) AS Orders1RadWithPaint, "
AddSQL "IF(SUM(QtyRadsExc) = 2, MAX(HasPaintFinish), 0) AS Orders2RadsWithPaint, "
AddSQL "IF(SUM(QtyRadsExc) = 3, MAX(HasPaintFinish), 0) AS Orders3RadsWithPaint, "
AddSQL "IF(SUM(QtyRadsExc) = 4, MAX(HasPaintFinish), 0) AS Orders4RadsWithPaint, "
AddSQL "IF(SUM(QtyRadsExc) >= 5, MAX(HasPaintFinish), 0) AS Orders5PlusRadsWithPaint, "
AddSQL "IF(SUM(QtyRadsExc) >= 1, MAX(HasPaintFinish), 0) AS OrdersRadsWithPaint"
' (SS,26/9/23) to count 0, 1, 2, 3, 4, 5+ rad orders with valves
AddSQL ", "
AddSQL "IF(SUM(QtyRadsExc) = 0, MAX(HasValve), 0) AS Orders0RadsWithValves, "
AddSQL "IF(SUM(QtyRadsExc) = 1, MAX(HasValve), 0) AS Orders1RadWithValves, "
AddSQL "IF(SUM(QtyRadsExc) = 2, MAX(HasValve), 0) AS Orders2RadsWithValves, "
AddSQL "IF(SUM(QtyRadsExc) = 3, MAX(HasValve), 0) AS Orders3RadsWithValves, "
AddSQL "IF(SUM(QtyRadsExc) = 4, MAX(HasValve), 0) AS Orders4RadsWithValves, "
AddSQL "IF(SUM(QtyRadsExc) >= 5, MAX(HasValve), 0) AS Orders5PlusRadsWithValves, "
AddSQL "IF(SUM(QtyRadsExc) >= 1, MAX(HasValve), 0) AS OrdersRadsWithValves"
End If
AddSQL "FROM"
AddSQL "("
AddSQLvcAs "SELECT o.OrderNo, CustomerID, EmailAddress, DateTimeOrdered, DateTimePaid, GrandTotal, Delivery, Status, od.ProductCode, pc.Main, pc.Category, pc.Subcategory"
If IsCIRC Then
AddSQL ", "
AddSQL "AttributeValue = 'Radiator' AS HasRad, "
AddSQL "AttributeValue = 'Valve Set' AS HasValve, "
AddSQL "AttributeValue = 'Valve Set' AND Subcategory = 'Thermostatic' AS HasValveThermostatic, "
AddSQL "AttributeValue = 'Valve Set' AND Subcategory = 'Manual' AS HasValveManual, "
AddSQL "AttributeValue = 'Wall Stay' AS HasWallStay, "
AddSQL "AttributeValue = 'Pipe Shrouds' AS HasPipeShroud, "
AddSQL "AttributeValue = 'Touch Up Paint' AS HasTouchUpPaint, "
AddSQL "AttributeValue = 'Radiator' AND odo.OptionValue IS NOT NULL AND odo.OptionValue <> 'Black Primer' AND odo.OptionValue <> 'Base Coat only' AS HasPaintFinish, "
AddSQL "IF(AttributeValue = 'Radiator', Qty, 0) AS QtyRads, "
AddSQL "IF(AttributeValue = 'Radiator' AND pc.Category <> 'Clearance', Qty, 0) AS QtyRadsExc, "
AddSQL "IF(AttributeValue = 'Radiator' AND odo.OptionValue IS NOT NULL AND odo.OptionValue <> 'Black Primer' AND odo.OptionValue <> 'Base Coat only', Qty, 0) AS QtyRadsWithPaint, "
AddSQL "IF(AttributeValue = 'Radiator' AND pc.Category <> 'Clearance' AND odo.OptionValue IS NOT NULL AND odo.OptionValue <> 'Black Primer' AND odo.OptionValue <> 'Base Coat only', Qty, 0) AS QtyRadsExcWithPaint, "
AddSQL "IF(AttributeValue = 'Valve Set', Qty, 0) AS QtyValves, "
AddSQL "IF(AttributeValue = 'Valve Set' AND Subcategory = 'Thermostatic', Qty, 0) AS QtyValvesThermostatic, "
AddSQL "IF(AttributeValue = 'Valve Set' AND Subcategory = 'Manual', Qty, 0) AS QtyValvesManual, "
AddSQL "IF(AttributeValue = 'Wall Stay', Qty, 0) AS QtyWallStays, "
AddSQL "IF(AttributeValue = 'Pipe Shrouds', Qty, 0) AS QtyPipeShrouds"
End If
AddSQL "FROM orders o"
AddSQL "INNER JOIN orderdetails od ON od.OrderNo = o.OrderNo"
AddSQL "INNER JOIN productcategories pc ON pc.ProductCode = od.ProductCode AND pc.Main"
If IsCIRC Then
' (SS,14/6/23) changed INNER JOIN to LEFT JOIN because we're now counting all orders and DeliveryIncome for all orders
AddSQL "LEFT JOIN product_attributes pa ON pa.ProductID = od.ProductID AND pa.AttributeID = 1"
AddSQL "LEFT JOIN order_detail_options odo ON odo.OrderDetailID = od.OrderDetailID AND odo.OptionName = 'Paint Finish'"
End If
AddSQL "WHERE " + oReport.DateRangeForSQL("DATE(DateTimePaid)") + " AND PaymentReceived AND Status <> 'CANCELLED' AND od.SubproductOrderDetailID IS NULL"
AddSQL "AND (o.Exchange = FALSE OR INSTR(o.ExchangeReason, 'Damaged in transit') > 0)"
AddSQL "ORDER BY OrderNo"
AddSQL ") a"
AddSQL "GROUP BY OrderNo"
AddSQL ") b"
AddSQL "INNER JOIN common.Calendar cc ON cc.CalendarDate = DatePaid"
If AHasRad Then AddSQL "WHERE HasRad"
AddSQL "GROUP BY Period"
ShowSQL GetSQL
ExecuteQuery GetSQL
End Sub
Sub CopySQLToArray(ASQL)
Dim LFieldCount, f, r, LFieldValue
OpenQuery(ASQL)
' oRS is global reference to record set used by OpenQuery (untidy I know)
LFieldCount = oRS.Fields.Count
' set the data array size to 0 (i.e. one record to hold the field names)
Redim FDataArray(LFieldCount - 1, 0)
' store field names in first row of array
For f = 0 To LFieldCount - 1
FDataArray(f, 0) = oRS.Fields.Item(f).Name
Next
r = 0
' copy each record, field by field to array
Do While Not EndOfQuery
r = r + 1
Redim Preserve FDataArray(LFieldCount - 1, r) ' resize the array preserving the existing data
For f = 0 To LFieldCount - 1
LFieldValue = oRS.Fields.Item(f).Value
FDataArray(f, r) = LFieldValue
Next
NextQueryRecord
Loop
CloseQuery
End Sub
' (SS,24/4/23)
Sub CopySQLToCrosstabArray(ACrosstabField, ADataField)
' FDataCrosstabArray
' redimension the array using unique groups and crosstabs
' populate the array
Dim LGroup1Used, LGroup2Used, LGroup3Used
LGroup1Used = oReport.GroupField1 <> ""
LGroup2Used = oReport.GroupField2 <> ""
LGroup3Used = oReport.GroupField3 <> ""
Dim LColumnNameArray, LCrosstabFieldIndex, LCrosstabFieldValue
Dim r, i, LFound
ReDim LColumnNameArray(-1) ' -1 for empty array because it starts from 0
ReDim FCrosstabColumnNameArray(-1) ' -1 for empty array because it starts from 0
'Response.Write "@" & UBound(LColumnNameArray) & "@" & BR
'ReDim Preserve FCrosstabColumnNameArray(0) ' -1 for empty array because it starts from 0
'FCrosstabColumnNameArray(0) = "ABC"
'Response.Write "@" & UBound(LColumnNameArray) & "@" & "=" & LColumnNameArray(UBound(LColumnNameArray)) & BR
'Redim LColumnNameArray(UBound(LColumnNameArray) + 1)
'ReDim Preserve FCrosstabColumnNameArray(UBound(FCrosstabColumnNameArray) + 1)
'FCrosstabColumnNameArray(1) = "DEF"
'Response.Write "@" & UBound(LColumnNameArray) & "@" & "=" & LColumnNameArray(0) & "=" & LColumnNameArray(1) & BR
'Redim LColumnNameArray(0)
' get the data field columns into sorted array
LCrosstabFieldIndex = GetArrayFieldIndex(ACrosstabField)
Dim LRecordCount
LRecordCount = UBound(FDataArray, 2)
For r = 1 To LRecordCount
LCrosstabFieldValue = FDataArray(LCrosstabFieldIndex, r)
' look if value already exists
LFound = False
If UBound(FCrosstabColumnNameArray) >= 0 Then
For i = 0 To UBound(FCrosstabColumnNameArray)
If FCrosstabColumnNameArray(i) = LCrosstabFieldValue Then
LFound = True
Exit For
End If
Next
End If
' add if not found
If Not LFound Then
ReDim Preserve FCrosstabColumnNameArray(UBound(FCrosstabColumnNameArray) + 1)
FCrosstabColumnNameArray(UBound(FCrosstabColumnNameArray)) = LCrosstabFieldValue
End If
Next
'ReDim Preserve LColumnNameArray(UBound(LColumnNameArray) + 1)
'LColumnNameArray(UBound(LColumnNameArray)) = "DEF"
'Response.Write "@@@@" & UBound(LColumnNameArray) & "@@@" & BR
'For i = 0 To UBound(LColumnNameArray)
' Response.Write "=" & LColumnNameArray(i) & BR
'Next
' sort the array
FCrosstabColumnNameArray = BubbleSort(FCrosstabColumnNameArray)
If IsDebug Then
Response.Write BR & "@@@SORTED@@@" & BR
For i = 0 To UBound(FCrosstabColumnNameArray)
Response.Write "=" & FCrosstabColumnNameArray(i) & BR
Next
End If
Dim LDataColumnCount
LDataColumnCount = UBound(FCrosstabColumnNameArray) + 1
' create the crosstab array
Dim LGroupFieldCount
LGroupFieldCount = 0
If LGroup1Used Then LGroupFieldCount = LGroupFieldCount + 1
If LGroup2Used Then LGroupFieldCount = LGroupFieldCount + 1
If LGroup3Used Then LGroupFieldCount = LGroupFieldCount + 1
ReDim FDataCrosstabArray(LGroupFieldCount + LDataColumnCount - 1, 0)
' first row has the field names
Dim f
f = -1
If LGroup1Used Then f = f + 1: FDataCrosstabArray(f, 0) = oReport.GroupField1
If LGroup2Used Then f = f + 1: FDataCrosstabArray(f, 0) = oReport.GroupField2
If LGroup3Used Then f = f + 1: FDataCrosstabArray(f, 0) = oReport.GroupField3
For i = 0 To LDataColumnCount - 1
f = f + 1
FDataCrosstabArray(f, 0) = FCrosstabColumnNameArray(i)
Next
If IsDebug Then
Response.Write "===" & BR
For i = 0 To f
Response.Write FDataCrosstabArray(i, 0) & ", "
Next
Response.Write "===" & BR
End If
' create the records
Dim LGroup1, LGroup2, LGroup3, LNewGroup
Dim LPrevGroup1, LPrevGroup2, LPrevGroup3
LPrevGroup1 = ""
LPrevGroup2 = ""
LPrevGroup3 = ""
Dim LGroupField1Index, LGroupField2Index, LGroupField3Index
If LGroup1Used Then LGroupField1Index = GetCrosstabArrayFieldIndex(oReport.GroupField1)
If LGroup2Used Then LGroupField2Index = GetCrosstabArrayFieldIndex(oReport.GroupField2)
If LGroup3Used Then LGroupField3Index = GetCrosstabArrayFieldIndex(oReport.GroupField3)
Dim LCurrentRow
LCurrentRow = 0
Dim LDataColumnIndex, LDataFieldIndex, LDataFieldValue
LDataFieldIndex = GetArrayFieldIndex(ADataField)
For r = 1 To LRecordCount
' get the group
If LGroup1Used Then LGroup1 = FDataArray(LGroupField1Index, r)
If LGroup2Used Then LGroup2 = FDataArray(LGroupField2Index, r)
If LGroup3Used Then LGroup3 = FDataArray(LGroupField3Index, r)
' detect new group
LNewGroup = False
If LGroup1Used And LGroup1 <> LPrevGroup1 Then LNewGroup = True
If LGroup2Used And LGroup2 <> LPrevGroup2 Then LNewGroup = True
If LGroup3Used And LGroup3 <> LPrevGroup3 Then LNewGroup = True
LPrevGroup1 = LGroup1
LPrevGroup2 = LGroup2
LPrevGroup3 = LGroup3
' if new group then add new record to crosstab array
If LNewGroup Then
ReDim Preserve FDataCrosstabArray(UBound(FDataCrosstabArray, 1), UBound(FDataCrosstabArray, 2) + 1)
LCurrentRow = UBound(FDataCrosstabArray, 2)
If LGroup1Used Then FDataCrosstabArray(LGroupField1Index, LCurrentRow) = LGroup1
If LGroup2Used Then FDataCrosstabArray(LGroupField2Index, LCurrentRow) = LGroup2
If LGroup3Used Then FDataCrosstabArray(LGroupField3Index, LCurrentRow) = LGroup3
' clear the values because they'll be zero, we prefer null to indicate no value
For f = UBound(FDataCrosstabArray, 1) - LDataColumnCount + 1 To UBound(FDataCrosstabArray, 1)
FDataCrosstabArray(f, LCurrentRow) = Null
Next
End If
LCrosstabFieldValue = FDataArray(LCrosstabFieldIndex, r)
LDataFieldValue = FDataArray(LDataFieldIndex, r)
If LCrosstabFieldValue <> "" Then
LDataColumnIndex = GetCrosstabArrayFieldIndex(LCrosstabFieldValue)
If LDataColumnIndex <> -1 Then
FDataCrosstabArray(LDataColumnIndex, LCurrentRow) = LDataFieldValue
Else
ShowErrorMsg "Data column " & LCrosstabFieldValue & "not found"
End If
Else ' show error, shouldn't occur
ShowErrorMsg "Blank CrosstabFieldValue"
End If
Next
DebugMsg "RECORD COUNT: " & LCurrentRow
End Sub
' (SS,25/4/23)
Sub AddTotalsToCrosstabArray(ADataArray, AColumnsToTotalArray)
' determine start and end number field
Dim LColStart, LColEnd
LColStart = oReport.GroupFieldCount
LColEnd = UBound(ADataArray, 1)
Dim LRecordCount, LTotalRow, c, r, LValue
' add a new row to holds totals, preserving existing data
ReDim Preserve ADataArray(UBound(ADataArray, 1), UBound(ADataArray, 2) + 1)
LTotalRow = oReport.TotalRow
LRecordCount = LTotalRow - 1
' zero totals first
For c = LColStart To LColEnd
ADataArray(c, LTotalRow) = 0
Next
For r = 1 To LRecordCount
' total the appropriate columns
For c = LColStart To LColEnd
LValue = ADataArray(c, r)
'If LValue = "" Then LValue = 0
LValue = NZ(LValue) ' treat null as zero
' Response.Write "###" & f & "#" & FDataArray(f, LRecordCount + 1) & " + " & LValue & " = " & FDataArray(f, LRecordCount + 1) + LValue & BR
ADataArray(c, LTotalRow) = ADataArray(c, LTotalRow) + LValue
'Response.Write "###" & f & "#" & FDataArray(f, LRecordCount + 1) & BR
'Response.Write "###" & f & "#" & LValue & BR
Next
Next
End Sub
' (SS,5/5/23)
Sub ApplyCrosstabDivCalc(ASourceName, ADivideByName, AResultName)
Dim LSourceRow, LDivideByRow, LResultRow
LSourceRow = GetCrosstabRowByName(ASourceName)
LDivideByRow = GetCrosstabRowByName(ADivideByName)
LResultRow = GetCrosstabRowByName(AResultName)
'Response.Write "###LSourceRow: " & LSourceRow & BR
'Response.Write "###LDivideByRow: " & LDivideByRow & BR
'Response.Write "###LResultRow: " & LResultRow & BR
' assumes 2nd column onwards are the period columns
Dim f, LLastCol, LDivideBy
LLastCol = UBound(FDataCrosstabArray, 1)
For f = 1 To LLastCol
LDivideBy = NZ(FDataCrosstabArray(f, LDivideByRow))
If LDivideBy <> 0 Then ' prevents divide by 0
FDataCrosstabArray(f, LResultRow) = FDataCrosstabArray(f, LSourceRow) / LDivideBy
End If
Next
End Sub
' (SS,5/5/23)
Function GetCrosstabRowByName(AName)
Dim r, LEndRow, LResult
LEndRow = UBound(FDataCrosstabArray, 2)
LResult = -1
For r = 0 To LEndRow
If FDataCrosstabArray(0, r) = AName Then
LResult = r
Exit For
End If
Next
GetCrosstabRowByName = LResult
End Function
' (SS,24/4/23) from http://stackoverflow.com/questions/45374401/how-to-sort-an-array-10a-23a-1a-2a-using-vbscript
Function BubbleSort(ByVal arr)
Dim i, j, tmp
For i = 0 To UBound(arr)
For j = i + 1 to UBound(arr)
If arr(i) > arr(j) Then
tmp = arr(i)
arr(i) = arr(j)
arr(j) = tmp
End If
Next
Next
Bubblesort = arr
End Function
' (SS,2/11/22)
Function GetArrayFieldIndex(AFieldName)
GetArrayFieldIndex = -1
Dim f, LFieldCount
LFieldCount = UBound(FDataArray, 1) ' size of first dimension i.e. columns
For f = 0 To LFieldCount
If FDataArray(f, 0) = AFieldName Then
GetArrayFieldIndex = f
Exit For
End If
Next
End Function
' (SS,24/4/23)
Function GetCrosstabArrayFieldIndex(AFieldName)
GetCrosstabArrayFieldIndex = -1
Dim f, LFieldCount
LFieldCount = UBound(FDataCrosstabArray, 1) ' size of first dimension i.e. columns
'Response.Write "#" & LFieldCount & "#"
For f = 0 To LFieldCount
If FDataCrosstabArray(f, 0) = AFieldName Then
GetCrosstabArrayFieldIndex = f
Exit For
End If
Next
End Function
Sub ShowTableFromArray(ByRef ADataArray)
ShowTableArrayHeader ADataArray
Dim r, f, LFieldName, LFieldValue, LStyle, LLastRecord, LLastField
LLastRecord = UBound(ADataArray, 2)
LLastField = UBound(ADataArray, 1)
For r = 1 To LLastRecord
Response.Write "<tr>"
LStyle = " class=""cell-left"" "
For f = 0 To LLastField
LFieldValue = ADataArray(f, r)
Response.Write "<td" & LStyle & ">" & LFieldValue & "</td>"
Next
Response.Write "</tr>" & NL
Next
ShowTableArrayFooter
End Sub
Sub ShowTableFromCrosstabArray(ByRef ADataArray, ByRef AColumnsToTotalArray)
ShowTableCrosstabArrayHeader ADataArray, AColumnsToTotalArray
Dim r, f, LFieldName, LFieldValue, LStyle, LRecordCount
LRecordCount = oReport.RowCount
oReport.StartColourGroup
For r = 1 To LRecordCount
' following to allow display format change for different rows (i.e. Metrics), also sets colour group if applicable
oReport.SetDisplayFormatGroup ADataArray(0, r)
If oReport.IsColoured And oReport.HasColourGroups Then
Response.Write "<tr class=""" + oReport.ColourGroupClass + """>"
Else
Response.Write "<tr>"
End If
LStyle = " class=""cell-left"" "
For f = 0 To oReport.GroupFieldCount - 1
LFieldValue = ADataArray(f, r)
Response.Write "<td" & LStyle & ">" & LFieldValue & "</td>"
Next
oReport.SetPeriodLoop
For f = oReport.LoopStart To oReport.LoopEnd Step oReport.LoopStep
ShowPeriodCells r, f, False
Next
Response.Write "</tr>" & NL
Next
ShowTableCrosstabArrayBodyFooter
If oReport.HasTotalRow Then ShowTableCrossArrayTotals ADataArray, AColumnsToTotalArray
ShowTableCrosstabArrayFooter
End Sub
Sub ShowTableCrosstabArrayHeader(ByRef ADataArray, ByRef AColumnsToTotalArray)
' for each field
' table-responsive table-sm table-bordered table-striped"
Dim LExtraClass
LExtraClass = ""
If oReport.IsBlack Then LExtraClass = LExtraClass + " table-dark"
If oReport.HasStripes Then LExtraClass = LExtraClass + " table-striped"
If oReport.Size <> "" Then
LExtraClass = LExtraClass + " table-sm"
If oReport.Size <> "Compact" Then
LExtraClass = LExtraClass + " font-size-pc-" & oReport.Size
End If
End If
' for small compact tables use "table-sm" class
' (12/5/23) replaced "table-responsive-lg" with ""table-responsive"
%>
<div class="table-responsive">
<table id="myTable" class="table table-bordered<%=LExtraClass%> font-small" style="width: auto;">
<thead>
<tr style="cursor: pointer;">
<%
Dim f, LFieldName, LStyle, LValue, LColspan
LStyle = " class=""cell-left"""
For f = 0 To oReport.GroupFieldCount - 1
LFieldName = ADataArray(f, 0)
Response.Write "<th" & LStyle & GetOnClickSort(f, "S") & ">" & LFieldName & "</th>"
Next
oReport.SetPeriodLoop
LStyle = " class=""cell-center"""
LColspan = ""
If oReport.PeriodColspan > 1 Then
LColspan = " colspan=""" & oReport.PeriodColspan & """"
Else
LColspan = ""
End If
For f = oReport.LoopStart To oReport.LoopEnd Step oReport.LoopStep
LFieldName = ADataArray(f, 0)
LValue = AdjustPeriodForQuarter(LFieldName)
' If IsNumericColumn(AColumnsToTotalArray, LFieldName) Then
Response.Write "<th" & LColspan & LStyle & GetOnClickSort(f, "N") & ">" & LValue & "</th>"
Next
%>
</tr>
</thead>
<tbody class="table-group-divider">
<%
End Sub
' ATYpe can be "S" for string string sort, "N" for numeric sort, HasTotalRow is also added to javascript function
Function GetOnClickSort(AIndex, AType)
GetOnClickSort = " onclick=""sortTable(" & AIndex & ", '" & AType & "', " & IIf(oReport.HasTotalRow, "true", "false") & ")"""
End Function
Sub ShowTableCrosstabArrayBodyFooter
%>
</tbody>
<%
End Sub
Sub ShowTableCrossArrayTotals(ByRef ADataArray, ByRef AColumnsToTotalArray)
Response.Write "<tfoot class=""table-group-divider"">" & NL
Response.Write "<tr>" & NL
Response.Write "<td colspan=""" & oReport.GroupFieldCount & """><b>Totals</b></td>" & NL
Dim f, LFieldValue, LTotalRowIndex
LTotalRowIndex = oReport.TotalRow ' assume last row is the total row
For f = oReport.LoopStart To oReport.LoopEnd Step oReport.LoopStep
LFieldValue = oReport.CellValue(LTotalRowIndex, f)
ShowPeriodCells LTotalRowIndex, f, True
Next
Response.Write "</tr>" & NL
Response.Write "<tfoot>" & NL
End Sub
Sub ShowTableCrosstabArrayFooter
%>
</tbody>
</table>
</div>
<%
AddSortTableScript
End Sub
' handles both main and totals cells
Sub ShowPeriodCells(ARow, AColumn, AIsTotal)
Dim LClass, LClassExtra, LValue
LClass = "cell-right"
If AIsTotal Then LClass = LClass + " cell-bold" ' add bold if total row
If oReport.ShowValue Then Response.Write "<td class=""" & LClass & """>" & oReport.CellValue(ARow, AColumn) & "</td>"
If oReport.ShowPercentage Then Response.Write "<td class=""" & LClass & """>" & oReport.CellPercentage(ARow, AColumn) & "</td>"
If oReport.ShowDifference Then
LValue = oReport.CellDifference(ARow, AColumn)
' if negative then make red
If InStr(LValue, "-") > 0 Then
LClassExtra = " text-danger" ' " cell-red"
'LValue = ReplaceStr(LValue, "-", "↓")
ElseIf InStr(LValue, ".") > 0 Then ' if positive (contains a dot) then prefix with + and make blue
LClassExtra = " text-primary" ' " cell-blue"
'LValue = "↑" & LValue
LValue = "+" & LValue
End If
Response.Write "<td class=""" & LClass + LClassExtra & """>" & LValue & "</td>"
End If
End Sub
' (SS,25/4/23)
Function IsNumericColumn(ByRef AColumnNameArray, AColumnName)
Dim i, LResult
LResult = False
For i = 0 To UBound(AColumnNameArray)
If AColumnNameArray(i) = AColumnName Then
LResult = True
Exit For
End If
Next
IsNumericColumn = LResult
End Function
' (SS,25/4/23) 0 places for now, adds pound prefix as well
Function FormatDP(ANumber)
Dim LResult
If IsNull(ANumber) Then
LResult = Null
Else
LResult = FormatNumber(ANumber, 0, vbTrue, vbFalse, vbTrue)
If oReport.DisplayFormat = DF_CURRENCY Then LResult = "£" & LResult
End If
FormatDP = LResult
End Function
Sub ShowTableArrayHeader(ByRef ADataArray)
%>
<table class="table table-responsive table-sm table-bordered table-striped" style="width: auto;">
<thead>
<tr>
<%
Dim f, LFieldName, LLastField, LStyle, LValue
LLastField = UBound(ADataArray, 1)
LStyle = " class=""cell-left"""
For f = 0 To LLastField
LFieldName = ADataArray(f, 0)
Response.Write "<th" & LStyle & ">" & LFieldName & "</th>"
Next
%>
</tr>
</thead>
<tbody>
<%
End Sub
Sub ShowTableArrayFooter
%>
</tbody>
</table>
<%
End Sub
' (SS,26/4/23) returns HTML list of options, period type can
Function GetPeriodOptionList(APeriodType)
' run query on the orders table DateTimePaid field to get the range of periods
Dim LResult, LSQL, LPeriodField, LValue, LValueDisplayed
' APeriodType in following already has CleanSQLStr applied to it, but I applied it again for habit (it won't harm the expected value here)
LSQL = "SELECT DISTINCT " & CleanSQLStr(APeriodType) & "1 AS Period FROM " &_
"(SELECT DISTINCT(DATE(DateTimePaid)) AS PeriodDate FROM orders) a INNER JOIN common.calendar c ON c.CalendarDate = a.PeriodDate"
OpenQuery LSQL
ReDim FPeriodListArray(-1)
Do While Not EndOfQuery
LValue = GetQueryValue("Period")
ReDim Preserve FPeriodListArray(UBound(FPeriodListArray) + 1)
FPeriodListArray(UBound(FPeriodListArray)) = LValue
NextQueryRecord
Loop
CloseQuery
' build option list in reverse
LResult = ""
Dim i
For i = UBound(FPeriodListArray) To 0 Step -1
LValue = FPeriodListArray(i)
LValueDisplayed = AdjustPeriodForQuarter(LValue)
LResult = LResult & "<option value=""" & LValue & """>" & LValueDisplayed & "</option>" & NL
Next
GetPeriodOptionList = LResult
End Function
Function AdjustPeriodForQuarter(APeriod)
If oReport.PeriodType = PT_QUARTER Then
AdjustPeriodForQuarter = ReplaceStr(APeriod, "-", " Q")
Else
AdjustPeriodForQuarter = APeriod
End If
End Function
' returns true if given period is valid, looks in the array created by GetPeriodOptionList
Function PeriodIsValid(APeriodValue)
Dim i, LResult
LResult = False
For i = 0 To UBound(FPeriodListArray)
If FPeriodListArray(i) = APeriodValue Then
LResult = True
Exit For
End If
Next
PeriodIsValid = LResult
End Function
' returns an appropriate default for start or End of given period type
Function SetPeriodDefault(APeriodType, AIsStart)
Dim LResult, LBottomIndex, LOffset
LBottomIndex = UBound(FPeriodListArray)
If AIsStart Then
If APeriodType = PT_MONTH Then
LOffset = 12
ElseIf APeriodType = PT_QUARTER Then
LOffset = 4
Else ' i.e. PT_YEAR
LOffset = 4
End If
LResult = FPeriodListArray(Max(LBottomIndex - LOffset, 0))
Else
LResult = FPeriodListArray(LBottomIndex)
End If
SetPeriodDefault = LResult
End Function
Function HasHostName(AValue)
HasHostName = InStr(1, Request.ServerVariables("SERVER_NAME"), AValue, vbTextCompare) > 0
End Function
Function IsCIRC
IsCIRC = HasHostName("castironrad")
' IsCIRC = False
End Function
' (SS,15/5/23)
Function IsHF
IsHF = HasHostName("hyperflight")
' IsHF = True
End Function
Function IsCheckMode
IsCheckMode = FCHECK_MODE
End Function
Sub ShowPageHeader
' (SS,26/9/23) changed from 5.3.0 to 5.3.1 for Bootstrap, and from 3.6.4 to 3.7.0 for jquery/jquery-3
%>
<!doctype html>
<html lang="en">
<head>
<meta charset="utf-8">
<meta name="viewport" content="width=device-width, initial-scale=1">
<title>Financial Reports</title>
<link href="/common/bootstrap/5.3.1/css/bootstrap.min.css" rel="stylesheet">
<link href="/common/bootstrap/5.3.1/js/bootstrap.bundle.min.js" rel="stylesheet">
<script src="/common/jquery/jquery-3.7.0.min.js"></script>
<style>
/*
.table td, .table th {
text-align: center;
}
*/
th, td {
white-space: nowrap;
}
.cell-right {
text-align: right;
}
.cell-left {
text-align: left;
}
.cell-center {
text-align: center;
}
.cell-bold {
font-weight: bold;
}
.font-size-pc-90 {
font-size: 90%;
}
.font-size-pc-80 {
font-size: 80%;
}
.font-size-pc-70 {
font-size: 70%;
}
.font-size-pc-60 {
font-size: 60%;
}
.font-size-pc-50 {
font-size: 50%;
}
.hide-processing { display: none; }
.form-control {
padding: 3px 3px;
}
.gunmetal-grey {
/* background-color: #8D918D; */
background-color: #BFC3BF;
}
.antique-bronze {
background-color: #B6AD6E;
}
.cream-white {
background-color: #FFFDD0;
}
.linen-white {
background-color: #F3EAD9;
}
.matt-black {
background-color: #8B8B8B; /* black; */
}
.satin-black {
background-color: #AEB0B2; /*#727476; */ /* gray; */
}
.base-coat-only {
background-color: white;
}
</style>
</head>
<body>
<div class="container-fluid">
<h2><img src="/images/logo.png" style="height:36px" class="img-thumbnail"> Financial Reports</span></h2>
<%
End Sub
Sub ShowPageFooter
%>
</div>
</body>
</html>
<%
End Sub
' (SS,14/6/23) added DeliveryIncome
Sub ShowReportForm
%>
<form method="get" name="frmChoice" class="d-print-none row row-cols-lg-auto g-2 align-items-center mb-2">
<div class="form-floating">
<select class="form-select" name="reportname" id="reportname" onchange="submit_form()">
<option value="Headline">Headline</option>
<option value="Sales Net">Sales Net</option>
<option value="Sales Qty">Sales Qty</option>
<%If IsCheckMode Then%>
<option value="Sales Only">Sales Only</option>
<option value="Refunds Only">Refunds Only</option>
<%End If%>
<%If IsCIRC Then%>
<option value="Paint Qty">Paint Qty</option>
<option value="Paint Sections">Paint Sections</option>
<option value="Paint Cost">Paint Cost</option>
<%End If%>
<option value="Delivery Income">Delivery Income</option>
</select>
<label class="ms-1" for="reportname">Report</label>
</div>
<div class="form-floating">
<select class="form-select" name="periodtype" id="periodtype" onchange="submit_form()">
<option value="Month">Month</option>
<option value="Quarter">Quarter</option>
<option value="Year">Year</option>
</select>
<label class="ms-1" for="periodtype">Period</label>
</div>
<div class="form-floating">
<select class="form-select" name="periodstart" id="periodstart" onchange="submit_form()">
<%=FPeriodOptionList%>
</select>
<label class="ms-1" for="periodstart">Start</label>
</div>
<div class="form-floating">
<select class="form-select" name="periodend" id="periodend" onchange="submit_form()">
<%=FPeriodOptionList%>
</select>
<label class="ms-1" for="periodend">End</label>
</div>
<div class="form-floating">
<select class="form-select" name="periodorder" id="periodorder" onchange="submit_form()">
<option value="Asc">→ </option>
<option value="Desc">← </option>
</select>
<label class="ms-1" for="periodorder">Order</label>
</div>
<div class="form-floating">
<select class="form-select" name="periodrange" id="periodrange" onchange="submit_form()">
<option value="Start to End">Start to End</option>
<option value="Start & End">Start & End</option>
<%If oReport.PeriodTypeIsMonth Or oReport.PeriodTypeIsQuarter Then%>
<option value="Same">Same <%=oReport.PeriodType%></option>
<%End If%>
</select>
<label class="ms-1" for="periodrange">Range</label>
</div>
<div class="form-floating">
<select class="form-select" name="show" id="show" onchange="submit_form()">
<option value="Value">Value</option>
<option value="% of Total">% of Total</option>
<option value="Difference">Difference</option>
<option value="Value, %">Value, %</option>
<option value="Value, Diff.">Value, Diff.</option>
<option value="Value, %, Diff.">Value, %, Diff.</option>
</select>
<label class="ms-1" for="show">Show</label>
</div>
<div class="form-floating">
<select class="form-select" name="background" id="background" onchange="submit_form()">
<option value="White">White</option>
<option value="Coloured">Coloured</option>
<option value="Black">Black</option>
<option value="Striped White">Striped W.</option>
<option value="Striped Coloured">Striped C.</option>
<option value="Striped Black">Stripe B.</option>
</select>
<label class="ms-1" for="background">Background</label>
</div>
<div class="form-floating">
<select class="form-select" name="size" id="size" onchange="submit_form()">
<option value="">Normal</option>
<option value="Compact">Compact</option>
<option value="90">90%</option>
<option value="80">80%</option>
<option value="70">70%</option>
<option value="60">60%</option>
<option value="50">50%</option>
</select>
<label class="ms-1" for="size">Size</label>
</div>
<%If oReport.ShowGroupBy Then%>
<div class="form-floating">
<select class="form-select" name="groupby" id="groupby" onchange="submit_form()">
<option value="Category">Category</option>
<option value="Subcategory">Subcategory</option>
<option value="Product">Product</option>
</select>
<label class="ms-1" for="groupby">Group</label>
</div>
<%If oReport.ShowCategory Then%>
<div class="form-floating">
<select class="form-select" name="category" id="category" onchange="submit_form()">
<%=oReport.CategoryOptionList%>
</select>
<label class="ms-1" for="show">Category</label>
</div>
<%End If%>
<%If oReport.ShowSubcategory Then%>
<div class="form-floating">
<select class="form-select" name="subcategory" id="subcategory" onchange="submit_form()">
<%=oReport.SubcategoryOptionList%>
</select>
<label class="ms-1" for="show">Subcategory</label>
</div>
<%End If%>
<%End If%>
<button id="processing" class="btn btn-primary hide-processing" type="button" disabled><span class="spinner-border spinner-border-sm" role="status" aria-hidden="true"></span> Processing...</button>
</form>
<script>
function submit_form()
{
$('#processing').removeClass('hide-processing'); // show hourglass
document.frmChoice.submit();
}
<% ' total percentage not applicable, i.e. no total row then remove them
If Not oReport.HasTotalRow Then%>
$('#show option').each(function() {
if ( $(this).val().indexOf('%') > -1 ) {
$(this).remove();
}
});
<%End If%>
$('#reportname option[value="<%=oReport.ReportName%>"]').attr('selected','selected');
$('#groupby option[value="<%=oReport.GroupBy%>"]').attr('selected','selected');
$('#periodtype option[value="<%=oReport.PeriodType%>"]').attr('selected','selected');
$('#periodstart option[value="<%=oReport.PeriodStart%>"]').attr('selected','selected');
$('#periodend option[value="<%=oReport.PeriodEnd%>"]').attr('selected','selected');
$('#periodorder option[value="<%=oReport.PeriodOrder%>"]').attr('selected','selected');
$('#periodrange option[value="<%=oReport.PeriodRange%>"]').attr('selected','selected');
$('#show option[value="<%=oReport.Show%>"]').attr('selected','selected');
$('#background option[value="<%=oReport.Background%>"]').attr('selected','selected');
$('#size option[value="<%=oReport.Size%>"]').attr('selected','selected');
$('#category option[value="<%=oReport.Category%>"]').attr('selected','selected');
$('#subcategory option[value="<%=oReport.Subcategory%>"]').attr('selected','selected');
</script>
<%
End Sub
Sub AddSortTableScript
' following from https://www.w3schools.com/howto/howto_js_sort_table.asp
' modified as required, added AType and AHasTotalRow parameters
%>
<script>
function sortTable(n, AType, AHasTotalRow) {
var table, rows, switching, i, x, y, shouldSwitch, dir, switchcount = 0;
table = document.getElementById("myTable");
switching = true;
// Set the sorting direction to ascending:
dir = "desc"; /* (SS,9/5/23) was "asc" */
/* Make a loop that will continue until
no switching has been done: */
while (switching) {
// Start by saying: no switching is done:
switching = false;
rows = table.rows;
/* Loop through all table rows (except the
first, which contains table headers): */
/* (SS,7/5/23) deduct 1 for last row being the "Totals" row, i.e. changed - 1 to -2 */
/* (SS,8/5/23) added (AHasTotalRow ? 1 : 0) */
for (i = 1; i < (rows.length - 1 - (AHasTotalRow ? 1 : 0)); i++) {
// Start by saying there should be no switching:
shouldSwitch = false;
/* Get the two elements you want to compare,
one from current row and one from the next: */
x = rows[i].getElementsByTagName("TD")[n];
y = rows[i + 1].getElementsByTagName("TD")[n];
/* Check if the two rows should switch place,
based on the direction, asc or desc: */
/* (SS,8/5/23) convert x and y to string or number
*/
x = x.innerHTML.toLowerCase();
y = y.innerHTML.toLowerCase();
if (AType == "N") {
// string numeric characters and convert to number
x = Number(x.replace(/[^\d.-]/g, ''));
y = Number(y.replace(/[^\d.-]/g, ''));
}
if (dir == "asc") {
// if (x.innerHTML.toLowerCase() > y.innerHTML.toLowerCase()) {
//if (Number(x.innerHTML) > Number(y.innerHTML)) {
if (x > y) {
// If so, mark as a switch and break the loop:
shouldSwitch = true;
break;
}
} else if (dir == "desc") {
//if (x.innerHTML.toLowerCase() < y.innerHTML.toLowerCase()) {
//if (Number(x.innerHTML) < Number(y.innerHTML)) {
if (x < y) {
// If so, mark as a switch and break the loop:
shouldSwitch = true;
break;
}
}
}
if (shouldSwitch) {
/* If a switch has been marked, make the switch
and mark that a switch has been done: */
rows[i].parentNode.insertBefore(rows[i + 1], rows[i]);
switching = true;
// Each time a switch is done, increase this count by 1:
switchcount ++;
} else {
/* If no switching has been done AND the direction is "asc",
set the direction to "desc" and run the while loop again. */
/* (SS,9/5/23) was "asc" and "desc" changed to optimise for numbers in descending order */
if (switchcount == 0 && dir == "desc") {
dir = "asc";
switching = true;
}
}
}
}
</script>
<%
End Sub
%>