Option Explicit

'Sampreedh Edited on 22Nov2022 to add Appointment dimension related changes & new
prod hier with pay vendor changes
'Sampreedh Edited on 17Jun2022 to incorporate Geography RDI removal based on small
supplier flag

'Sampreedh Edited on 30Mar2020 to incorporate

'Product Except ""All Products by Merch Group Benchmarking""
'Product Except DescendantsOf(""All Products by Merch Group Benchmarking"")

Dim PremiumAccess As Boolean

Dim smallSupplier As Boolean
' 2/5/19 - JW - added a check in the consolidate logic to explicitly call out when
a blank input row is found before any valid rows. The
' present CVS team seems to have made a specialty out of this. Also now
returns an explicit error message if the input sheet
' is not sorted by LDAP group asking the user to correct the problem.
' 1/22/19 - JW - restored the section of code that grants access to the All
Products by Vendor hierarchy.
' 1/17/19 - JW - modified the PremiumMeasure restrictions to eliminate redundancy
and to make it easier to add new measures without the
' need to further modify this code
' 10/4/18 - JW - added test to pay vendor inputs to make sure they are populated
and numeric
' 8/14/18 - JW - columns changed again
' 7/24/18 - JW - modified to support new input format - see consolidation routine
' 7/3/18 - JW - added exclusion of Premium Measures in advance of "phase 1"
enhancements. Note that this will need to be revisted once
' the first ldap groups show up that should see premium measures
' 9/19/17 - INSTALLED CODE FROM SRI BOUNIPALLY HANDED OVER ON HIS DEPARTURE
'
' 6/21/16 - JW: copied from Sri B's version, this one includes support
' for a new product hierarchy

Const cPathToDimensionScopingFile = "C:\temp\SVN\CVS_PIP\CVS_PIP\

DimensionScoping.csv"
'
' temp until RC model moves to mainstream
'
Const ModelHasDistributionCenterAsDimension = True

' 12/16/13 : adds distinct between regular/promo sales and unit measures and total
sales - primarily impacts cell security,
' requiring additional logic to subdivide the sales measures and layer in
additional geography crap. What previously could be handled by applying
' consistent rules to members of "Sales and Units" must now be handled by applying
separate rules for "CELLSECURITY:RegPromoSalesMeasures" and
' "CELLSECURITY:BaseSalesMeasures".
'
' 4/13/2014 - added to accommodate AS cell security but with product custom aggs.
Should
' not be neccessary. Note that model changes were also required - see model
description entry
' dated 4/13/14 for more info
' 4/21/2014 - added TimeMemberDesc to get around remaining issues with WTD-YA
periodicities.
' 9/29/2015 - added logic to hide the "All CVS Geographies - Internal" hierarchy
from
' third party users (anyone going thru the security tooling for
vendor/category)
' 11/14/17 - CVS_UpdateGeographyRestrictions
'
Const colLDAPGroup = 0
Const colPayVendor = 1
Const colL1ACategories = 2
Const colL1Categories = 3
Const colL2Categories = 4
Const colL2aCategories = 5 ' added 6/16/14, shifted other columns over
Const colL3Categories = 6
Const colInventoryMeasures = 7
Const colScanMarginMeasures = 8
'Sam Start
Const colPremiumAccessLevel = 9
Const colSmallSupplier = 10
'Sam End
Const colErrorOutput = 11
Const colCategoryOutput = 12
Const colSecurityResults = 13

Const cApplyIteratively = False ' set to true to apply all security changes in
batch

Const cMeasuresForProductCustomAggHack = "<RDIEntry>""DM:

TIME_YR_AGO_KEY""</RDIEntry>" & vbCrLf & _
"<RDIEntry>""POS Sales
Dollars""</RDIEntry>" & vbCrLf & _
"<RDIEntry>""TimeMemberDesc""</RDIEntry>" &
vbCrLf

Private Enum enumGeographyRestriction

geogNoRestrictions
geogRestrictStoreOnly
geogRestrictCityDistrictDCandStore
End Enum

Const cachedVendorCategoryInfoFilename = "c:\temp\

VendorPayVendorCategoryStoreBrand.xml"
Const cYMAS_Restrictions_Template = "C:\Users\dsjew\Documents\IRI\_Clients and
Projects\CVS PIP\Security Inputs and Outputs\
CVS_PIP_GeographyTemplateForYMasRestrictions.txt"
'Const cYMAS_StoreList = "C:\Users\dsjew\Documents\IRI\_Clients and Projects\CVS
PIP\Security Inputs and Outputs\Navarro_YMas_Stores_20171219.txt"

Public Sub CVS_UpdateGeographyRestrictions()

Dim ascs As String
Dim s As String
Dim Model As String

Model = SelectAModel("Select model for geography updates")

If Model = "" Then Exit Sub

' 2/12/18 - added file picker in place of hardcoded path

 Dim fn As Variant

If fn = "" Then

' startingPath = GetSetting("JASCS_Tools", "Defaults", "TemplatePath",

