#include %VHMacro
 
 ;Do TBXKenmerkVTL^Prod.Kenmerk.Utils.tmpDev
TBXKenmerkVTL
 New GroepID,lbKenm,i,j,TaalDFL,VTLType,VTLGroep
 Set GroepID="TB"
 Set VTLType="K"
 Set VTLGroep=$$tvkGetVTLGroep(GroepID)
 Set TaalDFL=##class(Res.PI.Taal).BasisTaalID()
 Set lbKenm=$LB("BasisType","Design","FBevestiging","FrontType","GlijderType","Kleur","LiRe","Opties","RugHoogte","Verpakking","ZijwandHoogte")
 For i=1:1:$LL(lbKenm) Do tkvWaardenPerKenm($LG(lbKenm,i))
   w !,"Create VTL's finished.",!
 Quit
tvkGetVTLGroep(GroepID)
 New GrpObj,VTLGroep
 Set GrpObj=##class(Prod.Kenmerk.MetaGroep).%OpenId(GroepID)
 Quit:('GrpObj) ""
 Set VTLGroep=GrpObj.VertalingsGroep
 Do GrpObj.%Close()
 Quit VTLGroep
tkvWaardenPerKenm(Kenm)
 Quit:(Kenm="")
   w !,!,"Voor Kenmerk "_Kenm_": Create VTL's"
 New lbWaarden
 &SQL(DECLARE crsTBX CURSOR FOR  SELECT DISTINCT(Waarden) INTO :lbWaarden FROM Prod_Kenmerk.DataDefinitie WHERE Kenmerk=(:GroepID || '||' || :Kenm) )
 &SQL(OPEN crsTBX)
 For  &SQL(FETCH crsTBX)  Quit:(SQLCODE)  Do tkvCreateVTLItemLB(lbWaarden,Kenm)
 &SQL(CLOSE crsTBX)
 Quit
tkvCreateVTLItemLB(lbWaarden,Kenm)
 For j=1:1:$LL(lbWaarden) 
 . Do tkvCreateVTLItem(Kenm_"-"_$LG(lbWaarden,j))   ; ,VTLGroep,VTLType,TaalDFL)
 Quit
