Er is geen root element deze wordt bepaald door de Groep 0 0 persistent 0 1 0 %Library.Persistent 0 0 Prod.Kenmerk.MetaGroep Root, Sibling, Leave %String Kan ook berekend worden via method NodeLevel() %Integer Kan ook berekend worden via method SortKey() %String %String %String %String Hier wordt de METAGROEP gezet waarmee verdere beperkingen kunnen ingesteld worden voor orgalux is deze OL voor gemonteerde tandembox is deze TBX %String Aantal producten die deze node bevat %String Prod.Kenmerk.DataTree one Siblings 1 Prod.Kenmerk.DataTree many Parent 1 %Cache Parent 1 1 Groep,SortKey 1 1 Groep d ##class(Prod.Kenmerk.DataTree).DeleteGroep("PB") 1 Groep recursief 1 Parent d ##class(Prod.Kenmerk.DataTree).%New().CreateGroep() Groep,KeyList,KeyMetaGroep,StripSingleFromLevel Kenmerk,Waarden,Kenmerk->WaardenSortering into :PRNr,:Kenmerk,:Waarden,:Sort from Prod_Kenmerk.DataDefinitie where Kenmerk->Groep=:Groep.Code) if $D(%MemCache) m %Cache=%MemCache else D .&sql(OPEN BLDTREE) .Set MemPRNr="" .Set (Kenmerken,MetaWaarde)="" .For &sql(FETCH BLDTREE) Quit:SQLCODE Do .. If MemPRNr'=PRNr Do .. . Do ..SplitWaarden($NA(@..#IndirectRef),MemPRNr,$G(Kenmerken),$G(MetaWaarde)) .. . Set MemPRNr=PRNr .. . Set (Kenmerken,MetaWaarde)="" .. Set Pos=$LF(KeyList,Kenmerk) .. If Pos Set $LI(Kenmerken,Pos)=$LB(Kenmerk,Waarden,Sort) .. Else If KeyMetaGroep=Kenmerk Set MetaWaarde=$LB(Kenmerk,Waarden,Sort) .Do ..SplitWaarden($NA(@..#IndirectRef),MemPRNr,$G(Kenmerken),$G(MetaWaarde)) ; Laatste ook verwerken .&sql(CLOSE BLDTREE) .Merge %MemCache=%Cache zw %Cache Do:$G(StripSingleFromLevel) ..StripSingleSiblings(,$NA(@..#IndirectRef),StripSingleFromLevel) Do ..BuildTree(Groep,,$NA(@..#IndirectRef)) ]]> recursief IndirectRef,PRNr,Kenmerken,MetaWaarde,Start,Waarden IndirectRef,Waarden,MetaWaarde Gaat recursief de ganse cache af en verwijderd alle single leave subtrees Als de level groter is dan het minlevel IndirectParentRef,IndirectRef,MinLevel,Level MinLevel Do ; Indien leaves . ;w "*" . If $O(@IndirectRef,+1)="",$O(@IndirectRef,-1)="" Do ; parent heeft geen buren dan leave eentje hoger plaatsen . . ;write !,"Move ",IndirectRef,"->",IndirectParentRef . . Set List=@IndirectParentRef . . Set LeaveList=@IndirectRef . . Set $LI(List)="L" ; Wordt leave . . Set $LI(List,4)=$LI(LeaveList,4) . . Set @IndirectParentRef=List . . Kill @IndirectRef ]]> recursief Groep,Parent,IndirectRef,SortKey Groep Groep,Parent,List,SortKey Groep,Parent,List,SortKey %Library.CacheStorage ^Prod.Kenmerk.DataTreeD DataTreeDefaultData ^Prod.Kenmerk.DataTreeD ^Prod.Kenmerk.DataTreeI ^Prod.Kenmerk.DataTreeS %%CLASSNAME Groep Kenmerk NodeLevel NodeType Parent ProductCount SortKey VolgOrde Waarde LinkGroep