#include vhLib.Macro
/*
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)="" ; ""
Do ptcCVTLoopHG
Set arLines($$$INCi)="" ; ""
Quit
ptcCVTLoopHG
For Set iHG=$O(arItems(iHG)) Quit:(iHG="") Do
. Set arLines($$$INCi)=$$$IndentUp_"- "
. Set arLines($$$INCi)=$$$IndentUp_""_$LG(arItems(iHG),OmsLI)_""
. If $$$aHasSubNodes(arItems(iHG)) Do
.. ;Set arLines($$$INCi)=$$$Indent_"oi(this)"
.. ;Set arLines($$$INCi)=$$$Indent_"oi(this)"
.. Set arLines($$$INCi)=$$$Indent_""
. Else Do
.. Set arLines($$$INCi)=$$$Indent_""_$$$Trim($LG(arItems(iHG),$$$liID))_""
.. Set arLines($$$INCi)=$$$Indent_"si('***')"
. If $$$IndentDn ; Nothing
. Set arLines($$$INCi)=$$$IndentDn_"
"
Quit
ptcCVTLoopGR
For Set iGR=$O(arItems(iHG,iGR)) Quit:(iGR="") Do
. Set arLines($$$INCi)=$$$IndentUp_"- "
. Set arLines($$$INCi)=$$$IndentUp_""_$LG(arItems(iHG,iGR),OmsLI)_""
. If $$$aHasSubNodes(arItems(iHG,iGR)) Do
.. ;Set arLines($$$INCi)=$$$Indent_"oi(this)"
.. ;Set arLines($$$INCi)=$$$Indent_"oi(this)"
.. Set arLines($$$INCi)=$$$Indent_""
. Else Do
.. Set arLines($$$INCi)=$$$Indent_""_$$$Trim($LG(arItems(iHG,iGR),$$$liID))_""
.. Set arLines($$$INCi)=$$$Indent_"si('***')"
. If $$$IndentDn ; Nothing
. Set arLines($$$INCi)=$$$IndentDn_"
"
Quit
ptcCVTLoopSG
For Set iSG=$O(arItems(iHG,iGR,iSG)) Quit:(iSG="") Do
. Set arLines($$$INCi)=$$$IndentUp_"- "
. Set arLines($$$INCi)=$$$IndentUp_""_$LG(arItems(iHG,iGR,iSG),OmsLI)_""
. Set arLines($$$INCi)=$$$Indent_""_$$$Trim($LG(arItems(iHG,iGR,iSG),$$$liID))_""
. Set arLines($$$INCi)=$$$IndentDn_"si('***')"
. Set arLines($$$INCi)=$$$IndentDn_"
"
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