cASCSTemplates)
' ChDir startingPath
fn = Application.GetOpenFilename(FileFilter:="Geography input files
(*.txt), *.txt", Title:="Please select a template file")
If fn = False Then
Exit Sub
End If

End If ' fn = ""

s = ReadFile(CStr(fn))

ascs = ReadFile(cYMAS_Restrictions_Template)

Dim arrS As Variant

Dim aStoreKey As Variant

arrS = Split(s, ",")

s = ""
Dim n As Integer
For Each aStoreKey In arrS
s = s & "<Value>" & Replace(Trim(aStoreKey), vbCrLf, "") & "</Value>" &
vbCrLf
n = n + 1
Next aStoreKey

MsgBox n & " store keys found in file " & CStr(fn)

ascs = Replace(ascs, "@@DIMENSION@@", "Geography")

ascs = Replace(ascs, "@@YMAS_STORES_VALUE_LIST@@", s)

s = vbCrLf & "@@NOW@@ - redefined store restrictions using

CVS_UpdateGeographyRestrictions(). " & n & " stores restricted.</Description>"
ascs = Replace(ascs, "</Description>", s)

Dim oResponse As DOMDocument

Set oResponse = SendASCSRequestToChangeModel("Disabling security, Updating

Geography Restrictions", ascs, Model, True)
MsgBox "Set restrictions for " & n & " stores. Rebuild hierarchies to pick up
changes. Also re-enable member security!", vbOKOnly, "Done"

End Sub
Private Function CSInnerL1_AND_L2ProductOrthRestrictions(arrCategoryNumbers As
Variant, invertL1 As Boolean) As String
' 6/6/2014 - adds the product orthogonal restrictions needed for level 1 cell
security. Would be unneeded if we didn't
' need to support combining level 1 and level 2 security - as member
security would meet requirements by itself. Argh.
 '
' the invertL1 boolean arguments tells us whether we are setting up the L1
product orth restrictions or the inverse restrictions for L2 categories
' / anchor node selections from the product orths

Dim aCategoryNumber As Variant

Dim s As String

s = s & CSInnerInnerL1_AND_L2ProductOrthRestrictions("Category", "All

Categories", "All_Categories", invertL1, arrCategoryNumbers)
s = s & CSInnerInnerL1_AND_L2ProductOrthRestrictions("Subcategory", "All
SubCategories", "SubCat_Category", invertL1, arrCategoryNumbers)
s = s & CSInnerInnerL1_AND_L2ProductOrthRestrictions("Segment", "All Segments",
"Segment_Category", invertL1, arrCategoryNumbers)
s = s & CSInnerInnerL1_AND_L2ProductOrthRestrictions("Brand", "All Brands",
"Brand_Category", invertL1, arrCategoryNumbers)
s = s & CSInnerInnerL1_AND_L2ProductOrthRestrictions("Brand", "All Brands by
Latest Pay Vendor", "LatestBrand_Category", invertL1, arrCategoryNumbers)

CSInnerL1_AND_L2ProductOrthRestrictions = s
End Function

Private Function CSInnerInnerL1_AND_L2ProductOrthRestrictions(dimName As String,

anchorNode As String, catLevelName As String, invertL1 As Boolean,
arrCategoryNumbers As Variant)
'
' relies on all product orths have a "CategoryNumber" non-hier filter attribute
'
Dim s As String
Dim aCategoryNumber As Variant

s = s & "<Dimension name=""" & dimName & """>" & vbCrLf

If invertL1 Then
s = s & "<RDIEntry>*~</RDIEntry>" & vbCrLf
Else
s = s & "<RDIEntry>""" & anchorNode & """</RDIEntry>" & vbCrLf
End If
For Each aCategoryNumber In arrCategoryNumbers
' Category orthogonal has only one level
s = s & RDIFilterClause(catLevelName, "CategoryNumber",
CStr(aCategoryNumber), -1, 0, invertL1)
Next aCategoryNumber
If Not invertL1 Then
s = s & "<RDIEntry>~</RDIEntry>" & vbCrLf
End If

s = s & "</Dimension>" & vbCrLf

CSInnerInnerL1_AND_L2ProductOrthRestrictions = s

End Function

Public Function HasDuplicateEntries() As String

'
' finds the last nonblank row, then works backward building a dictionary.
identifies lower numbered rows that are duplicated of higher numbered rows
' returns false is no duplicates are found, true if not
 '
Dim r As Long, s As String

HasDuplicateEntries = ""

r = 1
While Range("A1").Offset(r, 0) <> ""
r = r + 1
Wend

Dim oDict As New Dictionary

r = r - 1

While r > 0
Dim n As String
n = UCase(Range("A1").Offset(r, 0).Value)

If Not oDict.Exists(n) Then

oDict.Add n, n
Else
'Debug.Print "Duplicate " & n & " on row " & r + 1
s = s & r + 1 & " "
End If

r = r - 1
Wend
HasDuplicateEntries = s

End Function

Public Function DeleteDuplicateCVSEntries() As String

'
' finds the last nonblank row, then works backward building a dictionary.
identifies lower numbered rows that are duplicated of higher numbered rows
' returns false is no duplicates are found, true if not
'
Dim r As Long, c As Integer

r = 1
While Range("A1").Offset(r, 0) <> ""
r = r + 1
Wend

Dim oDict As New Dictionary

r = r - 1

While r >= 0
Dim n As String
n = UCase(Range("A1").Offset(r, 0).Value)

If Not oDict.Exists(n) Then

oDict.Add n, n
Else
'Debug.Print "Deleting duplicate row " & n & " on row " & r + 1
c = c + 1
Dim rowString As String
 rowString = r + 1 & ":" & r + 1
Rows(rowString).Delete shift:=xlUp

End If

r = r - 1
Wend

MsgBox "Removed " & c & " duplicates - see debug output for detail."
End Function
Public Sub ConsolidateCVSSecurityEntries()
' updated 10/31/14 for new format input, which has the following characteristics:
'
' LDAP group is in column C, starting at cell C2
' Pay Vendor number in column D, starting at cell D2
' Category number(s) are in column F, starting at cell F2, and there may be more
' one value, bar delimited
' Security level is in cell H, starting at cell H2
'
' 1/15/16 - JW - added support for suppressing inventory for LDAP groups
'
' 7/24/18 - JW - modified to support new input sheet, which uses different columns
and also requires
' testing for hidden rows
' 8/14/18 - modified for another new column format

Const firstUserGroupCell = "G2"

Const firstPayVendorCell = "I2"
Const firstCategoryCell = "R2"
Const firstSecurityLevelCell = "P2"
Const firstSuppressInventoryCell = "S2"
'Sam Start
Const firstPremiumAccessCell = "T2"
Const firstSmallSupplier = "O2"
'Sam End
Dim LastUserGroup As String

Dim dictTempVN As New Dictionary

Dim dictTempCN_1A As New Dictionary
Dim dictTempCN_1 As New Dictionary
Dim dicttempCN_2 As New Dictionary
Dim dicttempCN_2a As New Dictionary

Dim dictConsolidatedVN As New Dictionary

Dim dictConsolidatedCN_1A As New Dictionary
Dim dictConsolidatedCN_1 As New Dictionary
Dim dictConsolidatedCN_2 As New Dictionary
Dim dictConsolidatedCN_2a As New Dictionary
Dim dictIncludeInventory As New Dictionary

'Sam Start
Dim dictPremiumAccess As New Dictionary
Dim dictsmallSupplier As New Dictionary
'Sam End

Dim dictAllCN As New Dictionary ' keep track of all category numbers for a
given LDAP group - make sure nothing is assigned to multiple
 ' levels of security

Dim r As Integer
r = 0

While Range(firstUserGroupCell).Offset(r, 0).Value <> ""

If Range(firstUserGroupCell).Offset(r, 0).EntireRow.Hidden = False Then
LastUserGroup = Trim(Range(firstUserGroupCell).Offset(r, 0).Value) '
User Group

Dim LastSuppressInventorySetting As String ' this comes from the input

sheet
LastSuppressInventorySetting =
UCase(Range(firstSuppressInventoryCell).Offset(r, 0).Value)
'Sam Start
Dim LastPremiumAccessSetting As String ' this comes from the input
sheet
LastPremiumAccessSetting =
UCase(Range(firstPremiumAccessCell).Offset(r, 0).Value)

Dim LastSmallSupplierSetting As String ' this comes from the input

sheet
LastSmallSupplierSetting =
UCase(Range(firstSmallSupplier).Offset(r, 0).Value)
'Sam End

While Trim(Range(firstUserGroupCell).Offset(r, 0).Value) = LastUserGroup

Dim pv As String
Dim cn As Variant
Dim cnList() As String
Dim Level As String
Dim SuppressInventory As String
'Sam Start
Dim PremiumAccess As String
Dim smallSupplier As String
'Sam End

' Suppress Inventory? added 1/15/16

'
' note that suppress inventory variable gets set over and over again
for LDAP groups with multiple categories - but this is
' OK, as the code will ensure that the settings are consistent.
Having the single variable is easier than dealing with an
' array and a check later of that array for consistency
'
SuppressInventory = UCase(Range(firstSuppressInventoryCell).Offset(r,
0).Value)
'Sam Start
PremiumAccess = UCase(Range(firstPremiumAccessCell).Offset(r,
0).Value)
smallSupplier = UCase(Range(firstSmallSupplier).Offset(r, 0).Value)
'Sam End
If SuppressInventory <> "YES" And SuppressInventory <> "Y" And
SuppressInventory <> "" And SuppressInventory <> "NO" And SuppressInventory <> "N"
Then
MsgBox "Invalid value in the Suppress Inventory column for " &
LastUserGroup & ". Acceptable values are Yes, Y, No, N and empty cells. Please
correct.", vbCritical, "Inventory flag error"
 Exit Sub
End If

If SuppressInventory <> LastSuppressInventorySetting Then

MsgBox "Inventory settings for LDAP group " & LastUserGroup & "
are not consistent. Suppress inventory must be consistent for a given group.
Please correct.", vbCritical, "Inventory flag error"
Exit Sub
End If

If SuppressInventory = "YES" Or SuppressInventory = "Y" Then

If dictIncludeInventory.Exists(LastUserGroup) Then
dictIncludeInventory(LastUserGroup) = "No"
Else
dictIncludeInventory.Add LastUserGroup, "No"
End If
Else
If dictIncludeInventory.Exists(LastUserGroup) Then
dictIncludeInventory(LastUserGroup) = "Yes"
Else
dictIncludeInventory.Add LastUserGroup, "Yes"
End If
End If

' Debug.Print LastUserGroup, dictIncludeInventory(LastUserGroup)

'Sam Start
If PremiumAccess <> "YES" And PremiumAccess <> "Y" And PremiumAccess
<> "" And PremiumAccess <> "NO" And PremiumAccess <> "N" Then
MsgBox "Invalid value in the Premium Access Level column for " &
LastUserGroup & ". Acceptable values are Yes, Y, No, N and empty cells. Please
correct.", vbCritical, "Premium Access Level flag error"
Exit Sub
End If

If PremiumAccess <> LastPremiumAccessSetting Then

MsgBox "Premium Access Level settings for LDAP group " &
LastUserGroup & " are not consistent. Premium Access Level must be consistent
for a given group. Please correct.", vbCritical, "Premium Access Level flag error"
Exit Sub
End If

If Trim(smallSupplier) <> "SMALL SUPPLIER" And Trim(smallSupplier) <>

"ONLINE-UNIFY" And smallSupplier <> "" Then
MsgBox "Invalid value in the Small Supplier Level column for " &
LastUserGroup & ". Acceptable values are Small Supplier, Online-Unify and empty
cells. Please correct.", vbCritical, "Premium Access Level flag error"
Exit Sub
End If

If smallSupplier <> LastSmallSupplierSetting Then

MsgBox "Small Supplier Level settings for LDAP group " &
LastUserGroup & " are not consistent. Premium Access Level must be consistent
for a given group. Please correct.", vbCritical, "Premium Access Level flag error"
Exit Sub
End If
 If PremiumAccess = "YES" Or PremiumAccess = "Y" Then

If dictPremiumAccess.Exists(LastUserGroup) Then
dictPremiumAccess(LastUserGroup) = "Yes"
Else
dictPremiumAccess.Add LastUserGroup, "Yes"
End If
Else
If dictPremiumAccess.Exists(LastUserGroup) Then
dictPremiumAccess(LastUserGroup) = "No"
Else
dictPremiumAccess.Add LastUserGroup, "No"
End If
End If

If smallSupplier = "SMALL SUPPLIER" Or Trim(smallSupplier) = "SMALL

SUPPLIER" Or smallSupplier = "SMALL SUPPLIER " Then
If dictsmallSupplier.Exists(LastUserGroup) Then
dictsmallSupplier(LastUserGroup) = "Yes"
Else
dictsmallSupplier.Add LastUserGroup, "Yes"
End If
Else
If dictsmallSupplier.Exists(LastUserGroup) Then
dictsmallSupplier(LastUserGroup) = "No"
Else
dictsmallSupplier.Add LastUserGroup, "No"
End If
End If
'Sam End

' Pay Vendor

pv = Range(firstPayVendorCell).Offset(r, 0).Value
'10/3/18 check for missing or bad PVs
'
If Not IsNumeric(pv) Then
MsgBox "Missing or non numeric pay vendor in cell " &
Range(firstPayVendorCell).Offset(r, 0).Address, _
vbCritical, "Pay vendor error"
Exit Sub
End If

' Category Number(s)

' grab the potential bardelimited list into an array after removing
whitespace
cnList = Split(Replace(Range(firstCategoryCell).Offset(r, 0).Value, "
", ""), "|")

'
' security level
'
Level = Range(firstSecurityLevelCell).Offset(r, 0).Value

If Not dictTempVN.Exists(pv) Then

dictTempVN.Add pv, pv
End If
 Select Case UCase(Level)
Case "1A"
For Each cn In cnList
If Not dictTempCN_1A.Exists(cn) Then
dictTempCN_1A.Add cn, cn
End If
Next cn
Case "1"
For Each cn In cnList
If Not dictTempCN_1.Exists(cn) Then
dictTempCN_1.Add cn, cn
End If
Next cn
Case "2"
For Each cn In cnList
If Not dicttempCN_2.Exists(cn) Then
dicttempCN_2.Add cn, cn
End If
Next cn
Case "2A"
For Each cn In cnList
If Not dicttempCN_2a.Exists(cn) Then
dicttempCN_2a.Add cn, cn
End If
Next cn
Case Else
MsgBox "Invalid security level " & Level & " specified.",
vbCritical, "Error"
Exit Sub
End Select

r = r + 1
'
' it is possible that there are hidden rows within a block as well -
so test to see if the new row is
' hidden, and if it is, keep bumping rows
While Range(firstUserGroupCell).Offset(r, 0).EntireRow.Hidden = True
r = r + 1
Wend

Wend ' inner group iterator

If LastUserGroup <> "TBD" Then

Dim k As Variant
Dim s As String

s = ""
For Each k In dictTempVN.Keys
s = s & CStr(k) & "|"
Next k

If dictConsolidatedVN.Exists(LastUserGroup) Then
MsgBox "It appears that this input sheet is not sorted by LDAP
group - please correct and try again.", vbCritical, "Input sheet error"
Exit Sub
Else
dictConsolidatedVN.Add LastUserGroup, Left(s, Len(s) - 1)
 End If

Set dictAllCN = New Dictionary

s = ""
For Each k In dictTempCN_1A.Keys
If dictAllCN.Exists(k) Then
MsgBox "Category " & k & " is assigned to multiple security
levels for LDAP group " & LastUserGroup
Exit Sub
Else
dictAllCN.Add k, k
End If

s = s & CStr(k) & "|"

Next k
If s <> "" Then
dictConsolidatedCN_1A.Add LastUserGroup, Left(s, Len(s) - 1)
End If
s = ""
For Each k In dictTempCN_1.Keys

If dictAllCN.Exists(k) Then
MsgBox "Category " & k & " is assigned to multiple security
levels for LDAP group " & LastUserGroup
Exit Sub
Else
dictAllCN.Add k, k
End If

s = s & CStr(k) & "|"

Next k
If s <> "" Then
dictConsolidatedCN_1.Add LastUserGroup, Left(s, Len(s) - 1)
End If

s = ""
For Each k In dicttempCN_2.Keys

If dictAllCN.Exists(k) Then
MsgBox "Category " & k & " is assigned to multiple security
levels for LDAP group " & LastUserGroup
Exit Sub
Else
dictAllCN.Add k, k
End If
s = s & CStr(k) & "|"
Next k
If s <> "" Then
dictConsolidatedCN_2.Add LastUserGroup, Left(s, Len(s) - 1)
End If

s = ""
For Each k In dicttempCN_2a.Keys

If dictAllCN.Exists(k) Then
MsgBox "Category " & k & " is assigned to multiple security
levels for LDAP group " & LastUserGroup
Exit Sub
 Else
dictAllCN.Add k, k
End If
s = s & CStr(k) & "|"
Next k
If s <> "" Then
dictConsolidatedCN_2a.Add LastUserGroup, Left(s, Len(s) - 1)
End If

'Debug.Print LastUserGroup, dictConsolidatedVN(LastUserGroup)

'Debug.Print "1A:", dictConsolidatedCN_1A(LastUserGroup)
'Debug.Print "1:", dictConsolidatedCN_1(LastUserGroup)
'Debug.Print "2:", dictConsolidatedCN_2(LastUserGroup)
'Debug.Print "2A:", dictConsolidatedCN_2(LastUserGroup)
End If ' not TBD

Set dictTempCN_1A = New Dictionary

Set dictTempCN_1 = New Dictionary
Set dicttempCN_2 = New Dictionary
Set dicttempCN_2a = New Dictionary

Set dictTempVN = New Dictionary

Else ' row is hidden
r = r + 1
End If
Wend ' ldap group iterator

'
' 2/5/19 - JW - added this checkpoint because the CVS team kept submitting
flawed input sheets
'
If dictConsolidatedVN.count = 0 Then
MsgBox "No valid security input found before the first blank LDAP group
name in cell " & Range(firstUserGroupCell).Offset(r, 0).Address & _
". Please validate your input sheet - this sheet will not result in
new security.", vbCritical, "Input sheet error"

Else

'
' create a new sheet for our output
If (Workbooks.count = 0) Then Workbooks.Add
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.count)

Dim g As Variant
Range("a1").Offset(0, 0).Value = "LDAP Group"
Range("a1").Offset(0, 1).Value = "Pay Vendors"
Range("a1").Offset(0, 2).Value = "L1A Categories"
Range("a1").Offset(0, 3).Value = "L1 Categories"
Range("a1").Offset(0, 4).Value = "L2 Categories"
Range("A1").Offset(0, 5).Value = "L2a Categories"
Range("a1").Offset(0, 6).Value = "L3 Categories"
Range("a1").Offset(0, 7).Value = "Include Inventory"
Range("a1").Offset(0, 8).Value = "Include Cost Measures"
'Sam Start
Range("a1").Offset(0, 9).Value = "Premium Access"
Range("a1").Offset(0, 10).Value = "Small Supplier"
 'Sam End
r = 1
For Each g In dictConsolidatedVN.Keys
Range("A1").Offset(r, 0).Value = "iricommercial.com\" & CStr(g)
Range("a1").Offset(r, 1).Value = dictConsolidatedVN(g)
Range("A1").Offset(r, 2).Value = dictConsolidatedCN_1A(g)
Range("A1").Offset(r, 3).Value = dictConsolidatedCN_1(g)
Range("A1").Offset(r, 4).Value = dictConsolidatedCN_2(g)
Range("A1").Offset(r, 5).Value = dictConsolidatedCN_2a(g)
Range("A1").Offset(r, 6).Value = "" ' level 3 ' never implement, not
fully defined
Range("A1").Offset(r, 7).Value = dictIncludeInventory(g) ' added
1/15/16, used to be hardcoded to YES
Range("A1").Offset(r, 8).Value = "No" ' cost measures
'Sam Start
Range("A1").Offset(r, 9).Value = dictPremiumAccess(g)
Range("A1").Offset(r, 10).Value = dictsmallSupplier(g)
'Sam End
If dictConsolidatedCN_1A(g) <> "" And (dictConsolidatedCN_1(g) <> "" Or
dictConsolidatedCN_2(g) <> "" Or dictConsolidatedCN_2a(g) <> "") Then
MsgBox "Group " & g & " is attempting to combine level 1A security
with level 1, level 2 or level 2a security. That is not supported.", vbCritical
Range("A1").Offset(r, 9) = "INVALID CONFIGURATION: combines level
1a security with level 1 or level 2."
End If

'If dictConsolidatedCN_3(g) <> "" And (dictConsolidatedCN_1(g) <> "" Or

dictConsolidatedCN_2(g) <> "") Then
' MsgBox "Group " & g & " is attempting to combine level 3 security
with level 1 or level 2 security. That is not supported.", vbCritical
' Range("A1").Offset(r, 9) = "INVALID CONFIGURATION: combines level
3 security with level 1 or level 2."
'End If
r = r + 1
Next g ' next ldap group
Range("A1:L1").Columns.AutoFit
End If

End Sub

Public Sub CheckGroupsForCVS()

ProcessConsolidatedCVSSecurity True
End Sub
Public Sub ProcessConsolidatedCVSSecurity(Optional verifyGroupsOnly As Boolean =
False)

Dim r As Integer, modelName As String

Dim skipCount As Integer
Dim ans As Variant

'
' make sure there are no duplicate entries
'
Dim hde As String
hde = HasDuplicateEntries
If hde <> "" Then
MsgBox "You must remove duplicate entries before applying security from
this sheet. Duplicates are found on rows " & hde, vbCritical, "Duplicate entries"
 Exit Sub
End If

' prevent the potentially long running operation from stealing back windows
focus on each rows
JASCS_MenuAndWizardRoutines.SuppressModalDialogs = True

'Sam Edit Start

Range("l1:n10000").Clear
'Sam Edit End
'
' 6/30/14 - added other convenience formatting for readability
'
Range("a1:m10000").HorizontalAlignment = xlLeft
Range("a1:m10000").VerticalAlignment = xlTop
'Sam Edit Start
Columns("K:M").ColumnWidth = 5
Columns("M").ColumnWidth = 18
Columns("N").ColumnWidth = 65
'Sam Edit End
'
' if we are doing batch, clear the last set of batch chnage files
If Not cApplyIteratively Then
On Error Resume Next
Kill "C:\temp\CVS_PIP_LDAPGROUPS.txt"
Kill "C:\temp\CVS_PIP_MemberSecurity.txt"
Kill "C:\temp\CVS_PIP_CellSecurity.txt"
End If

'
' select a target model
'

modelName = SelectAModel("Select target model for member security")

If modelName = "" Then Exit Sub

'
' optionally refresh ldap security
'

ans = MsgBox("Refresh LDAP authentication before proceeding?", vbYesNo,

"Refresh authentication")

If ans = vbYes Then

If (Not RefreshAuthentication(modelName)) Then
Exit Sub
End If

End If
'
' 12/22/12 - added rebuild option
'
' optionally rebuild hierarchies
'
 If Not verifyGroupsOnly Then
ans = MsgBox("Rebuild model hierarchies?", vbYesNo, "Rebuild")
If ans = vbYes Then
If Not (RebuildModelHierarchies(modelName)) Then
Exit Sub
End If

End If
End If

Dim oNode As IXMLDOMNode

Dim oD As DOMDocument
Dim oRef As DOMDocument

If Not verifyGroupsOnly Then

ans = MsgBox("Fetch updated Vendor mappings?", vbYesNo, "Update Vendor
Mappings?")

If ans = vbYes Then

Set oRef = JASCS_ASCS.SendASCSRequest("Fetching reference vendor and

category information", _
"<ascs:getMembers modelName=""@@MODEL@@"" dimensionName=""Product""
qname=""Vendor-PayVendor-Category-StoreBrand"" relation=""Children"" depth=""4""
returnFullPath=""False"" returnLevelName=""True""/>", modelName, False)

If oRef Is Nothing Then Exit Sub

oRef.Save cachedVendorCategoryInfoFilename
Else
Set oRef = New DOMDocument
oRef.Load cachedVendorCategoryInfoFilename
End If
End If

' get the LDAP groups - not optional

Dim dictGroups As New Dictionary

Set oD = SendASCSRequest("Fetch available LDAP groups", "<ascs:getGroups/>",
modelName, False, 60)
If oD Is Nothing Then Exit Sub

For Each oNode In oD.SelectNodes("//Group")

Dim group As String
group = LCase(oNode.Attributes.getNamedItem("name").Text)
If Not dictGroups.Exists(group) Then
dictGroups.Add LCase(group), LCase(group)
End If
Next oNode

r = 0
While Range("A2").Offset(r, colLDAPGroup).Value <> ""
 Range("A2").Offset(r, colCategoryOutput).Value = ""
Range("A2").Offset(r, colSecurityResults).Value = ""
r = r + 1
Wend
r = 0

While Range("A2").Offset(r, colLDAPGroup).Value <> ""

Dim ldapGroup As String
ldapGroup = Range("A2").Offset(r, colLDAPGroup).Value
If (Not dictGroups.Exists(LCase(ldapGroup))) Then
Range("A2").Offset(r, colErrorOutput).Value = "SKIPPING " & ldapGroup &
" - NO MATCHING LDAP GROUP IN TARGET MODEL."
skipCount = skipCount + 1
Else

If verifyGroupsOnly Then
Range("A2").Offset(r, colCategoryOutput).Value = "Group found"
Else
Range("A2").Offset(r, colCategoryOutput).Value = "Processing..."
'
' 3/31/2014 - added logic to support deleting groups as well as
defining them
'
If UCase(Range("A2").Offset(r, colPayVendor).Value) = "DELETE" Then
Dim Accessor As String
Range("a2").Offset(r, colSecurityResults - 1).Value =
"Processing..."
Accessor = Range("a2").Offset(r, colLDAPGroup).Value
MergeAndSetMemberAndCellSecurity modelName, "Not Used", "Not
Used", Accessor, "have no member or cell security", True
Range("a2").Offset(r, colSecurityResults - 1).Value = Now
Range("A2").Offset(r, colSecurityResults).Value = "Member and
cell security cleared"
Else
' don't need to update status cells for this branch,
SetCVSSecurityForSpecificRow takes care of it
SetCVSSecurityForSpecifiedRow modelName, r, oRef, True

End If
End If

End If
r = r + 1
Wend
'
' if we are in bulk mode, only the deletes will have already taken effect in
the loop above, the rest of the calls to SetCVSSecurityForSpecifiedRow()
' will have built up text files - apply those now
'
If Not cApplyIteratively And Not verifyGroupsOnly Then
MergeAndSetMemberAndCellSecurityAndGenerateDimVisibility modelName, "Set
security in batch"
End If

If Not verifyGroupsOnly Then

 CheckMemberSecurity modelName
'MsgBox "restore security check when done"

If skipCount > 0 Then

MsgBox "Skipped " & skipCount & " entries - see column I", vbCritical,
"Could not process all entries"
Else
MsgBox "CVS PIP security applied. Dimension scoping by LDAP group
saved to " & cPathToDimensionScopingFile
End If
End If

JASCS_MenuAndWizardRoutines.SuppressModalDialogs = False

End Sub

Public Sub SetCVSSecurityForSpecifiedRow(modelName As String, r As Integer, oRef As

DOMDocument, Optional numberInputsOnly As Boolean = True)

'
Dim includeScanMarginMeasures As Boolean ' added 11/13/13 to override the long
term desired measure availabilities
'Sam Start Premium acces variable made as global
'Dim PremiumAccess As Boolean
'Sam End

Dim sMS As String, sCS As String, subS As String

Dim arrL1a As Variant, arrL1 As Variant, arrL2 As Variant, arrL2a As Variant,
arrL3 As Variant, arrVendors As Variant

'Dim r As Integer
Dim L1_Categories As String, L1a_Categories As String, L2_Categories As String,
L2a_Categories As String, L3_Categories As String
Dim payVendorNames As String, ldapGroup As String, includeInventory As Boolean
Dim oDictUsedCategories As New Dictionary
Dim oDictUsedCategoryNumbers As New Dictionary
'
' added 2/3/14
'
Dim oDictCategoryByNumber As New Dictionary
Dim oDictVendorByNumber As New Dictionary

' added 6/23/14

On Error GoTo ErrorReturn

ldapGroup = Range("A2").Offset(r, colLDAPGroup).Value ' must be a single

value, e.g. iricommercial.com\SomeGroup
payVendorNames = Range("A2").Offset(r, colPayVendor).Value ' one or more Pay
Vendor names as they appear in the model, bar delimited
L1a_Categories = Range("A2").Offset(r, colL1ACategories).Value ' one or more
category names as they appear in the model, bar delimited
L1_Categories = Range("A2").Offset(r, colL1Categories).Value ' ditto
L2_Categories = Range("A2").Offset(r, colL2Categories).Value ' ditto
L2a_Categories = Range("A2").Offset(r, colL2aCategories).Value ' ditto
L3_Categories = Range("A2").Offset(r, colL3Categories).Value ' ditto
 includeInventory = False
If UCase(Left(Range("A2").Offset(r, colInventoryMeasures).Value, 1)) = "Y" Then
includeInventory = True
End If

includeScanMarginMeasures = False
If UCase(Left(Range("A2").Offset(r, colScanMarginMeasures).Value, 1)) = "Y"
Then
includeScanMarginMeasures = True
End If
'Sam Start
PremiumAccess = False
If UCase(Left(Range("A2").Offset(r, colPremiumAccessLevel).Value, 1)) = "Y"
Then
PremiumAccess = True
End If

smallSupplier = False
If UCase(Left(Range("A2").Offset(r, colSmallSupplier).Value, 1)) = "Y" Or
UCase(Left(Range("A2").Offset(r, colSmallSupplier).Value, 1)) = "Yes" Then
smallSupplier = True
End If
'Sam End

'
' don't want to scrub these just yet
'
'payVendorNames = XMLScrub(payVendorNames)
ldapGroup = XMLScrub(ldapGroup)
'
' don't allow L1a or L3 to combine with other levels
'

If L1a_Categories <> "" And (L1_Categories <> "" Or L2_Categories <> "" Or
L3_Categories <> "") Then
MsgBox "Level 1A security cannot be combinated with other levels for a
given user group.", vbCritical, "Entry error"
Range("a2").Offset(r, colSecurityResults - 1).Value = "SKIPPING: Level 1A
security cannot be combinated with other levels for a given user group."

Exit Sub
End If
If L3_Categories <> "" And (L1_Categories <> "" Or L2_Categories <> "" Or
L1a_Categories <> "") Then
MsgBox "Level 3 security cannot be combinated with other levels for a given
user group.", vbCritical, "Entry error"
Range("a2").Offset(r, colSecurityResults - 1).Value = "SKIPPING: Level 3
security cannot be combinated with other levels for a given user group."
Exit Sub
End If

arrL1a = Split(L1a_Categories, "|")

arrL1 = Split(L1_Categories, "|")
arrL2 = Split(L2_Categories, "|")
 arrL2a = Split(L2a_Categories, "|")
arrL3 = Split(L3_Categories, "|")

arrVendors = Split(payVendorNames, "|")

Dim aVendor As Variant

Dim oPayVendor As IXMLDOMNode

Dim oDictCategorySBMappings As New Dictionary

Dim oDictCategoryNumberSBMappings As New Dictionary

Dim CategoryName As String, SBorNB As String, categoryNumber As String

If numberInputsOnly Then
' Debug.Print "skipping vendor name / category name validation"
'
' load up the category names and vendor names by number for output during
the mapping
'

For Each oPayVendor In

oRef.SelectNodes("//Member[@levelDisplayName='PayVendor']")
' Debug.Print oPayVendor.xml
Dim n As String
n = oPayVendor.Attributes.getNamedItem("name").Text
Dim sf As String
sf = GetNumberSuffix(n)

If Not oDictVendorByNumber.Exists(sf) Then

oDictVendorByNumber.Add sf, n
End If
Next oPayVendor
Dim oCategory As IXMLDOMNode
For Each oCategory In
oRef.SelectNodes("//Member[@levelDisplayName='Category']")
n = oCategory.Attributes.getNamedItem("name").Text
sf = GetNumberSuffix(n)

If Not oDictCategoryByNumber.Exists(sf) Then

oDictCategoryByNumber.Add sf, n
End If
Next oCategory

Else
'
' this block expects the format of ABC XX for vendors and categories
'

For Each aVendor In arrVendors

For Each oPayVendor In oRef.SelectNodes("//Member[@name='" &
CStr(aVendor) & "']")

For Each oCategory In oPayVendor.ChildNodes

CategoryName = oCategory.Attributes.getNamedItem("name").Text
categoryNumber = StripToNumber(CategoryName)
Dim oSBorNB As IXMLDOMNode
For Each oSBorNB In oCategory.ChildNodes
SBorNB = oSBorNB.Attributes.getNamedItem("name").Text
 If oDictCategorySBMappings.Exists(CategoryName) Then
oDictCategorySBMappings(CategoryName) = _
oDictCategorySBMappings(CategoryName) & "," &
SBorNB
Else
oDictCategorySBMappings.Add CategoryName, SBorNB
End If

If oDictCategoryNumberSBMappings.Exists(categoryNumber)
Then
oDictCategoryNumberSBMappings(categoryNumber) = _
oDictCategoryNumberSBMappings(categoryNumber) & ","
& SBorNB
Else
oDictCategoryNumberSBMappings.Add categoryNumber,
SBorNB
End If

'Debug.Print aVendor, CategoryName, SBorNB

Next oSBorNB ' store brand
Next oCategory ' category level
'Debug.Print oPayVendor.xml
Next oPayVendor
Next aVendor
End If ' not numberInputsOnly

Dim key As Variant

'
' make sure all of the categories were found
'
Dim category As Variant
Dim sErrors As String
For Each category In arrL1a
oDictUsedCategories.Add category, category
oDictUsedCategoryNumbers.Add StripToNumber(CStr(category)),
StripToNumber(CStr(category))

If numberInputsOnly Then
Else
If Not oDictCategorySBMappings.Exists(category) Then
sErrors = sErrors & "Category '" & category & "' not in model"
End If
End If
Next category
For Each category In arrL1
oDictUsedCategories.Add category, category
oDictUsedCategoryNumbers.Add StripToNumber(CStr(category)),
StripToNumber(CStr(category))

If numberInputsOnly Then
Else

If Not oDictCategorySBMappings.Exists(category) Then

sErrors = sErrors & "Category '" & category & "' not in model"
End If
End If
 Next category
For Each category In arrL2
'Debug.Print "category level 2:" & category
oDictUsedCategories.Add category, category
oDictUsedCategoryNumbers.Add StripToNumber(CStr(category)),
StripToNumber(CStr(category))

If numberInputsOnly Then
Else
If Not oDictCategorySBMappings.Exists(category) Then
sErrors = sErrors & "Category '" & category & "' not in model"
End If
End If
Next category

For Each category In arrL2a

oDictUsedCategories.Add category, category
oDictUsedCategoryNumbers.Add StripToNumber(CStr(category)),
StripToNumber(CStr(category))

If numberInputsOnly Then
Else
If Not oDictCategorySBMappings.Exists(category) Then
sErrors = sErrors & "Category '" & category & "' not in model"
End If
End If
Next category

For Each category In arrL3

oDictUsedCategories.Add category, category
oDictUsedCategoryNumbers.Add StripToNumber(CStr(category)),
StripToNumber(CStr(category))
If numberInputsOnly Then
Else
If Not oDictCategorySBMappings.Exists(category) Then
sErrors = sErrors & "Category '" & category & "' not in model"
End If
End If

Next category

If sErrors <> "" Then

MsgBox sErrors, vbCritical, "Invalid categories"
Exit Sub
End If
'
' now need category arrays with xml scrubbed names

L1a_Categories = XMLScrub(L1a_Categories)
L1_Categories = XMLScrub(L1_Categories)
L2_Categories = XMLScrub(L2_Categories)
L2a_Categories = XMLScrub(L2a_Categories)
L3_Categories = XMLScrub(L3_Categories)

arrL1a = Split(L1a_Categories, "|")

arrL1 = Split(L1_Categories, "|")
arrL2 = Split(L2_Categories, "|")
 arrL2a = Split(L2a_Categories, "|")
arrL3 = Split(L3_Categories, "|")

Dim summary As String

Dim modelSummary As String ' used to provide shorthand notation of access set
for each LDAP group

summary = payVendorNames & ":" & vbCrLf

'Dim oDictUsedCategories As New Dictionary
'
' 3/26/14 - JW - added for better tracking
'
modelSummary = "V:" & payVendorNames
If L1a_Categories <> "" Then
modelSummary = modelSummary & ",L1a:" & L1a_Categories
End If
If L1_Categories <> "" Then
modelSummary = modelSummary & ",L1:" & L1_Categories
End If
If L2_Categories <> "" Then
modelSummary = modelSummary & ",L2:" & L2_Categories
End If
If L2a_Categories <> "" Then
modelSummary = modelSummary & ",L2a:" & L2a_Categories
End If
If L3_Categories <> "" Then
modelSummary = modelSummary & ",L3:" & L3_Categories
End If

If Not numberInputsOnly Then

For Each key In oDictUsedCategories.Keys
summary = summary & key & "=" & oDictCategorySBMappings(key) & vbCrLf
' Debug.Print key, oDictCategorySBMappings(key)
Next key
End If

'
' write out what we found, store brand wise, on each category
'
'Range("A2").Offset(r, colCategoryOutput).Value = summary
'Exit Sub
'
' now scrub and reassign array - from here down we want xml safe text
'
' as part of the switch to finding categories and vendors by number only,
' reassign the arrays - ultimately this will probably happen further up
'
'
payVendorNames = XMLScrub(payVendorNames)
arrVendors = ConvertToNumberArray(payVendorNames)

arrL1a = ConvertToNumberArray(L1a_Categories)
arrL1 = ConvertToNumberArray(L1_Categories)
arrL2 = ConvertToNumberArray(L2_Categories)
arrL2a = ConvertToNumberArray(L2a_Categories)
arrL3 = ConvertToNumberArray(L3_Categories)
 Dim maxSecurityLevel As String ' keep track of max security level found
' for purposes of assigning restricted measure
' attributes

maxSecurityLevel = "1a"

' note that we don't need to replace the MODEL token - the default sendACS()
function will take care of that
'

's = "<setModelMemberSecurityDomains modelName=""@@MODEL@@"">" & vbCrLf

sMS = "<MemberSecurityDomain>" & vbCrLf & _

"<Accessor type=""Group"">@@LDAP_TOKEN@@</Accessor>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf

'
' l1a is the same as l1 for member security
'
If L1a_Categories <> "" Then
subS = subS & MSBlockProductL1(arrL1a, arrVendors)
maxSecurityLevel = "1a"
End If

'
' l1 access doesn't care about store brand - only categories and vendors
'
'For Each category In arrL1
If L1_Categories <> "" Then
subS = subS & MSBlockProductL1(arrL1, arrVendors)
maxSecurityLevel = "1"
End If

sMS = sMS & subS

'
' the first step of l2 and l3 access doesn't care about vendor.
' Subsequest steps care about store brand and vendor, but only need to be added
' once, rather than per category
'
Dim count As Integer

subS = ""
For Each category In arrL2
subS = subS & MSProductL2orL3_Step1_Category(CStr(category))
maxSecurityLevel = "2"

count = count + 1
Next category

For Each category In arrL3

 subS = subS & MSProductL2orL3_Step1_Category(CStr(category))
maxSecurityLevel = "3"
count = count + 1
Next category

' GoTo SkipForNow

If count > 0 Then ' And hideCompetitorStoreBrands Then

'
' do we need to hide competitor store brands ? The rule (as of 10/7/13
anyway) is that if for a given vendor
' for a given category, if that vendor sells only _National Brands_ in
that category, then they should not
' see Store brands in that category for competitors.
' if they sell store brands or both national and store in that category,
then it is ok for see both
' store brands and national brands for competitors
'
'

'subS = subS &

MSProductL2orL3_Step2_HideStoreBrandsAsNeeded(oDictUsedCategoryNumbers,
oDictCategoryNumberSBMappings)
subS = subS &
MSProductL2OrL3_Step2New_ShowStoreBrandsForVendorCategories(oDictUsedCategoryNumber
s, arrVendors)

End If
'SkipForNow:

sMS = sMS & subS

'
' 6/16/14 - add logic for level 2a
'
subS = ""
For Each category In arrL2a
subS = subS & MSProductL2a_Category(CStr(category))
maxSecurityLevel = "2a" ' for purposes of cell security attribute measure
restrictions - note that
' any value of 1, 2, 2a (which can be mixed for a
single ldap group will
' ultimately result in the same measure attribute
restrictions.
' 2a will never trump 3, as 3 cannot be mixed and
matched
Next category
sMS = sMS & subS

'
' add the surrogates, and close out the product settings and add the other
dimension defaults
'

sMS = sMS & AddSurrogates & "</Dimension>" & vbCrLf

'
 ' add the product othogonal restrictions
'
sMS = sMS & ProductOrthogonalRestrictions(arrL1a, arrL1, arrL2, arrL2a, arrL3,
arrVendors)

'
' we also need to replace the VENDOR_NAME_WO_NUMBER token in the standalone
vendor dimension
' the replacement value should also be the vendorName argument, less the
trailing number
'
'
'
'
' add the remaining restrictions, including vendor
'

'
' 11/7/13 - added rule to hide the dummy DC N/A members in the All CVS by DC
hierarchy
' WARNING: ALSO HIDES THE ONTARIO BRANCH OF THE TREE WHICH DOES NOT HAVE ANY
STORES at this time. Yuch.
'"<RDIEntry>except Filter(Group(DC_DC), ""ATTRIBUTE ""DC_DC"".""Name"" =
'ONTARIO'"")</RDIEntry>" & vbCrLf & _
'

' 7/2/14
'
' 9/29/15 - JW - added exclusion of "All CVS Geographies - Internal"
' 7/21/16 - Sri - added exclusion of "Added "All CVS Target Stores" -
"<RDIEntry>except DescendantsOf(""All CVS Target Stores"")</RDIEntry>" & vbCrLf & _
' 08/26/19 - SC - added Rdi entry to exclude "All CVS Stores by Primary DC"
geography hierarchy
'
If ModelHasDistributionCenterAsDimension Then
If PremiumAccess Then
sMS = sMS & "<Dimension name=""Geography"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"<RDIEntry>except ""All CVS Geographies -
Internal""</RDIEntry>" & vbCrLf & _
"<RDIEntry>except ""All CVS Stores""</RDIEntry>" & vbCrLf &
_
"<RDIEntry>except DescendantsOf(""All CVS Target
Stores"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>except ""Total Alternative Store Format -
Internal""</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Time"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf
Else
 sMS = sMS & "<Dimension name=""Geography"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"<RDIEntry>except ""All CVS Geographies -
Internal""</RDIEntry>" & vbCrLf & _
"<RDIEntry>except ""All CVS Stores""</RDIEntry>" & vbCrLf &
_
"<RDIEntry>except ""All CVS Stores by Primary
DC""</RDIEntry>" & vbCrLf & _
"<RDIEntry>except ""All CVS Geographies with Alternative
Store Format""</RDIEntry>" & vbCrLf & _
"<RDIEntry>except ""Total Alternative Store Format -
Internal""</RDIEntry>" & vbCrLf & _
"<RDIEntry>except DescendantsOf(""All CVS Geographies with
Alternative Store Format"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>except DescendantsOf(""All CVS Target
Stores"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Time"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"<RDIEntry>except ""Day Level Time Functions""</RDIEntry>" &
vbCrLf & _
"</Dimension>" & vbCrLf

End If
Else
sMS = sMS & "<Dimension name=""Geography"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"<RDIEntry>except ""All CVS Geographies -
Internal""</RDIEntry>" & vbCrLf & _
"<RDIEntry>except ""All CVS Stores""</RDIEntry>" & vbCrLf & _
"<RDIEntry>except ""All CVS Stores by Primary DC""</RDIEntry>"
& vbCrLf & _
"<RDIEntry>except ""All CVS Geographies with Alternative Store
Format""</RDIEntry>" & vbCrLf & _
"<RDIEntry>except ""Total Alternative Store Format -
Internal""</RDIEntry>" & vbCrLf & _
"<RDIEntry>except DescendantsOf(""All CVS Geographies with
Alternative Store Format"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>except DescendantsOf(""All CVS Target
Stores"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>except Filter(Group(DC_DC), ""ATTRIBUTE
""DC_DC"".""Name"" = 'N/A'"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>except Filter(Group(DC_STORE), ""ATTRIBUTE
""DC_STORE"".""Name"" = 'N/A - N/A, N/A, N/A, N/A'"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Time"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf
End If
'Sam Start
Dim GeogRDIExclude As String
If smallSupplier Then
GeogRDIExclude = "<RDIEntry>except ""All CVS Geographies with Alternative
Store Format""</RDIEntry>"
sMS = Replace(sMS, GeogRDIExclude & vbCrLf, "")
End If
'Sam End
'
' deal with measures.
 '
If includeScanMarginMeasures Then
If Not PremiumAccess Then
sMS = sMS & "<Dimension name=""Measures"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except ""QA Measures""</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except
DescendantsOf(""MemberSecurity:PremiumPackageMeasures"")</RDIEntry>" & vbCrLf
Else
sMS = sMS & "<Dimension name=""Measures"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except ""QA Measures""</RDIEntry>" & vbCrLf
End If
Else
If Not PremiumAccess Then
sMS = sMS & "<Dimension name=""Measures"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except ""Scan Margin""</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except DescendantsOf(""Scan Margin"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>Except ""Scan Margin TPR""</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except DescendantsOf(""Scan Margin
TPR"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except ""Margin Contribution""</RDIEntry>" & vbCrLf
& _
"<RDIEntry>Except DescendantsOf(""Margin
Contribution"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except ""QA Measures""</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except DescendantsOf(""QA Measures"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>Except
DescendantsOf(""MemberSecurity:PremiumPackageMeasures"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except ""Gas Measures : FOLDER""</RDIEntry>" &
vbCrLf & _
"<RDIEntry>Except ""Weather Measures : FOLDER""</RDIEntry>" &
vbCrLf
Else
sMS = sMS & "<Dimension name=""Measures"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except ""Scan Margin""</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except DescendantsOf(""Scan Margin"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>Except ""Scan Margin TPR""</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except DescendantsOf(""Scan Margin
TPR"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except ""Margin Contribution""</RDIEntry>" & vbCrLf
& _
"<RDIEntry>Except DescendantsOf(""Margin
Contribution"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except ""QA Measures""</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except DescendantsOf(""QA Measures"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>Except
DescendantsOf(""MemberSecurity:PremiumMeasures"")</RDIEntry>" & vbCrLf
End If
End If
'
' 7/3/18 - JW - added to hide premium measures from all groups that pass thru
this logic. (Internal and QA groups do not
 ' pass thru this logic) When premium LDAP groups appear, this logic
will need to detect them and act accordingly
' 7/24/18 - also need to hide gas and weather measures folders, as these are
root level and stubbornly refuse to be both
' root members and members of the premium measure collection
'1/17/19-JW-modified to restrict solely on the PremiumMeasures collection and
its descendants, previous
' versions of the code explicitly listed gas and weather, but this was
redundant. With this change
' future premium measures can be added to the model so long as they are
assigned to the PremiumMeasures
' collection and there will be no need to modify this code or rerun
security.
'03/12/19-Sudhakar-As Analytical Server does not allow you to add a folder to a
collection and also have it as a
'root level member, we enabled RDI filter that excludes Gas and Weather root
level folders.
'04/03/19-Sudhakar-Added 3 new RDI Entries to exclude CVS_PIP PhaseII related
measures namely Purchase Orders, Display and Planned Delivery for Suppliers.

If Not GroupGetsPremium(ldapGroup) Then

sMS = sMS & "<RDIEntry>Except
DescendantsOf(""MemberSecurity:PremiumMeasures"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except ""Planned Delivery : FOLDER""</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except ""Purchase Orders : FOLDER""</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except ""Appointment : FOLDER""</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except ""Display : FOLDER""</RDIEntry>" & vbCrLf
End If

' end change 7/3/18

Select Case maxSecurityLevel

Case "1a"
sMS = sMS & "<RDIEntry>Except
DescendantsOf(""MemberSecurity:Level1A_RestrictedAttributes"")</RDIEntry>" & vbCrLf
'
' since a single ldap group is allowed to mix and match 1,2 and 2a, the
member security restrictions on
' measure attributes must be the same for these levels
'
Case "1", "2", "2a"
sMS = sMS & "<RDIEntry>Except
DescendantsOf(""MemberSecurity:Level1_RestrictedAttributes"")</RDIEntry>" & vbCrLf
Case "2"
Case "3"
'
' for now - new restrictions for level 3 not yet provided by client
team - these could be different if the that
' is later decided to be desirable
'
sMS = sMS & "<RDIEntry>Except
DescendantsOf(""MemberSecurity:Level1_RestrictedAttributes"")</RDIEntry>" & vbCrLf
End Select

If Not includeInventory Then

sMS = sMS & "<RDIEntry>Except ""Inventory""</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except DescendantsOf(""Inventory"")</RDIEntry>" & vbCrLf
Else
'
 ' as of 1/3/14 - even if an external group is to see inventory, there are
a number of measures
' (essentially DOS and WOS measures) that are not to be visible.
' 2/4/14 - this list was extended in the model to also include the issue
#206 measures:
' In Stock % - Store (#43), In Stock – Store Cnt (#336) & Out of Stock –
Store Cnt (#249)
' 3/10/2014 - DC Service Level % was added to the list of hidden inventory
measures, per Eric Lang.
' 10/9/18 - Note that at some point all restricted inventory measures were
ok'd. This logic is still
' here in case measures need to be restricted from inventory again, but as
of this date, the collection
' RestrictedInventoryPlaceholder had only a "placeholder" measure in it
'
sMS = sMS & "<RDIEntry>Except
DescendantsOf(""CellSecurity:RestrictedInventoryMeasures"")</RDIEntry>" & vbCrLf
End If

'
' close off measure setting, add vendor settings
'
sMS = sMS & "</Dimension>" & vbCrLf & _
"<Dimension name=""Vendor"">" & vbCrLf & _
"<RDIEntry>""All Vendors""</RDIEntry>" & vbCrLf
'
' 11/7/13 - as evidenced by B&L, sometime the Vendor name won't be unique
across pay vendor: B&L and Bausch & Lomb
' for example
'

Dim aVendorNumber As Variant

' 2/12/14 - JW - removed access to the the three product hierachies that
start with the Vendor level (levels that start with Vend*)
' 2/20/14 - this block should not have been commented out, restored.

For Each aVendorNumber In arrVendors

sMS = sMS & "<RDIEntry>Filter(Group(Vendor_PayVendor), ""ATTRIBUTE

""Vendor_PayVendor"".""VendorNumber"" = '" & aVendorNumber & "'"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>DescendantsOf(Filter(Group(Vendor_PayVendor), ""ATTRIBUTE
""Vendor_PayVendor"".""VendorNumber"" = '" & aVendorNumber & "'""))</RDIEntry>" &
vbCrLf

Next aVendorNumber

sMS = sMS & AddSurrogates & _

"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf

'Sam Start
If PremiumAccess Then

'sudarshan added
 sMS = sMS & "<Dimension name=""Appointment Approved Date"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf

sMS = sMS & "<Dimension name=""Display Content"">" & vbCrLf

'Dim aVendorNumber As Variant

For Each aVendorNumber In arrVendors

sMS = sMS & "<RDIEntry>Filter(Group(SKU1), ""ATTRIBUTE

""SKU1"".""Display_Pay_Vendor"" = " & aVendorNumber & """)</RDIEntry>" & vbCrLf & _
"<RDIEntry>AncestorsOf(Filter(Group(SKU1), ""ATTRIBUTE
""SKU1"".""Display_Pay_Vendor"" = " & aVendorNumber & """))</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Filter(Group(Display3), ""ATTRIBUTE
""Display3"".""Display_Pay_Vendor"" = " & aVendorNumber & """)</RDIEntry>" & vbCrLf
& _
"<RDIEntry>AncestorsOf(Filter(Group(Display3), ""ATTRIBUTE
""Display3"".""Display_Pay_Vendor"" = " & aVendorNumber & """))</RDIEntry>" &
vbCrLf & _
"<RDIEntry>Filter(Group(PayVendor), ""ATTRIBUTE
""PayVendor"".""Display_Pay_Vendor"" = " & aVendorNumber & """)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>DescendantsOf(Filter(Group(PayVendor), ""ATTRIBUTE
""PayVendor"".""Display_Pay_Vendor"" = " & aVendorNumber & """))</RDIEntry>" &
vbCrLf & _
"<RDIEntry>AncestorsOf(Filter(Group(PayVendor), ""ATTRIBUTE
""PayVendor"".""Display_Pay_Vendor"" = " & aVendorNumber & """))</RDIEntry>" &
vbCrLf

