File: D:/web/hyperflight/! previous changes 2/2025-03-26/new c/CustomGetDeliveryRefactored.asp
<%
' this routine must exist if CustomDeliveryEnabled, -1 is returned if delivery cost could not be determined, user should be alerted using SetAlertMessage
' (SS,05/07/12) custom delivery to charge extra if carbon rod type item in basket (i.e. with "Postal Length" attribute >=90 and any option value is >= 90)
' (SS,04/10/12) replaced GetAttributeInBasketCountNumValCompare with GetAttributeInBasketMaxOptionValue which returns maximum option value
' (SS,09/12/14) added AByPriceDeliveryCost, AByWeightDeliveryCost to make compatible with latest apputils
' (SS,01/12/16) added setting of Priority for order, N.B. this routine isn't called if "delivery will collect", custom routine CustomGetPriority will always be called (see below) this can be used to set priority for "delivery will collect"
' (SS,08/03/17) modified to remove VAT from Value for Priority calculation
' (SS,25/07/17) improvements to Lipo delivery cost calculation
' (SS,31/10/17) adjustment to postal tube delivery for EU, EU2 and RW
' (SS,02/11/17) adjustment to priority 3
' (SS,26/01/18) minor change to priority
' (SS,28/06/18) modified to add delivery option code for tracked delivery
' (SS,16/07/18) change to priority when tracked delivery chosen
' (SS,15/02/19) Priority 7, changed to use grand total value not excluding VAT Value (requested by Deborah)
' (SS,22/04/21) added expedited delivery option, this adds an extra 30% to the delivery cost
' (SS,26/04/21) correction, due to extra 5.42 being charged incorrectly for tracked
' (SS,30/04/21) modified to call GetWeightRangeForCategory for reduced delivery for multiple RC Models
' (SS,05/05/21) modified GetDeliveryFromTable (in apputils.asp) to interpolate delivery costs from delivery costs table
' (SS,06/05/21) change to restrict LiPo to specific countries (previous setting was for region RW, LA, or USA)
' (SS,07/05/21) added call to SetAdjustedTotalWeight to set the adjusted total weight
' (SS,10/05/21) added check for delivery cost of <= 0 to abort, or >= 20000 and not UK to abort with error
' (SS,12/05/21) modified call to GetWeightRangeForCategory to remove RC_MODEL_MEDIUM_REF_WEIGHT and replaced LAboveMediumRCModelWeight with LHeavyRCModelTotalWeight
' (SS,03/06/21) fixed issue with Google Shopping Data Feed by not calling GetWeightRangeForCategory when in DoGoogleShoppingDataFeed
' (SS,11/06/21) bug fix to Tracked overriding Expedited delivery option, also set priority to 9 for expedited
' (SS,11/06/21) bug fix for Google Shopping Data Feed to ensure minimum UK delivery for all products
' (SS,08/07/22) new version, rewrite, renamed to CustomGetDeliveryRefactored
' (SS,15/11/22) added CustomShowSetDeliveryVars
' (SS,26/03/25) modified CustomGetDeliveryRefactored to make use of CustomGetRoyalMailDeliveryCost when applicable
' (SS,26/03/25) modified CustomGetDeliveryRefactored to add 3.00 extra instead of 5.42 for tracked in UK
' (SS,6/10/22) added following contants, replaced all 200 (200 inc VAT and 300 inc VAT with this), and 1500s
Const CUSTOM_DELIVERY_THRESHOLD_VALUE = 250 ' i.e. £250 excluding VAT
Const CUSTOM_DELIVERY_THRESHOLD_WEIGHT = 1500
Function CustomGetDeliveryRefactored(ATotalValue, AValueOfNonWeightedGoods, ATotalWeight, AVATContent, ATotalItems, ANormalDeliveryCost, AByPriceDeliveryCost, AByWeightDeliveryCost, APostcode, ARegionCode, ADeliveryRegion, ACountry)
' ====== DETERMINE ADJUSTED TOTAL WEIGHT AND DELIVERY COST OF THE ADJUSTED TOTAL WEIGHT ======
' (SS,8/7/22) weight adjusting code moved to new function CustomGetAdjustedWeight
Dim LTotalWeight, LNormalDeliveryCost
' (SS,8/7/22) different behaviour for Google Shopping data feed, i.e. one item with basic delivery
' also can't call CustomGetAdjustedWeight, not applicable due to one item and also will fail due to call to GetWeightRangeForCategory
If InGoogleShoppingDataFeed Then
LTotalWeight = ATotalWeight
LNormalDeliveryCost = ANormalDeliveryCost
' set tracked and expedited to False, to prevent subsequent products in feed from defaulting to tracked
' when heavy or expensive item encountered which will set default to tracked and delivery too high for following products
SetTrackedDeliverySelected False
SetExpeditedDeliverySelected False
Else
' get the adjusted weight by calling CustomGetAdjustedWeight
LTotalWeight = CustomGetAdjustedWeight(ATotalWeight)
' get the delivery cost for the adjusted adjusted total weight
LNormalDeliveryCost = GetDeliveryFromTable(ARegionCode, False, "W", LTotalWeight)
' (SS,10/5/21) if 0 or less returned from GetDeliveryFromTable then show alert and flag error with -1, also exit early
If (LNormalDeliveryCost <= 0) Or (LTotalWeight >= 20000 And ARegionCode <> "UK" And ARegionCode <> "UK2") Then
SetAlertMessage("Sorry, your package is too heavy for normal delivery, please contact us")
CustomGetDeliveryRefactored = -1
Exit Function
End If
End If
' ====== END OF ADJUST TOTAL WEIGHT AND DELIVERY COST ========================================
' ====== DETERMINE EXTRA DELIVERY COST IF POSTAL TUBE REQUIRED OR LIPO IN BASKET =============
' LIPO ONLY ALLOWED FOR SPECIFIC COUNTRIES
' EXTRA COST ONLY APPLIED IF TOTAL WEIGHT < 1500 FOR POSTAL TUBE AND LIPO
Dim LExtraDeliveryCost, LHasLiPo, LPostalTubeMaxLength
LExtraDeliveryCost = 0
LHasLiPo = GetAttributeInBasketCount("LiPo", "") > 0
'Response.Write "###" & GetAttributeInBasketCount("Exclude Delivery to RW", "") & "###" & ARegionCode & BR
' (SS,8/1/16) restrict delivery of batteries to RW
'If GetAttributeInBasketCount("Exclude Delivery to RW", "") > 0 Then
' If ARegionCode = "RW" Or ARegionCode = "LA" Or ARegionCode = "USA" Then
' (SS,6/5/21) replaced above two with following to allow LiPos only in these countries
If LHasLiPo Then
If InStr(",United Kingdom,Belgium,France,Germany,Italy,Netherlands,Spain,", "," & ACountry & ",") = 0 Then
SetAlertMessage("Sorry we can't deliver batteries to your region, please remove from basket")
CustomGetDeliveryRefactored = -1
Exit Function
End If
End If
' *** All these prices should NOT contain VAT - it will be added later if required. ***
' (SS,4/10/12) get max length of option for product with attribute "Requires Postal Tube"
' if no product in basket with this attribute then -1 is returned
' 0 is returned if product exists in basket with this attribute but has no option value
' if option value exists then the maximum integer value is returned
LPostalTubeMaxLength = GetAttributeInBasketMaxOptionValue("Requires Postal Tube")
' if at least one such item then add extra cost according to region
' (NS,12/3/13) Added ATotalWeight < 3000 parameter so charges are not added when sending a big box
' (NS, 4/7/13} Edited values, added LA code
' (NS 5/6/14) Changed weight opton to 1500g and changed logic
' (NS 27/8/15) Increased UK charges
' (SS,9/8/18) changed ATotalWeight <= 1500 to ATotalWeight < 1500
' (SS,30/4/21) changed all ATotalWeight below to LTotalWeight and ANormalDeliveryCost to LNormalDeliveryCost
' (SS,6/10/22) replaced 1500 with CUSTOM_DELIVERY_THRESHOLD_WEIGHT
If LTotalWeight < CUSTOM_DELIVERY_THRESHOLD_WEIGHT Then
Dim LExtraPostalTubeDeliveryCost ' (SS,10/7/22) for improved readability LExtraPostalTubeDeliveryCost instead of LExtraDeliveryCost
If LPostalTubeMaxLength >= 0 Then 'reduce these ' (SS,25/17/17) changed from > 0 to >= 0
If ARegionCode = "UK" Or ARegionCode = "UK2" Then
LExtraPostalTubeDeliveryCost = 2.50 ' ex VAT - was 2.09
ElseIf ARegionCode = "EU" Or ARegionCode = "EU2" Then
LExtraPostalTubeDeliveryCost = 3.00 ' (SS,31/10/17) changed to 3.00 was incorrectly set to 1.92
ElseIf ARegionCode = "USA" Or ARegionCode = "RW" Or ARegionCode = "LA" Then
LExtraPostalTubeDeliveryCost = 3.70 ' (SS,31/10/17) was 3.50, changed to 3.70
End If
If LPostalTubeMaxLength >= 90 Then
If ARegionCode = "UK" Or ARegionCode = "UK2" Then
LExtraPostalTubeDeliveryCost = 6.49 ' ex VAT - was 2.09, 4.34, 5.29, changed to 6.49 (from 5.29) on 20/11/18 (SS&NS)
ElseIf ARegionCode = "EU" Or ARegionCode = "EU2" or ARegionCode = "EU3" Then
LExtraPostalTubeDeliveryCost = 15.00
ElseIf ARegionCode = "USA" Or ARegionCode = "RW" Then
LExtraPostalTubeDeliveryCost = 30.00
ElseIf ARegionCode = "LA" Then
LExtraPostalTubeDeliveryCost = 10.00 'don't need add much for this region as it is sent by courier anyway
End If
End If
Else ' (SS,10/7/22)
LExtraPostalTubeDeliveryCost = 0
End If ' (SS,25/17/17) added End If to separate ElseIf LPostalTubeMaxLength = 0 into separate calc for Lipo delivery below
' (NS 5/6/14 added short courier opton. No Length opton required. Use for products that needs to be sent by courier always, eg LiPos.
' Remember to update the {LiPost} token text if these prices are changed.
'ElseIf LPostalTubeMaxLength = 0 Then
' (SS,25/7/17) replaced above ElseIf with If LLipo and replaced LExtraDeliveryCost with LExtraLipoDeliveryCost
Dim LExtraLipoDeliveryCost ' (SS,25/7/17)
If LHasLiPo Then
If ARegionCode = "UK" Then
LExtraLipoDeliveryCost = 2.30 ' ex VAT (SS,25/7/17) changed from 1.10 to 2.30
ElseIf ARegionCode = "UK2" Or ARegionCode = "EU" Or ARegionCode = "EU2" or ARegionCode = "EU3" Then
LExtraLipoDeliveryCost = 11.00
ElseIf ARegionCode = "USA" Or ARegionCode = "RW" Then 'don't need OR ARegionCode = "LA" as this region is sent by courier anyway
LExtraLipoDeliveryCost = 24.00
End If
Else ' i.e. no Lipo
LExtraLipoDeliveryCost = 0
End If
' (SS,25/7/17) set extra delivery cost to whichever is the greater lipo or postal tube
LExtraDeliveryCost = Max(LExtraPostalTubeDeliveryCost, LExtraLipoDeliveryCost)
End If
' Add 1% of the basket value to the delivery cost if the delivery address is RW or USA or LA
' (SS,2/11/12) added "LExtraDeliveryCost > 0" so that adhoc sales have no delivery, i.e. if there's no extra delivery then don't increase it
' (SS,16/11/12) removed LExtraDeliveryCost > 0 because it's incorrect, we're changing extra 2% of the total value, added - AValueOfNonWeightedGoods to remove the ad hoc items
' (NS, 18/8/16) changed from 2% to 1% uplift
Dim LDeliveryAdditionForRW_USA_LA ' (SS,15/11/22)
If ARegionCode = "USA" Or ARegionCode = "RW" Or ARegionCode = "LA" then ' (NS 5/6/14) added OR LA
' LExtraDeliveryCost = LExtraDeliveryCost + (ATotalValue - AValueOfNonWeightedGoods) * 0.01 ' add 1% (was 2%)
' (SS,15/11/22) replaced above with following
LDeliveryAdditionForRW_USA_LA = Round2dp((ATotalValue - AValueOfNonWeightedGoods) * 0.01) ' add 1% (was 2%)
LExtraDeliveryCost = LExtraDeliveryCost + LDeliveryAdditionForRW_USA_LA
End If
' ====== END OF EXTRA DELIVERY COST ==========================================================
' (SS,6/10,22) added following because we're using ex VAT prices for CUSTOM_DELIVERY_THRESHOLD_VALUE
Dim LTotalValueExcVAT
LTotalValueExcVAT = ATotalValue - AVATContent
' (SS,6/10/22) set minimum priority, we're now passing on priority to CustomSetDeliveryOption below via GetPriority to force tracking if priority >= 4
' we're also defaulting ATrackedDelivery and AExpeditedDelivery to False because we don't know at this point
CustomSetPriority LTotalValueExcVAT, ATotalWeight, ARegionCode, False, False, LPostalTubeMaxLength, LHasLiPo
' (SS,10/7/20) delivery option code moved to separate CustomSetDeliveryOption routine, which returns LTrackedDelivery and LExpeditedDelivery, code affecting LExtraDeliveryCost kept here
Dim LTrackedDelivery, LExpeditedDelivery
' (SS,6/10/22) replaced ATotalValue with LTotalValueExcVAT, added Priority (via GetPriority) to the end (new parameter) because we're forcing Tracking when >= 4
CustomSetDeliveryOption LTotalValueExcVAT, LTotalWeight, ARegionCode, ACountry, LTrackedDelivery, LExpeditedDelivery, GetPriority
' (SS,26/3/25)
Dim LExtraAddedForTrackedOrExpedited
LExtraAddedForTrackedOrExpedited = 0
' following is the else in: If ATotalValue >= 200 Or LTotalWeight >= 1500 Then
' i.e. extra delivery cost for tracked only added instead value 200 and total weight 1500
' (SS,6/10/22) replaced 1500 with CUSTOM_DELIVERY_THRESHOLD_WEIGHT
' (SS,6/10/22) replaced ATotalValue < 200 with LTotalValueExcVAT < CUSTOM_DELIVERY_THRESHOLD_VALUE
'If LTotalValueExcVAT < CUSTOM_DELIVERY_THRESHOLD_VALUE And LTotalWeight < CUSTOM_DELIVERY_THRESHOLD_WEIGHT Then
' (SS,15/11/22) reverted back to ATotalValue < 200 (to keep it the same as the original)
If ATotalValue < 200 And LTotalWeight < CUSTOM_DELIVERY_THRESHOLD_WEIGHT Then
' extra delivery cost for tracked delivery
' (SS,9/8/18) modified from 4.17 (5.00 inc VAT) to 5.42 (6.50 inc VAT)
' (SS,26/4/21) added Or LExpeditedDelivery because this extra delivery is also added for expedited for multiply by a factor later
If LTrackedDelivery Or LExpeditedDelivery Then
' (SS,26/3/25) added LExtraAddedForTrackedOrExpedited to allow removal later in Royal Mail calc
' (SS,26/3/25) add 3.00 extra for "UK" instead of 5.42 due to good deal with WebShip
If ARegionCode = "UK" Then
LExtraAddedForTrackedOrExpedited = 3.00
Else
LExtraAddedForTrackedOrExpedited = 5.42 ' (i.e. 6.50 inc VAT)
End If
LExtraDeliveryCost = LExtraDeliveryCost + LExtraAddedForTrackedOrExpedited
End If
End If
' (SS,22/4/21) for expedited add 30% more, later changed to 75% more
If LExpeditedDelivery Then LExtraDeliveryCost = LExtraDeliveryCost + Round2dp((LNormalDeliveryCost + LExtraDeliveryCost) * 0.75)
' (SS,10/7/22) set priority code moved to separate CustomSetPriority routine
' (SS,6/10/22) replaced ATotalValue with LTotalValueExcVAT, removed AVATContent (3rd parameter)
CustomSetPriority LTotalValueExcVAT, ATotalWeight, ARegionCode, LTrackedDelivery, LExpeditedDelivery, LPostalTubeMaxLength, LHasLiPo
' (SS,1/7/21) added following for debugging purposes to investigate cause of wrong priority sometimes being set, e.g. UK order being set to priority 1
' (SS,11/7/22) LPriority renamed to GetPriority, it's set in CustomSetPriority which has been separated from this routine and has lots of parameters
' (SS,26/3/25) calculate Royal Mail delivery cost, if priority 1, 2 or 3
Dim LRoyalMailDelivery
LRoyalMailDelivery = -1
If Not LExpeditedDelivery And GetPriority >= 1 And GetPriority <= 3 Then
LRoyalMailDelivery = CustomGetRoyalMailDeliveryCost(ACountry, LTrackedDelivery, ATotalWeight)
' set normal delivery cost to LRoyalMailDelivery if higher than previously calculated LNormalDeliveryCost
If LRoyalMailDelivery > LNormalDeliveryCost Then
LNormalDeliveryCost = LRoyalMailDelivery
LExtraDeliveryCost = LExtraAddedForTrackedOrExpedited - LExtraAddedForTrackedOrExpedited ' remove the extra 5.42 added for tracking
End If
End If
' (SS,6/10/22) replaced ATotalValue with LTotalValueExcVAT
CustomAddPriorityLog GetPriority, APostcode, ARegionCode, ADeliveryRegion, ACountry, LTotalValueExcVAT, ATotalWeight, ATotalItems, LNormalDeliveryCost, LExtraDeliveryCost, GetDeliveryOption
' VAT is added later to delivery, prices above include VAT, so we remove the VAT from the extra
' CustomGetDelivery = Round2dp(ANormalDeliveryCost + (LExtraDeliveryCost / (1 + GetVATRate)))
CustomGetDeliveryRefactored = Round2dp(LNormalDeliveryCost + LExtraDeliveryCost) ' decided to add ex VAT cost
' (SS,15/11/22) for debugging (ANormalDelivery, AExtraDelivery, ADeliveryAdditionForRW_USA_LA, AMaxPackagedWeight, ATrackedDelivery, AExpeditedDelivery)
CustomShowSetDeliveryVars LNormalDeliveryCost, LExtraDeliveryCost, LDeliveryAdditionForRW_USA_LA, "", LTrackedDelivery, LExpeditedDelivery
End Function
' (SS,8/7/22) code separated from CustomGetDelivery, not called if it's for a Google Data Feed
Function CustomGetAdjustedWeight(ATotalWeight)
' (SS,12/5/21) removed LAboveMediumRCModelWeight, added LHeavyRCModelTotalWeight
Dim LHeaviestRCModelWeight, LHeavyRCModelTotalWeight, LRCModelTotalWeight, LTotalWeight, LAdjustedWeight
' (SS,12/5/21) removed RC_MODEL_MEDIUM_REF_WEIGHT
Const RC_MODEL_HEAVY_REF_WEIGHT = 1500
' Const RC_MODEL_MEDIUM_REF_WEIGHT = 1000
Const RC_MODEL_WEIGHT_ADJUSTMENT_FACTOR = 0.3
' (SS,12/5/21) removed parameters RC_MODEL_MEDIUM_REF_WEIGHT (3rd), replaced LAboveMediumRCModelWeight with LHeavyRCModelTotalWeight
' values RC_MODEL_MEDIUM_REF_WEIGHT and LRCModelTotalWeight are ByRef and passed back here
' (SS,3/6/21) routine GetWeightRangeForCategory is not compatible with or applicable to the Google Shopping Data Feed i.e. DoGoogleShoppingDataFeed
' it prevents DoGoogleShoppingDataFeed from working by giving oRS type mismatch error, fixed issue by not calling GetWeightRangeForCategory
' when this routine gets called from DoGoogleShoppingDataFeed by using Not InGoogleShoppingDataFeed
' N.B.!!! modifying GetWeightRangeForCategory to use OpenQuery2 instead of OpenQuery or DoGoogleShoppingDataFeed to use OpenQuery2 or OpenQuery3 won't work due to use of GetPricingFromProductRecord
If GetWeightRangeForCategory("RC Models", RC_MODEL_HEAVY_REF_WEIGHT, LHeaviestRCModelWeight, LHeavyRCModelTotalWeight, LRCModelTotalWeight, LTotalWeight) Then
' (SS,12/5/21) replaced LAboveMediumRCModelWeight with LHeavyRCModelTotalWeight
LAdjustedWeight = LTotalWeight - Int((LHeavyRCModelTotalWeight - LHeaviestRCModelWeight) * (1 - RC_MODEL_WEIGHT_ADJUSTMENT_FACTOR))
' (SS,7/6/21) sets the new TotalWeight to save later in the order record
If ATotalWeight <> LAdjustedWeight Then
SetAdjustedTotalWeight(LAdjustedWeight)
End If
' If SHOW_DEBUG_INFO Then
' Response.Write "AdjustedWeight: " & LAdjustedWeight & BR
' Response.Write "NewNormalDeliveryCost: " & LNormalDeliveryCost & BR
' Response.Write "*** HEAVY RC MODEL DETECTED END ***" & BR
' Response.Write "" & BR
' End If
Else ' return the same weight i.e. no change
LAdjustedWeight = ATotalWeight
End If
CustomGetAdjustedWeight = LAdjustedWeight
End Function
' (SS,10/7/22) separated from CustomGetDelivery
' (SS,6/10/22) replaced ATotalValue with ATotalValueExcVAT, removed AVATContent
Sub CustomSetPriority(ATotalValueExcVAT, ATotalWeight, ARegionCode, ATrackedDelivery, AExpeditedDelivery, APostalTubeMaxLength, AHasLiPo)
' ========== START OF SET PRIORITY ==========
' (SS,1/12/16) Set priority
' (SS,2/2/18) added courier or air mail comments for 7, 8, 9 after discussing with Deborah
' 9 - weight > 2 kg (courier)
' 8 - weight > 1 kg (courier (uk) or air mail (might be tracked))
' 7 - value >= £400 (8/3/17 exc VAT) (courier)
' 6 - postal tube > 88 or LiPo
' 5 - inc postal upgrade
' 4 - UK & value > £200
' 3 - Non-UK & value >= £200 (2/11/17 added = and now inc VAT)
' 2 - UK low value
' 1 - non-UK low value
' 0 - collecting
' (SS,25/7/17) Lipo attribute code moved from here to delivery cost above
' (SS,2/11/17) Changed priority 3 to "=" and inc VAT
' (SS,16/7/18) added "Or LTrackedDelivery" to set priority to 4 for UK or 3 for non0Uk if tracked
' (SS,15/2/19) Priority 7, changed to use grand total value not excluding VAT Value (requested by Deborah)
Dim LPriority, LIncPostalUpgrade
LIncPostalUpgrade = GetAttributeInBasketCount("Postal Upgrade", "") > 0
'Response.Write "###TotalValue: " & ATotalValue & "###VATContent: " & AVATContent & BR ' ***
' (SS,8/3/17) adjusted ATotalValue by removing VAT from it
' (SS,6/10/22) removed following, no longer applicable due to ATotalValueExcVAT being passed as parameter replacing ATotalValue
'Dim LTotalValueExcVAT
'LTotalValueExcVAT = ATotalValue - AVATContent
' (SS,9/8/18) added = to ATotalWeight > 2000 and ATotalWeight > 1000
' (SS,11/6/21) also set priority of 9 if expedited chosen
' (SS,6/10/22) replaced all ATotalValue with ATotalValueExcVAT, and 200 with
If ATotalWeight >= 2000 Or AExpeditedDelivery Then
LPriority = 9
ElseIf ATotalWeight >= 1000 Then
LPriority = 8
ElseIf ATotalValueExcVAT >= 400 Then ' (SS,2/2/18 added =) ' (SS,15/2/19) Changed LTotalValueExcVAT to ATotalValue, requested by Deborah
LPriority = 7
ElseIf APostalTubeMaxLength > 88 Or AHasLiPo Then
LPriority = 6
ElseIf LIncPostalUpgrade Or AExpeditedDelivery Then ' (SS,22/4/21) added Or LExpeditedDelivery, i.e. if expedited then ensure at least 5
LPriority = 5
ElseIf ARegionCode = "UK" Or ARegionCode = "UK2" Then
' (SS,16/7/18) added Or LTrackedDelivery
If ATotalValueExcVAT >= CUSTOM_DELIVERY_THRESHOLD_VALUE Or ATrackedDelivery Then ' (SS,26/1/18) changed from LTotalValueExcVAT to ATotalValue, also > to >= as requested by Deborah
LPriority = 4
Else
LPriority = 2
End If
Else ' non-UK
' (SS,16/7/18) added Or LTrackedDelivery
If ATotalValueExcVAT >= CUSTOM_DELIVERY_THRESHOLD_VALUE Or ATrackedDelivery Then ' (SS,2/10/17) changed from LTotalValueExcVAT > 200 to ATotalValue >= 200 as requested by Deborah
LPriority = 3
Else
LPriority = 1
End If
End If
SetPriority LPriority
' ========== END OF SET PRIORITY ==========
End Sub
' (SS,10/7/22) separated from CustomGetDelivery, ATrackedDelivery and AExpeditedDelivery are passed back
' (SS,6/10/22) replaced ATotalValue with ATotalValueExcVAT, added APriority to force Tracked Delivery if >= 4
Sub CustomSetDeliveryOption(ATotalValueExcVAT, ATotalWeight, ARegionCode, ACountry, ByRef ATrackedDelivery, ByRef AExpeditedDelivery, APriority)
' ========== START OF DELIVERY OPTION ==========
' (SS,28/6/18) add addition cost for Tracked Delivery, set the DeliveryOption, don't allow option to be changed for certain countries
' if order value >= 200 then tracking always ticked and no extra cost
' if value below 200 then allow ticking and charge extra if ticked
' for certain countries i.e. Russia, Ukraine, Turkey, South Africa, Latin America, always tick and don't allow unticking
Dim LTrackedDelivery, LTrackedDeliverySelectionAllowed, LAlwaysTracked
LTrackedDelivery = False
LTrackedDeliverySelectionAllowed = True
' (SS,22/4/21)
Dim LExpeditedDelivery, LExpeditedDeliverySelectionAllowed
LExpeditedDelivery = False
LExpeditedDeliverySelectionAllowed = True
' (SS,22/4/21) expedited not allowed in UK
If ARegionCode = "UK" Or ARegionCode = "UK2" Then
LExpeditedDeliverySelectionAllowed = False
End If
Dim LUntrackedDeliverySelectionAllowed
LUntrackedDeliverySelectionAllowed = True
' get from user selection
LTrackedDelivery = GetTrackedDeliverySelected
LExpeditedDelivery = GetExpeditedDeliverySelected
' (SS,26/4/21) if expedited selected and not allowed then default to tracked
If LExpeditedDelivery And Not LExpeditedDeliverySelectionAllowed Then
LTrackedDelivery = True
SetTrackedDeliverySelected True
LExpeditedDelivery = False
SetExpeditedDeliverySelected False
End If
' (SS,9/8/18) added Or ATotalWeight >= 1500 to force tracked when weight is over 1500g
' (SS,6/10/22) replaced 1500 with CUSTOM_DELIVERY_THRESHOLD_WEIGHT, and ATotalValue >= 200 with ATotalValueExcVAT >= CUSTOM_DELIVERY_THRESHOLD_VALUE
' (SS,6/10/22) added Or APriority >= 4 to force Tracked if priority >= 4
If ATotalValueExcVAT >= CUSTOM_DELIVERY_THRESHOLD_VALUE Or ATotalWeight >= CUSTOM_DELIVERY_THRESHOLD_WEIGHT Or APriority >= 4 Then
LTrackedDelivery = True
SetTrackedDeliverySelected True' (SS,26/4/21) to make sure untracked isn't selected
' LTrackedDeliverySelectionAllowed = False
LUntrackedDeliverySelectionAllowed = False ' (SS,22/4/21) replaces above
Else ' less than 200
LAlwaysTracked = GetCountryOptions(ACountry) = "T"
If LAlwaysTracked Then
LTrackedDelivery = True
SetTrackedDeliverySelected True' (SS,26/4/21)
' LTrackedDeliverySelectionAllowed = False
LUntrackedDeliverySelectionAllowed = False ' (SS,22/4/21) replaces above, i.e. allows tracked and expedited
Else
' get from user selection
LTrackedDelivery = GetTrackedDeliverySelected
End If
End If
' (SS,22/4/21) if expedited allowed then allow tracked selection too
If LExpeditedDeliverySelectionAllowed Then LTrackedDeliverySelectionAllowed = True
' (SS,22/4/21) added expedited
' (SS,29/4/21) removed " Delivery" from end of "Tracked" and "Expedited"
' (SS,11/6/21) fixed bug where Tracked was overriding Expedited, we want Expedited to override Tracked, fixed by swapping the if so LExpeditedDelivery is before LTrackedDelivery
If LExpeditedDelivery Then
SetDeliveryOption "Expedited"
LTrackedDelivery = False ' (SS,11/6/21) added this to ensure "Expedited" is overriden later, i.e. we can't have both Expedited and Tracked
ElseIf LTrackedDelivery Then
SetDeliveryOption "Tracked"
Else
' (SS,29/4/21) changed from "" to "Untracked", value can also be "Collection" when customer choses to collect
' when that occurs delivery cost is set 0 and this function isn't called
SetDeliveryOption "Untracked"
End If
' set the values for the checkbox
SetTrackedDeliverySelected LTrackedDelivery
SetTrackedDeliverySelectionAllowed LTrackedDeliverySelectionAllowed
' (SS,22/4/21)
SetUntrackedDeliverySelectionAllowed LUntrackedDeliverySelectionAllowed
SetExpeditedDeliverySelected LExpeditedDelivery
SetExpeditedDeliverySelectionAllowed LExpeditedDeliverySelectionAllowed
' (SS,10/7/22) pass back
ATrackedDelivery = LTrackedDelivery
AExpeditedDelivery = LExpeditedDelivery
' ========== END OF DELIVERY OPTION ==========
End Sub
%>