"
'*******************************************
'* Code for background tables
'*******************************************
htmFullPageContent = htmFullPageContent & ""
'***********************************************
'* End background table code
'***********************************************
'htmPageContent = htmTitle & CRLF & htmFullPageContent
htmPageContent = htmFullPageContent
'***********************************************
'* End Mod
'***********************************************
' Populate the discount banner slot
ProductAffinity = Null
Set BasketAffinity = CollectBasketItems(mscsOrderGrp)
nDiscountsToShow = 1
htmDiscountBannerSlot = RenderDiscounts(ProductAffinity, BasketAffinity, nDiscountsToShow)
End Sub
' -----------------------------------------------------------------------------
' htmRenderBasketWarnings
'
' Description:
'
' Parameters:
'
' Returns:
'
' Notes :
' none
' -----------------------------------------------------------------------------
Function htmRenderBasketWarnings(mscsOrderGrp, oOrderFormDisplayOrder, sErrCollectionName)
Dim sErr, sOrderFormName, mscsOrderForm, htmContent
For Each sOrderFormName In oOrderFormDisplayOrder
Set mscsOrderForm = mscsOrderGrp.Value(ORDERFORMS).Value(sOrderFormName)
For Each sErr In mscsOrderForm.Value(sErrCollectionName)
htmContent = htmContent & RenderText(sErr, MSCSSiteStyle.Warning) & BR
Next
Next
htmRenderBasketWarnings = htmContent
End Function
' -----------------------------------------------------------------------------
' htmRenderBasket
'
' Description:
'
' Parameters:
'
' Returns:
'
' Notes :
' none
' -----------------------------------------------------------------------------
Function htmRenderBasket(mscsOrderGrp, oOrderFormDisplayOrder, iCustomer_Type)
Dim sOrderFormName, mscsOrderForm, dictItem, listAggregatedItems, sName, sBtnText
Dim i, urlLink, urlAction, bDiscountApplied, sProdCode, htmLinkText
Dim htmBasketHeaderRow, htmBasketDataRow, htmQtyCol, htmProdCode, htmRemoveCol, htmTotalRow
Dim arrData, arrParams, arrParamVals, arrDataAttLists
Dim htmDiscountRow, arrDiscData
bDiscountApplied = False
Set listAggregatedItems = Server.CreateObject("Commerce.SimpleList")
For Each sOrderFormName in oOrderFormDisplayOrder
Set mscsOrderForm = mscsOrderGrp.Value(ORDERFORMS).Value(sOrderFormName)
If mscsOrderForm.Value("_winners").Count > 0 Then
'NNT 040904 Disabled Discount Routin
bDiscountApplied = True
'bDiscountApplied = False
''' end
End If
For Each dictItem In mscsOrderForm.Items
Call listAggregatedItems.Add(dictItem)
Next
Next
Call CreatePOIndexes(mscsOrderGrp)
'mv03072001 - Display Color instead of Description.
If bDiscountApplied Then
arrData = Array( _
mscsMessageManager.GetMessage("L_BASKET_QUANTITY_COLUMN_TEXT", sLanguage), _
"SKU", _
mscsMessageManager.GetMessage("L_Product_Name_DisplayName_HTMLText", sLanguage), _
"Color", _
"Unit $", _
mscsMessageManager.GetMessage("L_BASKET_DISCOUNT_COLUMN_TEXT", sLanguage), _
mscsMessageManager.GetMessage("L_BASKET_MESSAGES_COLUMN_TEXT", sLanguage), _
"Total $", _
mscsMessageManager.GetMessage("L_BASKET_REMOVE_COLUMN_TEXT", sLanguage))
Else
arrData = Array( _
mscsMessageManager.GetMessage("L_BASKET_QUANTITY_COLUMN_TEXT", sLanguage), _
"SKU", _
mscsMessageManager.GetMessage("L_Product_Name_DisplayName_HTMLText", sLanguage), _
"Color", _
"Unit $", _
"Total $", _
mscsMessageManager.GetMessage("L_BASKET_REMOVE_COLUMN_TEXT", sLanguage))
End If
'mv Response.Write mscsMessageManager.GetMessage("L_Product_Description_DisplayName_HTMLText", sLanguage)
'mv Response.end
htmRenderBasket = htmRenderBasket & RenderTableHeaderRow(arrData, Array(), MSCSSiteStyle.TRCenter)
If bDiscountApplied Then
arrDataAttLists = Array( _
MSCSSiteStyle.TDCenter, _
MSCSSiteStyle.TDLeft, _
MSCSSiteStyle.TDLeft, _
MSCSSiteStyle.TDLeft, _
MSCSSiteStyle.TDRight, _
MSCSSiteStyle.TDRight, _
MSCSSiteStyle.TDLeft, _
MSCSSiteStyle.TDRight, _
MSCSSiteStyle.TDCenter)
Else
arrDataAttLists = Array( _
MSCSSiteStyle.TDCenter, _
MSCSSiteStyle.TDLeft, _
MSCSSiteStyle.TDLeft, _
MSCSSiteStyle.TDLeft, _
MSCSSiteStyle.TDRight, _
MSCSSiteStyle.TDRight, _
MSCSSiteStyle.TDCenter)
End If
For i = 0 To listAggregatedItems.Count -1
Set dictItem = listAggregatedItems(i)
sName = PRODUCT_QTY_URL_KEY & "_" & dictItem.Value("_poname") & "_" & dictItem.Value("_poindex")
'MV03142001 - see htm_lib.asp for function...
htmQtyCol = RenderLuckyTextBox2(sName, dictItem.quantity, 3, 3, MSCSSiteStyle.TextBox, iCustomer_Type, dictItem.Value("product_variant_id"))
sBtnText = mscsMessageManager.GetMessage("L_Update_Button", sLanguage)
htmQtyCol = htmQtyCol & RenderSubmitButton(SUBMIT_BUTTON, sBtnText, MSCSSiteStyle.Button)
arrParams = Array(CATALOG_NAME_URL_KEY, CATEGORY_NAME_URL_KEY, PRODUCT_ID_URL_KEY, VARIANT_ID_URL_KEY)
arrParamVals = Array(dictItem.Value("product_catalog"), dictItem.Value("product_category"), dictItem.Value("product_id"), dictItem.Value("product_variant_id"))
urlLink = GenerateURL(MSCSSitePages.Product, arrParams, arrParamVals)
sProdCode = dictItem.Value("product_variant_id") ' ** MV03132001 Begin **
'sProdCode = dictItem.Value("product_id")
'If Not IsNull(dictItem.Value("product_variant_id")) Then
' sProdCode = sProdCode & "-" & dictItem.Value("product_variant_id")
'End If ** MV03132001 End **
htmLinkText = RenderText(sProdCode, MSCSSiteStyle.Body)
htmProdCode = RenderLink(urlLink, htmLinkText, MSCSSiteStyle.Link)
arrParams = Array(CATALOG_NAME_URL_KEY, CATEGORY_NAME_URL_KEY, PRODUCT_ID_URL_KEY, VARIANT_ID_URL_KEY, ORDERFORM_NAME, PO_ITEMINDEX_URL_KEY, ITEM_INDEX_URL_KEY)
arrParamVals = Array(dictItem.Value("product_catalog"), dictItem.Value("product_category"), dictItem.Value("product_id"), dictItem.Value("product_variant_id"), dictItem.Value("_poname"), dictItem.Value("_poindex"), i)
urlLink = GenerateURL(MSCSSitePages.DeleteItem, arrParams, arrParamVals)
htmLinkText = RenderText(mscsMessageManager.GetMessage("L_Remove_Item_Link_HTMLText", sLanguage), MSCSSiteStyle.Body)
htmRemoveCol = RenderLink(urlLink, htmLinkText, MSCSSiteStyle.Link)
If bDiscountApplied Then
' "name" and "description" are required product properties and cannot have null values.
'mv03072001 - Display Color instead of Description.
arrData = Array(_
htmQtyCol, _
htmProdCode, _
LabelFreebie(dictItem), _
dictItem.Value("_product_color"), _
htmRenderCurrency(dictItem.Value("_cy_iadjust_currentprice")), _
htmRenderCurrency(dictItem.Value("_cy_oadjust_discount")), _
dictItem.Value("_messages"), _
htmRenderCurrency(dictItem.Value("_cy_oadjust_adjustedprice")), _
htmRemoveCol)
Else
' "name" and "description" are required product properties and cannot have null values.
'mv03072001 - Display Color instead of Description.
arrData = Array(_
htmQtyCol, _
htmProdCode, _
LabelFreebie(dictItem), _
dictItem.Value("_product_color"), _
htmRenderCurrency(dictItem.Value("_cy_iadjust_currentprice")), _
htmRenderCurrency(dictItem.Value("_cy_oadjust_adjustedprice")), _
htmRemoveCol)
End If
htmRenderBasket = htmRenderBasket & RenderTableDataRow(arrData, arrDataAttLists, MSCSSiteStyle.TRMiddle)
Next
urlLink = GenerateURL(MSCSSitePages.DeleteAllItems, Array(), Array())
htmLinkText = RenderText(mscsMessageManager.GetMessage("L_RemoveAll_HTMLText", sLanguage), MSCSSiteStyle.Body)
arrData = Array(_
NBSP, _
mscsMessageManager.GetMessage("L_BASKET_SUBTOTAL_COLUMN_TEXT", sLanguage), _
htmRenderCurrency(mscsOrderGrp.value.saved_cy_oadjust_subtotal), _
RenderLink(urlLink, htmLinkText, MSCSSiteStyle.Link))
If bDiscountApplied Then
arrDataAttLists = Array(" COLSPAN='6'", MSCSSiteStyle.TDLeft, MSCSSiteStyle.TDRight, MSCSSiteStyle.TDCenter)
Else
arrDataAttLists = Array(" COLSPAN='4'", MSCSSiteStyle.TDLeft, MSCSSiteStyle.TDRight, MSCSSiteStyle.TDCenter)
End If
'*******************************************
'* Volume Discount Logic
'*******************************************
arrDiscData = Array(_
NBSP, _
mscsOrderForm.VolumeDiscountPercentApplied & "% Volume Discount Applied:", _
htmRenderCurrency(mscsOrderForm.VolumeDiscountApplied), _
NBSP)
If mscsOrderForm.VolumeDiscountPercentApplied > 0 Then
htmDiscountRow = RenderTableDataRow(arrDiscData, arrDataAttLists, MSCSSiteStyle.TRMiddle)
'Response.Write "a"
Else
htmDiscountRow = ""
'Response.Write "b"
End If
'Response.write mscsOrderGrp.value.saved_cy_oadjust_subtotal
htmTotalRow = RenderTableDataRow(arrData, arrDataAttLists, MSCSSiteStyle.TRMiddle)
htmRenderBasket = htmRenderBasket & htmDiscountRow
'*******************************************
'* End Volume Discount Logic
'*******************************************
htmRenderBasket = htmRenderBasket & htmTotalRow
htmRenderBasket = RenderTable(htmRenderBasket, MSCSSiteStyle.BasketTable)
urlAction = GenerateURL(MSCSSitePages.EditItemQuantities, Array(), Array())
htmRenderBasket = RenderForm(urlAction, htmRenderBasket, HTTP_POST)
End Function
' -----------------------------------------------------------------------------
' htmRenderDiscountMessages
'
' Description:
'
' Parameters:
'
' Returns:
'
' Notes :
' none
' -----------------------------------------------------------------------------
Function htmRenderDiscountMessages(mscsOrderGrp)
htmRenderDiscountMessages = htmRenderDiscountsApplied(mscsOrderGrp) & _
htmRenderDiscountMessageGroup(mscsOrderGrp, "_discounts_removed", mscsMessageManager.GetMessage("L_BASKET_DISCOUNTS_REMOVED_TEXT", sLanguage)) & _
htmRenderDiscountMessageGroup(mscsOrderGrp, "discounts_clicked", mscsMessageManager.GetMessage("L_BASKET_DISCOUNTS_CLICKED_TEXT", sLanguage))
End Function
' -----------------------------------------------------------------------------
' htmRenderDiscountsApplied
'
' Description:
'
' Parameters:
'
' Returns:
'
' Notes :
' none
' -----------------------------------------------------------------------------
Function htmRenderDiscountsApplied(mscsOrderGrp)
Dim htmContent
Dim oCiidCollection, oContentList
Dim sOrderFormName, oOrderForm, iItem
Dim sShippingDiscountDescription, listShippingDiscounts
Dim ciid
Dim dictDescriptions
Set dictDescriptions = GetDictionary()
' Get the applied discounts
' Put the applied ciid's in a dictionary, so you only show one of each
For Each sOrderFormName In mscsOrderGrp.Value(ORDERFORMS)
Set oOrderForm = mscsOrderGrp.Value(ORDERFORMS).Value(sOrderFormName)
Set oContentList = oOrderForm.Value("_discounts")
For Each iItem In oOrderForm.Items
If IsObject(iItem.Value("discounts_applied")) Then
Response.Write "a"
Set oCiidCollection = iItem.Value("discounts_applied")
If oCiidCollection.Count > 0 Then
For Each ciid In oCiidCollection
dictDescriptions(ciid) = GetDiscountDescription(ciid, oContentList)
Next
End If
End If
Next
Next
' Get any shipping discounts
Set listShippingDiscounts = GetSimpleList()
For Each sOrderFormName In mscsOrderGrp.Value(ORDERFORMS)
Set oOrderForm = mscsOrderGrp.Value(ORDERFORMS).Value(sOrderFormName)
sShippingDiscountDescription = oOrderForm.Value("_shipping_discount_description")
If Not IsNull(sShippingDiscountDescription) Then
listShippingDiscounts.Add(sShippingDiscountDescription)
End If
Next
' Display any applied discounts
If dictDescriptions.Count > 0 Or listShippingDiscounts.Count > 0 Then
htmContent = Bold(mscsMessageManager.GetMessage("L_BASKET_DISCOUNTS_APPLIED_TEXT", sLanguage)) & CR
For Each ciid In dictDescriptions
htmContent = htmContent & dictDescriptions(ciid)
Next
For Each sShippingDiscountDescription In listShippingDiscounts
htmContent = htmContent & sShippingDiscountDescription
Next
htmRenderDiscountsApplied = RenderPreFormattedText(htmContent, GetDictionary())
End If
End Function
' -----------------------------------------------------------------------------
' htmRenderDiscountMessageGroup
'
' Description:
'
' Parameters:
'
' Returns:
'
' Notes :
' none
' -----------------------------------------------------------------------------
Function htmRenderDiscountMessageGroup(mscsOrderGrp, sCiidCollection, sMessageGroupDescription)
Dim htmContent
Dim oCiidCollection, oContentList
Dim sOrderFormName, oOrderForm
Dim ciid
Dim dictDescriptions
Set dictDescriptions = GetDictionary()
' Put the applied ciid's in a dictionary, so you only show one of each
For Each sOrderFormName In mscsOrderGrp.Value(ORDERFORMS)
Set oOrderForm = mscsOrderGrp.Value(ORDERFORMS).Value(sOrderFormName)
Set oContentList = oOrderForm.Value("_discounts")
If IsObject(oOrderForm.Value(sCiidCollection)) Then
Set oCiidCollection = oOrderForm.Value(sCiidCollection)
If oCiidCollection.Count > 0 Then
For Each ciid In oCiidCollection
dictDescriptions(ciid) = GetDiscountDescription(ciid, oContentList)
Next
End If
End If
Next
If dictDescriptions.Count > 0 Then
htmContent = Bold(sMessageGroupDescription) & CR
For Each ciid In dictDescriptions
htmContent = htmContent & dictDescriptions(ciid)
Next
htmRenderDiscountMessageGroup = RenderPreFormattedText(htmContent, GetDictionary())
End If
End Function
' -----------------------------------------------------------------------------
' htmRenderCheckoutButton
'
' Description:
'
' Parameters:
'
' Returns:
'
' Notes :
' none
' -----------------------------------------------------------------------------
Function htmRenderCheckoutButton()
Dim htmBodyContent, urlAction, sBtnText
If m_UserType = AUTH_USER Then
If dictConfig.i_AddressBookOptions <> ADDRESSBOOK_DISABLED Then
urlAction = GenerateURL(MSCSSitePages.AddressBook, Array(), Array())
Else
urlAction = GenerateURL(MSCSSitePages.AddressForm, Array(), Array())
End If
ElseIf m_UserType = GUEST_USER Then
urlAction = GenerateURL(MSCSSitePages.AddressForm, Array(), Array())
End If
sBtnText = mscsMessageManager.GetMessage("L_CheckOut_Button", sLanguage)
htmBodyContent = RenderSubmitButton(SUBMIT_BUTTON, sBtnText, MSCSSiteStyle.Button)
htmRenderCheckoutButton = RenderForm(urlAction, htmBodyContent, HTTP_POST)
End Function
' -----------------------------------------------------------------------------
' htmRenderPredictions
'
' Description:
'
' Parameters:
'
' Returns:
'
' Notes :
' none
' -----------------------------------------------------------------------------
Function htmRenderPredictions(mscsOrderGrp, oOrderFormDisplayOrder)
Dim sOrderFormName, oOrderForm, htmContent, dItem, strPropName, varValue, lQuantity
Dim oPredictor, slToPredict, dCase
Dim arPredictedProps, arPredictedVals
Dim lMaxPredictions, i, lPredictionCount
Dim strHREF
Set oPredictor = Application("MSCSPredictor")
If oPredictor Is Nothing Then
' Display this string in development mode to
' allow discovery of feature even if there are no recommendations.
If MSCSEnv = DEVELOPMENT Then
htmRenderPredictions = "" & mscsMessageManager.GetMessage("L_RecommendationsCaption_HTMLText", sLanguage) & "
"
End If
Exit Function
End If
' Construct the input case from the items in the basket.
' The constructed property name in the input dictionary
' is of the form: [Catalog Name].[Product ID]. This
' must correspond to the format used for "SKU" in the
' Trans_Predictor view in the data warehouse. Thes means
' that we treat all variants of a product equally
' for the purposes of prediction.
Set dCase = GetDictionary()
Set slToPredict = GetSimpleList()
' Add list of properties to predict. For product recommendations,
' we give the name of the PivotColumn defined in PredictorDataTables.
slToPredict.Add PREDICTOR_PIVOT_COLUMN
For Each sOrderFormName in oOrderFormDisplayOrder
Set oOrderForm = mscsOrderGrp.value.OrderForms.Value(sOrderFormName)
For Each dItem in oOrderForm.Items
strPropName = PREDICTOR_AGGREGATE_COLUMN & "([" & dItem.product_catalog & "].[" & dItem.product_id & "])"
lQuantity = CLng(dItem.quantity)
dCase(strPropName) = lQuantity
Next
Next
' Call the predictor.
lMaxPredictions = 5 'Display no more than this many predictions.
oPredictor.Predict dCase, slToPredict, arPredictedProps, arPredictedVals, lMaxPredictions
If IsArray(arPredictedProps) Then
htmContent = "" & mscsMessageManager.GetMessage("L_RecommendationsCaption_HTMLText", sLanguage) & "
"
For i = 0 To UBound(arPredictedProps)
strHREF = PredictedPropToHREF(arPredictedProps(i))
htmContent = htmContent & strHREF & "
"
Next
arPredictedProps = Empty
arPredictedVals = Empty
End If
htmRenderPredictions = htmContent
End Function
' -----------------------------------------------------------------------------
' PredictedPropToHREF
'
' Description:
' Construct a hyperlink into the catalog from the prediction information.
'
' Parameters:
'
' Returns:
'
' Notes :
' none
' -----------------------------------------------------------------------------
Function PredictedPropToHREF(strProp)
Dim regEx1
Dim arProps
Dim strCatalogName
Dim strProductID
Dim strProps
Dim strHREF
Set regEx1 = New RegExp
' The prediction property will return in the form:
' QTY([Catalog Name].[Product ID])
regEx1.Pattern = PREDICTOR_AGGREGATE_COLUMN & "\(\[(.+)\]\.\[(.+)\]\)"
strProps = regEx1.Replace(strProp, "$1;$2")
arProps = Split(strProps, ";")
strCatalogName = arProps(0)
strProductID = arProps(1)
PredictedPropToHREF = "" & strProductID & ""
End Function
' -----------------------------------------------------------------------------
' htmCategoryHTML
'
' Description:
' Generate HTML display of the given data
'
' Parameters:
'
' Returns:
'
' Notes :
' none
' -----------------------------------------------------------------------------
Function htmCategoryHTML(oCatalog, sCatalogName, sCategoryName, oCategory, rsProducts, iPageNumber, nOutPagesTotal, sCacheKey)
Dim htmPageContent
Dim htmTitle
' Render the page title
If IsNull(sCategoryName) Then
htmTitle = RenderText_Title(sCatalogName, MSCSSiteStyle.Title)
Else
htmTitle = RenderText_Title(sCategoryName, MSCSSiteStyle.Title)
End If
htmPageContent = htmTitle & CRLF & htmRenderCategoryPage(oCatalog, sCatalogName, sCategoryName, oCategory, rsProducts, iPageNumber, nOutPagesTotal)
Call CacheFragment("ProductListCache", sCacheKey, htmPageContent)
htmCategoryHTML = htmPageContent
End Function
' -----------------------------------------------------------------------------
' htmRenderBasketWarnings
'
' Description:
'
' Parameters:
'
' Returns:
'
' Notes :
' none
' -----------------------------------------------------------------------------
Function htmRenderInventoryError(mscsOrderGrp)
'htmContent = htmContent & RenderText("this is a test", MSCSSiteStyle.Warning) & BR 'MV
htmRenderInventoryError = RenderText(mscsordergrp("InventoryQtyError"), MSCSSiteStyle.Warning)
mscsordergrp("InventoryQtyError") = ""
End Function
%>
|
"
htmFullPageContent = htmFullPageContent & "