Next aVendorNumber

sMS = sMS & AddSurrogates & _

"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf

sMS = sMS & "<Dimension name=""Display Content Vendor"">" & vbCrLf

'Dim aVendorNumber As Variant

For Each aVendorNumber In arrVendors

sMS = sMS & "<RDIEntry>Filter(Group(DisplayContentVendor), ""ATTRIBUTE

""DisplayContentVendor"".""Display_Pay_Vendor"" = " & aVendorNumber &
""")</RDIEntry>" & vbCrLf & _
"<RDIEntry>AncestorsOf(Filter(Group(DisplayContentVendor), ""ATTRIBUTE
""DisplayContentVendor"".""Display_Pay_Vendor"" = " & aVendorNumber &
"""))</RDIEntry>" & vbCrLf

Next aVendorNumber

sMS = sMS & AddSurrogates & _

"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf

sMS = sMS & "<Dimension name=""Purchase Order"">" & vbCrLf

 'Dim aVendorNumber As Variant
For Each aVendorNumber In arrVendors

sMS = sMS & "<RDIEntry>Filter(Group(PayVendor), ""ATTRIBUTE

""PayVendor"".""PO_Pay_Vendor"" = " & aVendorNumber & """)</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(Filter(Group(PayVendor), ""ATTRIBUTE
""PayVendor"".""PO_Pay_Vendor"" = " & aVendorNumber & """))</RDIEntry>" & vbCrLf &
_
"<RDIEntry>AncestorsOf(Filter(Group(PayVendor), ""ATTRIBUTE
""PayVendor"".""PO_Pay_Vendor"" = " & aVendorNumber & """))</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Filter(Group(PayVendor1), ""ATTRIBUTE
""PayVendor1"".""PO_Pay_Vendor"" = " & aVendorNumber & """)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>DescendantsOf(Filter(Group(PayVendor1), ""ATTRIBUTE
""PayVendor1"".""PO_Pay_Vendor"" = " & aVendorNumber & """))</RDIEntry>" & vbCrLf &
_
"<RDIEntry>AncestorsOf(Filter(Group(PayVendor1), ""ATTRIBUTE
""PayVendor1"".""PO_Pay_Vendor"" = " & aVendorNumber & """))</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Filter(Group(PayVendor2), ""ATTRIBUTE
""PayVendor2"".""PO_Pay_Vendor"" = " & aVendorNumber & """)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>DescendantsOf(Filter(Group(PayVendor2), ""ATTRIBUTE
""PayVendor2"".""PO_Pay_Vendor"" = " & aVendorNumber & """))</RDIEntry>" & vbCrLf &
_
"<RDIEntry>AncestorsOf(Filter(Group(PayVendor2), ""ATTRIBUTE
""PayVendor2"".""PO_Pay_Vendor"" = " & aVendorNumber & """))</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Filter(Group(PayVendor3), ""ATTRIBUTE
""PayVendor3"".""PO_Pay_Vendor"" = " & aVendorNumber & """)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>DescendantsOf(Filter(Group(PayVendor3), ""ATTRIBUTE
""PayVendor3"".""PO_Pay_Vendor"" = " & aVendorNumber & """))</RDIEntry>" & vbCrLf &
_
"<RDIEntry>AncestorsOf(Filter(Group(PayVendor3), ""ATTRIBUTE
""PayVendor3"".""PO_Pay_Vendor"" = " & aVendorNumber & """))</RDIEntry>" & vbCrLf

Next aVendorNumber

sMS = sMS & AddSurrogates & _

"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf

sMS = sMS & "<Dimension name=""Appointment"">" & vbCrLf

'Dim aVendorNumber As Variant

For Each aVendorNumber In arrVendors

sMS = sMS & "<RDIEntry>Filter(Group(SKU1), ""ATTRIBUTE

""SKU1"".""Appt_Pay_Vendor"" = " & aVendorNumber & """)</RDIEntry>" & vbCrLf & _
"<RDIEntry>AncestorsOf(Filter(Group(SKU1), ""ATTRIBUTE
""SKU1"".""Appt_Pay_Vendor"" = " & aVendorNumber & """))</RDIEntry>" & vbCrLf & _
"<RDIEntry>Filter(Group(SKU), ""ATTRIBUTE ""SKU"".""Appt_Pay_Vendor"" = " &
aVendorNumber & """)</RDIEntry>" & vbCrLf & _
"<RDIEntry>AncestorsOf(Filter(Group(SKU), ""ATTRIBUTE
""SKU"".""Appt_Pay_Vendor"" = " & aVendorNumber & """))</RDIEntry>" & vbCrLf
 Next aVendorNumber

sMS = sMS & AddSurrogates & _

"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf

Else

sMS = sMS & "<Dimension name=""Display Content"">" & vbCrLf & _

"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Appointment"">" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Appointment Approved Date"">" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Display Content Vendor"">" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf

End If
'Sam End

If False Then
' use old logic

sMS = sMS & "<Dimension name=""Purchase Order"">" & vbCrLf & _

"<RDIEntry>""All Purchase Orders""</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf
sMS = sMS & "<Dimension name=""Organizational Role"">" & vbCrLf & _
"<RDIEntry>""All Merchandising""</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Inventory Directors"">" & vbCrLf & _
"<RDIEntry>""All Inventory Directors""</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Store Managers"">" & vbCrLf & _
"<RDIEntry>""All Store Managers""</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""DC Managers"">" & vbCrLf & _
"<RDIEntry>""All DC Managers""</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Like and Comparable Items"">" & vbCrLf & _
"<RDIEntry>""Actual Item""</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf

Else
'
' use new logic
'
' 5/5/2014 - changed the dimension and anchor node names for three dimensions
to
 ' "Inv Director", "Store Planner" and "DC Planner"
'
' added "Sr Inv Manager"
'
sMS = sMS & "<Dimension name=""Purchase Order"">" & vbCrLf & _
"<RDIEntry>""All Purchase Orders""</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf
sMS = sMS & "<Dimension name=""Organizational Role"">" & vbCrLf & _
"<RDIEntry>""All Merchandising""</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Inv Director"">" & vbCrLf & _
"<RDIEntry>""All Inv Directors""</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Sr Inv Manager"">" & vbCrLf & _
"<RDIEntry>""All Sr Inv Managers""</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Store Planner"">" & vbCrLf & _
"<RDIEntry>""All Store Planners""</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""DC Planner"">" & vbCrLf & _
"<RDIEntry>""All DC Planners""</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Like and Comparable Items"">" & vbCrLf & _
"<RDIEntry>""Actual Item""</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf
End If ' use new logic

sMS = sMS & "<Dimension name=""VPMM"">" & vbCrLf & _

"<RDIEntry>""All VPMMs""</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""DMM"">" & vbCrLf & _
"<RDIEntry>""All DMMs""</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""CM"">" & vbCrLf & _
"<RDIEntry>""All CMs""</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""BMM"">" & vbCrLf & _
"<RDIEntry>""All BMMs""</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf
sMS = sMS & "</RuleDomain>" & vbCrLf & _
"</MemberSecurityDomain>" & vbCrLf

' "</setModelMemberSecurityDomains>" & vbCrLf

'
' there is at least one ldap token in the wrapping text, so make sure that is
replaced
 '
sMS = Replace(sMS, "@@LDAP_TOKEN@@", ldapGroup)

'
' ok, we have all the member security, go ahead and merge that to the target
model
'
'MsgBox "skipping member security"

'
' setting the last argument to false skips prompting the user about merging
security, and does a merge
'

'
' for some reason,MergeMemberAndCellSecurity() changes the ldapgroup value, put
it back

' now deal with cell security

sCS = ""
'
's = s & "<SetCellSecurityDomains modelName=""@@MODEL@@"">" & vbCrLf

If L1a_Categories <> "" Then

sCS = sCS & CSBlockProductL1A(ldapGroup, arrVendors, includeInventory)
End If

If L1_Categories <> "" Or L2_Categories <> "" Or L2a_Categories <> "" Then
'
' if they literally have both l1 and (l2 or l2a), call the more fiddly
variant
'
If L1_Categories <> "" And (L2_Categories <> "" Or L2a_Categories <> "")
Then
sCS = sCS & NEW_CSBlockL1_AND_L2orL2a(ldapGroup, arrVendors, arrL1,
includeInventory)
Else
'
' call the simpler _or_ variant we have had all along
'
sCS = sCS & CSBlockProductL1_OR_L2(ldapGroup, arrVendors,
includeInventory)
End If
End If
If L3_Categories <> "" Then
sCS = sCS & CSBlockProductL3(ldapGroup, arrVendors, includeInventory)
End If
'
' if this group gets "Premium" measures, inject that rule into the sCS string
If GroupGetsPremium(ldapGroup, 1) Then
sCS = sCS & CS_AddPremiumAccess()
End If
 If PremiumAccess Then

sCS = sCS & CS_BenchMarkAccess()

sCS = sCS & CS_GenericAccess()
sCS = sCS & CS_GenericAccess_Split()

End If
's = s & "</SetCellSecurityDomains>" & vbCrLf

'
' there is at least one ldap token in the wrapping text, so make sure that is
replaced
'
sCS = Replace(sCS, "@@LDAP_TOKEN@@", ldapGroup)
'
' setting the last argument to false skips prompting the user about merging
security, and does a merge
'

' MsgBox "debug exit"

'GoTo DEBUGExit

JASCS_ASCS.SendASCSRequest "Setting group access for " & ldapGroup,

setGroupAccess(ldapGroup), modelName, False

If cApplyIteratively Then
MergeAndSetMemberAndCellSecurity modelName, sCS, sMS, ldapGroup,
modelSummary
Else
AppendFile ldapGroup, "C:\temp\CVS_PIP_LDAPGROUPS.txt"
AppendFile sMS, "C:\temp\CVS_PIP_MemberSecurity.txt"
AppendFile sCS, "C:\temp\CVS_PIP_CellSecurity.txt"
End If
'MergeMemberAndCellSecurity False, sMS, ldapGroup, False

'summary = "Member security: " & Len(sMS) & vbCrLf & "Cell security: " &
Len(sCS) & vbCrLf
Dim k As Variant