tkvCreateVTLItem(InternWde)   ; ,VTLGroep,VTLType,TaalDFL)
   w !,InternWde
 Quit:(##class(Res.Vertaling).%ExistsId(VTLGroep_"||"_InternWde_"||"_VTLType_"||"_TaalDFL))
 New objVTL,SaveRs
 Set objVTL=##class(Res.Vertaling).%New()   ; ID wordt VTLGroep_"||"_InternWde_"||"_VTLType_"||"_TaalDFL)
 Do objVTL.GroepSetObjectId(VTLGroep)
 Set objVTL.Intern=InternWde
 Do objVTL.TypeSetObjectId(VTLType)
 Do objVTL.TaalSetObjectId(TaalDFL)
 Set SaveRs=objVTL.%Save()
   w "  Vertaling: object Save:"_SaveRs
 Write:('SaveRs) SaveRs_"  - Fout bij bewaren van Vertaling met ID: "_VTLGroep_"||"_InternWde_"||"_VTLType_"||"_Taal,!
 Do objVTL.%Close()
 Quit
 
 
 ;Do ImportSleutelVTL^Prod.Kenmerk.Utils.tmpDev
ImportSleutelVTL
 New ArPR,PRNr,objVTL,GroepID,DataID,SleutelVal,lbWaarden,TxtN1,TxtN2,TxtN3,TxtF1,TxtF2,TxtF3,OmsNL,OmsFR,Oms
 New VTLGroep,MetaGroep
 Set GroepID="OL"
 Set MetaGroep=##class(Prod.Kenmerk.MetaGroep).%OpenId(GroepID)
 Set VTLGroep=MetaGroep.VertalingsGroep
 Do MetaGroep.%Close()
 ;Lijst van PRNr's:
 Do ##class(Prod.Kenmerk.DataIndex).SPAlle(GroepID,"ArPR")   ; Array opbouwen van alle producten
 Set PRNr=""
 For  Set PRNr=$O(ArPR(PRNr)) Quit:(PRNr="")  Do
 . Set (lbWaarden,TxtN1,TxtN2,TxtN3,TxtF1,TxtF2,TxtF3)=""
 . ; Ophalen van de Interne Waarde van de "Sleutel"
 . Set DataID=PRNr_"||"_GroepID_"||Sleutel"
 . &sql(SELECT Waarden INTO :lbWaarden FROM Prod_Kenmerk.DataDefinitie WHERE (ID=:DataID))
 . Set SleutelVal=$LG(lbWaarden,1)
 . ; Ophalen van de vertalingen uit het Mumps productenbestand
 . //            SELECT OmschrijvingN1,OmschrijvingN2,Orderreferenties3N,OmschrijvingF1,OmschrijvingF2,Orderreferenties3F INTO :TxtN1,:TxtN2,:TxtN3,:TxtF1,:TxtF2,:TxtF3 
 . &sql(SELECT OmschrijvingN1,OmschrijvingN2 INTO :TxtN1,:TxtN2 FROM Prod.Product WHERE (ID=:PRNr))
 . Set OmsNL=$$isvConcatTxt(TxtN1,TxtN2,TxtN3)
 . Set OmsFR=$$isvConcatTxt(TxtF1,TxtF2,TxtF3)
 . Do isvVertaling(SleutelVal,"N",OmsNL)
 . Do isvVertaling(SleutelVal,"F",OmsFR)
 
 /*
 . &sql(DECLARE crsDD CURSOR FOR SELECT Waarden INTO :lbWaarden FROM Prod_Kenmerk.DataDefinitie WHERE (ID=:DataID))
 . &sql(OPEN crsDD)
 . &sql(FETCH crsDD)   ; Fetch Interne Waarde(n) for "Sleutel"
 . &sql(CLOSE crsDD)
 . Set SleutelVal=$LG(lbWaarden,1)
 . ; Ophalen van de vertalingen uit het Mumps productenbestand
 . //            SELECT OmschrijvingN1,OmschrijvingN2,Orderreferenties3N,OmschrijvingF1,OmschrijvingF2,Orderreferenties3F INTO :TxtN1,:TxtN2,:TxtN3,:TxtF1,:TxtF2,:TxtF3 
 . &sql(DECLARE crsPR1 CURSOR FOR 
                 SELECT OmschrijvingN1,OmschrijvingN2 INTO :TxtN1,:TxtN2 
                 FROM Prod.Product WHERE (ID=:PRNr))
 . &sql(OPEN crsPR1)
 . &sql(FETCH crsPR1)   ; Fetch Tekstlijnen
 . &sql(CLOSE crsPR1)
 */
 
 Quit
isvConcatTxt(Txt1,Txt2,Txt3)
 Set Oms=Txt1
 Set Oms=Oms_$S($L(Oms)&$L(Txt2):$C(13,10), 1:"")_Txt2
 Set Oms=Oms_$S($L(Oms)&$L(Txt3):$C(13,10), 1:"")_Txt3
 Quit Oms
isvVertaling(Intern,Taal,Waarde)
 If ##class(Res.Vertaling).%ExistsId(VTLGroep_"||"_Intern_"||O||"_Taal) Do
 . Set objVTL=##class(Res.Vertaling).%OpenId(VTLGroep_"||"_Intern_"||O||"_Taal)
 Else  Do
 . Set objVTL=##class(Res.Vertaling).%New(VTLGroep_"||"_Intern_"||O||"_Taal)
 . Do objVTL.GroepSetObjectId(VTLGroep)
 . Set objVTL.Intern=Intern
 . Do objVTL.TypeSetObjectId("O")
 . Do objVTL.TaalSetObjectId(Taal)
 
 Quit:('objVTL)
 If '$L(objVTL.Vertaling) Do
 . Set objVTL.Vertaling=Waarde
 . Set SaveRs=objVTL.%Save()
 . Write:('SaveRs) SaveRs_"  - Fout bij bewaren van Vertaling met ID: "_VTLGroep_"||"_Intern_"||O||"_Taal
 Do objVTL.%Close()
 Quit
 
 
 
PRLijstViaCriteriaExtra   ; Parameters: GroepID,Ref,CriteriaArray,BeperkLastKM,arLastKMVal
#define CVTBool(%v)     (+%v'=0)
 Kill arLastKMVal
 If $D(CriteriaArray("PRNr")) Do
 . ; Array van PRNr opbouwen via opgegeven PRNrs
 . Do ##class(Prod.Kenmerk.Utils).PRLijstViaPRNr(GroepID,Ref,.CriteriaArray)
 Else  Do
 . ; Array van PRNr's opbouwen via opgegeven Kenmerken
 . New blnUndefs   ; ,ArKM
 . Set blnUndefs=$$$CVTBool($G(CriteriaArray("IncludeUndefs",1)))
 . Kill @Ref
 . Kill ArKM
 . Merge ArKM=CriteriaArray
 . Do ##class(Prod.Kenmerk.Utils).FilterKenmerken(GroepID,.ArKM)
 . If $L($G(BeperkLastKM))&&($D(ArKM(BeperkLastKM))) Do
 ..  New tmpCArray,LBSortedVal,i
 ..  Set i=""
 ..  Merge tmpCArray(BeperkLastKM)=ArKM(BeperkLastKM)   ; temp array met LastKM.  Wordt achteraf beperkt
 ..  ; Beperken tot alle behalve het laatste Kenmerk
 ..  Kill ArKM(BeperkLastKM)
 ..    ;d WL^vhDBG("Na splitsen:"_$$$ArrayTT("ArKM")_$$$ArrayTT("tmpCArray"))
 ..  Do ##class(Prod.Kenmerk.Utils).PRLijstViaKenmerk(GroepID,Ref,.ArKM,blnUndefs)
 ..  ; Lijst van alle waarden voor het laatste kenmerk van alle nog aanwezige producten
 ..  Set LBSortedVal=##class(Prod.Kenmerk.DataIndex).SPKenmerkWaardenLB(GroepID,BeperkLastKM,.@Ref,1)
 ..  Set arLastKMVal("SORTED","ALL")=LBSortedVal
 ..  Set arLastKMVal("SORTED","KMVAL")=$G(tmpCArray(BeperkLastKM))
 ..  For  Set i=$O(tmpCArray(BeperkLastKM,i)) Quit:(i="")  Set arLastKMVal("SORTED","KMVAL")=arLastKMVal("SORTED","KMVAL")_$LB($G(tmpCArray(BeperkLastKM,i)))
 ..    ;d WL^vhDBG("Values"_$$$ArrayTT("arLastKMVal"))
 ..  ; Beperking op LastKM toepassen:
 ..  Do:($D(@Ref)) ##class(Prod.Kenmerk.Utils).PRLijstViaKenmerk(GroepID,Ref,.tmpCArray,blnUndefs)
 . Else  Do
 ..  Do ##class(Prod.Kenmerk.Utils).PRLijstViaKenmerk(GroepID,Ref,.ArKM,blnUndefs)
 ; Groeperen op Kenmerken
 Do ##class(Prod.Kenmerk.Utils).GroepeerOpKenmerk(GroepID,.@Ref)
 Quit
 
PRLijstViaCriteria   ; Parameters: GroepID,Ref,CriteriaArray
#define CVTBool(%v)     (+%v'=0)
 If $D(CriteriaArray("PRNr")) Do
 . ; Array van PRNr opbouwen via opgegeven PRNrs
 . Do ##class(Prod.Kenmerk.Utils).PRLijstViaPRNr(GroepID,Ref,.CriteriaArray)
 Else  Do
 . ; Array van PRNr's opbouwen via opgegeven Kenmerken
 . New blnUndefs   ; ,ArKM
 . Set blnUndefs=$$$CVTBool($G(CriteriaArray("IncludeUndefs",1)))
 . Kill @Ref
 . Kill ArKM
 . Merge ArKM=CriteriaArray
 . Do ##class(Prod.Kenmerk.Utils).FilterKenmerken(GroepID,.ArKM)
 . Do ##class(Prod.Kenmerk.Utils).PRLijstViaKenmerk(GroepID,Ref,.ArKM,blnUndefs)
 ; Groeperen op Kenmerken
 Do ##class(Prod.Kenmerk.Utils).GroepeerOpKenmerk(GroepID,.@Ref)
 Quit
 
FilterKenmerken   ; Parameters: GroepID,KenmerkArray
 New rs,LBKenm,Kenm
 Set LBKenm=""
 Set rs=##class(%ResultSet).%New("Prod.Kenmerk.MetaDefinitie:LijstPerGroep")
 Do rs.Execute(GroepID)
 For  Quit:('rs.Next())  Set LBKenm=LBKenm_$LB(rs.GetData(2))
 Do rs.%Close()
 ; LBKenm is een lijst met alle Kenmerken van de groep GroepID
 Set Kenm=""
 For  Set Kenm=$O(KenmerkArray(Kenm))  Quit:(Kenm="")  Do
 . If $LF(LBKenm,Kenm)=0  Kill KenmerkArray(Kenm)   ; Kenm is geen correct Kenmerk van de groep
 Quit
 
PRLijstViaPRNr   ; Parameters: GroepID,Ref,CriteriaArray
 New i
 Kill @Ref
 Quit:('$D(CriteriaArray("PRNr")))
 Do ##class(Prod.Kenmerk.DataIndex).SPAlle(GroepID,"tmpAllePRNr")   ; Array opbouwen van alle producten
 ; CriteriaArray controleren op geldige PRNr's
 ; - PRNr op subnodes van "PRNr" controleren
 Set i=""
 For  Set i=$O(CriteriaArray("PRNr",i))  Quit:(i="")  Do lvpCheckAddToRef(CriteriaArray("PRNr",i))
 ; - PRNr op node (PRNr) controleren
 If $D(CriteriaArray("PRNr"))#10 Do lvpCheckAddToRef(CriteriaArray("PRNr"))
 Kill tmpAllePRNr   ; Opkuisen
 Quit
lvpCheckAddToRef(PRNr)
 Quit:(PRNr="")
 Set:($D(tmpAllePRNr(PRNr))>0) @Ref@(PRNr)=""
 Quit
 
 
PRLijstViaKenmerk   ; Parameters: GroepID,Ref,KenmerkArray,IncludeUndefs
#define CompareType     "C"
 New Kenm,i,objKenm,objCompare
 ; Array opbouwen van alle producten
 Do:('$D(@Ref)) ##class(Prod.Kenmerk.DataIndex).SPAlle(GroepID,Ref)
 ; Array beperken voor ieder ieder kenmerk van KenmerkArray
 Set Kenm=""
 For  Set Kenm=$O(KenmerkArray(Kenm))  Quit:(Kenm="")  Do
 . Set objKenm=##class(Prod.Kenmerk.MetaDefinitie).%OpenId(GroepID_"||"_Kenm)
 . Set:(IncludeUndefs) objCompare=$S(objKenm:objKenm.GetVTLTransformByType($$$CompareType), 1:"")
 . ; - Beperking op waarde van de subnodes
 . Set i=""
 . For  Set i=$O(KenmerkArray(Kenm,i))  Quit:(i="")  Do lvkBeperk(KenmerkArray(Kenm,i))
 . ; - Beperking op waarde van node (Kenm)
 . If $D(KenmerkArray(Kenm))#10 Do lvkBeperk(KenmerkArray(Kenm))
 . Do:(objKenm) objKenm.%Close()
 Quit
lvkBeperk(KWaarde)
 If IncludeUndefs Do ##class(Prod.Kenmerk.DataIndex).SPBeperk(GroepID,Kenm,KWaarde,Ref,$G(objCompare))
 Else           Do ##class(Prod.Kenmerk.DataIndex).SPBeperkExcl(GroepID,Kenm,KWaarde,Ref)
 Quit
 
 
GroepeerOpKenmerk   ; Parameters: GroepID,PRNrArray
#define lstEXTRA           "WandDikte;Kleur"
#define SPLIT              "||"
#define QUOTEDSPLIT        """||"""
#define XTDSPLIT           ",""||"""
 
 Set GroepID="OL"
 ;Do Start^TRTimer
 New PRNr,BeperkAr,BeperkAr2,lstKeys,i,j,D,LBSortKenm,CntKenm,sQry,tmpQry,PrevQry
 New KWdnSort,NumAr
 Set D="\"
 Set CntKenm=$$gokSortKenm()   ; Maakt ook LBSortKenm aan en KWdnSort
 Set PRNr=""
 For  Set PRNr=$O(PRNrArray(PRNr))  Quit:(PRNr="")  Do
 . Set lstKeys=##class(Prod.Kenmerk.Utils).SortWaarden(PRNr,LBSortKenm,D)
 . ;Set $P(lstKeys,D,$LF(LBSortKenm,$$$SPLIT))=$$$SPLIT
 . Set $P(lstKeys,D,$LF(LBSortKenm,$$$SPLIT))=$$$QUOTEDSPLIT
 . Set $P(lstKeys,D,CntKenm+1)=PRNr
 . ; dit product invullen in BeperkAr 
 . Do gokFillNodeNum
 
 ; Reduceren van de Array door de Basis-nodes te vervangen door één volgnummer
 Set i=0
 Set PrevQry=""
 Set sQry="BeperkAr"
 For  Set sQry=$Q(@sQry)  Quit:(sQry="")  Do
 . Set tmpQry=$E(sQry,1,$F(sQry_$$$XTDSPLIT,$$$XTDSPLIT)-1)_")"
 . If tmpQry'=PrevQry Do
 ..  Merge BeperkAr2($INCREMENT(i))=@tmpQry
 ..  Set PrevQry=tmpQry
 ..  Set NumAr(i)=$P($P(sQry,"(",2),",",1)   ; _"."_$P($P(sQry,"(",2),",",2)
 
 ; Kenmerken Extra vervangen door één volgnummer (= tweede node)
 Kill BeperkAr
 Set i=""
 Set PrevI=""
 Set sQry="BeperkAr2"
 For  Set sQry=$Q(@sQry)  Quit:(sQry="")  Do
 . Set i=$P($P(sQry,"(",2),",",1)                 ; Eerste node (=incremented counter
 . Set PRNr=$TR($$$LastPiece(sQry,","), ")","")   ; Laatste node
 . If i'=PrevI Do
 ..  Set j=0
 ..  Set PrevI=i
 ..  Set BeperkAr(i,1,"NDX")=NumAr(i)
 . Set BeperkAr(i,$INCREMENT(j))=PRNr
 
 Kill PRNrArray
 Merge PRNrArray=BeperkAr
 Kill BeperkAr
 Kill BeperkAr2
 ;Do Stop^TRTimer
 ;Write !,"Tijd voor Groeperen (New): "_$$GetTime^TRTimer(),!
 Quit
gokFillNode   ;(lstKeys)
 ; Vult in BeperkAr de uitgebreide node-structuur in
 ; Lege pieces door 0 vervangen
 For i=1:1:$L(lstKeys,D) Set:($P(lstKeys,D,i)="") $P(lstKeys,D,i)=0
 ; Niet-numerieke waarden tussen "" zetten
 For i=1:1:$L(lstKeys,D) Set:('$IsValidNum($P(lstKeys,D,i))) $P(lstKeys,D,i)=""""_$P(lstKeys,D,i)_""""
 ; Komma's vervangen door punt-komma's  ("," ==> ";") en dan Delimiters vervangen door komma's (D ==> ",")
 Set lstKeys=$TR($TR(lstKeys,",",";"),D,",")
 X "Set BeperkAr("_lstKeys_")="""" "
 Quit
gokFillNodeNum   ;(lstKeys)
 ; Vult in BeperkAr de uitgebreide node-structuur in
 ; Lege pieces door 0 vervangen
 For i=1:1:$L(lstKeys,D) Set:($P(lstKeys,D,i)="") $P(lstKeys,D,i)=0
 ; Delimiters vervangen door komma's (D ==> ",")
 Set lstKeys=$TR(lstKeys,D,",")
 X "Set BeperkAr("_lstKeys_")="""" "
 Quit
gokSortKenm()
 ; Gesorteerde lijst opbouwen van alle Kenmerken van de Groep.
 ; Kenmerken worden wel gesplitst in Basis en Extra
 New rs,LBBasis,LBExtra,i,Kenm
 Set (LBBasis,LBExtra)=""
 Set rs=##class(%ResultSet).%New("Prod.Kenmerk.MetaDefinitie:LijstPerGroep")
 Do rs.Execute(GroepID)
 For  Quit:('rs.Next())  Do
 . Set Kenm=rs.GetData(2)
 . If ($$$lstEXTRA[Kenm) Set LBExtra=LBExtra_$LB(Kenm)
 . Else                  Set LBBasis=LBBasis_$LB(Kenm)
 . Set KWdnSort(Kenm)=rs.GetData(3)
 Do rs.%Close()
 ; Samenvoegen van Basis en Extra, gescheiden door $$$SPLIT
 Set LBSortKenm=LBBasis_$LB($$$SPLIT)_LBExtra
 Quit $LL(LBSortKenm)
 
 
SortWaarden()   ; Parameters: PRNr,LBSortKenm,Delimiter
#define Kenm   2
#define Wdn    3
#define VolgN  4
 New sBasis,rs,tmpVal
 New KPos,VPos,Index
 Set sBasis=""
 Set rs=##class(%ResultSet).%New("Prod.Kenmerk.DataDefinitie:LijstPerProduct")
 Do rs.Execute(PRNr)
 For  Quit:'rs.Next()  Do
 . Set Kenm=rs.GetData($$$Kenm)
 . Set $P(sBasis,Delimiter,$$swdSubNodePos)=$$swdListValuesIndex(rs.GetData($$$Wdn))
 Do rs.%Close()
 Quit sBasis
swdSubNodePos()
 ; SubNode positie opzoeken
 Set KPos=$LF(LBSortKenm,Kenm)
 Quit $S(KPos=0:rs.GetData($$$VolgN), 1:KPos)
swdListValuesIndex(List)
 ; List splitsen in values en als ";"-gescheiden text teruggeven
 Quit:($LL(List)=1) $$swdValueIndex($LI(List,1))
 Quit:($LL(List)=0) 0
 ; Else  Meerdere waarden in list: maakt Index decimaal, bvb. 2.003006  (Index1=2;Index2=3;Index3=6)
 Set Index=$$swdValueIndex($LI(List,1))_"."
 For i=2:1:$LL(List) Set Index=Index_$E(1000+$$swdValueIndex($LG(List,i)), 2,4)
 Quit Index
swdValueIndex(Val)
 Set VPos=$LF($G(KWdnSort(Kenm)),Val)
 If (VPos=0)&&($L(Val)) Do   ; als Val nog niet voorkomt in de $LB
 . Set KWdnSort(Kenm)=$G(KWdnSort(Kenm))_$LB(Val)
 . Set VPos=$LL(KWdnSort(Kenm))
 Quit VPos
 
DeleteViaPRNr()   ; Parameters: PRNr,lbGroepIDs
 Quit:($G(PRNr)="")
 New i
 If $G(lbGroepIDs)="" Do ; Allen
 . Do dvpDeleteGroep(PRNr,"*")
 Else  Do
 . For i=1:1:$LL(lbGroepIDs) Do
 . . Do:$L($LG(lbGroepIDs,i)) dvpDeleteGroep(PRNr,$LG(lbGroepIDs,i)) ; Per groep
 Quit 1
 
dvpDeleteGroep(PRNr,GroepID)
 New DDefID,SQLCODE
 &sql(DECLARE crsDP CURSOR FOR 
 		SELECT ID INTO :DDefID FROM Prod_Kenmerk.DataDefinitie 
 		WHERE (Product=:PRNr) AND ((Kenmerk->Groep = :GroepID) OR (:GroepID="*")) )
 ;Test     
 &sql(OPEN crsDP)
 For  &sql(FETCH crsDP) Quit:SQLCODE  Do ##class(Prod.Kenmerk.DataDefinitie).%DeleteId(DDefID)
 &sql(CLOSE crsDP)
 Quit