#include %VHMacro
 
 /*
ProductTreeCodeFetch(Row,AtEnd)   ; Row en AtEnd als .locals doorgeven
 Set Row=""
 Set AtEnd=0
 Set iPTreeLines=$O(arPTreeLines(iPTreeLines))
 If iPTreeLines=""  Set AtEnd=1  Quit 
 Set Row=$LB(iPTreeLines,$G(arPTreeLines(iPTreeLines)))
 Quit
	
ProductTreeCodeClose
 Kill arPTreeLines
 Kill iPTreeLines
 Quit
 */
 
ProductTreeCodeExecute   ; Parameters: OutputMode,Taal(="N")
#define IndentItems   0
 If $G(Taal)="" Set Taal="N"
 New tmpAr
 Kill tmpAr
 Do ptcBuildItemsArray(.tmpAr)
  ;d WLIP^vhDBG(15,$$$ArrayTT("tmpAr"))
 Kill arPTreeLines
 Do:($G(OutputMode)="JS_TM" ) ptcItemsToJSTM(.tmpAr,.arPTreeLines)
 Do:($G(OutputMode)="XML_CT") ptcItemsToXMLCT(.tmpAr,.arPTreeLines)
 Set iPTreeLines=""
 Quit
ptcBuildItemsArray(arItems)   ; arItems als .local doorgeven
 // arLines("01HG","01GR","01SG")=$LB(FullID,OmsN,OmsF)
 New i,crsHG,crsGR,crsSG,pID,SortKey,OmsN,OmsF,ECType
 Kill arItems
  ;w "building array ...  ",!
 ; Loop through all HG's
 &sql(DECLARE crsHG CURSOR FOR 
         SELECT PGroep.ID,PGroep.SortSleutel,PGroep.OmschrijvingN,PGroep.OmschrijvingF,PKlas.ECType INTO :pID,:SortKey,:OmsN,:OmsF,:ECType 
         FROM Prod_Klas.HoofdGroep PGroep, Prod_Klas.Klas PKlas 
         WHERE PKlas.KKey=PGroep.Klas AND PKlas.ECType>0
         ORDER BY PGroep.SortSleutel)
 &sql(OPEN crsHG)
 For  &sql(FETCH crsHG) Quit:SQLCODE  Do ptcAddToArrayHG
 &sql(CLOSE crsHG)
 ; Loop through all GR's
 &sql(DECLARE crsGR CURSOR FOR 
         SELECT PGroep.ID,PGroep.SortSleutel,PGroep.OmschrijvingN,PGroep.OmschrijvingF,PKlas.ECType INTO :pID,:SortKey,:OmsN,:OmsF,:ECType 
         FROM Prod_Klas.Groep PGroep, Prod_Klas.Klas PKlas 
         WHERE PKlas.KKey=PGroep.Klas AND PKlas.ECType>0
         ORDER BY PGroep.SortSleutel)
 &sql(OPEN crsGR)
 For  &sql(FETCH crsGR) Quit:SQLCODE  Do ptcAddToArrayGR
 &sql(CLOSE crsGR)
 ; Loop through all SG's
 &sql(DECLARE crsSG CURSOR FOR 
         SELECT PGroep.ID,PGroep.SortSleutel,PGroep.OmschrijvingN,PGroep.OmschrijvingF,PKlas.ECType INTO :pID,:SortKey,:OmsN,:OmsF,:ECType 
         FROM Prod_Klas.SubGroep PGroep, Prod_Klas.Klas PKlas, Prod_Klas.Klas PKlasGrp 
         WHERE PKlas.KKey=PGroep.Klas AND PKlas.ECType>0 AND PKlas.Groep=PKlasGrp.KKey AND PKlasGrp.ECType=1
         ORDER BY PGroep.SortSleutel)
 &sql(OPEN crsSG)
 For  &sql(FETCH crsSG) Quit:SQLCODE  Do ptcAddToArraySG
 &sql(CLOSE crsSG)
  ;w "done.",!
  ;w $$$ArrayTT("arLines")
 Quit