Const q = """"

summary = "Vendors set: "

For Each k In arrVendors
summary = summary & q & oDictVendorByNumber(k) & q & ", "
Next k
summary = Left(summary, Len(summary) - 2) & vbCrLf & "Categories: "
For Each k In arrL1a
summary = summary & "L1a:" & q & oDictCategoryByNumber(k) & q & ", "
Next k
For Each k In arrL1
summary = summary & "L1:" & q & oDictCategoryByNumber(k) & q & ", "
Next k
For Each k In arrL2
summary = summary & "L2:" & q & oDictCategoryByNumber(k) & q & ", "
Next k

For Each k In arrL2a

 summary = summary & "L2a:" & q & oDictCategoryByNumber(k) & q & ", "
Next k

For Each k In arrL3

summary = summary & "L3:" & q & oDictCategoryByNumber(k) & q & ", "
Next k
summary = Left(summary, Len(summary) - 2)

Range("a2").Offset(r, colSecurityResults - 1).Value = Now

Range("A2").Offset(r, colSecurityResults).Value = summary

DEBUGExit:

Exit Sub
ErrorReturn:
MsgBox "DANGER DANGER! Unhandled error in SetCVSSecurityForSpecificRow()" &
vbCrLf & Err.Description, vbCritical, "Unhandled error"

End Sub

Private Function ConvertToNumberArray(s As String) As Variant

Dim anArray As Variant

anArray = Split(s, "|")

Dim i As Variant

For i = LBound(anArray) To UBound(anArray)

Dim ss As String
ss = CStr(anArray(i))
anArray(i) = StripToNumber(ss)
Next i
ConvertToNumberArray = anArray

End Function
Private Function StripToNumber(s As String) As String
s = Trim(s)

If IsNumeric(s) Then
StripToNumber = s
Else ' must have alpha text too..
Dim i As Integer
i = Len(s)
While IsNumeric(Mid(s, i, 1)) And i > 1
i = i - 1
Wend
' Debug.Print s, Right(s, Len(s) - i)
StripToNumber = Right(s, Len(s) - i)
End If

End Function
Private Function InnerProductOrthClause(categoryNumber As Variant, groupName As
String, IsCategoryDim As Boolean)
Dim c As String
c = CStr(categoryNumber)
 If IsCategoryDim Then
'c = RemoveNumberSuffix(c)
InnerProductOrthClause = "<RDIEntry>Filter(Group(" & groupName & "),
""ATTRIBUTE """ & groupName & """.""CategoryNumber"" = '" & c & "'"")</RDIEntry>" &
vbCrLf
Else
'
' don't remove suffix, include children
'
InnerProductOrthClause = "<RDIEntry>Filter(Group(" & groupName & "),
""ATTRIBUTE """ & groupName & """.""CategoryNumber"" = '" & c & "'"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>DescendantsOf(Filter(Group(" & groupName & "), ""ATTRIBUTE """ &
groupName & """.""CategoryNumber"" = '" & c & "'""))</RDIEntry>" & vbCrLf

End If

End Function

Private Function InnerProductBrandOrthClause(Level As Integer, categoryNumber As

Variant, arrVendorNumbers As Variant) As String
' level should be 1, 2, or 3
Dim s As String
Dim aVendorNumber As Variant
Dim CategoryNumber_VendorNumber As String

If Level = 2 Or Level = 3 Then

'
' give them access to the vendors that have national brands, and national
brands and desc
'
's = "<RDIEntry>Filter(Group(Brand_Category), ""ATTRIBUTE
""Brand_Category"".""CategoryNumber"" = '" & categoryNumber & "'"")</RDIEntry>" &
vbCrLf & _
' "<RDIEntry>Filter(Group(Brand_PayVendor), ""ATTRIBUTE
""Brand_PayVendor"".""StoreBrand"" = 'NATIONAL BRAND'"")</RDIEntry>" & vbCrLf & _
' "<RDIEntry>Filter(Group(Brand_StoreBrand), ""ATTRIBUTE
""Brand_StoreBrand"".""Name"" = 'NATIONAL BRAND'"")</RDIEntry>" & vbCrLf & _
' "<RDIEntry>Group(All_Brand)</RDIEntry>" & vbCrLf
'
' 5/16/14 - changed from commented out block above - that block had the
side effect of giving groups with mixed level 1 and level 2 security
' accidental access to all vendors below the level 1 categories. The first
three lines make sure that only competitive vendors with national
' brands are seen, and that if you drill thru a competitor with both store
and national, you'll only see the national brands for that competitor
' The fourth line (indented) makes sure you will see both national store
brands for the pay vendor itself for the purchased category
'
s = "<RDIEntry>Filter(Group(Brand_Category), ""ATTRIBUTE
""Brand_Category"".""CategoryNumber"" = '" & categoryNumber & "'"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>Filter(Group(Brand_PayVendor), ""ATTRIBUTE
""Brand_PayVendor"".""CategoryNumber_StoreBrand"" = '" & categoryNumber & "
NATIONAL BRAND'"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>Filter(Group(Brand_StoreBrand), ""ATTRIBUTE
""Brand_StoreBrand"".""Name"" = 'NATIONAL BRAND'"")</RDIEntry>" & vbCrLf & _
 "<RDIEntry>DescendantsOf(Filter(Group(Brand_PayVendor), ""ATTRIBUTE
""Brand_PayVendor"".""CategoryNumber_VendorNumber"" = '" &
CategoryNumber_VendorNumber & "'""))</RDIEntry>" & vbCrLf & _
"<RDIEntry>Group(All_Brand)</RDIEntry>" & vbCrLf & _
"<RDIEntry>Filter(Group(LatestBrand_Category), ""ATTRIBUTE
""LatestBrand_Category"".""CategoryNumber"" = '" & categoryNumber &
"'"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>Filter(Group(LatestBrand_PayVendor), ""ATTRIBUTE
""LatestBrand_PayVendor"".""CategoryNumber_StoreBrand"" = '" & categoryNumber & "
NATIONAL BRAND'"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>AncestorsOf(Filter(Group(LatestBrand_StoreBrand), ""ATTRIBUTE
""LatestBrand_StoreBrand"".""CategoryNumber_StoreBrand"" = '" & categoryNumber & "
NATIONAL BRAND'""))</RDIEntry>" & vbCrLf & _
"<RDIEntry>Filter(Group(LatestBrand_StoreBrand), ""ATTRIBUTE
""LatestBrand_StoreBrand"".""Name"" = 'NATIONAL BRAND'"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(Filter(Group(LatestBrand_PayVendor),
""ATTRIBUTE ""LatestBrand_PayVendor"".""CategoryNumber_VendorNumber"" = '" &
CategoryNumber_VendorNumber & "'""))</RDIEntry>" & vbCrLf & _
"<RDIEntry>Group(LatestAll_Brand)</RDIEntry>" & vbCrLf

' "<RDIEntry>DescendantsOf(Filter(Group(Brand_Category), ""ATTRIBUTE

""Brand_Category"".""CategoryNumber"" = '" & categoryNumber & "'""))</RDIEntry>" &
vbCrLf
'
' if the category is one in which the vendor has only national brands,
remove access to the store brands
'
'If (InStr(1, oDictCategoryNumberSBMappings(categoryNumber), "NATIONAL
BRAND") > 0 And _
' InStr(1, oDictCategoryNumberSBMappings(categoryNumber), "STORE BRAND")
<= 0) Then
' s = s & "<RDIEntry>Except Filter(Group(Brand_StoreBrand), ""ATTRIBUTE
""Brand_StoreBrand"".""CategoryNumber_StoreBrand"" = '" & CStr(categoryNumber) & "
STORE BRAND" & "'"")</RDIEntry>" & vbCrLf
'End If
'
' override for the vendor itself, so they can see everything below their
own cat/vendors
For Each aVendorNumber In arrVendorNumbers

CategoryNumber_VendorNumber = categoryNumber & " " & aVendorNumber

s = s & "<RDIEntry>Filter(Group(Brand_PayVendor), ""ATTRIBUTE
""Brand_PayVendor"".""CategoryNumber_VendorNumber"" = '" &
CategoryNumber_VendorNumber & "'"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(Filter(Group(Brand_PayVendor), ""ATTRIBUTE
""Brand_PayVendor"".""CategoryNumber_VendorNumber"" = '" &
CategoryNumber_VendorNumber & "'""))</RDIEntry>" & vbCrLf & _
"<RDIEntry>Filter(Group(LatestBrand_PayVendor), ""ATTRIBUTE
""LatestBrand_PayVendor"".""CategoryNumber_VendorNumber"" = '" &
CategoryNumber_VendorNumber & "'"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>AncestorsOf(Filter(Group(LatestBrand_PayVendor),
""ATTRIBUTE ""LatestBrand_PayVendor"".""CategoryNumber_VendorNumber"" = '" &
CategoryNumber_VendorNumber & "'""))</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(Filter(Group(LatestBrand_PayVendor),
""ATTRIBUTE ""LatestBrand_PayVendor"".""CategoryNumber_VendorNumber"" = '" &
CategoryNumber_VendorNumber & "'""))</RDIEntry>" & vbCrLf

Next aVendorNumber
 ElseIf Level = 1 Then
'
' they should only see their own pay vendor codes below category
'
s = "<RDIEntry>Filter(Group(Brand_Category), ""ATTRIBUTE
""Brand_Category"".""CategoryNumber"" = '" & categoryNumber & "'"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>Filter(Group(LatestBrand_Category), ""ATTRIBUTE
""LatestBrand_Category"".""CategoryNumber"" = '" & categoryNumber &
"'"")</RDIEntry>" & vbCrLf

For Each aVendorNumber In arrVendorNumbers

CategoryNumber_VendorNumber = categoryNumber & " " & aVendorNumber
s = s & "<RDIEntry>Filter(Group(Brand_PayVendor), ""ATTRIBUTE
""Brand_PayVendor"".""CategoryNumber_VendorNumber"" = '" &
CategoryNumber_VendorNumber & "'"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(Filter(Group(Brand_PayVendor), ""ATTRIBUTE
""Brand_PayVendor"".""CategoryNumber_VendorNumber"" = '" &
CategoryNumber_VendorNumber & "'""))</RDIEntry>" & vbCrLf & _
"<RDIEntry>Filter(Group(LatestBrand_PayVendor), ""ATTRIBUTE
""LatestBrand_PayVendor"".""CategoryNumber_VendorNumber"" = '" &
CategoryNumber_VendorNumber & "'"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>AncestorsOf(Filter(Group(LatestBrand_PayVendor),
""ATTRIBUTE ""LatestBrand_PayVendor"".""CategoryNumber_VendorNumber"" = '" &
CategoryNumber_VendorNumber & "'""))</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(Filter(Group(LatestBrand_PayVendor),
""ATTRIBUTE ""LatestBrand_PayVendor"".""CategoryNumber_VendorNumber"" = '" &
CategoryNumber_VendorNumber & "'""))</RDIEntry>" & vbCrLf

Next aVendorNumber
Else
MsgBox "Unsupport level number in InnerProductBrandOrthClause!"
End If

InnerProductBrandOrthClause = s
End Function
Private Function ProductOrthogonalRestrictions(arrL1a As Variant, arrL1 As Variant,
arrL2 As Variant, arrL2a As Variant, arrL3 As Variant, arrVendorNumbers As Variant)
'
' 11/18/13 - JW - modified to deal with new requirement that L1A security
groups should see only anchor nodes in Merchant Group, Category,
' SubCategory, Segment and Brand.
'
' 12/30/14 - JW - added level 2a support
'
' Note that the code branch relies on the input restriction that a group that
has L1A categories cannot have L1, L2 or L3 categories
'
Dim categoryNumber As Variant
Dim s As String

If UBound(arrL1a) >= 0 Then

'
' only allow to skip the dimension or see the all members - so no need for
custom aggs
'
ProductOrthogonalRestrictions = "<Dimension name=""Merchandise Group"">" &
vbCrLf & _
"<RDIEntry>""All Merchandise Groups""</RDIEntry>" & vbCrLf
& _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf

ProductOrthogonalRestrictions = ProductOrthogonalRestrictions & "<Dimension

name=""Category"">" & vbCrLf & _
"<RDIEntry>""All Categories""</RDIEntry>" & vbCrLf

'
' 5/9/14 - added access to purchased categories to level 1a
'

For Each categoryNumber In arrL1a

ProductOrthogonalRestrictions = ProductOrthogonalRestrictions &
InnerProductOrthClause(categoryNumber, "All_Categories", True)
Next categoryNumber

ProductOrthogonalRestrictions = ProductOrthogonalRestrictions &

"<RDIEntry>~</RDIEntry>" & vbCrLf & _
AddSurrogates & "</Dimension>" & vbCrLf

ProductOrthogonalRestrictions = ProductOrthogonalRestrictions & "<Dimension

name=""Subcategory"">" & vbCrLf & _
"<RDIEntry>""All SubCategories""</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf

ProductOrthogonalRestrictions = ProductOrthogonalRestrictions & "<Dimension

name=""Segment"">" & vbCrLf & _
"<RDIEntry>""All Segments""</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf

ProductOrthogonalRestrictions = ProductOrthogonalRestrictions & "<Dimension

name=""Brand"">" & vbCrLf & _
"<RDIEntry>""All Brands""</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf

Else ' L1, L2, L2a or L3 group - or possible a combination of L1 and L2

'
' no need for surrogate access for merchandise group, since we are giving
full access to the dimension
'
' 11/20/13 - Removed access to all but the anchor node for merch group dim
ProductOrthogonalRestrictions = "<Dimension name=""Merchandise Group"">" &
vbCrLf & _
"<RDIEntry>""All Merchandise Groups""</RDIEntry>" & vbCrLf
& _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf
'ProductOrthogonalRestrictions = "<Dimension name=""Merchandise Group"">" &
vbCrLf & _
' "<RDIEntry>*~</RDIEntry>" & vbCrLf & _
' "</Dimension>" & vbCrLf

s = ""
'For Each categoryNumber In arrL1a
 ' s = s & InnerProductOrthClause(categoryNumber, "All_Categories", True)
'Next categoryNumber
For Each categoryNumber In arrL1
s = s & InnerProductOrthClause(categoryNumber, "All_Categories", True)
Next categoryNumber
For Each categoryNumber In arrL2
s = s & InnerProductOrthClause(categoryNumber, "All_Categories", True)
Next categoryNumber
' 12/30/14 - added l2a for/next loop
For Each categoryNumber In arrL2a
s = s & InnerProductOrthClause(categoryNumber, "All_Categories", True)
Next categoryNumber
For Each categoryNumber In arrL3
s = s & InnerProductOrthClause(categoryNumber, "All_Categories", True)
Next categoryNumber
'
'at this point, s holds the RDI elements - factor these into various
product orth dimensions
' (just category for now, ultimately all of them)
ProductOrthogonalRestrictions = ProductOrthogonalRestrictions & "<Dimension
name=""Category"">" & vbCrLf & _
"<RDIEntry>""All Categories""</RDIEntry>" & vbCrLf & _
s & "<RDIEntry>~</RDIEntry>" & vbCrLf & _
AddSurrogates & "</Dimension>" & vbCrLf

s = ""
'
' SubCategory
'
'For Each categoryNumber In arrL1a
' s = s & InnerProductOrthClause(categoryNumber, "SubCat_Category",
False)
'Next categoryNumber
For Each categoryNumber In arrL1
s = s & InnerProductOrthClause(categoryNumber, "SubCat_Category",
False)
Next categoryNumber
For Each categoryNumber In arrL2
s = s & InnerProductOrthClause(categoryNumber, "SubCat_Category",
False)
Next categoryNumber
' 12/30/14 - added l2a for/next loop
For Each categoryNumber In arrL2a
s = s & InnerProductOrthClause(categoryNumber, "SubCat_Category",
False)
Next categoryNumber
For Each categoryNumber In arrL3
s = s & InnerProductOrthClause(categoryNumber, "SubCat_Category",
False)
Next categoryNumber

ProductOrthogonalRestrictions = ProductOrthogonalRestrictions & "<Dimension

name=""Subcategory"">" & vbCrLf & _
"<RDIEntry>""All SubCategories""</RDIEntry>" & vbCrLf & _
s & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
AddSurrogates & "</Dimension>" & vbCrLf
s = ""
'
 ' Segment
'
'For Each categoryNumber In arrL1a
' s = s & InnerProductOrthClause(categoryNumber, "Segment_Category",
False)
'Next categoryNumber
For Each categoryNumber In arrL1
s = s & InnerProductOrthClause(categoryNumber, "Segment_Category",
False)
Next categoryNumber
For Each categoryNumber In arrL2
s = s & InnerProductOrthClause(categoryNumber, "Segment_Category",
False)
Next categoryNumber
' 12/30/14 - added l2a loop
For Each categoryNumber In arrL2a
s = s & InnerProductOrthClause(categoryNumber, "Segment_Category",
False)
Next categoryNumber
For Each categoryNumber In arrL3
s = s & InnerProductOrthClause(categoryNumber, "Segment_Category",
False)
Next categoryNumber

ProductOrthogonalRestrictions = ProductOrthogonalRestrictions & "<Dimension

name=""Segment"">" & vbCrLf & _
"<RDIEntry>""All Segments""</RDIEntry>" & vbCrLf & _
s & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
AddSurrogates & "</Dimension>" & vbCrLf
s = ""
'
' Brand
'
'For Each categoryNumber In arrL1a
' s = s & InnerProductOrthClause(categoryNumber, "Brand_Category",
False)
'Next categoryNumber
'For Each categoryNumber In arrL1
' s = s & InnerProductOrthClause(categoryNumber, "Brand_Category",
False)
'Next categoryNumber
'For Each categoryNumber In arrL2
' s = s & InnerProductOrthClause(categoryNumber, "Brand_Category",
False)
'Next categoryNumber
'For Each categoryNumber In arrL3
' s = s & InnerProductOrthClause(categoryNumber, "Brand_Category",
False)
'Next categoryNumber

'GoTo SkipBrandLogic

'
' if this is a 1a client, they should not see anything but the all member
of brand
'
Dim count As Integer
 count = 0
For Each categoryNumber In arrL1
s = s & InnerProductBrandOrthClause(1, categoryNumber,
arrVendorNumbers)
count = count + 1
Next categoryNumber
For Each categoryNumber In arrL2
s = s & InnerProductBrandOrthClause(2, categoryNumber,
arrVendorNumbers)
Next categoryNumber
' 12/30/14 - added l2a loop
For Each categoryNumber In arrL2a
s = s & InnerProductBrandOrthClause(2, categoryNumber,
arrVendorNumbers)
Next categoryNumber
For Each categoryNumber In arrL3
s = s & InnerProductBrandOrthClause(3, categoryNumber,
arrVendorNumbers)
Next categoryNumber

ProductOrthogonalRestrictions = ProductOrthogonalRestrictions & "<Dimension

name=""Brand"">" & vbCrLf & _
"<RDIEntry>""All Brands""</RDIEntry>" & vbCrLf & _
s & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
AddSurrogates & "</Dimension>" & vbCrLf
End If ' L1, L2, L2a or L3 group

End Function

Private Function AddSurrogates() As String

AddSurrogates = "<RDIEntry>CountSurrogate</RDIEntry>" & vbCrLf & _
"<RDIEntry>SurrogateMembers</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(SurrogateMembers)</RDIEntry>" & vbCrLf
End Function
Private Function RemoveNumberSuffix(s As Variant)
'
'
Dim i As Integer

i = Len(s)

While Mid(s, i, 1) <> " "

i = i - 1
Wend

RemoveNumberSuffix = Trim(Left(s, i))

End Function

Private Function GetNumberSuffix(s As Variant)

Dim i As Integer, c As Integer
i = Len(s)
 While Mid(s, i, 1) <> " "
i = i - 1
c = c + 1
Wend

GetNumberSuffix = Trim(Right(s, c))

End Function

Private Function setGroupAccess(ldapGroup As String) As String

'
' makes sure the group in question has read/query access to the model
'
setGroupAccess = "<ascs:modifyGroups action=""Update"" >" & vbCrLf & _
"<Group name=""" & ldapGroup & """ >" & vbCrLf & _
"<Roles >" & vbCrLf & _
"<Role name=""queryuser"" />" & vbCrLf & _
"</Roles>" & vbCrLf & _
"<ModelAccesses >" & vbCrLf & _
"<ModelAccess name=""@@MODEL@@"" >" & vbCrLf & _
"<Privilege >Read</Privilege>" & vbCrLf & _
"</ModelAccess>" & vbCrLf & _
"</ModelAccesses>" & vbCrLf & _
"</Group>" & vbCrLf & _
"</ascs:modifyGroups>" & vbCrLf

End Function

Private Function MSProductL2orL3_Step1_Category(categoryNumber As String) As String

'
' this shoudl be called for each category a particular LDAP group purchases.
note that the
' MSProductL2orL3_Step_SBorNB() should only be called once, regardless of the
number of categories purchase
'
'
' 10/6/13 - JW - added support for the newly modified "All Products by Vendor"
(Vend_* levels)
' and "All Products by Brand" (ProdBrand_* levels) hierarchies.
' 11/11/13 - JW - converted to work from array of category numbers, rather than
an array of category name plus number
'
' 1/3/14 - JW - modified for latest hare brained CVS member security - this
time the goal is to only show national brand vendors
' and national brand split members, except for the pay vendor themselves. pay
vendors that have only store brands, and store brand members
' should otherwise be suppressed.
'
' 1/9/14 - JW - rewritten to work wiht PushRDIFilteringToDB:False - which
requires a reliance on ancestorsof() against the store brand level
' which may be less stable over time. But we use ancestorof () even in the
pushrdifiltertodb:true approach, and models open an order of magniture
' faster with PushRDIFilteringToDB:False
'
' 2/12/14 - JW - removed access to the the three product hierachies that start
with the Vendor level
' 3/26/14 - JW - restored access to one of the three product hierarchies (All
Products by Vendor-Merch Group) removed on 2/12. Arrgh.
 ' 6/2/14 - JW - modified the code so that segments would show up in the corner
case that all vendors in that segment are competitive and
' have only store brands. This is need to get around the inadvertant
suppression that occurs due to the rule added on 1/3/14 as described above.

Dim s As String

'
' All Products by Merch Group - desc,2 on category takes you dowo thru SubCat
and Segment. then pick up additional restrictions at PayVendor and StoreBrand
levels
' note that you have to include category number and store brand info on the
last three rules, else when level 1 and level 2 are mixed, you will grant
' inadvertant access.
'

' 6/2/14 - make sure all segments in the category are visible as well as their
ancestors
'
s = RDIFilterClause("ProdMG_Segment", "CategoryNumber", "@@CATEGORY_TOKEN@@",
0, -1)

If PremiumAccess Then
s = s & RDIFilterClause("ProdMG_Category_BM", "CategoryNumber",
"@@CATEGORY_TOKEN@@", 0, -1)
End If
' RDIFilterClause will generate ancestor and descendant variants as well for
this one

s = s & RDIFilterClause("ProdMG_StoreBrand", "CategoryNumber_StoreBrand",

"@@CATEGORY_TOKEN@@ NATIONAL BRAND", 0, 0)

'
' All Products by Vendor-Merch Group - try approach of pivoting everything on
store brand level
'
' 2/12/14 - CVS no longer want vendor hierarchies to be visible - I'm leaving
the code block in case they later change their minds
' note that the vendor hierarchies all have level names starting with Vend*
' 3/26/14 - partially restore access to the Vendor anchor hierarchies blocked
on 2/12

s = s & RDIFilterClause("VendMG_StoreBrand", "CategoryNumber_StoreBrand",

"@@CATEGORY_TOKEN@@ NATIONAL BRAND", 0, 0)

'
' All Products by Vendor - requires similar logic to "All Products by Vendor-
Merch Group"
'
' 2/12/14 - CVS no longer want vendor hierarchies to be visible - I'm leaving
the code block in case they later change their minds
' note that the vendor hierarchies all have level names starting with Vend*

' 1/22/19 - CVS now wants vendor hierarchies again to be visible, restored,
line of code below, which had been commented out back on 2/12/14
s = s & RDIFilterClause("Vend_StoreBrand", "CategoryNumber_StoreBrand",
"@@CATEGORY_TOKEN@@ NATIONAL BRAND", 0, 0)
s = s & RDIFilterClause("LatestVend_StoreBrand", "CategoryNumber_StoreBrand",
"@@CATEGORY_TOKEN@@ NATIONAL BRAND", 0, 0)

'
' All Products by Brand - requires similar logic to "All Products by Merch
Group"
'

' 6/2/14 - make sure all segments in the category are visible as well as their
ancestors
'
s = s & RDIFilterClause("ProdBrand_Segment", "CategoryNumber",
"@@CATEGORY_TOKEN@@", 0, -1)

s = s & RDIFilterClause("ProdBrand_StoreBrand", "CategoryNumber_StoreBrand",

"@@CATEGORY_TOKEN@@ NATIONAL BRAND", 0, 0)
'
' All products by Vendor-Brand - requires similar logic to "All Products by
Vendor-Merch Group"
'
' 2/12/14 - CVS no longer want vendor hierarchies to be visible - I'm leaving
the code block in case they later change their minds
' note that the vendor hierarchies all have level names starting with Vend*

's = s & RDIFilterClause("VendBrand_StoreBrand", "CategoryNumber_StoreBrand",

"@@CATEGORY_TOKEN@@ NATIONAL BRAND", 0, 0)

'Sri Added 3/16 -

'Sri commented out to run the security; Turn it back on when rolling out this
feature
' 6/21/16 - JW - change to apply to the ProdBC_StoreBrand level - the goal of
this entry is to allow them to see
' everything in the hierarhcy which contains the purchased category and a
national brand - essentially gives them
' access to all vendors that have national brands, and screens all store brands
s = s & RDIFilterClause("ProdBC_StoreBrand", "CategoryNumber_StoreBrand",
"@@CATEGORY_TOKEN@@ NATIONAL BRAND", 0, 0)

s = Replace(s, "@@CATEGORY_TOKEN@@", categoryNumber)

MSProductL2orL3_Step1_Category = s

End Function

Private Function MSProductL2a_Category(categoryNumber As String) As String

'
' adopted from MSProductL2_Step1_Category() based on new security level L2a
requirements
' L2a allows users to see store brands for competitve vendors

Dim s As String

'
' All Products by Merch Group - all that is needed is to the specific category
as visible, along with all ancestors and
' descendants, since there are not restrictions on store brands
 '
s = RDIFilterClause("ProdMG_Category", "CategoryNumber", "@@CATEGORY_TOKEN@@",
0, 0)

If PremiumAccess Then
s = s & RDIFilterClause("ProdMG_Category_BM", "CategoryNumber",
"@@CATEGORY_TOKEN@@", 0, 0)
End If

' All Products by Vendor-Merch Group - again, category is all we need to work
about for level 2a

s = s & RDIFilterClause("VendMG_Category", "CategoryNumber",

"@@CATEGORY_TOKEN@@", 0, 0)

'
' All Products by Vendor - requires similar logic to "All Products by Vendor-
Merch Group"
'
' 2/12/14 - CVS no longer want vendor hierarchies to be visible - I'm leaving
the code block in case they later change their minds
' note that the vendor hierarchies all have level names starting with Vend*

' 1/22/19 - JW - restored following line of code to give access to the All
Products by Vendor hierarchy per CVS
s = s & RDIFilterClause("Vend_Category", "CategoryNumber",
"@@CATEGORY_TOKEN@@", 0, 0)
s = s & RDIFilterClause("LatestVend_Category", "CategoryNumber",
"@@CATEGORY_TOKEN@@", 0, 0)

'
' All Products by Brand - requires similar logic to "All Products by Merch
Group"
'

' 6/2/14 - make sure all segments in the category are visible as well as their
ancestors
' 1/14/15 - changed to allow both ancestors and descendants

s = s & RDIFilterClause("ProdBrand_Category", "CategoryNumber",

"@@CATEGORY_TOKEN@@", 0, 0)

'
' All products by Vendor-Brand - requires similar logic to "All Products by
Vendor-Merch Group"
'
' 2/12/14 - CVS no longer want vendor hierarchies to be visible - I'm leaving
the code block in case they later change their minds
' note that the vendor hierarchies all have level names starting with Vend*

's = s & RDIFilterClause("VendBrand_Category", "CategoryNumber",

"@@CATEGORY_TOKEN@@", 0, 0)

'Sri 3/18 (L2A)- Added to make sure any ldap group defined at l2a has access to
competetive vendors' store brands as well since this is the
'requirement for l2a level
 'Sri 3/28 - Commented out to work on security. wait to roll this out
' 6/21/16 - JW - modified ProdBC - L2a spec for the ProdBC hierarchy allows
them to see selected categories and then all vendors / store
' brands below - so we give unfettered access to the levels above (which is
just the root) and below) the categories specified

s = s & RDIFilterClause("ProdBC_Category", "CategoryNumber",

"@@CATEGORY_TOKEN@@", 0, 0)

s = Replace(s, "@@CATEGORY_TOKEN@@", categoryNumber)

MSProductL2a_Category = s

End Function

Private Function RDIFilterClause(level_name As Variant, Attr_Name As Variant,

attr_value As Variant, _
Optional AncestorLevels As Integer = -1, Optional DescLevels As Integer = -1,
Optional exceptEntry As Boolean = False) As String
'
' generates the one to three part RDI clauses that are so common, based on
level.attribute comparisons.
' can generate either just a single group clause, or also include the
descendants and ancestors variants if needed.
'
' to generate the ancestor/descendant clause, set the optional arguments to 0
(for all ancestor or desc levels) or some
' positive integer to restrict the number of ancestor/descendant levels
'
Dim s As String
Dim exceptClause As String

If exceptEntry Then
exceptClause = "Except "
Else
exceptClause = ""
End If

s = "<RDIEntry>" & exceptClause & "Filter(Group(" & level_name & "),

""ATTRIBUTE """ & level_name & """.""" & Attr_Name & """ = '" & attr_value &
"'"")</RDIEntry>" & vbCrLf

If (AncestorLevels = 0) Then
' all ancestors
s = s & "<RDIEntry>" & exceptClause & "AncestorsOf(Filter(Group(" &
level_name & "), ""ATTRIBUTE """ & level_name & """.""" & Attr_Name & """ = '" &
attr_value & "'""))</RDIEntry>" & vbCrLf
ElseIf (AncestorLevels > 0) Then
' restricted number of ancestors
s = s & "<RDIEntry>" & exceptClause & "AncestorsOf(" & CStr(AncestorLevels)
& ",Filter(Group(" & level_name & "), ""ATTRIBUTE """ & level_name & """.""" &
Attr_Name & """ = '" & attr_value & "'""))</RDIEntry>" & vbCrLf
'
' else no ancestor clause
End If

If (DescLevels = 0) Then
 ' all descendants
s = s & "<RDIEntry>" & exceptClause & "DescendantsOf(Filter(Group(" &
level_name & "), ""ATTRIBUTE """ & level_name & """.""" & Attr_Name & """ = '" &
attr_value & "'""))</RDIEntry>" & vbCrLf
ElseIf (DescLevels > 0) Then
' restricted number of ancestors
s = s & "<RDIEntry>" & exceptClause & "DescendantsOf(" & CStr(DescLevels) &
",Filter(Group(" & level_name & "), ""ATTRIBUTE """ & level_name & """.""" &
Attr_Name & """ = '" & attr_value & "'""))</RDIEntry>" & vbCrLf
'
' else no descendants clause
End If

RDIFilterClause = s

End Function

Private Function
MSProductL2OrL3_Step2New_ShowStoreBrandsForVendorCategories(oDictUsedCategoryNumber
s As Dictionary, arrVendors As Variant) As String
'
' replaces the MSProductL2orL3_Step2_HideStoreBrandsAsNeeded() function - that
function had to hide store brands by exception. But now the rule is
' always hide store brands (handled byMSProductL2orL3_Step1_Category()) and
then be careful to show everything below the paying vendor's categories
'
' 2/12/14 - JW - removed access to the the three product hierachies that start
with the Vendor level
' 3/26/14 - JW - restored access to one of the three product hierarchies (All
Products by Vendor-Merch Group) removed on 2/12. Arrgh.

Dim categoryNumber As Variant

Dim vendorNumber As Variant
Dim s As String
For Each vendorNumber In arrVendors
'
' for the hierachies that have Vendor below category, we only need to over
the vendor number (All Products by Merch Group and All Product by Brand)
' 1/9/14 - added the group itself as well as the descendants - otherwise
won't work for vendors that have only store brands - I'm looking at you
' Dr Reddy
'
' 3/26/14 - JW - restored access to one of the three product hierarchies
(All Products by Vendor-Merch Group) removed on 2/12. Arrgh.
For Each categoryNumber In oDictUsedCategoryNumbers.Keys
'
' for the hierarchies with vendor above category, we need to override
the permutation of category and vendor
'
Dim catNumVendNum As String

catNumVendNum = CStr(categoryNumber) & " " & CStr(vendorNumber)

'
' for these two hierarchies, vendor is below cateogry
'
 s = s & RDIFilterClause("ProdMG_PayVendor",
"CategoryNumber_VendorNumber", catNumVendNum, 0, 0)
s = s & RDIFilterClause("ProdBrand_PayVendor",
"CategoryNumber_VendorNumber", catNumVendNum, 0, 0)

'Sri - 3/20 11am - Since SB is always blocked, according to this

function, Pay vendors who have purchased categories can have
'access to only their SBs and I think NBs but not other Vendors's SBs.
Also new Hierarchy has Category above Vendor level.
'Sri - 3/28 - Commentd out to run security.
' 6/21/16 - JW - reviewed, seems correct

s = s & RDIFilterClause("ProdBC_PayVendor",
"CategoryNumber_VendorNumber", catNumVendNum, 0, 0)
'
' for these three, category is below vendor
'
' 2/12/14 - CVS no longer want vendor hierarchies to be visible - I'm
leaving the code block in case they later change their minds
' note that the vendor hierarchies all have level names starting with
Vend*
' 3/26/14 - partially restore access to the Vendor anchor hierarchies
blocked on 2/12

s = s & RDIFilterClause("VendMG_Category",
"CategoryNumber_VendorNumber", catNumVendNum, 0, 0)
' 1/22/19 - JW - restored following line of code to give access to the
All Products by Vendor hierarchy per CVS
s = s & RDIFilterClause("Vend_Category", "CategoryNumber_VendorNumber",
catNumVendNum, 0, 0)
s = s & RDIFilterClause("LatestVend_Category",
"CategoryNumber_VendorNumber", catNumVendNum, 0, 0)
's = s & RDIFilterClause("VendBrand_Category",
"CategoryNumber_VendorNumber", catNumVendNum, 0, 0)

Next categoryNumber
Next vendorNumber
MSProductL2OrL3_Step2New_ShowStoreBrandsForVendorCategories = s
End Function

Private Function MSBlockProductL1(arrCategoryNumbers As Variant, arrVendorNumbers

As Variant) As String
'
' 10/6/13 - JW - added support for the newly modified "All Products by Vendor"
(Vend_* levels)
' and "All Products by Brand" (ProdBrand_* levels) hierarchies.
'
' 10/31/13 - JW - the code worked fine for L1 vendors if all of their
categories were L1, but in testing it was discovered
' that if a client had a mix of L1 and L2 categories, the L2 rules were
allowing users to get to L1 competitors they
' shouldn't.
' 11/11/13 - JW - converted to expect arrays of numbers rather than names +
numbers
' 2/12/14 - JW - removed access to the the three product hierachies that start
with the Vendor level
 ' 3/26/14 - JW - restored access to one of the three product hierarchies (All
Products by Vendor-Merch Group) removed on 2/12. Arrgh.

Dim s As String
Dim aCategoryNumber As Variant, aVendorNumber As Variant

s = ""
'
' two of the hierarchies have Category above Vendor and can be handled in a
simple catgory loop
'
'Sri 5/5/16 - Added access to Category level to L1/L1A levels for new hierarchy
All Products by Brand Consolidated(ProdBC_Category)
' 6/21/16 - JW - modified to reflect that new product hierarchy (ProdBC) has
the Category/Pay Vendor and StoreBrand as the immediate
' top 3 levels of the hierarchy
'
For Each aCategoryNumber In arrCategoryNumbers
s = s & "<RDIEntry>Filter(Group(ProdMG_Category), ""ATTRIBUTE
""ProdMG_Category"".""CategoryNumber"" = '" & aCategoryNumber & "'"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>AncestorsOf(Filter(Group(ProdMG_Category), ""ATTRIBUTE
""ProdMG_Category"".""CategoryNumber"" = '" & aCategoryNumber & "'""))</RDIEntry>"
& vbCrLf & _
"<RDIEntry>DescendantsOf(2, Filter(Group(ProdMG_Category), ""ATTRIBUTE
""ProdMG_Category"".""CategoryNumber"" = '" & aCategoryNumber & "'""))</RDIEntry>"
& vbCrLf & _
"<RDIEntry>Filter(Group(ProdBrand_Category), ""ATTRIBUTE
""ProdBrand_Category"".""CategoryNumber"" = '" & aCategoryNumber &
"'"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>AncestorsOf(Filter(Group(ProdBrand_Category), ""ATTRIBUTE
""ProdBrand_Category"".""CategoryNumber"" = '" & aCategoryNumber &
"'""))</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(2, Filter(Group(ProdBrand_Category), ""ATTRIBUTE
""ProdBrand_Category"".""CategoryNumber"" = '" & aCategoryNumber &
"'""))</RDIEntry>" & vbCrLf & _
"<RDIEntry>Filter(Group(ProdBC_Category), ""ATTRIBUTE
""ProdBC_Category"".""CategoryNumber"" = '" & aCategoryNumber & "'"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>AncestorsOf(Filter(Group(ProdBC_Category), ""ATTRIBUTE
""ProdBC_Category"".""CategoryNumber"" = '" & aCategoryNumber & "'""))</RDIEntry>"
& vbCrLf
If PremiumAccess Then
s = s & "<RDIEntry>Filter(Group(ProdMG_Category_BM), ""ATTRIBUTE
""ProdMG_Category_BM"".""CategoryNumber"" = '" & aCategoryNumber &
"'"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>AncestorsOf(Filter(Group(ProdMG_Category_BM), ""ATTRIBUTE
""ProdMG_Category_BM"".""CategoryNumber"" = '" & aCategoryNumber &
"'""))</RDIEntry>" & vbCrLf
End If

's = s & RDIFilterClause("ProdMG_Category", "CategoryNumber_VendorNumber",

catNumVendNum, -1, 0)

Next aCategoryNumber

'
' the other three hierarchies have vendor above category, and have to be
handled in a nested loop to avoid accidental access in cases where
' a client might have L1 and L2 categories -
'
' NOTE: as an optimization - this could be combined into the simpler logic
above in cases where a client had only L1 categories
'
' 2/12/14 - CVS no longer want these to be visible - I'm leaving the code block
in case they later change their minds
' 3/26/14 - partially restore access to the Vendor anchor hierarchies blocked
on 2/12
' 1/22/19 - JW - restored access to the "all Products by Vendor" hierarchy by
uncommenting the line below involving "Vend_Category"
For Each aCategoryNumber In arrCategoryNumbers
For Each aVendorNumber In arrVendorNumbers
Dim CatNumberVendorNumber As String
CatNumberVendorNumber = aCategoryNumber & " " & aVendorNumber
s = s & RDIFilterClause("VendMG_Category",
"CategoryNumber_VendorNumber", CatNumberVendorNumber, 1, 0)
s = s & RDIFilterClause("Vend_Category",
"CategoryNumber_VendorNumber", CatNumberVendorNumber, 1, 0)
s = s & RDIFilterClause("LatestVend_Category",
"CategoryNumber_VendorNumber", CatNumberVendorNumber, 1, 0)
's = s & RDIFilterClause("VendBrand_Category",
"CategoryNumber_VendorNumber", CatNumberVendorNumber, 1, 0)

Next aVendorNumber
Next aCategoryNumber

' 2/12/14 - CVS no longer want vendor hierarchies to be visible - I'm leaving
the code block in case they later change their minds
' note that the vendor hierarchies all have level names starting with Vend*

' 3/26/14 - partially restore access to the Vendor anchor hierarchies blocked
on 2/12

' 1/22/19 - JW - restored access to the "all Products by Vendor" hierarchy by

uncommenting the line below involving "Vend_Category"
For Each aVendorNumber In arrVendorNumbers
s = s & RDIFilterClause("ProdMG_PayVendor", "VendorNumber",
CStr(aVendorNumber), -1, 0)
s = s & RDIFilterClause("VendMG_PayVendor", "VendorNumber",
CStr(aVendorNumber), 0, -1)
s = s & RDIFilterClause("Vend_PayVendor", "VendorNumber",
CStr(aVendorNumber), 0, -1)
s = s & RDIFilterClause("ProdBrand_PayVendor", "VendorNumber",
CStr(aVendorNumber), -1, 0)
s = s & RDIFilterClause("LatestVend_PayVendor", "VendorNumber",
CStr(aVendorNumber), 0, -1)
's = s & RDIFilterClause("VendBrand_PayVendor", "VendorNumber",
CStr(aVendorNumber), 0, -1)
'Sri 5/5/16 - Added access to Category level to L1/L1A levels for new hierarchy
All Products by Brand Consolidated(ProdBC_Category)
'6/14/16 - Sri-Changed the arguments from -1, 0 to 0, -1;
'6/20/16 - Sri - commented out

'6/21/16 JW - for level 1 ProdBC hierarchy, they can only see their own pay
vendor codes, and everything below (store brand / national)
' is fair game, as they are at this point restricted to the category/vendor
that are themselves
 s = s & RDIFilterClause("ProdBC_PayVendor", "VendorNumber",
CStr(aVendorNumber), -1, 0)

Next aVendorNumber

MSBlockProductL1 = s

End Function

Private Function CSBlockProductL3(ldapGroupName As String, arrVendorNumbers As

Variant, includeInventory As Boolean) As String
'
' 10/6/13 - JW - factored and extended for new hierarchies
' 11/11/13 - JW - adapted to use array of vendor numbers rather than vendor
names
' 11/18/13 - JW - modified to restrict the "All" anchor nodes of product for
all measures
' 11/20/13 - JW - extended to suppress results for the ProdMG_MerchGrp,
ProdBrand_MerchGrp, VendMG_MerchGrp, VendBrand_MerchGrp levels.
' Note that the last two groups are at level 2 of hierarchy -
meaning a user might see results at level 1 and level 3
' but not at level 2. Goofy.
' 2/12/14 - JW - removed access to the the three product hierachies that start
with the Vendor level (levels that start with Vend*)
' 3/26/14 - JW - restored access to one of the three product hierarchies (All
Products by Vendor-Merch Group) removed on 2/12. Arrgh.
'
' note that vendor names can be an array of vendor names
'
Dim s As String

'
' CELLSECURITY:BaseSalesMeasures, Inventory and Restricted Product Attributes
'
' see CSBlockProductL2 for cell security note
'

' 2/12/14 - removed these two clauses:

' "<RDIEntry>Except Group(VendMG_MerchGrp)</RDIEntry>" & vbCrLf & _
' "<RDIEntry>Except Group(VendBrand_MerchGrp)</RDIEntry>" & vbCrLf & _
'
' 3/26/14 - partially restore access to the Vendor anchor hierarchies blocked
on 2/12 (VendMG*)
'
' 4/13/14 - added cMeasuresForProductCustomAggHack
'
s = "<SecurityDomain>" & vbCrLf & _
"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _

"<RDIEntry>DescendantsOf(""CELLSECURITY:BaseSalesMeasures"")</RDIEntry>" & vbCrLf &

_
"<RDIEntry>DescendantsOf(""CELLSECURITY:Sales and Units
Datamaps"")</RDIEntry>" & _
cMeasuresForProductCustomAggHack & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except RootsOf(Product)</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except Group(ProdMG_MerchGrp)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Except Group(ProdBrand_MerchGrp)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>Except Group(VendMG_MerchGrp)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Except ""All Products by Merch Group
Benchmarking""</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except DescendantsOf(""All Products by Merch Group
Benchmarking"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
CSInnerGeographyRestriction(geogNoRestrictions) & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf
'
' CELLSECURITY:RegPromoSalesMeasures
'
' 2/2/14 - removed "<RDIEntry>DescendantsOf(""Restricted Product
Attributes"")</RDIEntry>" & vbCrLf & _
' from Measures grouping immediately below.
'
' 2/12/14 - removed these two clauses:
' "<RDIEntry>Except Group(VendMG_MerchGrp)</RDIEntry>" & vbCrLf & _
' "<RDIEntry>Except Group(VendBrand_MerchGrp)</RDIEntry>" & vbCrLf & _
'
' 2/13/14 - changed to use CELLSECURITY:RegPromoSalesAndUnitsDatamaps rather
than
' CELLSECURITY:Sales and Units Datamaps to get around AS custom agg bug
with cell security
'
'
' 3/26/14 - partially restore access to the Vendor anchor hierarchies blocked
on 2/12 (VendMG*)

s = s & "<SecurityDomain>" & vbCrLf & _

"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _

"<RDIEntry>DescendantsOf(""CELLSECURITY:RegPromoSalesMeasures"")</RDIEntry>" &
vbCrLf & _

"<RDIEntry>DescendantsOf(""CELLSECURITY:RegPromoSalesAndUnitsDatamaps"")</
RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except RootsOf(Product)</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except Group(ProdMG_MerchGrp)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Except Group(ProdBrand_MerchGrp)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>Except Group(VendMG_MerchGrp)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Except ""All Products by Merch Group
Benchmarking""</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except DescendantsOf(""All Products by Merch Group
Benchmarking"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
CSInnerGeographyRestriction(geogRestrictCityDistrictDCandStore) & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf

'
' Scan Margin, Scan Margin TPR and restricted product attributes - from pay
vendor, is restricted to vendor associated with user group. But allowed for all
members of the
' Merchant Group, Category and Subcategory levels which are found about Pay
Vendor in the Product by Merch Group hierarchy. Ditto for the same levels
' in the "All Products by Brand" hierarchy.
'
'
' as part of the 11/18/13 changes - removed this block of product RDI entries:
'
'"<RDIEntry>""All Products by Merch Group""</RDIEntry>" & vbCrLf & _
' "<RDIEntry>""All Products by Vendor-Merch Group""</RDIEntry>"
& vbCrLf & _
' "<RDIEntry>""All Products by Vendor""</RDIEntry>" & vbCrLf & _
' "<RDIEntry>""All Products by Brand""</RDIEntry>" & vbCrLf & _
' "<RDIEntry>""All Products by Vendor-Brand""</RDIEntry>" &
vbCrLf & _

'
' 2/2/2014 - removed from Measures grouping immediately below
'
' "<RDIEntry>DescendantsOf(""Restricted Product Attributes"")</RDIEntry>" &
vbCrLf & _
'
' 1/24/15 - added Margin Contribution measures

s = s & "<SecurityDomain>" & vbCrLf & _

"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Scan Margin"")</RDIEntry>" & vbCrLf
& _
"<RDIEntry>DescendantsOf(""Scan Margin TPR"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>DescendantsOf(""Margin Contribution"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>DescendantsOf(""CELLSECURITY:Scan Margin
Datamaps"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf & _
"<RDIEntry>Group(ProdMG_MerchGrp)</RDIEntry>" & vbCrLf & _
"<RDIEntry>Group(ProdMG_Category)</RDIEntry>" & vbCrLf & _
"<RDIEntry>Group(ProdMG_SubCat)</RDIEntry>" & vbCrLf & _
"<RDIEntry>Group(ProdMG_Segment)</RDIEntry>" & vbCrLf & _
 "<RDIEntry>Group(ProdBrand_MerchGrp)</RDIEntry>" & vbCrLf & _
"<RDIEntry>Group(ProdBrand_Category)</RDIEntry>" & vbCrLf & _
"<RDIEntry>Group(ProdBrand_SubCat)</RDIEntry>" & vbCrLf & _
"<RDIEntry>Group(ProdBrand_Segment)</RDIEntry>" & vbCrLf

s = s & CSInnerProductFilteredVendorClause(arrVendorNumbers)

s = s & "<RDIEntry>Except ""All Products by Merch Group

Benchmarking""</RDIEntry>" & vbCrLf
s = s & "<RDIEntry>Except DescendantsOf(""All Products by Merch
Group Benchmarking"")</RDIEntry>" & vbCrLf

s = s & "</Dimension>" & vbCrLf & _

CSInnerGeographyRestriction(geogRestrictStoreOnly) & vbCrLf
& _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf
'
' Sales and Units TPR, can't be combined with Sales and Units, due to geog
restriction
'
' 2/12/14 - removed these clauses:
' "<RDIEntry>Except Group(VendMG_MerchGrp)</RDIEntry>" & vbCrLf & _
' "<RDIEntry>Except Group(VendBrand_MerchGrp)</RDIEntry>" & vbCrLf & _
'
' 3/26/14 - partially restore access to the Vendor anchor hierarchies blocked
on 2/12 (VendMG*)
'

s = s & "<SecurityDomain>" & vbCrLf & _

"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Sales and Units TPR"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>DescendantsOf(""CELLSECURITY:Sales and Units TPR
Datamaps"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except RootsOf(Product)</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except Group(ProdMG_MerchGrp)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Except Group(ProdBrand_MerchGrp)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>Except Group(VendMG_MerchGrp)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Except ""All Products by Merch Group
Benchmarking""</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except DescendantsOf(""All Products by Merch Group
Benchmarking"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
CSInnerGeographyRestriction(geogRestrictStoreOnly) & vbCrLf & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf
 '
' Inventory - only available for purchased pay vendors, can't be combined with
POS
' groups for this security level, as they are available at all levels of
product
'
' 10/28/13 - corrected inventory restriction. Was restricted, should not have
been.
' 20190302
If includeInventory Then
If PremiumAccess Then
s = s & "<SecurityDomain>" & vbCrLf & _
"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Inventory"")</RDIEntry>" & vbCrLf &
_
"<RDIEntry>DescendantsOf(""CELLSECURITY:Inventory
Datamaps"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Purchase Orders :
FOLDER"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Appointment : FOLDER"")</RDIEntry>"
& vbCrLf & _
"<RDIEntry>DescendantsOf(""Planned Delivery :
FOLDER"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Display : FOLDER"")</RDIEntry>" &
vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf

s = s & CSInnerProductFilteredVendorClause(arrVendorNumbers)

s = s & "<RDIEntry>Except ""All Products by Merch Group

Benchmarking""</RDIEntry>" & vbCrLf
s = s & "<RDIEntry>Except DescendantsOf(""All Products by Merch
Group Benchmarking"")</RDIEntry>" & vbCrLf

s = s & "</Dimension>" & vbCrLf & _

CSInnerGeographyRestriction(geogNoRestrictions) & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf
End If
Else
s = s & "<SecurityDomain>" & vbCrLf & _
"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Inventory"")</RDIEntry>" & vbCrLf &
_
"<RDIEntry>DescendantsOf(""CELLSECURITY:Inventory
Datamaps"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf

s = s & CSInnerProductFilteredVendorClause(arrVendorNumbers)
 s = s & "<RDIEntry>Except ""All Products by Merch Group
Benchmarking""</RDIEntry>" & vbCrLf
s = s & "<RDIEntry>Except DescendantsOf(""All Products by Merch
Group Benchmarking"")</RDIEntry>" & vbCrLf

s = s & "</Dimension>" & vbCrLf & _

CSInnerGeographyRestriction(geogNoRestrictions) & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf
End If ' includeInventory

s = s & CSUnrestrictedAttributeMeasuresClause

s = Replace(s, "@@LDAP_GROUP@@", ldapGroupName)

CSBlockProductL3 = s
End Function

Private Function CS_AddPremiumAccess() As String

CS_AddPremiumAccess = "<SecurityDomain>" & vbCrLf & _

"<Accessor type=""Group"">@@LDAP_TOKEN@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Gas Measures : FOLDER"")</RDIEntry>"
& vbCrLf & _
"<RDIEntry>DescendantsOf(""Weather Measures :
FOLDER"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except ""All Products by Merch Group
Benchmarking""</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except DescendantsOf(""All Products by Merch Group
Benchmarking"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Geography"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf

End Function

Private Function CS_BenchMarkAccess() As String

CS_BenchMarkAccess = "<SecurityDomain>" & vbCrLf & _

"<Accessor type=""Group"">@@LDAP_TOKEN@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Measures Exposed for Benchmarking
Collection"")</RDIEntry>" & vbCrLf & _
 "</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf & _
"<RDIEntry>""All Products by Merch Group
Benchmarking""</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(""All Products by Merch Group
Benchmarking"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Geography"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf

End Function

Private Function CS_GenericAccess() As String

CS_GenericAccess = "<SecurityDomain>" & vbCrLf & _

"<Accessor type=""Group"">@@LDAP_TOKEN@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Weather Measures :
FOLDER"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Gas Measures : FOLDER"")</RDIEntry>"
& vbCrLf & _
"<RDIEntry>DescendantsOf(""Purchase Order
Attributes"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Appointment
Attributes"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Display Content
Attributes"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Dimension Keys"")</RDIEntry>" &
vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Geography"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Display Content"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except RootsOf(""Display Content"")</RDIEntry>"
& vbCrLf & _
"</Dimension>" & vbCrLf

End Function

Private Function CS_GenericAccess_Split() As String

CS_GenericAccess_Split = "<Dimension name=""Purchase Order"">" & vbCrLf & _

"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except RootsOf(""Purchase Order"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>Except Group(""PO Status2"")</RDIEntry>" &
vbCrLf & _
"</Dimension>" & vbCrLf & _
 "<Dimension name=""Display Content Vendor"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except RootsOf(""Display Content
Vendor"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf

End Function

Private Function CSBlockProductL1A(ldapGroupName As String, arrVendorNumbers As

Variant, includeInventory As Boolean) As String

'
' 10/6/13 - JW - added support for the newly modified "All Products by Vendor"
(Vend_* levels)
' and "All Products by Brand" (ProdBrand_* levels) hierarchies.
'
' 11/11/13 - JW - adapted to use array of vendor numbers, rather than names
'
' 3/27/14 - JW - as part of restoring access to the All Products by Vendor-
Merch Group hierarchy (VendMG*),
' CVS introduced a new requirement that POS measures not report
against the VendMG hierarchy at all.
' Bizarre, since the hierarchy is already restricted to specified pay
vendor.
'
' 8/21/14 - JW - reviewed procedure to determine whether security hack for
explicit access to
' "Vendor-PayVendor-Category-StoreBrand" product member - else time
custom aggs
' will sometimes not work is needed here. Deteremine that it was not
needed directly in this procedure, but is
' needed in the CSInnerProductFilteredVendorClause() routine called from
here.
'
' note that vendor names can be an array of vendor names
' L1A applies the same product level restrictions for all of the POS measure
groups. But Sales and Units
' still needs its own block, as it doesn't carry the same geography
restriction that the other
' groups do.
'
Dim s As String
'
' CELLSECURITY:BaseSalesMeasures, Inventory and Restricted Product Attributes
'
' we can't allow custom aggs for L1A even for Sales and Units, as the upper
levels are restricted, and
' custom aggs might allow an end run
'
' 4/13/14 - added cMeasuresForProductCustomAggHack
'
s = "<SecurityDomain>" & vbCrLf & _
"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
 "<Dimension name=""Measures"">" & vbCrLf & _

"<RDIEntry>DescendantsOf(""CELLSECURITY:BaseSalesMeasures"")</RDIEntry>" & vbCrLf &

_
"<RDIEntry>DescendantsOf(""CELLSECURITY:Sales and Units
Datamaps"")</RDIEntry>" & vbCrLf & _
cMeasuresForProductCustomAggHack
' 20190302
If includeInventory Then
If PremiumAccess Then
s = s & "<RDIEntry>DescendantsOf(""Inventory"")</RDIEntry>" & vbCrLf &
_
"<RDIEntry>DescendantsOf(""CELLSECURITY:Inventory
Datamaps"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Purchase Orders :
FOLDER"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Appointment : FOLDER"")</RDIEntry>"
& vbCrLf & _
"<RDIEntry>DescendantsOf(""Planned Delivery :
FOLDER"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Display : FOLDER"")</RDIEntry>"
Else
s = s & "<RDIEntry>DescendantsOf(""Inventory"")</RDIEntry>" & vbCrLf &
_
"<RDIEntry>DescendantsOf(""CELLSECURITY:Inventory
Datamaps"")</RDIEntry>"
End If
End If

s = s & "</Dimension>" & vbCrLf & _

"<Dimension name=""Product"">" & vbCrLf

s = s & CSInnerProductFilteredVendorClause(arrVendorNumbers)
s = s & "<RDIEntry>Except ""All Products by Merch Group
Benchmarking""</RDIEntry>" & vbCrLf
s = s & "<RDIEntry>Except DescendantsOf(""All Products by Merch
Group Benchmarking"")</RDIEntry>" & vbCrLf
s = s & "</Dimension>" & vbCrLf & _
CSInnerGeographyRestriction(geogNoRestrictions) & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf

'
' CELLSECURITY:RegPromoSalesMeasures
'
' we can't allow custom aggs for L1A even for Sales and Units, as the upper
levels are restricted, and
' custom aggs might allow an end run
'
' 2/2/2014 - removed "<RDIEntry>DescendantsOf(""Restricted Product
Attributes"")</RDIEntry>" & vbCrLf & _

' 2/13/14 - changed to use CELLSECURITY:RegPromoSalesAndUnitsDatamaps rather

than
' CELLSECURITY:Sales and Units Datamaps to get around AS custom agg bug
with cell security
'
s = s & "<SecurityDomain>" & vbCrLf & _
"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
 "<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _

"<RDIEntry>DescendantsOf(""CELLSECURITY:RegPromoSalesMeasures"")</RDIEntry>" &
vbCrLf & _

"<RDIEntry>DescendantsOf(""CELLSECURITY:RegPromoSalesAndUnitsDatamaps"")</
RDIEntry>"

s = s & "</Dimension>" & vbCrLf & _

"<Dimension name=""Product"">" & vbCrLf

s = s & CSInnerProductFilteredVendorClause(arrVendorNumbers)
s = s & "<RDIEntry>Except ""All Products by Merch Group
Benchmarking""</RDIEntry>" & vbCrLf
s = s & "<RDIEntry>Except DescendantsOf(""All Products by Merch
Group Benchmarking"")</RDIEntry>" & vbCrLf

s = s & "</Dimension>" & vbCrLf & _

CSInnerGeographyRestriction(geogRestrictCityDistrictDCandStore) & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf

'
' Scan Margin, Scan Margin TPR, Sales and Units TPR
' must be separate from the other POS measure groups, as these are not
' allowed at the leaves of geography
' 1/24/15 - added Margin Contribution measures
'
s = s & "<SecurityDomain>" & vbCrLf & _
"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Scan Margin"")</RDIEntry>" & vbCrLf
& _
"<RDIEntry>DescendantsOf(""Scan Margin TPR"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>DescendantsOf(""Margin Contribution"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>DescendantsOf(""CELLSECURITY:Scan Margin
Datamaps"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Sales and Units TPR"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>DescendantsOf(""CELLSECURITY:Sales and Units TPR
Datamaps"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf

s = s & CSInnerProductFilteredVendorClause(arrVendorNumbers)

s = s & "<RDIEntry>Except ""All Products by Merch Group

Benchmarking""</RDIEntry>" & vbCrLf
 s = s & "<RDIEntry>Except DescendantsOf(""All Products by Merch
Group Benchmarking"")</RDIEntry>" & vbCrLf

s = s & "</Dimension>" & vbCrLf & _

CSInnerGeographyRestriction(geogRestrictStoreOnly) & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf

'
' add the unrestricted measure attributes
'

s = s & CSUnrestrictedAttributeMeasuresClause

s = Replace(s, "@@LDAP_GROUP@@", ldapGroupName)

CSBlockProductL1A = s

End Function

Private Function CSInnerProductFilteredVendorClause(arrVendorNumbers As Variant,

Optional ExcludeVendMGHierarchy As Boolean = False, Optional IncludeAncestors As
Boolean = False) As String
' Predicated on pay vendor.
'
' 10/6/13 - JW - factored out of calling routine
' 11/11/13 - JW - converted to expect arrays of vendor numbers rather than
vendor name plus number
' 11/20/13 - JW - added exception to prevent access to the VendMG_MerchGrp and
VendBrand_MerchGrp levels, which fall under pay vendor
'
' 2/12/14 - JW - removed access to the the three product hierachies that start
with the Vendor level (levels that start with Vend*)
' 3/26/14 - JW - restored access to one of the three product hierarchies (All
Products by Vendor-Merch Group) removed on 2/12. Arrgh.
'
' 3/27/14 - JW - as part of restoring access to the All Products by Vendor-
Merch Group hierarchy (VendMG*),
' CVS introduced a new requirement that POS measures not report
against the VendMG hierarchy at all.
' Bizarre, since the hierarchy is already restricted to specified pay
vendor.
' 6/6/14 - converted to use RDI helper function. Added IncludeAncestors
argument - by default always includes descendants, but new
' corner case makes it convenient to include ancestors in some cases

'
Dim aVendorNumber As Variant

Dim ancestorArg As Integer

If IncludeAncestors Then
ancestorArg = 0 ' all ancestors
Else
ancestorArg = -1 ' no ancestors
End If
 '
' was:
' CSInnerProductFilteredVendorClause = CSInnerProductFilteredVendorClause & _
' "<RDIEntry>Filter(Group(ProdMG_PayVendor), ""ATTRIBUTE
""ProdMG_PayVendor"".""VendorNumber"" = '" & aVendorNumber & "'"")</RDIEntry>" &
vbCrLf & _
' "<RDIEntry>DescendantsOf(Filter(Group(ProdMG_PayVendor), ""ATTRIBUTE
""ProdMG_PayVendor"".""VendorNumber"" = '" & aVendorNumber & "'""))</RDIEntry>" &
vbCrLf & _
' "<RDIEntry>Filter(Group(Vend_PayVendor), ""ATTRIBUTE
""Vend_PayVendor"".""VendorNumber"" = '" & aVendorNumber & "'"")</RDIEntry>" &
vbCrLf & _
' "<RDIEntry>DescendantsOf(Filter(Group(Vend_PayVendor), ""ATTRIBUTE
""Vend_PayVendor"".""VendorNumber"" = '" & aVendorNumber & "'""))</RDIEntry>" &
vbCrLf & _
' "<RDIEntry>Filter(Group(ProdBrand_PayVendor), ""ATTRIBUTE
""ProdBrand_PayVendor"".""VendorNumber"" = '" & aVendorNumber & "'"")</RDIEntry>" &
vbCrLf & _
' "<RDIEntry>DescendantsOf(Filter(Group(ProdBrand_PayVendor), ""ATTRIBUTE
""ProdBrand_PayVendor"".""VendorNumber"" = '" & aVendorNumber & "'""))</RDIEntry>"
& vbCrLf & _
' "<RDIEntry>Filter(Group(VendBrand_PayVendor), ""ATTRIBUTE
""VendBrand_PayVendor"".""VendorNumber"" = '" & aVendorNumber & "'"")</RDIEntry>" &
vbCrLf & _
' "<RDIEntry>DescendantsOf(Filter(Group(VendBrand_PayVendor), ""ATTRIBUTE
""VendBrand_PayVendor"".""VendorNumber"" = '" & aVendorNumber & "'""))</RDIEntry>"
& vbCrLf
'
' ' 3/26/14 - partially restore access to the Vendor anchor hierarchies blocked
on 2/12 (VendMG clauses)
' 3/27/14 - added ExcludeVendMG logic. Blech.
' 6/20/16 - Sri - Added ProdBC_PayVendor line
'
If ExcludeVendMGHierarchy Then
For Each aVendorNumber In arrVendorNumbers
CSInnerProductFilteredVendorClause = CSInnerProductFilteredVendorClause
& _
RDIFilterClause("ProdMG_PayVendor", "VendorNumber", aVendorNumber,
ancestorArg, 0) & _
RDIFilterClause("ProdBrand_PayVendor", "VendorNumber",
aVendorNumber, ancestorArg, 0) & _
RDIFilterClause("ProdBC_PayVendor", "VendorNumber", aVendorNumber,
ancestorArg, 0)

'"<RDIEntry>Filter(Group(ProdMG_PayVendor), ""ATTRIBUTE
""ProdMG_PayVendor"".""VendorNumber"" = '" & aVendorNumber & "'"")</RDIEntry>" &
vbCrLf & _
'"<RDIEntry>DescendantsOf(Filter(Group(ProdMG_PayVendor),
""ATTRIBUTE ""ProdMG_PayVendor"".""VendorNumber"" = '" & aVendorNumber &
"'""))</RDIEntry>" & vbCrLf & _
'"<RDIEntry>Filter(Group(ProdBrand_PayVendor), ""ATTRIBUTE
""ProdBrand_PayVendor"".""VendorNumber"" = '" & aVendorNumber & "'"")</RDIEntry>" &
vbCrLf & _
'"<RDIEntry>DescendantsOf(Filter(Group(ProdBrand_PayVendor),
""ATTRIBUTE ""ProdBrand_PayVendor"".""VendorNumber"" = '" & aVendorNumber &
"'""))</RDIEntry>" & vbCrLf
 Next aVendorNumber
Else ' include
'6/20/16 - Sri - Added ProdBC_PayVendor line
'
' 3/2/19 - JW - added support for All Products by Vendor (VEND_*) which had
been removed back in 2014
'
For Each aVendorNumber In arrVendorNumbers
CSInnerProductFilteredVendorClause = CSInnerProductFilteredVendorClause
& _
RDIFilterClause("ProdMG_PayVendor", "VendorNumber", aVendorNumber,
ancestorArg, 0) & _
RDIFilterClause("ProdBrand_PayVendor", "VendorNumber",
aVendorNumber, ancestorArg, 0) & _
RDIFilterClause("VendMG_PayVendor", "VendorNumber", aVendorNumber,
ancestorArg, 0) & _
RDIFilterClause("ProdBC_PayVendor", "VendorNumber", aVendorNumber,
ancestorArg, 0) & _
RDIFilterClause("Vend_PayVendor", "VendorNumber", aVendorNumber,
ancestorArg, 0) & _
RDIFilterClause("LatestVend_PayVendor", "VendorNumber",
aVendorNumber, ancestorArg, 0)
'"<RDIEntry>Filter(Group(ProdMG_PayVendor), ""ATTRIBUTE
""ProdMG_PayVendor"".""VendorNumber"" = '" & aVendorNumber & "'"")</RDIEntry>" &
vbCrLf & _
'"<RDIEntry>DescendantsOf(Filter(Group(ProdMG_PayVendor),
""ATTRIBUTE ""ProdMG_PayVendor"".""VendorNumber"" = '" & aVendorNumber &
"'""))</RDIEntry>" & vbCrLf & _
'"<RDIEntry>Filter(Group(ProdBrand_PayVendor), ""ATTRIBUTE
""ProdBrand_PayVendor"".""VendorNumber"" = '" & aVendorNumber & "'"")</RDIEntry>" &
vbCrLf & _
'"<RDIEntry>DescendantsOf(Filter(Group(ProdBrand_PayVendor),
""ATTRIBUTE ""ProdBrand_PayVendor"".""VendorNumber"" = '" & aVendorNumber &
"'""))</RDIEntry>" & vbCrLf & _
'"<RDIEntry>Filter(Group(VendMG_PayVendor), ""ATTRIBUTE
""VendMG_PayVendor"".""VendorNumber"" = '" & aVendorNumber & "'"")</RDIEntry>" &
vbCrLf & _
'"<RDIEntry>DescendantsOf(Filter(Group(VendMG_PayVendor),
""ATTRIBUTE ""VendMG_PayVendor"".""VendorNumber"" = '" & aVendorNumber &
"'""))</RDIEntry>" & vbCrLf
Next aVendorNumber
End If ' include VendMG

' 2/12/14 - CVS no longer want vendor hierarchies to be visible - I'm leaving
the code block in case they later change their minds
' note that the vendor hierarchies all have level names starting with Vend*

' 3/26/14 - partially restore access to the Vendor anchor hierarchies blocked
on 2/12
' still ommitting: "<RDIEntry>Except Group(VendBrand_MerchGrp)</RDIEntry>" &
vbCrLf
'
' 3/27/14 - added exclude logic - this little block could be consolidated
above, but I strongly suspect CVS will end up reversing
' themselves on this weird exclusion, and so keep this separate in
case the if/then/else block folds back into a single block
' above
'
If Not ExcludeVendMGHierarchy Then
 CSInnerProductFilteredVendorClause = CSInnerProductFilteredVendorClause & _
"<RDIEntry>Except Group(VendMG_MerchGrp)</RDIEntry>" & vbCrLf
'"<RDIEntry>Except ""All Products by Merch Group
Benchmarking""</RDIEntry>" & vbCrLf & _
'"<RDIEntry>Except DescendantsOf(""All Products by Merch Group
Benchmarking"")</RDIEntry>" & vbCrLf
' "<RDIEntry>Except Group(VendBrand_MerchGrp)</RDIEntry>" & vbCrLf
End If
'
' 8/21/14 - added explicit access to "Vendor-PayVendor-Category-StoreBrand"
product member - else time custom aggs
' will sometimes not work.
'
CSInnerProductFilteredVendorClause = "<RDIEntry>""Vendor-PayVendor-Category-
StoreBrand""</RDIEntry>" & vbCrLf & _
CSInnerProductFilteredVendorClause
End Function
Private Function CSInnerGeographyRestriction(restriction As
enumGeographyRestriction) As String
' 2/12/14 - JW - removed access to the the three product hierachies that
start with the Vendor level (levels that start with Vend*)
' 2/24/14 - JW - added logic to deal with new Store Cluster hierarchy
(entries with StoreCluster_Store)

Select Case restriction

Case geogNoRestrictions
CSInnerGeographyRestriction = _
"<Dimension name=""Geography"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf
Case geogRestrictStoreOnly

If ModelHasDistributionCenterAsDimension Then
CSInnerGeographyRestriction = "<Dimension name=""Geography"">" &
vbCrLf & _
"<RDIEntry>except
group(StateCounty_Store)</RDIEntry>" & vbCrLf & _
"<RDIEntry>except group(State_Store)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>except group(AdRegion_Store)</RDIEntry>"
& vbCrLf & _
"<RDIEntry>except group(DMA_Store)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>except group(Area_Store)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>except
group(StoreCluster_Store)</RDIEntry>" & vbCrLf & _
"<RDIEntry>except group(Store)</RDIEntry>" & vbCrLf
& _
"<RDIEntry>except
group(withYmasNavarro_Store)</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf
Else
CSInnerGeographyRestriction = "<Dimension name=""Geography"">" &
vbCrLf & _
"<RDIEntry>except
group(StateCounty_Store)</RDIEntry>" & vbCrLf & _
"<RDIEntry>except group(State_Store)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>except group(AdRegion_Store)</RDIEntry>"
& vbCrLf & _
"<RDIEntry>except group(DMA_Store)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>except group(Area_Store)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>except group(DC_Store)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>except
group(StoreCluster_Store)</RDIEntry>" & vbCrLf & _
"<RDIEntry>except group(Store)</RDIEntry>" & vbCrLf
& _
"<RDIEntry>except
group(withYmasNavarro_Store)</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf
End If
Case geogRestrictCityDistrictDCandStore

If ModelHasDistributionCenterAsDimension Then

CSInnerGeographyRestriction = "<Dimension name=""Geography"">" &

vbCrLf & _
"<RDIEntry>except
group(StateCounty_City)</RDIEntry>" & vbCrLf & _
"<RDIEntry>except
group(StateCounty_Store)</RDIEntry>" & vbCrLf & _
"<RDIEntry>except group(State_City)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>except group(State_Store)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>except group(Area_District)</RDIEntry>"
& vbCrLf & _
"<RDIEntry>except group(Area_Store)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>except group(AdRegion_Store)</RDIEntry>"
& vbCrLf & _
"<RDIEntry>except group(DMA_Store)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>except
group(StoreCluster_Store)</RDIEntry>" & vbCrLf & _
"<RDIEntry>except group(Store)</RDIEntry>" & vbCrLf
& _
"<RDIEntry>except
group(withYmasNavarro_Store)</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf
Else

CSInnerGeographyRestriction = "<Dimension name=""Geography"">" &

vbCrLf & _
"<RDIEntry>except
group(StateCounty_City)</RDIEntry>" & vbCrLf & _
"<RDIEntry>except
group(StateCounty_Store)</RDIEntry>" & vbCrLf & _
"<RDIEntry>except group(State_City)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>except group(State_Store)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>except group(Area_District)</RDIEntry>"
& vbCrLf & _
"<RDIEntry>except group(Area_Store)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>except group(DCState_City)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>except group(DCState_DC)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>except group(AdRegion_Store)</RDIEntry>"
& vbCrLf & _
"<RDIEntry>except group(DMA_Store)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>except
group(StoreCluster_Store)</RDIEntry>" & vbCrLf & _
"<RDIEntry>except group(DC_Store)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>except group(Store)</RDIEntry>" & vbCrLf
& _
"<RDIEntry>except
group(withYmasNavarro_Store)</RDIEntry>" & vbCrLf & _
"<RDIEntry>~</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf
End If
Case Else
MsgBox "Invalid argument passed to CSInnerGeographyRestriction()",
vbCritical, "Internal error"
End Select

End Function

Private Function CSUnrestrictedAttributeMeasuresClause() As String

'
' all but one attribute measure group are unrestricted
' 11/18/13 - changed to restrict these measures at the "all" anchor nodes in
product
' 11/20/13 - JW - extended to suppress results for the ProdMG_MerchGrp,
ProdBrand_MerchGrp, VendMG_MerchGrp, VendBrand_MerchGrp levels.
' Note that the last two groups are at level 2 of hierarchy -
meaning a user might see results at level 1 and level 3
' but not at level 2. Goofy. '
' I can't imagine this is important, but just to be consistent...
' 2/12/14 - JW - removed access to the the three product hierachies that
start with the Vendor level (levels that start with Vend*)
' 3/26/14 - JW - restored access to one of the three product hierarchies (All
Products by Vendor-Merch Group) removed on 2/12. Arrgh.
'
' removed these clauses:
' "<RDIEntry>Except Group(VendMG_MerchGrp)</RDIEntry>" & vbCrLf & _
' "<RDIEntry>Except Group(VendBrand_MerchGrp)</RDIEntry>" & vbCrLf & _
'
' 3/26/14 - partially restore access to the Vendor anchor hierarchies blocked
on 2/12 (VendMG*)
'
CSUnrestrictedAttributeMeasuresClause = "<SecurityDomain>" & vbCrLf & _
"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
 "<Dimension name=""Measures"">" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Product Attributes"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>DescendantsOf(""Store Attributes"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>DescendantsOf(""Time Attributes"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>DescendantsOf(""DC Attributes"")</RDIEntry>" &
vbCrLf & _

"<RDIEntry>DescendantsOf(""CELLSECURITY:AttributeDatamaps"")</RDIEntry>" & vbCrLf &

_
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except RootsOf(Product)</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except Group(ProdMG_MerchGrp)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Except Group(ProdBrand_MerchGrp)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>Except Group(VendMG_MerchGrp)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Except ""All Products by Merch Group
Benchmarking""</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except DescendantsOf(""All Products by Merch Group
Benchmarking"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
CSInnerGeographyRestriction(geogNoRestrictions) & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf
End Function

Private Function CSBlockProductL1_OR_L2(ldapGroupName As String, arrVendorNumbers

As Variant, includeInventory As Boolean) As String
'
' 10/6/13 - JW - factored and added support for two additional hierarhies
' 11/11/13 - JW - updated to work with arrays of vendornumbers, rather than
vendor name plus number
' 11/18/13 - JW - extended to prevent "All" anchor nodes from returning results
' 11/20/13 - JW - extended to suppress results for the ProdMG_MerchGrp,
ProdBrand_MerchGrp, VendMG_MerchGrp, VendBrand_MerchGrp levels.
' Note that the last two groups are at level 2 of hierarchy -
meaning a user might see results at level 1 and level 3
' but not at level 2. Goofy. '
' 2/12/14 - JW - removed access to the the three product hierachies that start
with the Vendor level (levels that start with Vend*)
' 3/26/14 - JW - restored access to one of the three product hierarchies (All
Products by Vendor-Merch Group) removed on 2/12. Arrgh.
'
' 8/21/14 - JW - reviewed procedure to determine whether security hack for
explicit access to
' "Vendor-PayVendor-Category-StoreBrand" product member - else time
custom aggs
' will sometimes not work is needed here. Deteremine that it was not
needed directly in this procedure, but is
' needed in the CSInnerProductFilteredVendorClause() routine called from
here.
' note that vendor names can be an array of vendor names
'
 Dim s As String
'
' CELLSECURITY:BaseSalesMeasures, Inventory and Restricted Product Attributes
'
' note the CELLSECURITY ref to the underlying datamaps - necessary to make
custom aggs work with
' cell security. Which is totally bogus
'
'
' 2/12/14 - removed these two clauses:
' "<RDIEntry>Except Group(VendMG_MerchGrp)</RDIEntry>" & vbCrLf & _
' "<RDIEntry>Except Group(VendBrand_MerchGrp)</RDIEntry>" & vbCrLf & _
' 3/26/14 - partially restore access to the Vendor anchor hierarchies blocked
on 2/12 (VendMG*)
'
' 4/13/14 - added cMeasuresForProductCustomAggHack
'
s = "<SecurityDomain>" & vbCrLf & _
"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _

"<RDIEntry>DescendantsOf(""CELLSECURITY:BaseSalesMeasures"")</RDIEntry>" & vbCrLf &

_
"<RDIEntry>DescendantsOf(""CELLSECURITY:Sales and Units
Datamaps"")</RDIEntry>" & vbCrLf & _
cMeasuresForProductCustomAggHack & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except RootsOf(Product)</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except Group(ProdMG_MerchGrp)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Except Group(ProdBrand_MerchGrp)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>Except Group(VendMG_MerchGrp)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Except ""All Products by Merch Group
Benchmarking""</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except DescendantsOf(""All Products by Merch Group
Benchmarking"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
CSInnerGeographyRestriction(geogNoRestrictions) & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf

'
' CELLSECURITY:RegPromoSalesMeasures
'
' 2/2/14 - removed "<RDIEntry>DescendantsOf(""Restricted Product
Attributes"")</RDIEntry>" & vbCrLf & _
' 2/12/14 - removed these two clauses:
' "<RDIEntry>Except Group(VendMG_MerchGrp)</RDIEntry>" & vbCrLf & _
' "<RDIEntry>Except Group(VendBrand_MerchGrp)</RDIEntry>" & vbCrLf & _
 ' 2/13/14 - changed to use CELLSECURITY:RegPromoSalesAndUnitsDatamaps rather
than
' CELLSECURITY:Sales and Units Datamaps to get around AS custom agg bug
with cell security
'
' 3/26/14 - partially restore access to the Vendor anchor hierarchies blocked
on 2/12 (VendMG*)
'
' Note the geography restriction "geogRestrictCityDistrictDCandStore"
corresponds to security level
' yellow in the security bible.
s = s & "<SecurityDomain>" & vbCrLf & _
"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _

"<RDIEntry>DescendantsOf(""CELLSECURITY:RegPromoSalesMeasures"")</RDIEntry>" &
vbCrLf & _

"<RDIEntry>DescendantsOf(""CELLSECURITY:RegPromoSalesAndUnitsDatamaps"")</
RDIEntry>" & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except RootsOf(Product)</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except Group(ProdMG_MerchGrp)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Except Group(ProdBrand_MerchGrp)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>Except Group(VendMG_MerchGrp)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Except ""All Products by Merch Group
Benchmarking""</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except DescendantsOf(""All Products by Merch Group
Benchmarking"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
CSInnerGeographyRestriction(geogRestrictCityDistrictDCandStore) & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf

'==================================================================================
============
'
' FROM HERE ON DOWN, IS THE SAME AS CSBLOCKL1_AND_L2 - SHOULD BE FACTORED INTO
COMMON ROUTINE
'

'==================================================================================
============

'
' Scan Margin, Scan Margin TPR and Restricted Product Attributes
'
' no datamap reference here - we don't want custom aggs to work with cell
security for these
' measures yet
'
' 2/2/14 - removed "<RDIEntry>DescendantsOf(""Restricted Product
Attributes"")</RDIEntry>" & vbCrLf & _
'
' 1/24/15 - added Margin Contribution measures

s = s & "<SecurityDomain>" & vbCrLf & _

"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Scan Margin"")</RDIEntry>" & vbCrLf
& _
"<RDIEntry>DescendantsOf(""Scan Margin TPR"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>DescendantsOf(""Margin Contribution"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>DescendantsOf(""CELLSECURITY:Scan Margin
Datamaps"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf

s = s & CSInnerProductFilteredVendorClause(arrVendorNumbers)

s = s & "<RDIEntry>Except ""All Products by Merch Group

Benchmarking""</RDIEntry>" & vbCrLf
s = s & "<RDIEntry>Except DescendantsOf(""All Products by Merch
Group Benchmarking"")</RDIEntry>" & vbCrLf

s = s & "</Dimension>" & vbCrLf & _

CSInnerGeographyRestriction(geogRestrictStoreOnly) & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf
'
' Sales and Units TPR (can't be combined with Sales and Units, due to
additional geog restriction)
'
' Custom aggs with cell security are ok for these measures
'
' 2/12/14 - removed these two clauses:
' "<RDIEntry>Except Group(VendMG_MerchGrp)</RDIEntry>" & vbCrLf & _
' "<RDIEntry>Except Group(VendBrand_MerchGrp)</RDIEntry>" & vbCrLf & _
'
' 3/26/14 - partially restore access to the Vendor anchor hierarchies blocked
on 2/12 (VendMG*)
'
' 6/2/14 - changed restriction from "geogRestrictCityDistrictDCandStore" to
"geogRestrictStoreOnly" based on
' feedback from Tim.
'
s = s & "<SecurityDomain>" & vbCrLf & _
"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
 "<Dimension name=""Measures"">" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Sales and Units TPR"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>DescendantsOf(""CELLSECURITY:Sales and Units TPR
Datamaps"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except RootsOf(Product)</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except Group(ProdMG_MerchGrp)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Except Group(ProdBrand_MerchGrp)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>Except Group(VendMG_MerchGrp)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Except ""All Products by Merch Group
Benchmarking""</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except DescendantsOf(""All Products by Merch Group
Benchmarking"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
CSInnerGeographyRestriction(geogRestrictStoreOnly) & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf
'
' Inventory - only available for purchased pay vendors, but can't be
combined with the
' Scan Margin measures, as these are not subject to geography restriction.
Can't be
' combined with Sales and Units, as those are available at all levels of
the product hierarchy.
'
' again - we don't want custom aggs to work with inventory measures yet -
'
' 10/28/13 - corrected geography restriction - was restricted, shouldn't
have een
' 20190302
If includeInventory Then
If PremiumAccess Then
s = s & "<SecurityDomain>" & vbCrLf & _
"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Inventory"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>DescendantsOf(""CELLSECURITY:Inventory
Datamaps"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Purchase Orders :
FOLDER"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Appointment :
FOLDER"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Planned Delivery :
FOLDER"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Display : FOLDER"")</RDIEntry>"
& vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf
 s = s & CSInnerProductFilteredVendorClause(arrVendorNumbers)
s = s & "<RDIEntry>Except ""All Products by Merch Group
Benchmarking""</RDIEntry>" & vbCrLf
s = s & "<RDIEntry>Except DescendantsOf(""All Products by Merch
Group Benchmarking"")</RDIEntry>" & vbCrLf
s = s & "</Dimension>" & vbCrLf & _
CSInnerGeographyRestriction(geogNoRestrictions) & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf
Else
s = s & "<SecurityDomain>" & vbCrLf & _
"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Inventory"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>DescendantsOf(""CELLSECURITY:Inventory
Datamaps"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf

s = s & CSInnerProductFilteredVendorClause(arrVendorNumbers)
s = s & "<RDIEntry>Except ""All Products by Merch Group
Benchmarking""</RDIEntry>" & vbCrLf
s = s & "<RDIEntry>Except DescendantsOf(""All Products by Merch
Group Benchmarking"")</RDIEntry>" & vbCrLf
s = s & "</Dimension>" & vbCrLf & _
CSInnerGeographyRestriction(geogNoRestrictions) & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf
End If
End If ' includeInventory

s = s & CSUnrestrictedAttributeMeasuresClause

s = Replace(s, "@@LDAP_GROUP@@", ldapGroupName)

CSBlockProductL1_OR_L2 = s

End Function

Private Function NEW_CSBlockL1_AND_L2orL2a(ldapGroupName As String,

arrVendorNumbers As Variant, arrL1CategoryNumbers As Variant, includeInventory As
Boolean) As String
'

' 6/6/14 - JW - corner case problems with combining level 2 and level 1
categories for a single ldap group forced creation of this routine
' note that Level 2 and level 2a are the same as far as this routine is
concerned, and only the level 1 categories need to be specified
' as they are subject to additional restrictions.

' note that vendor names can be an array of vendor names

'
Dim s As String
 '
' CELLSECURITY:BaseSalesMeasures, Inventory and Restricted Product Attributes
'
' note the CELLSECURITY ref to the underlying datamaps - necessary to make
custom aggs work with
' cell security. Which is totally bogus
'
'
' 2/12/14 - removed these two clauses:
' "<RDIEntry>Except Group(VendMG_MerchGrp)</RDIEntry>" & vbCrLf & _
' "<RDIEntry>Except Group(VendBrand_MerchGrp)</RDIEntry>" & vbCrLf & _
' 3/26/14 - partially restore access to the Vendor anchor hierarchies blocked
on 2/12 (VendMG*)
'
' 4/13/14 - added cMeasuresForProductCustomAggHack
'

'
' deal with level 2 categories. There might not be any - but we need to call
this anyway to make sure the all nodes of the product orths do the
' right thing in terms of not restricting our sales measures

s = s & "<SecurityDomain>" & vbCrLf & _

"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _

"<RDIEntry>DescendantsOf(""CELLSECURITY:BaseSalesMeasures"")</RDIEntry>" & vbCrLf &

_
"<RDIEntry>DescendantsOf(""CELLSECURITY:Sales and Units
Datamaps"")</RDIEntry>" & vbCrLf & _
cMeasuresForProductCustomAggHack & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except RootsOf(Product)</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except Group(ProdMG_MerchGrp)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Except Group(ProdBrand_MerchGrp)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>Except Group(VendMG_MerchGrp)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Except ""All Products by Merch Group
Benchmarking""</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except DescendantsOf(""All Products by Merch Group
Benchmarking"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
CSInnerL1_AND_L2ProductOrthRestrictions(arrL1CategoryNumbers, True)
& vbCrLf & _
CSInnerGeographyRestriction(geogNoRestrictions) & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf

'
' and level 1
 '
s = s & "<SecurityDomain>" & vbCrLf & _
"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _

"<RDIEntry>DescendantsOf(""CELLSECURITY:BaseSalesMeasures"")</RDIEntry>" & vbCrLf &

_
"<RDIEntry>DescendantsOf(""CELLSECURITY:Sales and Units
Datamaps"")</RDIEntry>" & vbCrLf & _
cMeasuresForProductCustomAggHack & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf & _
CSInnerProductFilteredVendorClause(arrVendorNumbers, False,
True) & vbCrLf & _
ExceptProductRootsAndMerchLevels & _
"</Dimension>" & vbCrLf & _
CSInnerL1_AND_L2ProductOrthRestrictions(arrL1CategoryNumbers, False)
& _
CSInnerGeographyRestriction(geogNoRestrictions) & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf

'
' CELLSECURITY:RegPromoSalesMeasures
'
' 2/2/14 - removed "<RDIEntry>DescendantsOf(""Restricted Product
Attributes"")</RDIEntry>" & vbCrLf & _
' 2/12/14 - removed these two clauses:
' "<RDIEntry>Except Group(VendMG_MerchGrp)</RDIEntry>" & vbCrLf & _
' "<RDIEntry>Except Group(VendBrand_MerchGrp)</RDIEntry>" & vbCrLf & _

' 2/13/14 - changed to use CELLSECURITY:RegPromoSalesAndUnitsDatamaps rather

than
' CELLSECURITY:Sales and Units Datamaps to get around AS custom agg bug
with cell security
'
' 3/26/14 - partially restore access to the Vendor anchor hierarchies blocked
on 2/12 (VendMG*)
'
' Note the geography restriction "geogRestrictCityDistrictDCandStore"
corresponds to security level
' yellow in the security bible.
'

' LEVEL 2

s = s & "<SecurityDomain>" & vbCrLf & _

"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _
"<RDIEntry>DescendantsOf(""CELLSECURITY:RegPromoSalesMeasures"")</RDIEntry>" &
vbCrLf & _

"<RDIEntry>DescendantsOf(""CELLSECURITY:RegPromoSalesAndUnitsDatamaps"")</
RDIEntry>" & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except RootsOf(Product)</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except Group(ProdMG_MerchGrp)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Except Group(ProdBrand_MerchGrp)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>Except Group(VendMG_MerchGrp)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Except ""All Products by Merch Group
Benchmarking""</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except DescendantsOf(""All Products by Merch Group
Benchmarking"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
CSInnerL1_AND_L2ProductOrthRestrictions(arrL1CategoryNumbers,
True) & vbCrLf & _
CSInnerGeographyRestriction(geogRestrictCityDistrictDCandStore) & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf

'
' Level 1
'

s = s & "<SecurityDomain>" & vbCrLf & _

"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _

"<RDIEntry>DescendantsOf(""CELLSECURITY:RegPromoSalesMeasures"")</RDIEntry>" &
vbCrLf & _

"<RDIEntry>DescendantsOf(""CELLSECURITY:RegPromoSalesAndUnitsDatamaps"")</
RDIEntry>" & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf & _
CSInnerProductFilteredVendorClause(arrVendorNumbers, False,
True) & vbCrLf & _
ExceptProductRootsAndMerchLevels & _
"</Dimension>" & vbCrLf & _
CSInnerL1_AND_L2ProductOrthRestrictions(arrL1CategoryNumbers,
False) & vbCrLf & _
CSInnerGeographyRestriction(geogRestrictCityDistrictDCandStore) & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf

'==================================================================================
============
'
 ' FROM HERE ON DOWN, IS THE SAME AS CSBLOCKL1_OR_L2 - SHOULD BE FACTORED INTO
COMMON ROUTINE
'

'==================================================================================
============

'
' Scan Margin, Scan Margin TPR and Restricted Product Attributes
'
' no datamap reference here - we don't want custom aggs to work with cell
security for these
' measures yet
'
' 2/2/14 - removed "<RDIEntry>DescendantsOf(""Restricted Product
Attributes"")</RDIEntry>" & vbCrLf & _
'
' 1/24/15 - added Margin Contribution measures

s = s & "<SecurityDomain>" & vbCrLf & _

"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Scan Margin"")</RDIEntry>" & vbCrLf
& _
"<RDIEntry>DescendantsOf(""Scan Margin TPR"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>DescendantsOf(""Margin Contribution"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>DescendantsOf(""CELLSECURITY:Scan Margin
Datamaps"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf

s = s & CSInnerProductFilteredVendorClause(arrVendorNumbers)
s = s & "<RDIEntry>Except ""All Products by Merch Group
Benchmarking""</RDIEntry>" & vbCrLf
s = s & "<RDIEntry>Except DescendantsOf(""All Products by Merch
Group Benchmarking"")</RDIEntry>" & vbCrLf
s = s & "</Dimension>" & vbCrLf & _
CSInnerGeographyRestriction(geogRestrictStoreOnly) & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf
'
' Sales and Units TPR (can't be combined with Sales and Units, due to
additional geog restriction)
'
' Custom aggs with cell security are ok for these measures
'
' 2/12/14 - removed these two clauses:
' "<RDIEntry>Except Group(VendMG_MerchGrp)</RDIEntry>" & vbCrLf & _
' "<RDIEntry>Except Group(VendBrand_MerchGrp)</RDIEntry>" & vbCrLf & _
'
' 3/26/14 - partially restore access to the Vendor anchor hierarchies blocked
on 2/12 (VendMG*)
'
 ' 6/2/14 - changed restriction from "geogRestrictCityDistrictDCandStore" to
"geogRestrictStoreOnly" based on
' feedback from Tim.
'
s = s & "<SecurityDomain>" & vbCrLf & _
"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Sales and Units TPR"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>DescendantsOf(""CELLSECURITY:Sales and Units TPR
Datamaps"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf & _
"<RDIEntry>*~</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except RootsOf(Product)</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except Group(ProdMG_MerchGrp)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Except Group(ProdBrand_MerchGrp)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>Except Group(VendMG_MerchGrp)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Except ""All Products by Merch Group
Benchmarking""</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except DescendantsOf(""All Products by Merch Group
Benchmarking"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
CSInnerGeographyRestriction(geogRestrictStoreOnly) & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf
'
' Inventory - only available for purchased pay vendors, but can't be
combined with the
' Scan Margin measures, as these are not subject to geography restriction.
Can't be
' combined with Sales and Units, as those are available at all levels of
the product hierarchy.
'
' again - we don't want custom aggs to work with inventory measures yet -
'
' 10/28/13 - corrected geography restriction - was restricted, shouldn't
have een
' 20190302
If includeInventory Then
If PremiumAccess Then
s = s & "<SecurityDomain>" & vbCrLf & _
"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Inventory"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>DescendantsOf(""CELLSECURITY:Inventory
Datamaps"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Purchase Orders :
FOLDER"")</RDIEntry>" & vbCrLf & _
 "<RDIEntry>DescendantsOf(""Appointment :
FOLDER"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Planned Delivery :
FOLDER"")</RDIEntry>" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Display : FOLDER"")</RDIEntry>"
& vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf

s = s & CSInnerProductFilteredVendorClause(arrVendorNumbers)
s = s & "<RDIEntry>Except ""All Products by Merch Group
Benchmarking""</RDIEntry>" & vbCrLf
s = s & "<RDIEntry>Except DescendantsOf(""All Products by Merch
Group Benchmarking"")</RDIEntry>" & vbCrLf
s = s & "</Dimension>" & vbCrLf & _
CSInnerGeographyRestriction(geogNoRestrictions) & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf
Else
s = s & "<SecurityDomain>" & vbCrLf & _
"<Accessor type=""Group"">@@LDAP_GROUP@@</Accessor>" & vbCrLf & _
"<CanWriteBack>false</CanWriteBack>" & vbCrLf & _
"<CanEditUEV>false</CanEditUEV>" & vbCrLf & _
"<RuleDomain>" & vbCrLf & _
"<Dimension name=""Measures"">" & vbCrLf & _
"<RDIEntry>DescendantsOf(""Inventory"")</RDIEntry>" &
vbCrLf & _
"<RDIEntry>DescendantsOf(""CELLSECURITY:Inventory
Datamaps"")</RDIEntry>" & vbCrLf & _
"</Dimension>" & vbCrLf & _
"<Dimension name=""Product"">" & vbCrLf

s = s & CSInnerProductFilteredVendorClause(arrVendorNumbers)
s = s & "<RDIEntry>Except ""All Products by Merch Group
Benchmarking""</RDIEntry>" & vbCrLf
s = s & "<RDIEntry>Except DescendantsOf(""All Products by Merch
Group Benchmarking"")</RDIEntry>" & vbCrLf
s = s & "</Dimension>" & vbCrLf & _
CSInnerGeographyRestriction(geogNoRestrictions) & _
"</RuleDomain>" & vbCrLf & _
"</SecurityDomain>" & vbCrLf
End If
End If ' includeInventory

s = s & CSUnrestrictedAttributeMeasuresClause

s = Replace(s, "@@LDAP_GROUP@@", ldapGroupName)

NEW_CSBlockL1_AND_L2orL2a = s

End Function

Private Function ExceptProductRootsAndMerchLevels() As String

ExceptProductRootsAndMerchLevels = "<RDIEntry>Except
RootsOf(Product)</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except Group(ProdMG_MerchGrp)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Except Group(ProdBrand_MerchGrp)</RDIEntry>" &
vbCrLf & _
"<RDIEntry>Except Group(VendMG_MerchGrp)</RDIEntry>" & vbCrLf &
_
"<RDIEntry>Except ""All Products by Merch Group
Benchmarking""</RDIEntry>" & vbCrLf & _
"<RDIEntry>Except DescendantsOf(""All Products by Merch Group
Benchmarking"")</RDIEntry>" & vbCrLf

End Function

'==================================================================================
===================================
'
' The following routines are based on logic fromt the JASCS_MemberSecurity module,
but have been tailored here
' to allow member and cell security to be set together for 1 or more groups at once
' Note that there exists a separate version of this routine which handles only a
single LDAP group at a time. That
' version also allows for deleting an entry, which the batch version does not
'
'==================================================================================
===================================
Public Sub MergeAndSetMemberAndCellSecurityAndGenerateDimVisibility(modelName As
String, modelSummary As String)
'
' 5/9/14 - JW - created
' 7/24/18 - JW - extended to also generate dimension visible by LDAP groups,
since CVS now want to selecting
' hide/show one or more dimensions
'
Dim s As String, ldapGroups As String, memberSecurityContent As String,
cellSecurityContent As String
'Dim cellSecurityContent As String
Dim oD As DOMDocument
Dim accessorList As String
' read in the files that were built up by processing the security input sheet -
they specify the groups that
' are getting replaced or added and member and cell security content for those
groups
'
ldapGroups = ReadFile("C:\temp\CVS_PIP_LDAPGROUPS.txt")
memberSecurityContent = ReadFile("C:\temp\CVS_PIP_MemberSecurity.txt")
cellSecurityContent = ReadFile("C:\temp\CVS_PIP_CellSecurity.txt")

'
' get dim list
'
Dim oDimensionXML As DOMDocument
Set oDimensionXML = JASCS_ASCS.SendASCSRequest("Fetching dimension
information", "<ascs:getDimensions modelName=""@@MODEL@@""/>", modelName, False)
Dim sDimVizCSV As String

'
' get the existing member and cell security
 Set oD = GetMemberAndCellSecurityForModel(modelName, True)

'
' build a dictionary of the accessors
'
Dim oDictAccessors As New Dictionary

Dim arrL As Variant, k As Variant

arrL = Split(ldapGroups, vbCrLf)

For Each k In arrL

If Trim(k) <> "" Then
oDictAccessors.Add UCase(k), UCase(k)
accessorList = accessorList & k & "|"
End If
Next k
'
' 7/24/18 build header row of dim viz csv file - this should be the LDAP groups
with a blank
' corresponding to the dim row headers
'

'
' spin through our existing cell and member security dom twice - on the first
pass merge member security, on the second do
' cell

Dim iteration As Integer

For iteration = 1 To 2

'
Dim oNode As IXMLDOMNode

Dim existingContent As String

Dim countReplaced As Integer
Dim n As Integer
Dim mainElement As String
Dim summary As String
'
' 9/27/13 - changed to explicity compare against false
'
If (iteration = 1) Then
mainElement = "//MemberSecurityDomain"
Else
mainElement = "//SecurityDomain"
End If

For Each oNode In oD.SelectNodes(mainElement)

n = n + 1
Dim a As String
a = XMLScrub(UCase(Trim(oNode.SelectSingleNode("Accessor").Text)))
' Debug.Print accessor

'
' 11/4/15 - we need to convert "a" to uppercase when doing the
comparison, as the xmlscrub
' routine may insert lower case. We don't want to permanently change
a, however, as the
' upper case magic XML characters won't do what is needed

If Not oDictAccessors.Exists(UCase(a)) Then

' we want to keep this entry
existingContent = existingContent & oNode.xml & vbCrLf
Else
'Debug.Print "tossing out existing entry for " & accessor
countReplaced = countReplaced + 1
End If
Next oNode
'
' now join new cellSecurityContent with whatever remains of the old
cellSecurityContent
If iteration = 1 Then
memberSecurityContent = memberSecurityContent & existingContent
summary = n & " member security entries checked." & vbCrLf & vbTab
& countReplaced & " entries will be replaced by your new security." & vbCrLf
countReplaced = 0
existingContent = ""
Else
cellSecurityContent = cellSecurityContent & existingContent
summary = summary & n & " cell security entries checked." & vbCrLf
& vbTab & countReplaced & " entries will be replaced by your new security."
countReplaced = 0
End If

Next iteration ' member securiyt, cell security

'MsgBox summary, vbOKOnly, "Set security for CVS"

'
' go ahead and generate dim viz before we tackle the model changes
'
Dim oDV As New DOMDocument
Dim nn As Integer
oDV.LoadXML "<foo>" & memberSecurityContent & "</foo>"
If oDV.parseError.reason <> "" Then
MsgBox "Invalid member security: " & oD.parseError.reason & vbCrLf &
oD.parseError.srcText, vbCritical, "Invalid member security"
Exit Sub
Else
Dim oUG As IXMLDOMNode
Dim dictUsers As New Dictionary
'
' use a dict to make sure we have no dupes

sDimVizCSV = ""
For Each oUG In oDV.SelectNodes("//Accessor")
If Not dictUsers.Exists(oUG.Text) Then
dictUsers.Add oUG.Text, oUG.Text
End If
If InStr(1, oUG.Text, ",") Then
' Debug.Print oUG.Text
End If

Next oUG
 For Each k In dictUsers.Keys
sDimVizCSV = sDimVizCSV & ",""" & k & """"
'Debug.Print oUG.xml
nn = nn + 1
Next k
'Debug.Print "group count " & nn

sDimVizCSV = sDimVizCSV & vbCrLf

Dim oDim As IXMLDOMNode

For Each oDim In oDimensionXML.SelectNodes("//Dimension")

Dim dimName As String
dimName = oDim.Attributes.getNamedItem("name").Text
sDimVizCSV = sDimVizCSV & dimName

If (InStr(1, oDim.xml, "<IsHidden>false") > 0) Then

'
' vis dim
'
nn = 0
For Each k In dictUsers.Keys
If (InStr(1, oDim.xml, "PREMIUM DIMENSION")) Then
'
' if this is the premium Display Content dimension, see if
we
' are a group that gets premium
'
If GroupGetsPremium(CStr(k)) Then
sDimVizCSV = sDimVizCSV & ",X"
Else
sDimVizCSV = sDimVizCSV & ","

End If
Else
sDimVizCSV = sDimVizCSV & ",X"
nn = nn + 1
End If
Next k
' Debug.Print "visible dim " & nn
sDimVizCSV = sDimVizCSV & vbCrLf
Else
'
' hidden dim - hidden dims stay hidden for everyone
'
nn = 0
For Each k In dictUsers.Keys
sDimVizCSV = sDimVizCSV & ","
'Debug.Print oUG.xml
nn = nn + 1
Next k
' Debug.Print "hidden dim group count " & nn
sDimVizCSV = sDimVizCSV & vbCrLf
End If

Next oDim

End If
 WriteFile sDimVizCSV, cPathToDimensionScopingFile

Dim caption As String

caption = "Bulk security set for " & oDictAccessors.count & " accessors: " &
Left(accessorList, Len(accessorList) - 1) & vbCrLf & " See " & ActiveWorkbook.Name
& " tab " & ActiveSheet.Name

MergeMemberAndCellSecurityInner cellSecurityContent, memberSecurityContent,

modelName, caption
' CheckMemberSecurity modelName
' End If

End Sub

Private Function GroupGetsPremium(groupName As String, Optional isCSOrMS As Integer

= 0) As Boolean
' in spring 2018, the notion of "Premium" user groups was added, primarily
concerned with ui side functionality. However, associated with Premium access
' there were also a set of new dimensions and measures. This routine
determines whether a given LDAP group is a Premium group - the rule being that a
fixed
' list of internal groups have premium access as do external LDAP groups ending
in "-PREMIUM" or "_PREMIUM".
'
' Note that this is not a function of category/vendor/security level as is
virtually everything else handled by the model security tooling.
'
Dim internalPremiumGroups As String

GroupGetsPremium = False

internalPremiumGroups = "|IRICOMMERCIAL.COM\CVS_PIP_ADMIN|IRICOMMERCIAL.COM\
CVS_PIP_CVS|IRICOMMERCIAL.COM\CVS_PIP_INTERNAL|IRICOMMERCIAL.COM\
CVS_PIP_INV_MEASURES|IRICOMMERCIAL.COM\LD_DEMO_ADMIN|INFORES.COM\LD_DEMO_ADMIN|"

Dim s As String
s = "|" & UCase(groupName) & "|"

If InStr(1, internalPremiumGroups, s) Then

GroupGetsPremium = True
End If

'
' any DEV or QA group gets access

If (InStr(1, groupName, "_DEV_") > 0 Or InStr(1, groupName, "_QA_")) Then

GroupGetsPremium = True
End If

If (Right(UCase(groupName), Len("-PREMIUM")) = "-PREMIUM") Or

(Right(UCase(groupName), Len("_PREMIUM")) = "_PREMIUM") Then
GroupGetsPremium = True
End If

'Sam Start
 If (isCSOrMS = 0) Then
Dim r As Integer
Dim ldapGroup As String
r = 0
While Range("A2").Offset(r, 0) <> ""
ldapGroup = Range("A2").Offset(r, colLDAPGroup).Value
If ldapGroup = groupName Then
If UCase(Left(Range("A2").Offset(r,
colPremiumAccessLevel).Value, 1)) = "Y" Then
GroupGetsPremium = True
Else
GroupGetsPremium = False
End If
End If
r = r + 1
Wend
'Sam End
End If

If GroupGetsPremium Then
Debug.Print "Premium Access:" & groupName
End If

End Function

'==================================================================================
===================================
'
' The following routines are based on logic fromt the JASCS_MemberSecurity module,
but have been tailored here
' to allow member and cell security to be set together, and to reduce the number of
questions posed to the user.
' This version assumes that only one LDAP group is being handled at a time. There
is a separate routine for doing
' batch changes.
' Note that only the iterative vesion below can handle deletes
'
'==================================================================================
===================================
Private Sub MergeAndSetMemberAndCellSecurity(modelName As String,
cellSecurityContent As String, memberSecurityContent As String, _
Accessor As String, modelSummary As String,
Optional DeleteAccessor As Boolean = False)
'
' 10/8/13 - based on more iteractive version in JASCS_MemberSecurity
'
' 3/26/14 - added modelSummary - which is intended to keep a short notation of
the vendor/category settings in the model
' description
' 3/31/14 - added DeleteAccessor optional arg to allow this same function to
delete a group. AS APIs don't have a way to
' do that short of simply resubmitting the entire block of security,
less the entry that is no longer desired.
'
Dim s As String, mergeSecurity As Boolean
'Dim cellSecurityContent As String
Dim oD As DOMDocument
 '
' get both member and cell security
Set oD = GetMemberAndCellSecurityForModel(modelName, True)

Dim oDictAccessors As New Dictionary

oDictAccessors.Add UCase(Accessor), UCase(Accessor)

'
' spin through our existing cell and member security dom twice - on the first
pass merge member security, on the second do
' cell

Dim iteration As Integer

For iteration = 1 To 2

'
Dim oNode As IXMLDOMNode

Dim existingContent As String

Dim countReplaced As Integer
Dim n As Integer
Dim mainElement As String
Dim summary As String
'
' 9/27/13 - changed to explicity compare against false
'
If (iteration = 1) Then
mainElement = "//MemberSecurityDomain"
Else
mainElement = "//SecurityDomain"
End If

For Each oNode In oD.SelectNodes(mainElement)

n = n + 1
Dim a As String
a = XMLScrub(UCase(Trim(oNode.SelectSingleNode("Accessor").Text)))
' 11/4/15 - we need to convert "a" to uppercase when doing the
comparison, as the xmlscrub
' routine may insert lower case. We don't want to permanently change
a, however, as the
' upper case magic XML characters won't do what is needed
If Not oDictAccessors.Exists(UCase(a)) Then
' we want to keep this entry
existingContent = existingContent & oNode.xml & vbCrLf
Else
'Debug.Print "tossing out existing entry for " & accessor
countReplaced = countReplaced + 1
End If
Next oNode
'
' now join new cellSecurityContent with whatever remains of the old
cellSecurityContent
If iteration = 1 Then
If DeleteAccessor Then
memberSecurityContent = existingContent
summary = n & " member security entries checked." & vbCrLf & vbTab
& "ecurity for " & Accessor & " will be removed." & vbCrLf
 Else
memberSecurityContent = memberSecurityContent & existingContent
summary = n & " member security entries checked." & vbCrLf & vbTab
& countReplaced & " entries will be replaced by your new security." & vbCrLf
countReplaced = 0
End If
existingContent = ""
Else
If DeleteAccessor Then
cellSecurityContent = existingContent
summary = n & " cell security entries checked." & vbCrLf & vbTab &
"Cell security for " & Accessor & " will be removed." & vbCrLf
countReplaced = 0
Else
cellSecurityContent = cellSecurityContent & existingContent
summary = summary & n & " cell security entries checked." & vbCrLf
& vbTab & countReplaced & " entries will be replaced by your new security."
countReplaced = 0
End If
End If

Next iteration ' member securiyt, cell security

'MsgBox summary, vbOKOnly, "Set security for CVS"

Dim caption As String

caption = Replace(Accessor, "iricommercial.com\", "") & " set to " &
modelSummary

MergeMemberAndCellSecurityInner cellSecurityContent, memberSecurityContent,

modelName, caption
' CheckMemberSecurity modelName
' End If

End Sub

Public Function MergeMemberAndCellSecurityInner(cellSecurityContent As String,

memberSecurityContent As String, Model As String, caption As String) As Boolean
'
' 3/11/13 - JW - extended to support cell security
'
' returns true is successful, else displays the error and returns false
'
Dim oD As New DOMDocument, s As String

MergeMemberAndCellSecurityInner = False
'
' check both payloads to make sure they are valid XML
'
oD.LoadXML "<foo>" & cellSecurityContent & "</foo>"
If oD.parseError.reason <> "" Then
MsgBox "Invalid cell security: " & oD.parseError.reason & vbCrLf &
oD.parseError.srcText, vbCritical, "Invalid cell security"
Exit Function
 End If

oD.LoadXML "<foo>" & memberSecurityContent & "</foo>"

If oD.parseError.reason <> "" Then
MsgBox "Invalid member security: " & oD.parseError.reason & vbCrLf &
oD.parseError.srcText, vbCritical, "Invalid member security"
Exit Function
End If

' cell security

' 11/4/2015 - changed to use "Update" instruction, which removes the need to
always send the entire set of
' security

s = "<ascs:setModelProperties modelName='@@MODEL@@'>" & vbCrLf

s = s & "<IsSecurityOn>true</IsSecurityOn>" & vbCrLf
s = s & "</ascs:setModelProperties>" & vbCrLf
s = s & "<ascs:setModelSecurityDomains modelName='@@MODEL@@' action='Replace'>"
& vbCrLf
's = s & "<ascs:setModelSecurityDomains modelName='@@MODEL@@' action='Update'>"
& vbCrLf
s = s & cellSecurityContent & vbCrLf
s = s & "</ascs:setModelSecurityDomains>" & vbCrLf

Set oD = Nothing
Set oD = SendASCSRequestToChangeModel(caption, s, Model, False, 900)

' member security

' 11/4/2015 - changed to use "Update" instruction, which removes the need to
always send the entire set of
' security

s = ""
s = s & "<ascs:setModelProperties modelName='@@MODEL@@'>" & vbCrLf
s = s & "<IsMemberSecurityEnabled>true</IsMemberSecurityEnabled>" & vbCrLf
s = s & "</ascs:setModelProperties>" & vbCrLf
s = s & "<ascs:setModelMemberSecurityDomains modelName='@@MODEL@@'
action='Replace'>" & vbCrLf
s = s & memberSecurityContent & vbCrLf
s = s & "</ascs:setModelMemberSecurityDomains>" & vbCrLf

Set oD = Nothing
Set oD = SendASCSRequestToChangeModel(caption, s, Model, False, 900)

'
' If there had been an error, it will have already been display and oD will
have been returned as nothing
'
If Not oD Is Nothing And Trim(oD.xml) <> "" Then
'MsgBox "Member and cell security applied to " & model, vbOKOnly, model &
"Security"
MergeMemberAndCellSecurityInner = True
End If
End Function

Private Function GetMemberAndCellSecurityForModel(Model As String, getCellSecurity

As Boolean) As DOMDocument
' 10/8/13 - JW - based on routine in JASCS_MemberSecurity that fetches one or
the other - this one gets both

Set GetMemberAndCellSecurityForModel = SendASCSRequest("Fetching cell and

member security", "<ascs:getModelSecurityDomains
modelName=""@@MODEL@@""/><ascs:getModelMemberSecurityDomains
modelName=""@@MODEL@@""/>", Model, False, 900)

End Function

Private Sub dumpVendorsPayVendors()

Dim oRef As New DOMDocument

oRef.Load cachedVendorCategoryInfoFilename

Dim oVendor As IXMLDOMNode

Dim r As Integer

Dim oDictVendor As New Dictionary

r = 2

SKIP:
With frmWizard
.ListBox1.Clear
.ListBox1.MultiSelect = fmMultiSelectMulti
.caption = "foo"

For Each oVendor In oRef.SelectNodes("//Member[@levelName='PayVendor']")

Dim oCategory As IXMLDOMNode
Dim cats As String

cats = ""
For Each oCategory In oVendor.ChildNodes
'Debug.Print "foo"
'Debug.Print vbTab & oCategory.Attributes.getNamedItem("name").Text
If InStr(1, oCategory.xml, "name=""STORE BRAND""") > 0 Then
cats = cats & oCategory.Attributes.getNamedItem("name").Text &
"|"
Else
cats = cats & oCategory.Attributes.getNamedItem("name").Text &
"[NATIONAL BRAND ONLY]" & "|"
End If

