HEX
Server: Microsoft-IIS/10.0
System: Windows NT ITPWINWEBSVR22 10.0 build 20348 (Windows Server 2022) AMD64
User: www.conferencesearch.co.uk (0)
PHP: 8.3.30
Disabled: NONE
Upload Files
File: D:/web/hyperflight/! previous changes 2/2025-07-24/prev/customutils-delivery.asp
<%
' adjustable delivery cost calculation constants

Const TRACKING_MANDATORY_VALUE = 250 ' i.e. £250 excluding VAT
Const TRACKING_MANDATORY_WEIGHT = 1500

Const UK_TRACKING_DELIVERY_CHARGE_UPLIFT = 1.25
Const NON_UK_TRACKING_DELIVERY_CHARGE_UPLIFT = 0

Const RC_MODEL_HEAVY_REF_WEIGHT = 1500
Const RC_MODEL_WEIGHT_ADJUSTMENT_FACTOR = 0.3

Const POSTAL_TUBE_90_OR_LESS_MIN_WEIGHT = 500
Const POSTAL_TUBE_90_OR_LESS_ADD_DELIVERY_CHARGE = 1
Const POSTAL_TUBE_91_OR_MORE_MIN_WEIGHT = 2000
Const POSTAL_TUBE_91_OR_MORE_ADD_DELIVERY_CHARGE = 2

Const LIPO_UK_MIN_WEIGHT = 100
Const LIPO_NON_UK_MIN_WEIGHT = 1500

Const ROYAL_MAIL_WEIGHT_ADJUST_RATIO = 1.5
Const ROYAL_MAIL_COST_ADJUST_RATIO = 1.2

' ========================
' customutils-delivery.asp
' ========================
' Version 1.00 (28/03/25)
' ========================
' HISTORY
' ========================
' (SS,28/03/25) First created, separated from customutils.asp, CustomGetDelivery in customutils.asp calls CustomGetDeliveryCharge in this unit



' this routine must exist if CustomDeliveryEnabled, -1 is returned if delivery cost could not be determined, user should be alerted using SetAlertMessage
' (SS,5/7/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,4/10/12) replaced GetAttributeInBasketCountNumValCompare with GetAttributeInBasketMaxOptionValue which returns maximum option value
' (SS,9/12/14) added AByPriceDeliveryCost, AByWeightDeliveryCost to make compatible with latest apputils
' (SS,1/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,8/3/17) modified to remove VAT from Value for Priority calculation
' (SS,25/7/17) improvements to Lipo delivery cost calculation
' (SS,31/10/17) adjustment to postal tube delivery for EU, EU2 and RW
' (SS,2/11/17) adjustment to priority 3
' (SS,26/1/18) minor change to priority
' (SS,28/6/18) modified to add delivery option code for tracked delivery
' (SS,16/7/18) change to priority when tracked delivery chosen
' (SS,15/2/19) Priority 7, changed to use grand total value not excluding VAT Value (requested by Deborah)
' (SS,22/4/21) added expedited delivery option, this adds an extra 30% to the delivery cost
' (SS,26/4/21) correction, due to extra 5.42 being charged incorrectly for tracked
' (SS,30/4/21) modified to call GetWeightRangeForCategory for reduced delivery for multiple RC Models
' (SS,05/5/21) modified GetDeliveryFromTable (in apputils.asp) to interpolate delivery costs from delivery costs table
' (SS,06/5/21) change to restrict LiPo to specific countries (previous setting was for region RW, LA, or USA)
' (SS,07/5/21) added call to SetAdjustedTotalWeight to set the adjusted total weight
' (SS,10/5/21) added check for delivery cost of <= 0 to abort, or >= 20000  and not UK to abort with error 
' (SS,12/5/21) modified call to GetWeightRangeForCategory to remove RC_MODEL_MEDIUM_REF_WEIGHT and replaced LAboveMediumRCModelWeight with LHeavyRCModelTotalWeight
' (SS,03/6/21) fixed issue with Google Shopping Data Feed by not calling GetWeightRangeForCategory when in DoGoogleShoppingDataFeed
' (SS,11/6/21) bug fix to Tracked overriding Expedited delivery option, also set priority to 9 for expedited
' (SS,11/6/21) bug fix for Google Shopping Data Feed to ensure minimum UK delivery for all products
' (SS,11/7/22) new version, rewrite, renamed to CustomGetDeliveryNewAlgorithm
' (SS,5/10/22) new version called CustomGetDeliveryNewAlgorithmV2 which looks at new MinPackagedWeight attribute 
' (SS,21/3/25) new version CustomGetDeliveryNewAlgorithmV3 with Royal Mail looked up from Royal Mail delivery costs table
' (SS,27/3/25) new version CustomGetDeliveryNewAlgorithmV4 with Royal Mail looked up from Royal Mail delivery costs table and revised algorithm
' (SS,28/3/25) now just this one version, renamed from CustomGetDeliveryNewAlgorithmV4 to CustomGetDeliveryCharge
Function CustomGetDeliveryCharge(ATotalValue, AValueOfNonWeightedGoods, ATotalWeight, AVATContent, ATotalItems, ANormalDeliveryCost, AByPriceDeliveryCost, AByWeightDeliveryCost, APostcode, ARegionCode, ADeliveryRegion, ACountry)
 

