<%
' 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
Function CustomGetDeliveryNewAlgorithmV3(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
  
  Dim LMaxPackagedWeight ' (SS,5/10/22)
  LMaxPackagedWeight = 0 ' (SS,15/11/22)
  
  ' (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")
    
    ' Response.Write "###" & LMaxPackagedWeight & ": " & LMaxPackagedWeight & BR
    
    ' (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,5/10/22) 
    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")
      CustomGetDeliveryNewAlgorithmV2 = -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")
      CustomGetDeliveryNewAlgorithmV2 = -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
  
    'ExtraTypes in new deliverycosts_extra table: 'Postal Tube < 90cm','Postal Tube >= 90cm','LiPo'
    
    ' if postal tube then look up extra cost from table
    Dim LExtraPostalTubeDeliveryCost ' (SS,10/7/22) for improved readability LExtraPostalTubeDeliveryCost instead of LExtraDeliveryCost
    If LPostalTubeMaxLength >= 90 Then
      LExtraPostalTubeDeliveryCost = CustomGetExtraDelivery("Postal Tube >= 90cm", ARegionCode)
    ElseIf LPostalTubeMaxLength >= 0 Then
      LExtraPostalTubeDeliveryCost = CustomGetExtraDelivery("Postal Tube < 90cm", ARegionCode)
    Else ' i.e. no postal tube
      LExtraPostalTubeDeliveryCost = 0
    End If
    
    ' if lipo then look up extra cost from table
    Dim LExtraLipoDeliveryCost
    If LHasLiPo Then
      LExtraLipoDeliveryCost = CustomGetExtraDelivery("LiPo", ARegionCode)
    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
  ' (SS,11/7/22) no uplift in latest algorithm
  '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%) 
  'End If
  ' (SS,16/11/22) replaced above with following to apply uplift to all regions, also changed to apply to net amount (i.e. excluding VAT)
  Dim LWeightedGoodsExcVAT, LDeliveryUplift
  LWeightedGoodsExcVAT = Round2dp((ATotalValue - AVATContent) - (AValueOfNonWeightedGoods - GetVATAmount(AValueOfNonWeightedGoods)))
  LDeliveryUplift = Round2dp(LWeightedGoodsExcVAT * 0.01)
  LExtraDeliveryCost = LExtraDeliveryCost + LDeliveryUplift  
  ' ====== 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 <= 3 Then
    LRoyalMailDelivery = CustomGetRoyalMailDeliveryCost(ACountry, LTrackedDelivery, ATotalWeight)
  End If
  
  
  ' 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,11/7/22) changed 200 to 300
  ' (SS,6/10/22) replaced 1500 with CUSTOM_DELIVERY_THRESHOLD_WEIGHT
  ' (SS,6/10/22) replaced ATotalValue < 300 with LTotalValueExcVAT < CUSTOM_DELIVERY_THRESHOLD_VALUE 
  If LTotalValueExcVAT < CUSTOM_DELIVERY_THRESHOLD_VALUE 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
    ' (SS,11/7/22) changed 5.42 to 6.00
    If LTrackedDelivery Or LExpeditedDelivery Then LExtraDeliveryCost = LExtraDeliveryCost + 6.00
  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)))
  CustomGetDeliveryNewAlgorithmV3 = 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

' routines CustomGetAdjustedWeight, CustomSetPriority, CustomSetDeliveryOption are in CustomGetDeliveryRefactored.asp

' (SS,11/7/22)
' ExtraTypes in new deliverycosts_extra table: 'Postal Tube < 90cm','Postal Tube >= 90cm','LiPo'
Function CustomGetExtraDelivery(AExtraType, ARegionCode)
  Dim LSQL  
  LSQL = "SELECT `" & ARegionCode & "` FROM deliverycosts_extra WHERE ExtraType = '" & AExtraType & "'"  
  CustomGetExtraDelivery = NZD(GetSQLValue(LSQL)) 
End Function


%>