File: D:/web/circ.itp/financial-reports-v22.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 (2)officialal release
' (SS,10/05/23) Version 2.10 (3) official release, Bootstrap 5 and extra features
' (SS,11/05/23) Version 2.20 (4) official release, renamed Metric to Headline, added Headline for VDK
' (SS,12/05/23) Version 2.30 (5) release, added size feature
' (SS,15/05/23) Version 2.40 (6) release, added VAT correction for HyperFlight (not quite completed)
' (SS,14/06/23) Version 2.50 (7) 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 (8) 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 (9) - 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 (10) - 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 (11) - Added Rad Orders with Paint and Valves (as %) to bottom of Headline report
' (SS,27/09/23) Version 2.55 (12) - Added Orders without Rads and Valve Orders without Rads (as %) to bottom of Headline report
' (SS,20/10/23) Version 2.56 (13) - Added "Valves per Rad (exc. clearance)" (to help clarify a confusion with valve %, hopefully)
' (SS,01/11/23) Version 2.57 (14) - Added further headline rows to help clarify and show the working out
' (SS,03/11/23) Version 15 - Further refinements after chat with John
' (SS,05/11/23) Version 16 - Further improvements to help with valve calc checks, also new Headline Combined which combined orders for same customer/email in the period, also added some further rad and value calcs, also added addition header row for headline (CIRC)
' (SS,06/11/23) Version 17 - Removed some of the figures
' (SS,07/11/23) Version 18 - Changed colour groups, replaced "Headline Combined" with new "Distinct" (Distinct Order) combo allowing, Order No, Email or Postcode
' (SS,07/11/23) Version 19 - Moved following lines together for CIRC Headline 1 - 5 and 12 - 17 in one colour
' (SS,08/01/24) Version 20 - Various changes for CIRC mainly moving lines for headline report and adding extra lines, also creating a separated "Headline 2" report.
' (SS,09/01/24) Version 21 - CIRC Headline, replaced "Rad Orders without.." with "with", and replaced (Rads - Valves) etc. with Valves etc.. Changed order default in Public Sub SetDefaults to "Desc" so that latest month is first
' (SS,13/01/24) Version 22 - CIRC Headline, added Rad Sales, Valve Sales, Other Sales and Rad Sales / Rads Sold, Valve Sales / Valves Sold, also other headline name changes
' *** To Check/adjust Sales Qty etc, i.e. Check Mode may not be removing cancelled or non-exchange orders
' (SS,4/11/23)
Const VERSION_NO = 22
Const RELEASE_DATE = "13/01/2024"
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_HEADLINE_COMBINED = "Headline Combined" ' (SS,3/11/23) For CIRC, to combined orders for same customer/email
Const RN_HEADLINE_2 = "Headline 2" ' (SS,8/1/24)
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
Const MA_FAINT_ROW = 3 ' (SS,3/11/23)
' (SS,1/11/23) clearance type for headline (CIRC)
Const CL_EXC = " (exc)"
Const CL_INC = " (inc)"
Const CL_NA = ""
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 FDistinctOrder ' (SS,7/11/23)
Private FDataField, FDisplayFormat, FHasTotalRow, FHasColourGroups
Private FReportImplemented, FReportIsPaint, FReportIsDeliveryIncome
Private FLoopStart, FLoopEnd, FLoopStep
Private FHeadlineSQL
Private FShowGroupBy
Private FColourGroup, FPrevGroupName
Private FHeadlineArray
Private FFaintRow ' (SS,3/11/23)
Private Sub Class_Initialize
FReportImplemented = False
FHeadlineSQL = ""
FColourGroup = 0
FFaintRow = False ' (SS,3/11/23)
ReDim FHeadlineArray(3, -1) ' (SS,3/11/23) increased first row from 2 to 3 due to adding of MA_FAINT_ROW
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
' (SS,7/11/23)
Public Property Get DistinctOrder
DistinctOrder = FDistinctOrder
End Property
' (SS,7/11/23)
Public Property Let DistinctOrder(AValue)
FDistinctOrder = 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>"
Response.Write " <span class=""d-print-none""><small> (Version " & VERSION_NO & " - " & RELEASE_DATE & ")</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 = "Desc" ' (SS,9/1/24) changed default from "Asc." to "Desc", I think "Asc." should have been "Asc" anyway
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
If FDistinctOrder = "" Then FDistinctOrder = "Order No"
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 ReportIsHeadline Then ' (SS,3/11/23) replaced FReportName = RN_HEADLINE with ReportIsHeadline
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
' Or ReportIs(RN_HEADLINE_COMBINED) ' (SS,3/11/23) added RN_HEADLINE_COMBINED (SS,7/11/23) removed
' (SS,8/1/24) added ReportIsHeadline2
ReportIsHeadline = ReportIs(RN_HEADLINE) Or ReportIsHeadline2
End Function
' (SS,8/1/24)
Public Function ReportIsHeadline2
ReportIsHeadline2 = ReportIs(RN_HEADLINE_2)
End Function
' (SS,3/11/23)
' (SS,7/11/23)
'Public Function ReportIsHeadlineCombined
' ReportIsHeadlineCombined = ReportIs(RN_HEADLINE_COMBINED)
'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
' (SS,7/11/23)
Public Property Get DistinctOrderIsDefault
DistinctOrderIsDefault = FDistinctOrder = "Order No"
End Property
' (SS,7/11/23)
Public Property Get DistinctOrderField
If FDistinctOrder = "Email" Then
DistinctOrderField = "EmailAddress"
ElseIf FDistinctOrder = "Postcode" Then
DistinctOrderField = "Postcode"
Else ' i.e. "Order No"
DistinctOrderField = "OrderNo"
End If
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)
FFaintRow = FHeadlineArray(MA_FAINT_ROW, i) ' (SS,3/11/23)
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
' (SS,3/11/23) used to make the whole row faint/grey
Public Sub SetFaintRow
FFaintRow = True
End Sub
' (SS,3/11/23)
Public Property Get IsFaintRow
IsFaintRow = FFaintRow
End Property
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
FHeadlineArray(MA_FAINT_ROW, LHeadlineIndex) = FFaintRow
FHeadlineSQL = FHeadlineSQL + ASQL
FFaintRow = False ' (SS,3/11/23) clear faint row, ready for next
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")
' (SS,6/11/23) replaced above groups with following
LColourGroups = Array("table-danger", "table-success", "table-primary", "table-info", "table-warning", "table-secondary")
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
' (SS,5/11/23)
Public Property Get ShowHeaderRowInFooter
ShowHeaderRowInFooter = ReportIsHeadline And IsCIRC
End Property
' (SS,5/11/23)
Public Property Get HeaderRowClickSort
HeaderRowClickSort = Not ReportIsHeadline
End Property
End Class
Sub GetFormSettings
oReport.ReportName = CleanRequest("reportname")
oReport.DistinctOrder = CleanRequest("distinctorder") ' (SS,7/11/23)
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
' (SS,13/1/24)
'LHeadlineName = "Rad Sales" & CL_INC
'oReport.AddHeadlineSQL LHeadlineName, DF_CURRENCY, "SELECT '" + LHeadlineName + "' AS Headline, Period, RadSales FROM tmp_headline_all"
'LHeadlineName = "Valve Sales"
'oReport.AddHeadlineSQL LHeadlineName, DF_CURRENCY, "SELECT '" + LHeadlineName + "' AS Headline, Period, ValveSales FROM tmp_headline_all"
'LHeadlineName = "Other Sales"
'oReport.AddHeadlineSQL LHeadlineName, DF_CURRENCY, "SELECT '" + LHeadlineName + "' AS Headline, Period, OtherSales FROM tmp_headline_all"
'LHeadlineName = "Total Sales"
'oReport.AddHeadlineSQL LHeadlineName, DF_CURRENCY, "SELECT '" + LHeadlineName + "' AS Headline, Period, RadSales + ValveSales + OtherSales AS TotalSales FROM tmp_headline_all"
' (SS,13/1/24) following used instead of above due to discount being factored in
' !! N.B. the total of the following may not match Net Sales, due to the way discount is factored, partial refunds not taken into account, at least the figure where you divide by valves and rads will be better because of this
' to improve in future we really need to hold the discount per order line, and accurately record which items have been partially refunded
LHeadlineName = "Rad Sales"
oReport.AddHeadlineSQL LHeadlineName, DF_CURRENCY, "SELECT '" + LHeadlineName + "' AS Headline, Period, RadSalesAfterDiscount FROM tmp_headline_all"
LHeadlineName = "Valve Sales"
oReport.AddHeadlineSQL LHeadlineName, DF_CURRENCY, "SELECT '" + LHeadlineName + "' AS Headline, Period, ValveSalesAfterDiscount FROM tmp_headline_all"
LHeadlineName = "Other Sales"
oReport.AddHeadlineSQL LHeadlineName, DF_CURRENCY, "SELECT '" + LHeadlineName + "' AS Headline, Period, OtherSalesAfterDiscount FROM tmp_headline_all"
LHeadlineName = "Total Sales"
oReport.SetFaintRow
oReport.AddHeadlineSQL LHeadlineName, DF_CURRENCY, "SELECT '" + LHeadlineName + "' AS Headline, Period, RadSalesAfterDiscount + ValveSalesAfterDiscount + OtherSalesAfterDiscount AS TotalSalesAfterDiscount FROM tmp_headline_all"
' (SS,14/6/23)
' (SS,8/1/24) moved above "Net Sales per Rad" & CL_EXC
LHeadlineName = "Rads Sold" & CL_EXC
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, QtyRadsExc FROM tmp_headline_hasrad"
' (SS,8/1/24)
LHeadlineName = "Clearance Rads Sold"
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, QtyRads - QtyRadsExc AS QtyRadsClearance FROM tmp_headline_hasrad"
'LHeadlineName = "Rads Sold" & CL_INC
' (SS,8/1/24) renamed from above to "Rads Sold (total)""
LHeadlineName = "Rads Sold (total)"
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, QtyRads FROM tmp_headline_hasrad"
' (SS,8/1/24)
' (SS,11/1/24) name change from "Clearance / Total Rads %" to "Clearance / Total Rads Sold %"
LHeadlineName = "Clearance / Total Rads Sold %"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, (QtyRads - QtyRadsExc) / QtyRads * 100 AS ClearanceOverTotalRads FROM tmp_headline_hasrad"
' (SS,11/1/24) name change from "Net Sales per Rad (inc)" to "Net Sales / Rads Sold (total)"
LHeadlineName = "Net Sales / Rads Sold (total)"
oReport.AddHeadlineSQL LHeadlineName, DF_CURRENCY, "SELECT '" + LHeadlineName + "' AS Headline, Period, NULL AS NetSalesPerRad FROM tmp_headline_all"
' (SS,11/1/24)
LHeadlineName = "Rad Sales / Rads Sold (total)"
oReport.AddHeadlineSQL LHeadlineName, DF_CURRENCY, "SELECT '" + LHeadlineName + "' AS Headline, Period, NULL AS RadSalesPerRad FROM tmp_headline_all"
' (SS,13/1/24)
LHeadlineName = "Valve Sales / Valves Sold"
oReport.AddHeadlineSQL LHeadlineName, DF_CURRENCY, "SELECT '" + LHeadlineName + "' AS Headline, Period, NULL AS ValveSalesPerValve FROM tmp_headline_all"
' (SS,6/11/23) moved following here from below
' (SS,7/11/23) renamed from "Qty of Valves" to "Valves Sold"
LHeadlineName = "Valves Sold"
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, QtyValves FROM tmp_headline_all"
' (SS,7/11/23) in following 4, replaced "Rad Orders without" with "with", and replaced (Rads - Valves) etc. with Valves etc.
LHeadlineName = "Rad Orders with Valves" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(Valves / Rads * 100, 2) AS Percentage FROM tmp_headline_hasrad"
LHeadlineName = "Rad Orders with Wall Stays" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(WallStays / Rads * 100, 2) AS Percentage FROM tmp_headline_hasrad"
LHeadlineName = "Rad Orders with Shrouds" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(PipeShrouds / Rads * 100, 2) AS Percentage FROM tmp_headline_hasrad"
LHeadlineName = "Rad Orders with Touch Up" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(TouchUpPaint / Rads * 100, 2) AS Percentage FROM tmp_headline_hasrad"
' (SS,6/11/23) removed
'LHeadlineName = "Rad Orders without Paint" + CL_INC
'oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND((Rads - PaintFinish) / Rads * 100, 2) AS Percentage FROM tmp_headline_hasrad"
' (SS,6/11/23) removed
'LHeadlineName = "Rad Orders with Paint" + CL_INC
'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" + CL_EXC
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(QtyRadsExcWithPaint / QtyRadsExc * 100, 2) FROM tmp_headline_all"
' (SS,6/11/23) added [A]
LHeadlineName = "Valves per Rad" + CL_INC + " [A]"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(QtyValves / QtyRads * 100, 2) FROM tmp_headline_all"
' (SS,8/1/24%) moved following 4 here from below, same pink colour
'oReport.NextColourGroup
' (SS,20/10/23)
' (SS,6/11/23) removed
'LHeadlineName = "Valves per Rad" + CL_EXC
'oReport.SetFaintRow
'oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(QtyValves / QtyRadsExc * 100, 2) FROM tmp_headline_all"
LHeadlineName = "Manual Valves per Rad" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(QtyValvesManual / QtyRads * 100, 2) FROM tmp_headline_all"
LHeadlineName = "Thermostatic Valves per Rad" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(QtyValvesThermostatic / QtyRads * 100, 2) FROM tmp_headline_all"
LHeadlineName = "Wall Stays per Rad" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(QtyWallStays / QtyRads * 100, 2) FROM tmp_headline_all"
LHeadlineName = "Pipe Shrouds per Rad" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(QtyPipeShrouds / QtyRads * 100, 2) FROM tmp_headline_all"
' (SS,8/1/24) following section only in "Headline 2" not "Headline"
If oReport.ReportIsHeadline2 Then
' (SS,5/11/23)
oReport.NextColourGroup
' LHeadlineName = "<small><b># Primary figures above, secondary below #</b></small>"
LHeadlineName = "<small><b># Secondary #</b></small>"
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, NULL FROM tmp_headline_all"
' (SS,14/6/23)
' (SS,13/1/24) changed "Net Sales per Rad" & CL_EXC to "Net Sales / Rads Sold" & CL_EXC
LHeadlineName = "Net Sales / Rads Sold" & CL_EXC
oReport.SetFaintRow
oReport.AddHeadlineSQL LHeadlineName, DF_CURRENCY, "SELECT '" + LHeadlineName + "' AS Headline, Period, NULL AS NetSalesPerRadExc FROM tmp_headline_hasrad"
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)
' (SS,6/11/23) removed
'LHeadlineName = "Delivery Income per Order"
'oReport.SetFaintRow
'oReport.AddHeadlineSQL LHeadlineName, DF_CURRENCY, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(DeliveryIncome / Orders, 2) FROM tmp_headline_all"
' (SS,14/6/23)
' (SS,6/11/23) removed
'oReport.NextColourGroup
'LHeadlineName = "Orders with Rads: 1" + CL_EXC
'oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders1RadExc FROM tmp_headline_hasrad"
'LHeadlineName = "Orders with Rads: 2" + CL_EXC
'oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders2RadsExc FROM tmp_headline_hasrad"
'LHeadlineName = "Orders with Rads: 3" + CL_EXC
'oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders3RadsExc FROM tmp_headline_hasrad"
'LHeadlineName = "Orders with Rads: 4" + CL_EXC
'oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders4RadsExc FROM tmp_headline_hasrad"
'LHeadlineName = "Orders with Rads: 5+" + CL_EXC
'oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders5PlusRadsExc FROM tmp_headline_hasrad"
'LHeadlineName = "Orders with Rads" + CL_EXC
'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" + CL_EXC
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" + CL_EXC
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" + CL_EXC
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" + CL_EXC
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" + CL_EXC
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(Orders5PlusRadsWithPaint / Orders5PlusRadsExc * 100, 2) FROM tmp_headline_hasrad"
LHeadlineName = "Rad Orders with Paint" + CL_EXC
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(OrdersRadsWithPaint / OrdersRadsExc * 100, 2) FROM tmp_headline_hasrad"
' (SS,26/9/23)
' (SS,3/11/23) changed from exc. to inc.
oReport.NextColourGroup
LHeadlineName = "1 Rad Orders with Valves" & CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(Orders1RadWithValves / Orders1Rad * 100, 2) FROM tmp_headline_hasrad"
LHeadlineName = "2 Rad Orders with Valves" & CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(Orders2RadsWithValves / Orders2Rads * 100, 2) FROM tmp_headline_hasrad"
LHeadlineName = "3 Rad Orders with Valves" & CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(Orders3RadsWithValves / Orders3Rads * 100, 2) FROM tmp_headline_hasrad"
LHeadlineName = "4 Rad Orders with Valves" & CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(Orders4RadsWithValves/ Orders4Rads * 100, 2) FROM tmp_headline_hasrad"
LHeadlineName = "5+ Rad Orders with Valves" & CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(Orders5PlusRadsWithValves / Orders5PlusRads * 100, 2) FROM tmp_headline_hasrad"
LHeadlineName = "Rad Orders with Valves" & CL_INC & " [B]"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(OrdersRadsWithValves / OrdersRads * 100, 2) FROM tmp_headline_hasrad"
' (SS,1/11/23) added following to help clarify, may remove later
' (SS,6/11/23) removed following
' oReport.NextColourGroup
'LHeadlineName = "Valves per Rad" & CL_INC & " [A]" ' 2 used to ensure unique name for same colour group to be applied to this
'oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(QtyValves / QtyRads * 100, 2) FROM tmp_headline_all"
'LHeadlineName = "Qty of Rads" + CL_INC
'oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, QtyRads FROM tmp_headline_all"
' (SS,6/11/23) removed following
'LHeadlineName = "Qty of Rads" + CL_EXC
'oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, QtyRadsExc FROM tmp_headline_all"
'LHeadlineName = "Valves per Rad" & CL_EXC & " (2)" ' 2 used to ensure unique name for same colour group to be applied to this
'oReport.SetFaintRow
'oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(QtyValves / QtyRadsExc * 100, 2) FROM tmp_headline_all"
' (SS,26/9/23)
'oReport.NextColourGroup
'LHeadlineName = "Orders without Rads" + CL_EXC
'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" + CL_EXC
'oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(Orders0RadsWithValves / (OrdersRadsExc + Orders0RadExc) * 100, 2) FROM tmp_headline_hasrad"
' (SS,3/11/23) replaced above with following
oReport.NextColourGroup
LHeadlineName = "Orders without Rads" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders0Rads FROM tmp_headline_all"
LHeadlineName = "Orders with Valves but no Rads" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders0RadsWithValves FROM tmp_headline_all"
LHeadlineName = "Orders without Rads %" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(Orders0Rads / Orders * 100, 2) FROM tmp_headline_all"
LHeadlineName = "Orders with Valves but no Rads %" + CL_INC + " [C]"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(Orders0RadsWithValves / Orders * 100, 2) FROM tmp_headline_all"
' (SS,4/11/23) Valve calc check
oReport.NextColourGroup
LHeadlineName = "Valve Calc Check: [A] - [B]"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, NULL AS ValvesCalcCheck FROM tmp_headline_hasrad"
LHeadlineName = "Valve Calc Check: [A] - [B] - [C]"
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, NULL AS ValvesCalcCheck FROM tmp_headline_hasrad"
' (SS,5/11/23)
oReport.NextColourGroup
'LHeadlineName = "<small><b># Rows below are new (to be removed?) #</b></small>"
LHeadlineName = "<small><b># Tertiary #</b></small>"
' (SS,8/1/24) added "All " before "Orders with Valves.." to clarify
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, NULL FROM tmp_headline_all"
LHeadlineName = "All Orders with Valves: 1"
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders1Valve FROM tmp_headline_all"
LHeadlineName = "All Orders with Valves: 2"
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders2Valves FROM tmp_headline_all"
LHeadlineName = "All Orders with Valves: 3"
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders3Valves FROM tmp_headline_all"
LHeadlineName = "All Orders with Valves: 4"
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders4Valves FROM tmp_headline_all"
LHeadlineName = "All Orders with Valves: 5+"
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders5PlusValves FROM tmp_headline_all"
LHeadlineName = "All Orders with Valves"
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, OrdersValves FROM tmp_headline_all"
' (SS,5/11/23)
oReport.NextColourGroup
LHeadlineName = "Orders with Rads: 1" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders1Rad FROM tmp_headline_hasrad"
LHeadlineName = "Orders with Rads: 2" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders2Rads FROM tmp_headline_hasrad"
LHeadlineName = "Orders with Rads: 3" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders3Rads FROM tmp_headline_hasrad"
LHeadlineName = "Orders with Rads: 4" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders4Rads FROM tmp_headline_hasrad"
LHeadlineName = "Orders with Rads: 5+" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders5PlusRads FROM tmp_headline_hasrad"
LHeadlineName = "Orders with Rads" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, OrdersRads FROM tmp_headline_hasrad"
' (SS,8/1/24) added following to show as % of total
LHeadlineName = "% Orders with Rads: 1" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders1Rad / OrdersRads * 100 FROM tmp_headline_hasrad"
LHeadlineName = "% Orders with Rads: 2" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders2Rads / OrdersRads * 100 FROM tmp_headline_hasrad"
LHeadlineName = "% Orders with Rads: 3" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders3Rads / OrdersRads * 100 FROM tmp_headline_hasrad"
LHeadlineName = "% Orders with Rads: 4" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders4Rads / OrdersRads * 100 FROM tmp_headline_hasrad"
LHeadlineName = "% Orders with Rads: 5+" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, Orders5PlusRads / OrdersRads * 100 FROM tmp_headline_hasrad"
LHeadlineName = "% Orders with Rads" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, OrdersRads / OrdersRads * 100 FROM tmp_headline_hasrad"
' (SS,5/11/23)
oReport.NextColourGroup
LHeadlineName = "Valve Orders / Rad Orders" + CL_INC
oReport.SetFaintRow ' (SS,8/1/24)
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(OrdersValves / OrdersRads * 100, 2) FROM tmp_headline_all"
' (SS,5/11/23)
oReport.NextColourGroup
LHeadlineName = "Orders with Rads and Valves" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, HasRadAndValve FROM tmp_headline_all"
LHeadlineName = "Orders with Rads = Valves" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, HasRadAndValveEqual FROM tmp_headline_all"
LHeadlineName = "Orders with Rads > Valves)" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, HasRadAndValveGreater FROM tmp_headline_all"
LHeadlineName = "Orders with Rads < Valves" + CL_INC
oReport.AddHeadlineSQL LHeadlineName, DF_INTEGER, "SELECT '" + LHeadlineName + "' AS Headline, Period, HasRadAndValveLess FROM tmp_headline_all"
' LHeadlineName = "<small>Orders with Rads & Valves - Valves per Rad" + CL_INC + "</small>"
LHeadlineName = "Valves per Rad when Order has both" + CL_INC
oReport.SetFaintRow ' (SS,8/1/24)
oReport.AddHeadlineSQL LHeadlineName, DF_PERCENTAGE, "SELECT '" + LHeadlineName + "' AS Headline, Period, ROUND(QtyValvesHasRadAndValve / QtyRadsHasRadAndValve * 100, 2) FROM tmp_headline_all"
End If
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
' (SS,8/1/24) renamed "Rads Sold" & CL_INC to "Rads Sold (total)"
' (SS,13/1/24) renamed "Net Sales per Rad" & CL_INC to "Net Sales / Rads Sold (total)"
ApplyCrosstabDivCalc "Net Sales", "Rads Sold (total)", "Net Sales / Rads Sold (total)"
' (SS,13/1/24) new
ApplyCrosstabDivCalc "Rad Sales", "Rads Sold (total)", "Rad Sales / Rads Sold (total)"
ApplyCrosstabDivCalc "Valve Sales", "Valves Sold", "Valve Sales / Valves Sold"
' (SS,8/1/24) added "If" for following which are only applicable in "Headline 2"
If oReport.ReportIsHeadline2 Then
' (SS,13/1/24) changed "Net Sales per Rad" & CL_EXC to "Net Sales / Rads Sold" & CL_EXC
ApplyCrosstabDivCalc "Net Sales", "Rads Sold" & CL_EXC, "Net Sales / Rads Sold" & CL_EXC
'Sub ApplyCrosstabCalc(AResultName, ASourceNameA, ASourceNameB, ASourceNameC, AOperationB, AOperationC)
ApplyCrosstabCalc "Valve Calc Check: [A] - [B]", "Valves per Rad" & CL_INC & " [A]", "Rad Orders with Valves" & CL_INC & " [B]", "", "-", ""
ApplyCrosstabCalc "Valve Calc Check: [A] - [B] - [C]", "Valves per Rad" & CL_INC & " [A]", "Rad Orders with Valves" & CL_INC & " [B]", "Orders with Valves but no Rads %" & CL_INC & " [C]", "-", "-"
End If
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 an "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
' (SS,3/11/23) added code to combined orders for same customer i.e. email address if oReport.ReportIsHeadlineCombined
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 "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,3/11/23) to count how many orders with 1, 2, 3, 4, 5+ rads (including clearance)
AddSQL "SUM(Orders0Rads) AS Orders0Rads, "
AddSQL "SUM(Orders1Rad) AS Orders1Rad, "
AddSQL "SUM(Orders2Rads) AS Orders2Rads, "
AddSQL "SUM(Orders3Rads) AS Orders3Rads, "
AddSQL "SUM(Orders4Rads) AS Orders4Rads, "
AddSQL "SUM(Orders5PlusRads) AS Orders5PlusRads, "
AddSQL "SUM(OrdersRads) AS OrdersRads, "
' (SS,26/9/23) to count 0, 1, 2, 3, 4, 5+ rad orders with valves (excluding clearance)
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, "
' (SS,5/11/23) to count how many orders with 1, 2, 3, 4, 5+ valves
AddSQL "SUM(Orders0Valves) AS Orders0Valves, "
AddSQL "SUM(Orders1Valve) AS Orders1Valve, "
AddSQL "SUM(Orders2Valves) AS Orders2Valves, "
AddSQL "SUM(Orders3Valves) AS Orders3Valves, "
AddSQL "SUM(Orders4Valves) AS Orders4Valves, "
AddSQL "SUM(Orders5PlusValves) AS Orders5PlusValves, "
AddSQL "SUM(OrdersValves) AS OrdersValves, "
' (SS,5/11/23) to count how many orders with both rads and valves and whether =, > or <
AddSQL "SUM(HasRadAndValve) AS HasRadAndValve, "
AddSQL "SUM(HasRadAndValveEqual) AS HasRadAndValveEqual, "
AddSQL "SUM(HasRadAndValveGreater) AS HasRadAndValveGreater, "
AddSQL "SUM(HasRadAndValveLess) AS HasRadAndValveLess, "
AddSQL "SUM(QtyRadsHasRadAndValve) AS QtyRadsHasRadAndValve, "
AddSQL "SUM(QtyValvesHasRadAndValve) AS QtyValvesHasRadAndValve, "
' (SS,13/1/24)
AddSQL "SUM(RadSales) AS RadSales, "
AddSQL "SUM(ValveSales) AS ValveSales, "
AddSQL "SUM(OtherSales) AS OtherSales, "
AddSQL "SUM(RadSalesAfterDiscount) AS RadSalesAfterDiscount, "
AddSQL "SUM(ValveSalesAfterDiscount) AS ValveSalesAfterDiscount, "
AddSQL "SUM(OtherSalesAfterDiscount) AS OtherSalesAfterDiscount"
End If
AddSQL "FROM"
' ### level 4, for CIRC only, additional fields, per order (or email/period)
' (SS,5/11/23) values modified to remove SUM and MAX
If IsCIRC Then
AddSQL "("
AddSQL "### 4 start ###"
AddSQL "SELECT *, "
' (SS,14/6/23) to count how many orders with 1, 2, 3, 4, 5+ rads (excluding clearance)
AddSQL "IF(QtyRadsExc = 0, 1, 0) AS Orders0RadExc, " ' (SS,27/9/23)
AddSQL "IF(QtyRadsExc = 1, 1, 0) AS Orders1RadExc, "
AddSQL "IF(QtyRadsExc = 2, 1, 0) AS Orders2RadsExc, "
AddSQL "IF(QtyRadsExc = 3, 1, 0) AS Orders3RadsExc, "
AddSQL "IF(QtyRadsExc = 4, 1, 0) AS Orders4RadsExc, "
AddSQL "IF(QtyRadsExc >= 5, 1, 0) AS Orders5PlusRadsExc, "
AddSQL "IF(QtyRadsExc >= 1, 1, 0) AS OrdersRadsExc, "
' (SS,26/9/23) to count 1, 2, 3, 4, 5+ rad orders with paint (excluding clearance)
AddSQL "IF(QtyRadsExc = 1, HasPaintFinish, 0) AS Orders1RadWithPaint, "
AddSQL "IF(QtyRadsExc = 2, HasPaintFinish, 0) AS Orders2RadsWithPaint, "
AddSQL "IF(QtyRadsExc = 3, HasPaintFinish, 0) AS Orders3RadsWithPaint, "
AddSQL "IF(QtyRadsExc = 4, HasPaintFinish, 0) AS Orders4RadsWithPaint, "
AddSQL "IF(QtyRadsExc >= 5, HasPaintFinish, 0) AS Orders5PlusRadsWithPaint, "
AddSQL "IF(QtyRadsExc >= 1, HasPaintFinish, 0) AS OrdersRadsWithPaint, "
' (SS,3/11/23) to count how many orders with 1, 2, 3, 4, 5+ rads (including clearance)
AddSQL "IF(QtyRads = 0, 1, 0) AS Orders0Rads, "
AddSQL "IF(QtyRads = 1, 1, 0) AS Orders1Rad, "
AddSQL "IF(QtyRads = 2, 1, 0) AS Orders2Rads, "
AddSQL "IF(QtyRads = 3, 1, 0) AS Orders3Rads, "
AddSQL "IF(QtyRads = 4, 1, 0) AS Orders4Rads, "
AddSQL "IF(QtyRads >= 5, 1, 0) AS Orders5PlusRads, "
AddSQL "IF(QtyRads >= 1, 1, 0) AS OrdersRads, "
' (SS,26/9/23) to count 0, 1, 2, 3, 4, 5+ rad orders with valves (including clearance)
' (SS,3/11/23) changed from QtyRadsExc to QtyRads
AddSQL "IF(QtyRads = 0, HasValve, 0) AS Orders0RadsWithValves, "
AddSQL "IF(QtyRads = 1, HasValve, 0) AS Orders1RadWithValves, "
AddSQL "IF(QtyRads = 2, HasValve, 0) AS Orders2RadsWithValves, "
AddSQL "IF(QtyRads = 3, HasValve, 0) AS Orders3RadsWithValves, "
AddSQL "IF(QtyRads = 4, HasValve, 0) AS Orders4RadsWithValves, "
AddSQL "IF(QtyRads >= 5, HasValve, 0) AS Orders5PlusRadsWithValves, "
AddSQL "IF(QtyRads >= 1, HasValve, 0) AS OrdersRadsWithValves, "
' (SS,5/11/23) to count how many orders with 1, 2, 3, 4, 5+ valves
AddSQL "IF(QtyValves = 0, 1, 0) AS Orders0Valves, "
AddSQL "IF(QtyValves = 1, 1, 0) AS Orders1Valve, "
AddSQL "IF(QtyValves = 2, 1, 0) AS Orders2Valves, "
AddSQL "IF(QtyValves = 3, 1, 0) AS Orders3Valves, "
AddSQL "IF(QtyValves = 4, 1, 0) AS Orders4Valves, "
AddSQL "IF(QtyValves >= 5, 1, 0) AS Orders5PlusValves, "
AddSQL "IF(QtyValves >= 1, 1, 0) AS OrdersValves, "
' (SS,5/11/23) to count how many orders with both rads and valves and whether =, > or <
AddSQL "IF(HasRad And HasValve, 1, 0) AS HasRadAndValve, "
AddSQL "IF(HasRad And HasValve And QtyRads = QtyValves, 1, 0) AS HasRadAndValveEqual, "
AddSQL "IF(HasRad And HasValve And QtyRads > QtyValves, 1, 0) AS HasRadAndValveGreater, "
AddSQL "IF(HasRad And HasValve And QtyRads < QtyValves, 1, 0) AS HasRadAndValveLess, "
AddSQL "IF(HasRad And HasValve, QtyRads, 0) AS QtyRadsHasRadAndValve, "
AddSQL "IF(HasRad And HasValve, QtyValves, 0) AS QtyValvesHasRadAndValve"
AddSQL "FROM"
End If
' ### level 3 (optional for combined orders per email and period)
' (SS,3/11/23) additional group to combine orders for same customer (i.e. email address), also added Period, because it's email address in same period
' (SS,7/11/23) modified to also allow Postcode, replaced EmailAddress with oReport.DistinctOrderField
If Not oReport.DistinctOrderIsDefault Then
AddSQL "("
AddSQL "### 3 start ###"
AddSQL "SELECT " + oReport.DistinctOrderField + ", cc.Month1 AS PeriodHC, MAX(DatePaid) AS DatePaid, SUM(DeliveryIncome) AS DeliveryIncome, "
AddSQL "MAX(HasRad) AS HasRad, "
AddSQL "MAX(HasValve) AS HasValve, "
AddSQL "MAX(HasValveThermostatic) AS HasValveThermostatic, "
AddSQL "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,13/1/24)
AddSQL "SUM(RadSales) AS RadSales, "
AddSQL "SUM(ValveSales) AS ValveSales, "
AddSQL "SUM(OtherSales) AS OtherSales, "
AddSQL "SUM(RadSalesAfterDiscount) AS RadSalesAfterDiscount, "
AddSQL "SUM(ValveSalesAfterDiscount) AS ValveSalesAfterDiscount, "
AddSQL "SUM(OtherSalesAfterDiscount) AS OtherSalesAfterDiscount"
AddSQL "FROM"
End If
' ### level 2, group/sum per order
' (SS,7/11/23) modified to also allow Postcode, added Postcode after EmailAddress, didn't use oReport.DistinctOrderField because it may return OrderNo (i.e. cause duplicate)
AddSQL "("
AddSQL "### 2 start ###"
AddSQL "SELECT OrderNo, EmailAddress, Postcode, DatePaid, MAX(Delivery) AS DeliveryIncome"
If IsCIRC Then
AddSQL ", "
AddSQL "MAX(HasRad) AS HasRad, "
AddSQL "MAX(HasValve) AS HasValve, "
AddSQL "MAX(HasValveThermostatic) AS HasValveThermostatic, "
AddSQL "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,13/1/24)
AddSQL "SUM(RadSales) AS RadSales, "
AddSQL "SUM(ValveSales) AS ValveSales, "
AddSQL "SUM(OtherSales) AS OtherSales, "
AddSQL "SUM(RadSalesAfterDiscount) AS RadSalesAfterDiscount, "
AddSQL "SUM(ValveSalesAfterDiscount) AS ValveSalesAfterDiscount, "
AddSQL "SUM(OtherSalesAfterDiscount) AS OtherSalesAfterDiscount"
End If
AddSQL "FROM"
' ### level 1, per order and order line (no group)
' (SS,7/11/23) modified to also allow Postcode, added Postcode after EmailAddress (didn't use oReport.DistinctOrderField because it may return OrderNo)
AddSQL "("
AddSQL "### 1 start ###"
' AddSQLvcAs "SELECT o.OrderNo, CustomerID, EmailAddress, DateTimeOrdered, DateTimePaid, Delivery, Status, od.ProductCode, pc.Main, pc.Category, pc.Subcategory"
' (SS,3/11/23) replaced above with following, also added DATE function to DateTimeOrdered and DateTimePaid to remove the time portion
AddSQLvcAs "SELECT o.OrderNo, EmailAddress, Postcode, DATE(DateTimePaid) AS DatePaid, Delivery"
If IsCIRC Then
' (SS,4/11/23) Replaced the first 8 "AttributeValue = 'xxxx'" with IF(, 1,0) to prevent any NULL results from potientiall adversely affected the results, NULL will be returned product type is null due to no such attribute for the product
' quick glance at before and after shows no difference, only in the intermediate result view in HeidiSQL
AddSQL ", "
' AddSQL "AttributeValue = 'Radiator' AS HasRad, "
AddSQL "IF(AttributeValue = 'Radiator', 1, 0) AS HasRad, "
AddSQL "IF(AttributeValue = 'Valve Set', 1, 0) AS HasValve, "
AddSQL "IF(AttributeValue = 'Valve Set' AND Subcategory = 'Thermostatic', 1, 0) AS HasValveThermostatic, "
AddSQL "IF(AttributeValue = 'Valve Set' AND Subcategory = 'Manual', 1, 0) AS HasValveManual, "
AddSQL "IF(AttributeValue = 'Wall Stay', 1, 0) AS HasWallStay, "
AddSQL "IF(AttributeValue = 'Pipe Shrouds', 1, 0) AS HasPipeShroud, "
AddSQL "IF(AttributeValue = 'Touch Up Paint', 1, 0) AS HasTouchUpPaint, "
AddSQL "IF(AttributeValue = 'Radiator' AND odo.OptionValue IS NOT NULL AND odo.OptionValue <> 'Black Primer' AND odo.OptionValue <> 'Base Coat only', 1, 0) 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, "
' (SS,13/1/24) added Rad Sales, ValveSales, OtherSales, RadSalesAfterDiscount, ValveSalesAfterDiscount, OtherSalesAfterDiscount
AddSQL "IF(AttributeValue = 'Radiator', PriceEach * Qty, 0) AS RadSales, "
AddSQL "IF(AttributeValue = 'Valve Set', PriceEach * Qty, 0) AS ValveSales, "
AddSQL "IF(AttributeValue = 'Radiator' OR AttributeValue = 'Valve Set', 0, PriceEach * Qty) AS OtherSales, "
' AddSQL "IF(AttributeValue = 'Radiator', PriceEach * Qty * (1 + (o.Discount / o.Subtotal)), 0) AS RadSalesAfterDiscount, "
' AddSQL "IF(AttributeValue = 'Valve Set', PriceEach * Qty * (1 + (o.Discount / o.Subtotal)), 0) AS ValveSalesAfterDiscount, "
' AddSQL "IF(AttributeValue = 'Radiator' OR AttributeValue = 'Valve Set', 0, PriceEach * Qty * (1 + (o.Discount / o.Subtotal))) AS OtherSalesAfterDiscount"
' " / o.Subtotal" results in divide by zero error when CREATE TEMPORARY TABLE used, added IF to check if o.Subtotal is zero and * 0 if it is
AddSQL "IF(AttributeValue = 'Radiator', ROUND(PriceEach * Qty * IF(o.Subtotal = 0, 0, (1 + (o.Discount / o.Subtotal))), 2), 0) AS RadSalesAfterDiscount, "
AddSQL "IF(AttributeValue = 'Valve Set', ROUND(PriceEach * Qty * IF(o.Subtotal = 0, 0, (1 + (o.Discount / o.Subtotal))), 2), 0) AS ValveSalesAfterDiscount, "
AddSQL "IF(AttributeValue = 'Radiator' OR AttributeValue = 'Valve Set', 0, ROUND(PriceEach * Qty * IF(o.Subtotal = 0, 0, (1 + (o.Discount / o.Subtotal))), 2)) AS OtherSalesAfterDiscount"
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 "### 1 end ###"
AddSQL ") a"
' ### end of level 1
AddSQL "GROUP BY OrderNo"
AddSQL "### 2 end ###"
AddSQL ") b"
' ### end of level 2
' (SS,3/11/23) additional group to combine orders for same customer
' (SS,7/11/23) modified to also allow also allow Postcode, replaced EmailAddress with oReport.DistinctOrderField, also replaced oReport.ReportIsHeadlineCombined with Not oReport.DistinctOrderIsDefault Then
If Not oReport.DistinctOrderIsDefault Then
AddSQL "INNER JOIN common.Calendar cc ON cc.CalendarDate = DatePaid"
AddSQL "GROUP BY " + oReport.DistinctOrderField + ", PeriodHC"
AddSQL "### 3 end ###"
AddSQL ") c"
End If
' (SS,5/11/23) level that adds extra fields for CIRC
If IsCIRC Then
AddSQL "### 4 end ###"
AddSQL ") d"
End If
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,4/11/23)
Sub ApplyCrosstabCalc(AResultName, ASourceNameA, ASourceNameB, ASourceNameC, AOperationB, AOperationC)
Dim LResultRow, LSourceRowA, LSourceRowB, LSourceRowC
LResultRow = GetCrosstabRowByName(AResultName)
LSourceRowA = GetCrosstabRowByName(ASourceNameA)
LSourceRowB = GetCrosstabRowByName(ASourceNameB)
LSourceRowC = GetCrosstabRowByName(ASourceNameC)
'Response.Write "###LResultRow: " & LResultRow & BR
'Response.Write "###LSourceRowA: " & LSourceRowA & BR
'Response.Write "###LSourceRowB: " & LSourceRowB & BR
'Response.Write "###LSourceRowC: " & LSourceRowC & BR
' assumes 2nd column onwards are the period columns
Dim f, LLastCol, LDivideBy
LLastCol = UBound(FDataCrosstabArray, 1)
For f = 1 To LLastCol
FDataCrosstabArray(f, LResultRow) = FDataCrosstabArray(f, LSourceRowA)
If AOperationB = "-" Then
FDataCrosstabArray(f, LResultRow) = FDataCrosstabArray(f, LResultRow) - FDataCrosstabArray(f, LSourceRowB)
End If
If AOperationC = "-" Then
FDataCrosstabArray(f, LResultRow) = FDataCrosstabArray(f, LResultRow) - FDataCrosstabArray(f, LSourceRowC)
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
' (SS,3/11/23) added If oReport.IsFaintRow
LStyle = "cell-left"
If oReport.IsFaintRow Then LStyle = LStyle + " cell-faint"
For f = 0 To oReport.GroupFieldCount - 1
LFieldValue = ADataArray(f, r)
Response.Write "<td class=""" & 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
' (SS,5/11/23)
If oReport.ShowHeaderRowInFooter Then ShowTableCrosstabArrayHeaderRow 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;">
<%
ShowTableCrosstabArrayHeaderRow ADataArray, AColumnsToTotalArray
%>
<tbody class="table-group-divider">
<%
End Sub
' (SS,5/11/23) separated from ShowTableCrosstabArrayHeader to allow it be shown multiple times
Sub ShowTableCrosstabArrayHeaderRow(ByRef ADataArray, ByRef AColumnsToTotalArray)
Dim LCursorPointer
If oReport.HeaderRowClickSort Then
LCursorPointer = " style=""cursor: pointer;"""
Else
LCursorPointer = ""
End If
%>
<thead>
<tr<%=LCursorPointer%>>
<%
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>
<%
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)
If oReport.HeaderRowClickSort Then
GetOnClickSort = " onclick=""sortTable(" & AIndex & ", '" & AType & "', " & IIf(oReport.HasTotalRow, "true", "false") & ")"""
Else
GetOnClickSort = ""
End If
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.IsFaintRow Then LClass = LClass + " cell-faint" ' make faint
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;
}
/* (SS,3/11/23) */
.cell-faint {
color: rgba(0, 0, 0, 0.4) !important;
}
.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
' (SS,7/1/24) added "Headline 2" for CIRC
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>
<%If IsCIRC Then%>
<option value="Headline 2">Headline 2</option>
<%End If%>
<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>
<%If oReport.ReportIsHeadline Then%>
<div class="form-floating">
<select class="form-select" name="distinctorder" id="distinctorder" onchange="submit_form()">
<option value="Order No">Order No</option>
<option value="Email">Email</option>
<option value="Postcode">Postcode</option>
</select>
<label class="ms-1" for="distinctorder">Distinct</label>
</div>
<%End If%>
<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');
$('#distinctorder option[value="<%=oReport.DistinctOrder%>"]').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
%>