' New Algorithm 27/03/25 see Neil's email
' =======================================
' All countries:

'Carbon strips don’t weigh much but always require a pizza box or a postal tube – so can’t go large letter. Currently we aren’t charging extra but we should, as we lose money if the order weight less than 100g. We have a Package Weight attribute (that I don’t think we are using). We could put a value in that (eg 250) to say the minimum packaged weight is 250g.

'Postal Tubes
'If length <91 cm increase weight to 500g if less and add £1+VAT to the postal charge
'Else increase weight to 2000g if less and add £2+VAT to the postal charge

'UK:
'1. If the user selects tracking then always use the small parcel rate, not the large letter rate.
'2. Reduce the tracking uplift over non-tracked to £1.25 (from £3 currently).
'3. Increase the value over which tracking is mandatory to £300
'4. No longer give free tracking for these over £300 parcels  - ie if the value increases from £299 to £301 we auto select tracking and the cost goes up by £1.25
'5. LiPo: increase weight to 100g if less, auto-select Tracked only

'Non UK:
'1. Use RM table to work out tracked & untracked cost
'2. N/A
'3. Increase the value over which tracking is mandatory to £300
'4. No longer give free tracking for these over £300 parcels  - ie if the value increases from £299 to £301 we auto select tracking and the cost goes up by whatever the RM tables say.
'5. LiPo: increase weight to 1500g if less, auto-select Tracked only

 
 
  ' ====== 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
  
  Dim LMaxPackagedWeight ' (SS,5/10/22)
  LMaxPackagedWeight = 0 ' (SS,15/11/22)
  
  Dim LExtraDeliveryCost, LHasLiPo, LPostalTubeMaxLength
  LExtraDeliveryCost = 0
  
  LHasLiPo = GetAttributeInBasketCount("LiPo", "") > 0

  ' (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")  
  
  ' (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

    ' (SS,5/10/22) get the maximum "Packaged Weight" attribute value    
    LMaxPackagedWeight = GetAttributeInBasketMaxValue("Packaged Weight")
    
    ' (SS,5/10/22) maximum of max packaged weight and total weight
    LTotalWeight = Max(LMaxPackagedWeight, ATotalWeight)
  
    ' get the adjusted weight by calling CustomGetAdjustedWeight
    ' (SS,5/10/22) modified ATotalWeight to LTotalWeight
    LTotalWeight = CustomGetAdjustedWeight(LTotalWeight)
    
    ' (SS,27/3/25) postal tube adjustments
    If LPostalTubeMaxLength >= 0 Then
      
      If LPostalTubeMaxLength <= 90 Then
        LTotalWeight = MAX(LTotalWeight, POSTAL_TUBE_90_OR_LESS_MIN_WEIGHT)
        LExtraDeliveryCost = LExtraDeliveryCost + POSTAL_TUBE_90_OR_LESS_ADD_DELIVERY_CHARGE
      Else ' >= 91
        LTotalWeight = MAX(LTotalWeight, POSTAL_TUBE_91_OR_MORE_MIN_WEIGHT)
        LExtraDeliveryCost = LExtraDeliveryCost + POSTAL_TUBE_91_OR_MORE_ADD_DELIVERY_CHARGE
      End If
      
    End If
    
    ' (SS,27/3/25) LiPo adjustments
    If LHasLiPo Then    
      If ARegionCode = "UK" Or ARegionCode <> "UK2" Then
        LTotalWeight = MAX(LTotalWeight, LIPO_UK_MIN_WEIGHT)  
      Else
        LTotalWeight = MAX(LTotalWeight, LIPO_NON_UK_MIN_WEIGHT) 
      End If    
    End If    
    
    ' (SS,5/10/22) set the adjusted weight if different to original 
    If ATotalWeight <> LTotalWeight Then
      SetAdjustedTotalWeight(LTotalWeight)
    Else
      SetAdjustedTotalWeight(0)
    End If
    
    ' 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")
      CustomGetDeliveryCharge = -1
      Exit Function
    End If

    '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")
        CustomGetDeliveryCharge = -1
        Exit Function
      End If      
    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
  


  ' *** All these prices should NOT contain VAT - it will be added later if required. ***
   

     
  ' ====== END OF EXTRA DELIVERY COST ==========================================================


  ' ====== ADJUST FOR DELIVERY OPTION, TOTAL THE DELIVERY COST, SET PRIORITY ===================
  ' (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,21/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 <= 4 Then
    LRoyalMailDelivery = CustomGetRoyalMailDeliveryCost(ACountry, LTrackedDelivery, ATotalWeight)
    ' set normal delivery cost to LRoyalMailDelivery if higher than previously calculated LNormalDeliveryCost
    If LRoyalMailDelivery > LNormalDeliveryCost Then
      LNormalDeliveryCost = LRoyalMailDelivery
    End If
  End If
  
  ' (SS,27/3/25) extra for tracking
  Dim LDeliveryUplift
  If LTrackedDelivery Then
    If ARegionCode = "UK" Or ARegionCode = "UK2" Then
      LDeliveryUplift = UK_TRACKING_DELIVERY_CHARGE_UPLIFT
    Else
      LDeliveryUplift = NON_UK_TRACKING_DELIVERY_CHARGE_UPLIFT
    End If
    LExtraDeliveryCost = LExtraDeliveryCost + LDeliveryUplift
  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,11/7/22) added a further £10 for expedited delivery
    LExtraDeliveryCost = LExtraDeliveryCost + 10
  End If
  
  ' (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,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)))
  CustomGetDeliveryCharge = Round2dp(LNormalDeliveryCost + LExtraDeliveryCost) ' decided to add ex VAT cost    
  
  ' (SS,15/11/22) for debugging (ANormalDelivery, AExtraDelivery, ADeliveryUplift, AMaxPackagedWeight, ATrackedDelivery, AExpeditedDelivery
  CustomShowSetDeliveryVars LNormalDeliveryCost, LExtraDeliveryCost, LDeliveryUplift, LMaxPackagedWeight, LTrackedDelivery, LExpeditedDelivery
  
  ' ====== END OF ==============================================================================
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
' (SS,28/3/25) replaced constant CUSTOM_DELIVERY_THRESHOLD_VALUE with TRACKING_MANDATORY_VALUE
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 >= TRACKING_MANDATORY_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 >= TRACKING_MANDATORY_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
' (SS,28/3/25) replaced CUSTOM_DELIVERY_THRESHOLD_VALUE with TRACKING_MANDATORY_VALUE and CUSTOM_DELIVERY_THRESHOLD_WEIGHT with TRACKING_MANDATORY_WEIGHT
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 >= TRACKING_MANDATORY_VALUE Or ATotalWeight >= TRACKING_MANDATORY_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


%>