<%@ Language=VBScript %>
<%
On Error Resume Next
Dim objCommerce 'AldaT Commerce Object
Dim objVolumePricing 'AldaT Volume Pricing Object
Dim locADORecords 'locRecordset
Dim locStatus 'Maintains state from menu
Dim ErrorFlag 'Flag if string error occurs
Dim ErrorNumber 'Err.number to error.asp
Dim ErrorDescription 'Err.description to error.asp
Dim ErrorSource 'Err.source to error.asp
Dim ErrorPage 'Error source page
Dim ErrorUser 'Error source user
Dim locProductline 'store productline name
Dim locAttrTypeID 'store attribute type id for loop condition
Dim TitleContent, AttributeContent, DescriptionContent 'create content strings
Dim PriceVariationsContent, NoteContent, ImageContent, LinkContent
Dim AttributeDesc 'concatenate attribute info
Dim NumAttributes 'count number of attribute types
Dim FirstLoopFlag
Dim AttributeSize, AttributeCount 'attribute delimiter count, attribute count
Dim Count
Dim sExistingVolumeContent
Dim dBasePrice, dAdjPrice, sPriceContent
Dim locProductID
Dim arrProductID 'list of products to be associated on this page; the first element is the master product which will be used to populate much of the content dynamically
Dim iArrSize 'size of arrProductID
Dim sDescription, sLongDescription, sVolConRow1, sVolConRow2
Dim iVolColumnCount
Dim iCount, iCount2
Set objCommerce = Server.CreateObject("aldatCommerce.Product")
Session("Submitted") = ""
AttributeContent = ""
DescriptionContent = ""
PriceVariationsContent = ""
LinkContent = " "
AdditionalNotesContent = ""
AttributeDesc = ""
NoteContent = ""
ImageContent = ""
AttributeSize = 0
AttributeCount = 0
FirstLoopFlag = True
sExistingVolumeContent = ""
arrProductID = Array(12000, 12005, 12006, 12014, 12015) 'POPULATE with related products per page
locProductID = arrProductID(0)
iArrSize = UBound(arrProductID)
%>
<%
If Err.number > 0 Then
'Conversion error
Err.Clear
Response.Redirect("product.asp?urlmessage=" & Server.URLEncode("Invalid product ID. Could not load product details."))
End If
If Session("OrderID") <> "" Then
'redirect to last page visited in check out process if applicable
Select Case True
Case (InStr(1, Session("Submitted"), "ship_misc", 1) > 0)
Response.Redirect("../commerce/receipt.asp?urlmessage=" & Server.URLEncode("Order already in progress"))
Case (InStr(1, Session("Submitted"), "payment", 1) > 0)
Response.Redirect("../commerce/ship_misc.asp?urlmessage=" & Server.URLEncode("Order already in progress"))
Case (InStr(1, Session("Submitted"), "addresses", 1) > 0)
Response.Redirect("../commerce/payment.asp?urlmessage=" & Server.URLEncode("Order already in progress"))
End Select
End If
'Required: vCompanyID
'Optional: vProductId, vName, vEnabled, vAttributeID, vAttriDescription, vAttriEnabled, vAttriTypeEnabled
Set locADORecords = objCommerce.getProdAttrByProdSort(Application("Company"),locProductID)
If Err.number > 0 Then
Err.Clear
'Required: vCompanyID
'Optional: vProductId, vProdLineID, vName, vEnabled
Set locADORecords = objCommerce.getProduct(Application("Company"),locProductID)
If Err.number > 0 Then
Err.Clear
DescriptionContent = "No Product Found"
Else
'TitleContent = Trim(locADORecords("Name"))
DescriptionContent = Trim(locADORecords("Description"))
End If
Else
If Not locADORecords.EOF Then
'TitleContent = Trim(locADORecords("Name"))
DescriptionContent = Trim(locADORecords("Description"))
While Not locADORecords.EOF
locAttrTypeID = locADORecords("AttrTypeID")
AttributeCount = AttributeCount + 1
If FirstLoopFlag = False Then
'add delimiter
AttributeDesc = AttributeDesc & "@"
AttributeSize = AttributeSize + 1
End If
AttributeContent = AttributeContent & "
"
FirstLoopFlag = False
Wend
locADORecords.Close()
End If
End If
'Required: vCompanyID
'Optional: ContentId, vContentType, vProductId, vEnabled
Set locADORecords = objCommerce.getContent(Application("Company"),,1,locProductID,1)
If Err.number > 0 then
Err.Clear
Else
ImageContent = locADORecords("ContentValue")
End If
Set locADORecords = objCommerce.getContent(Application("Company"),,2,locProductID,1)
If Err.number > 0 then
Err.Clear
Else
NoteContent = locADORecords("ContentValue")
End If
'**********BEGIN volume pricing content per account type
If Session("AcctType") <> "End User" And Session("AcctType") <> "Dealer" Then
sExistingVolumeContent = "
Log-in to an active account to access discounted pricing.
"
Else
sExistingVolumeContent = ""
Set objVolumePricing = Server.CreateObject("AldatVolumePricing.Admin")
For iCount = 0 to iArrSize
'initialize vars for entire pricing matrix
iVolColumnMax = 0
Set locADORecords = objCommerce.getProduct(Application("Company"),arrProductID(iCount))
'BYVAL: vCompanyID OPTIONAL: vVolumePricingID, vProductID, vQty, vAcctType
If Err.number > 0 Then
sDescription = ""
sLongDescription = ""
dBasePrice = 0
iProductID = 0
Else
sDescription = locADORecords("Name")
dBasePrice = locADORecords("BasePrice")
iProductID = locADORecords("ProductID")
If Session("AcctType") = "Dealer" Then
sLongDescription = sDescription & " Retail Price: " & FormatCurrency(dBasePrice) & ""
Else
sLongDescription = sDescription
End If
End If
If arrProductID(iCount) = 12014 Then
sExistingVolumeContent = sExistingVolumeContent & "
Add versatility to your TrachView by purchasing extra videocables
" & Chr(13)
End If
Set locADORecords = objVolumePricing.getVolumePricing(Application("Company"),,arrProductID(iCount),,Session("AcctType"))
If Err.number > 0 Then
Err.Clear
'sExistingVolumeContent = sExistingVolumeContent & "No existing volume prices were found for this product."
sExistingVolumeContent = sExistingVolumeContent & "
" & Chr(13) &_
"
" & Chr(13) &_
"
Description
" & Chr(13) &_
"
No Volume Pricing Available
" & Chr(13) &_
"
" & Chr(13) &_
"
" & Chr(13) &_
"
" & sDescription & "
" & Chr(13) &_
"
" & Chr(13) &_
"
" & FormatCurrency(dBasePrice) & "
" & Chr(13) &_
"
" & Chr(13) &_
"
" & Chr(13) &_
"
" & Chr(13) &_
"
" & Chr(13) &_
"
" & Chr(13) &_
"
" & Chr(13)
Else
'initialize vars per volume pricing per product in array
iVolColumnCount = 0
sVolConRow1 = ""
sVolConRow2 = ""
While Not locADORecords.EOF
dAdjPrice = CDbl(dBasePrice) * CDbl(locADORecords("Coeff"))
If Err.number > 0 Then
Err.Clear
sPriceContent = "Error"
Else
sPriceContent = FormatCurrency(dAdjPrice)
End If
If CDbl(locADORecords("MinQty")) = -1 Then
ExistingMinQty = "No Minimum"
Else
ExistingMinQty = locADORecords("MinQty")
End If
If Err.number > 0 Then
Err.Clear
ExistingMinQty = ""
End If
If CDbl(locADORecords("MaxQty")) = 50000000 Then
ExistingMaxQty = "No Maximum"
Else
ExistingMaxQty = locADORecords("MaxQty")
End If
If Err.number > 0 Then
ExistingMaxQty = Err.Description
Err.Clear
ExistingMaxQty = ""
End If
iVolColumnCount = iVolColumnCount + 1
sVolConRow1 = sVolConRow1 & "
" & Chr(13)
For iCount2 = 1 to iVolColumnCount
sExistingVolumeContent = sExistingVolumeContent & "
Min Qty
" & Chr(13)
Next
sExistingVolumeContent = sExistingVolumeContent & "
" & Chr(13) &_
"
" & Chr(13)
For iCount2 = 1 to iVolColumnCount
sExistingVolumeContent = sExistingVolumeContent & "
Price/Item
" & Chr(13)
Next
sExistingVolumeContent = sExistingVolumeContent & "
" & Chr(13) &_
"
" & Chr(13) &_
"
" & sLongDescription & "
" & Chr(13) &_
sVolConRow1 &_
"
" & Chr(13) &_
"
" & Chr(13) &_
sVolConRow2 &_
"
" & Chr(13) &_
"
" & Chr(13) &_
"
" & Chr(13) &_
"
" & Chr(13) &_
"
" & Chr(13) &_
"
" & Chr(13)
Set locADORecords = Nothing
End If
Next 'Product ID per array
End If
'**********END volume pricing content per account type
%>
<%=Application("CompanyDisplay")%> Item