Next oCategory

.ListBox1.AddItem oVendor.Attributes.getNamedItem("name").Text
oDictVendor.Add oVendor.Attributes.getNamedItem("name").Text,
Left(cats, Len(cats) - 1)

Next oVendor
 .Cancelled = False
.cmdOK.Enabled = True
.Show vbModal
Dim i As Integer

For i = 0 To .ListBox1.ListCount - 1
If .ListBox1.Selected(i) Then
'Debug.Print .ListBox1.List(i)
'Debug.Print oDictVendor(.ListBox1.List(i))
End If
Next i
'
' now find the categories owned by these vendors
'

End With

End Sub

Public Sub ScanMemberSecurity()

'
' expects a dump of security to be found in c:\temp\CVS_PIP_Security.xml
'
Dim oMS As New DOMDocument

oMS.Load "c:\temp\CVS_PIP_Security.xml"
Dim oAccessor As IXMLDOMNode

For Each oAccessor In oMS.SelectNodes("//MemberSecurityDomain")

Dim oMeasures As IXMLDOMNode
Dim Accessor As String
Accessor = oAccessor.SelectSingleNode("Accessor").Text

Set oMeasures =
oAccessor.SelectSingleNode("RuleDomain/Dimension[@name='Measures']")
GoTo SKIP

If (InStr(1, oMeasures.xml, "Scan Margin") > 0) Then

'Debug.Print Accessor & " does not see scan margin"
Else
'Debug.Print Accessor & " does see scan margin"
End If
SKIP:
If (InStr(1, oMeasures.xml, "RestrictedInventoryMeasures") > 0) Then
'Debug.Print Accessor & " does see inventory"
Else
'Debug.Print Accessor & " does not see inventory"
End If

Next oAccessor
End Sub