ptcAddToArrayHG
   ;q:(+SortKey>4)
 Quit:($G(OutputMode)["_CT")&&(+SortKey>2)   ; Loading CT-tree takes a long time when lot of items. Cut off at HG02
 Set arItems($E(SortKey,1,4))=$LB(SortKey,OmsN,OmsF)
 Quit
ptcAddToArrayGR
 Set:($D(arItems($E(SortKey,1,4)))) arItems($E(SortKey,1,4),$E(SortKey,5,9))=$LB(SortKey,OmsN,OmsF)
 Quit
ptcAddToArraySG
   ;q:(+SortKey>4)
 Set:($D(arItems($E(SortKey,1,4),$E(SortKey,5,9)))) arItems($E(SortKey,1,4),$E(SortKey,5,9),$E(SortKey,10,14))=$LB(SortKey,OmsN,OmsF)
 Quit
 
 // Convert Items to JavaScript (for TreeMenu)
ptcItemsToJSTM(arItems,arLines)   ; arItems en arLines als .local doorgeven
#define INCi         $INCREMENT(i)
#define IndentUp     $$ptcIndentChange(+1)
#define Indent       $$ptcIndentChange(0)
#define IndentDn     $$ptcIndentChange(-1)
#define liID         1
#define CvtID(%v)    $TR(%v,"*","x")
 New i,OmsLI,iHG,iGR,iSG,Indent,AuxHG,AuxGR,lbAuxHG,lbAuxGR,lbItemsSG
 Set i=0
 Set OmsLI=$S(Taal="F":3, 1:2)
 Set lbAuxHG=""
 Set (iHG,iGR,iSG)=""
 Set arLines($$$INCi)=$$$IndentUp
 Do ptcCVTLoopHG2
 Set arLines($$$INCi)=$$$IndentDn
 Set arLines($$$INCi)=$$$Indent_"foldersTree.addChildren(["_$$LCVTSimple^vhLib(lbAuxHG,",")_"])"
 Quit
ptcCVTLoopHG2
 For  Set iHG=$O(arItems(iHG)) Quit:(iHG="")  Do
 . Set AuxHG="aux"_$$$CvtID(iHG)
 . Set lbAuxHG=lbAuxHG_$LB(AuxHG)
 . If $$$aHasSubNodes(arItems(iHG)) Do
 ..  Set arLines($$$INCi)=$$$Indent_AuxHG_"=gFld("""_$LG(arItems(iHG),OmsLI)_""","""")"
 ..  Set lbAuxGR=""
 ..  If $$$IndentUp  ; Nothing
 ..  Do ptcCVTLoopGR2
 ..  If $$$IndentDn  ; Nothing
 ..  Set arLines($$$INCi)=$$$Indent_AuxHG_".addChildren(["_$$LCVTSimple^vhLib(lbAuxGR,",")_"])"
 . Else  Do
 ..  Set arLines($$$INCi)=$$$Indent_AuxHG_"=gLnk(""JS"","""_$LG(arItems(iHG),OmsLI)_""",""si('"_$$$Trim($LG(arItems(iHG),$$$liID))_"')"")"   ; BldRef("""_$$$Trim($LG(arItems(iHG),$$$liID))_""")
 Quit
ptcCVTLoopGR2
 For  Set iGR=$O(arItems(iHG,iGR)) Quit:(iGR="")  Do
 . Set AuxGR="aux"_$$$CvtID(iHG_iGR)
 . Set lbAuxGR=lbAuxGR_$LB(AuxGR)
 . If $$$aHasSubNodes(arItems(iHG,iGR)) Do
 ..  Set arLines($$$INCi)=$$$Indent_AuxGR_"=gFld("""_$LG(arItems(iHG,iGR),OmsLI)_""","""")"
 ..  Set lbItemsSG=""
 ..  Do ptcCVTLoopSG2
 ..  Set arLines($$$INCi)=$$$Indent_AuxGR_".addChildren(["_$$LCVTSimple^vhLib(lbItemsSG,",")_"])"
 . Else  Do
 ..  Set arLines($$$INCi)=$$$Indent_AuxGR_"=gLnk(""JS"","""_$LG(arItems(iHG,iGR),OmsLI)_""",""si('"_$$$Trim($LG(arItems(iHG,iGR),$$$liID))_"')"")"   ; BldRef("""_$$$Trim($LG(arItems(iHG,iGR),$$$liID))_""")
 Quit
ptcCVTLoopSG2
 For  Set iSG=$O(arItems(iHG,iGR,iSG)) Quit:(iSG="")  Do
 . Set lbItemsSG=lbItemsSG_$LB("["""_$LG(arItems(iHG,iGR,iSG),OmsLI)_""",""si('"_$$$Trim($LG(arItems(iHG,iGR,iSG),$$$liID))_"')""]")   ; BldRef("""_$$$Trim($LG(arItems(iHG,iGR,iSG),$$$liID))_""")
 Quit
 
 // Convert Items to XML (for CodeThat Tree)
ptcItemsToXMLCT(arItems,arLines)   ; arItems en arLines als .local doorgeven
#define INCi         $INCREMENT(i)
#define IndentUp     $$ptcIndentChange(+1)
#define Indent       $$ptcIndentChange(0)
#define IndentDn     $$ptcIndentChange(-1)
#define liID         1
 ;Set arPTreeLines(1)="Test lijn 1"
 ;Set arPTreeLines(2)="Test lijn 2"
 New i,OmsLI,iHG,iGR,iSG,Indent
 Set i=0
 Set OmsLI=$S(Taal="F":3, 1:2)
 Set (iHG,iGR,iSG)=""
 Set arLines($$$INCi)=""   ; "<items>"
 Do ptcCVTLoopHG
 Set arLines($$$INCi)=""   ; "</items>"
 Quit
ptcCVTLoopHG
 For  Set iHG=$O(arItems(iHG)) Quit:(iHG="")  Do
 . Set arLines($$$INCi)=$$$IndentUp_"<item>"
 . Set arLines($$$INCi)=$$$IndentUp_"<text>"_$LG(arItems(iHG),OmsLI)_"</text>"
 . If $$$aHasSubNodes(arItems(iHG)) Do
 ..  ;Set arLines($$$INCi)=$$$Indent_"<onopen>oi(this)</onopen>"
 ..  ;Set arLines($$$INCi)=$$$Indent_"<onclose>oi(this)</onclose>"
 ..  Set arLines($$$INCi)=$$$Indent_"<menu>"
 ..  Set arLines($$$INCi)=$$$IndentUp_"<items>"
 ..  Do ptcCVTLoopGR
 ..  Set arLines($$$INCi)=$$$IndentDn_"</items>"
 ..  Set arLines($$$INCi)=$$$Indent_"</menu>"
 . Else  Do
 ..  Set arLines($$$INCi)=$$$Indent_"<id>"_$$$Trim($LG(arItems(iHG),$$$liID))_"</id>"
 ..  Set arLines($$$INCi)=$$$Indent_"<action><js>si('***')</js></action>"
 . If $$$IndentDn  ; Nothing
 . Set arLines($$$INCi)=$$$IndentDn_"</item>"
 Quit
ptcCVTLoopGR
 For  Set iGR=$O(arItems(iHG,iGR)) Quit:(iGR="")  Do
 . Set arLines($$$INCi)=$$$IndentUp_"<item>"
 . Set arLines($$$INCi)=$$$IndentUp_"<text>"_$LG(arItems(iHG,iGR),OmsLI)_"</text>"
 . If $$$aHasSubNodes(arItems(iHG,iGR)) Do
 ..  ;Set arLines($$$INCi)=$$$Indent_"<onopen>oi(this)</onopen>"
 ..  ;Set arLines($$$INCi)=$$$Indent_"<onclose>oi(this)</onclose>"
 ..  Set arLines($$$INCi)=$$$Indent_"<menu>"
 ..  Set arLines($$$INCi)=$$$IndentUp_"<items>"
 ..  Do ptcCVTLoopSG
 ..  Set arLines($$$INCi)=$$$IndentDn_"</items>"
 ..  Set arLines($$$INCi)=$$$Indent_"</menu>"
 . Else  Do
 ..  Set arLines($$$INCi)=$$$Indent_"<id>"_$$$Trim($LG(arItems(iHG,iGR),$$$liID))_"</id>"
 ..  Set arLines($$$INCi)=$$$Indent_"<action><js>si('***')</js></action>"
 . If $$$IndentDn  ; Nothing
 . Set arLines($$$INCi)=$$$IndentDn_"</item>"
 Quit
ptcCVTLoopSG
 For  Set iSG=$O(arItems(iHG,iGR,iSG)) Quit:(iSG="")  Do
 . Set arLines($$$INCi)=$$$IndentUp_"<item>"
 . Set arLines($$$INCi)=$$$IndentUp_"<text>"_$LG(arItems(iHG,iGR,iSG),OmsLI)_"</text>"
 . Set arLines($$$INCi)=$$$Indent_"<id>"_$$$Trim($LG(arItems(iHG,iGR,iSG),$$$liID))_"</id>"
 . Set arLines($$$INCi)=$$$IndentDn_"<action><js>si('***')</js></action>"
 . Set arLines($$$INCi)=$$$IndentDn_"</item>"
 Quit
 
 
ptcIndentChange(N,blnAbsolute)
#define ChrIndent   $C(9)
 Quit:('$$$IndentItems) ""
 Set N=N\1
 If $G(blnAbsolute) Do  Quit Indent
 . Set Indent=$S(N=1:$$$ChrIndent, 1:"")
 . Quit:(N<2)
 . Set $P(Indent,$$$ChrIndent,N+1)=""
 ; Else 
 Set Indent=$G(Indent)
 Quit:(N=0) Indent
 If N>0 Do  Quit Indent
 . New i
 . For i=1:1:N Set Indent=Indent_$$$ChrIndent
 ;Else
 New tmpIndent
 If -N>$L(Indent) Do
 . Set tmpIndent=Indent
 . Set Indent=""
 Else  Do
 . Set tmpIndent=Indent
 . Set Indent=$E(Indent,1,$L(Indent)+N)   ; N is negatief
 Quit tmpIndent
 
 
VhisieLog(KLNr)
 New t,k,i,tmpAr
 Set KLNr=$G(KLNr)
 Set (t,k,i)=""
 For  Set t=$O(^ATK("L",t)) Quit:(t="")  Do
 . For  Set k=$O(^ATK("L",t,k)) Quit:(k="")  Do:(k=KLNr)||(KLNr="")
 ..  For  Set i=$O(^ATK("L",t,k,i)) Quit:(i="")  Do 
 ...   Merge tmpAr(k,$P(i,"\",1),t)=^ATK("L",t,k,i)
 ;zw tmpAr
 Do vhlAnalyseLog 
 w $$ArrayToText^vhLib($Na(tmpAr("S")))
 Quit
vhlAnalyseLog
 New i,k,t,h,tmpLB,Log1
 Set (i,k,t,h)=""
 For  Set k=$O(tmpAr(k)) Quit:(k="")  Do:(k'="S")
 . For  Set i=$O(tmpAr(k,i)) Quit:(i="")  Do
 ..  Set tmpAr("S",k,i)=""
 ..  For  Set t=$O(tmpAr(k,i,t)) Quit:(t="")  Do
 ...   Set tmpLB=""
 ...   Set Log1=""
 ...   For  Set h=$O(tmpAr(k,i,t,h)) Quit:(h="")  Do
 ....    If $G(tmpAr(k,i,t,h),"1")="1" Set Log1=h
 ....    Else  Set tmpLB=tmpLB_$LB($ZT(h,2)_"-"_tmpAr(k,i,t,h))
 ...   Set:(tmpLB="") tmpLB=$LB($ZT(h,2)_"-1")
 ...   Set tmpLB=$LB($ZD(t,4),tmpLB)
 ...   Set tmpAr("S",k,i)=tmpAr("S",k,i)_tmpLB
 Quit