BTPWLTMP ;VNGT/HS/ALA-TIU Templates for CMET Letters ; 18 Mar 2009 11:16 AM
;;1.1;CARE MANAGEMENT EVENT TRACKING;**3**;Apr 01, 2015;Build 14
;
;
EN(DATA,FAKE) ; EP -- BTPW GET TIU LIST
NEW UID,II,HDR,RN,RTIEN,LIST1,LIST,DOC,DIEN,TIUDA,ARRAY,CT,TMCHILD,TOP,CHILD,DOCA
NEW L1,L2,L3,L4,L5,L6,LVL1,LVL2,LVL3,LVL4,LVL5,LVL6,ROOT,TIUDA1,TIUDA2,TIUDA3,TIUDA4,TIUDA5
NEW LSNM
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWLTMP",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWLTMP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S HDR="T00060TOP^T00001CHILDREN^T00060LEVEL1^T00060LEVEL2^T00060LEVEL3^T00060LEVEL4^T00060LEVEL5^T00060LEVEL6"_$C(30)
S @DATA@(II)=HDR
D GETROOTS^TIUSRVT(.LIST,.DUZ)
S RN=0
F S RN=$O(LIST(RN)) Q:RN="" D
. S RTIEN=$P(LIST(RN),U,1)
. D TACCESS^TIUSRVT2(.LIST1,RTIEN,.DUZ)
. ; 0 = FULL ACCESS, 1 = READ ONLY, 2 = NO ACCESS,
. ; 3 = SHARED TEMPLATES EDITOR - ACCESS PARAMETERS DO NOT APPLY
. ;I $G(LIST1)=1!($G(LIST1)=2) K LIST(RN) Q
. I $G(LIST1)=2 K LIST(RN) Q
. S LSNM=$$UP^XLFSTR($P(LIST(RN),U,4))
. I LSNM'="SHARED TEMPLATES"&(LSNM'="MY TEMPLATES") K LIST(RN) Q
. ;I $P(LIST(RN),U,4)'="Shared Templates"&($P(LIST(RN),U,4)'="My Templates") K LIST(RN) Q
. K DOC
. ; one
. D GETITEMS^TIUSRVT(.DOC,RTIEN)
. S DIEN=0
. F S DIEN=$O(@DOC@(DIEN)) Q:'DIEN D
.. I $P(@DOC@(DIEN),U,3)'="A" Q
.. S TIUDA=$P(@DOC@(DIEN),U,1)
.. S ARRAY(RTIEN,TIUDA)=@DOC@(DIEN) Q
. S TIUDA=""
. F S TIUDA=$O(ARRAY(RTIEN,TIUDA)) Q:TIUDA="" D
.. ; Has Children flag (0=NONE,1=ACTIVE,2=INACTIVE,3=BOTH
.. S TMCHILD=$P(ARRAY(RTIEN,TIUDA),U,8) I TMCHILD=2 Q
.. K @DOC
.. ; two
.. D GETITEMS^TIUSRVT(.DOCA,TIUDA)
.. S DIEN=0,CT=0
.. F S DIEN=$O(@DOC@(DIEN)) Q:'DIEN D
... I $P(@DOC@(DIEN),U,3)'="A" Q
... I $P(@DOC@(DIEN),U,8)=2 Q
... S CT=CT+$P(@DOC@(DIEN),U,8)
... S TIUDA1=$P(@DOC@(DIEN),U,1)
... S ARRAY(RTIEN,TIUDA,TIUDA1)=@DOC@(DIEN)
.. I CT=0 Q
.. S TIUDA1=""
.. F S TIUDA1=$O(ARRAY(RTIEN,TIUDA,TIUDA1)) Q:TIUDA1="" D
... S TMCHILD=$P(ARRAY(RTIEN,TIUDA,TIUDA1),U,8) I TMCHILD=2 Q
... K @DOC
... ; three
... D GETITEMS^TIUSRVT(.DOCA,TIUDA1)
... S DIEN=0,CT=0
... F S DIEN=$O(@DOC@(DIEN)) Q:'DIEN D
.... I $P(@DOC@(DIEN),U,3)'="A" Q
.... I $P(@DOC@(DIEN),U,8)=2 Q
.... S CT=CT+$P(@DOC@(DIEN),U,8)
.... S TIUDA2=$P(@DOC@(DIEN),U,1)
.... S ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2)=@DOC@(DIEN)
... I CT=0 Q
... S TIUDA2=""
... F S TIUDA2=$O(ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2)) Q:TIUDA2="" D
.... S TMCHILD=$P(ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2),U,8) I TMCHILD=2 Q
.... K @DOC
.... ; four
.... D GETITEMS^TIUSRVT(.DOCA,TIUDA2)
.... S DIEN=0,CT=0
.... F S DIEN=$O(@DOC@(DIEN)) Q:'DIEN D
..... I $P(@DOC@(DIEN),U,3)'="A" Q
..... I $P(@DOC@(DIEN),U,8)=2 Q
..... S CT=CT+$P(@DOC@(DIEN),U,8)
..... S TIUDA3=$P(@DOC@(DIEN),U,1)
..... S ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2,TIUDA3)=@DOC@(DIEN)
.... I CT=0 Q
.... S TIUDA3=""
.... F S TIUDA3=$O(ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2,TIUDA3)) Q:TIUDA3="" D
..... S TMCHILD=$P(ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2,TIUDA3),U,8) I TMCHILD=2 Q
..... K @DOC
..... ; five
..... D GETITEMS^TIUSRVT(.DOCA,TIUDA3)
..... S DIEN=0,CT=0
..... F S DIEN=$O(@DOC@(DIEN)) Q:'DIEN D
...... I $P(@DOC@(DIEN),U,3)'="A" Q
...... I $P(@DOC@(DIEN),U,8)=2 Q
...... S CT=CT+$P(@DOC@(DIEN),U,8)
...... S TIUDA4=$P(@DOC@(DIEN),U,1)
...... S ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2,TIUDA3,TIUDA4)=@DOC@(DIEN)
..... I CT=0 Q
..... S TIUDA4=""
..... F S TIUDA4=$O(ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2,TIUDA3,TIUDA4)) Q:TIUDA4="" D
...... S TMCHILD=$P(ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2,TIUDA3,TIUDA4),U,8) I TMCHILD=2 Q
...... K @DOC
...... ; six
...... D GETITEMS^TIUSRVT(.DOCA,TIUDA4)
...... S DIEN=0,CT=0
...... F S DIEN=$O(@DOC@(DIEN)) Q:'DIEN D
....... I $P(@DOC@(DIEN),U,3)'="A" Q
....... I $P(@DOC@(DIEN),U,8)=2 Q
....... S CT=CT+$P(@DOC@(DIEN),U,8)
....... S TIUDA5=$P(@DOC@(DIEN),U,1)
....... S ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2,TIUDA3,TIUDA4,TIUDA5)=@DOC@(DIEN)
. ;
. S TOP=$P(LIST(RN),U,4),CHILD=$S($D(ARRAY(RTIEN))>1:"Y",1:"N")
. S (LVL1,LVL2,LVL3,LVL4,LVL5,LVL6)="",TOP=RTIEN_$C(28)_TOP
. S ROOT=TOP_U_CHILD_U_LVL1_U_LVL2_U_LVL3_U_LVL4_U_LVL5_U_LVL6
. S II=II+1,@DATA@(II)=ROOT_$C(30)
. S L1=""
. F S L1=$O(ARRAY(RTIEN,L1)) Q:L1="" D
.. S CHILD=$S($D(ARRAY(RTIEN,L1))>1:"Y",1:"N")
.. S LVL1=$P(ARRAY(RTIEN,L1),U,1)_$C(28)_$P(ARRAY(RTIEN,L1),U,4)
.. S ROOT=TOP_U_CHILD_U_LVL1_U_LVL2_U_LVL3_U_LVL4_U_LVL5_U_LVL6
.. S II=II+1,@DATA@(II)=ROOT_$C(30)
.. S L2=""
.. F S L2=$O(ARRAY(RTIEN,L1,L2)) Q:L2="" D
... S CHILD=$S($D(ARRAY(RTIEN,L1,L2))>1:"Y",1:"N")
... S LVL2=$P(ARRAY(RTIEN,L1,L2),U,1)_$C(28)_$P(ARRAY(RTIEN,L1,L2),U,4)
... S ROOT=TOP_U_CHILD_U_LVL1_U_LVL2_U_LVL3_U_LVL4_U_LVL5_U_LVL6
... S II=II+1,@DATA@(II)=ROOT_$C(30)
... S L3=""
... F S L3=$O(ARRAY(RTIEN,L1,L2,L3)) Q:L3="" D
.... S CHILD=$S($D(ARRAY(RTIEN,L1,L2,L3))>1:"Y",1:"N")
.... S LVL3=$P(ARRAY(RTIEN,L1,L2,L3),U,1)_$C(28)_$P(ARRAY(RTIEN,L1,L2,L3),U,4)
.... S ROOT=TOP_U_CHILD_U_LVL1_U_LVL2_U_LVL3_U_LVL4_U_LVL5_U_LVL6
.... S II=II+1,@DATA@(II)=ROOT_$C(30)
.... S L4=""
.... F S L4=$O(ARRAY(RTIEN,L1,L2,L3,L4)) Q:L4="" D
..... S CHILD=$S($D(ARRAY(RTIEN,L1,L2,L3,L4))>1:"Y",1:"N")
..... S LVL4=$P(ARRAY(RTIEN,L1,L2,L3,L4),U,1)_$C(28)_$P(ARRAY(RTIEN,L1,L2,L3,L4),U,4)
..... S ROOT=TOP_U_CHILD_U_LVL1_U_LVL2_U_LVL3_U_LVL4_U_LVL5_U_LVL6
..... S II=II+1,@DATA@(II)=ROOT_$C(30)
..... S L5=""
..... F S L5=$O(ARRAY(RTIEN,L1,L2,L3,L4,L5)) Q:L5="" D
...... S CHILD=$S($D(ARRAY(RTIEN,L1,L2,L3,L4,L5))>1:"Y",1:"N")
...... S LVL5=$P(ARRAY(RTIEN,L1,L2,L3,L4,L5),U,1)_$C(28)_$P(ARRAY(RTIEN,L1,L2,L3,L4,L5),U,4)
...... S ROOT=TOP_U_CHILD_U_LVL1_U_LVL2_U_LVL3_U_LVL4_U_LVL5_U_LVL6
...... S II=II+1,@DATA@(II)=ROOT_$C(30)
...... S L6=""
...... F S L6=$O(ARRAY(RTIEN,L1,L2,L3,L4,L5,L6)) Q:L6="" D
....... S CHILD=$S($D(ARRAY(RTIEN,L1,L2,L3,L4,L5,L6))>1:"Y",1:"N")
....... S LVL6=$P(ARRAY(RTIEN,L1,L2,L3,L4,L5,L6),U,1)_$C(28)_$P(ARRAY(RTIEN,L1,L2,L3,L4,L5,L6),U,4)
....... S ROOT=TOP_U_CHILD_U_LVL1_U_LVL2_U_LVL3_U_LVL4_U_LVL5_U_LVL6
....... S II=II+1,@DATA@(II)=ROOT_$C(30)
...... S LVL6=""
..... S LVL5=""
.... S LVL4=""
... S LVL3=""
.. S LVL2=""
. S LVL1=""
K ARRAY
S II=II+1,@DATA@(II)=$C(31)
Q
;
TOP(DATA,FAKE) ; EP -- BTPW GET TIU TEMP TOP
NEW UID,II,HDR
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWTMPL",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWLTMP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
NEW TDATA,BQII,NDATA,RN,RTIEN,LIST1,LIST,DIEN,DOC,TMCHILD,NN,BWI,QFL,NTO,BTII,BTW
NEW LSNM
;
S HDR="I00010ROOT_IEN^T00035ROOT_NAME^T00001CHILDREN"
S @DATA@(II)=HDR_$C(30)
;
D GETROOTS^TIUSRVT(.LIST,.DUZ)
S RN=0
F S RN=$O(LIST(RN)) Q:RN="" D
. S RTIEN=$P(LIST(RN),U,1)
. D TACCESS^TIUSRVT2(.LIST1,RTIEN,.DUZ)
. ; 0 = FULL ACCESS, 1 = READ ONLY, 2 = NO ACCESS,
. ; 3 = SHARED TEMPLATES EDITOR - ACCESS PARAMETERS DO NOT APPLY
. ;I $G(LIST1)=1!($G(LIST1)=2) K LIST(RN) Q
. I $G(LIST1)=2 K LIST(RN) Q
. S LSNM=$$UP^XLFSTR($P(LIST(RN),U,4))
. I LSNM'="SHARED TEMPLATES"&(LSNM'="MY TEMPLATES") K LIST(RN) Q
. ;I $P(LIST(RN),U,4)'="Shared Templates"&($P(LIST(RN),U,4)'="My Templates") K LIST(RN) Q
. ; Has Children flag (0=NONE,1=ACTIVE,2=INACTIVE,3=BOTH
. S CHILD=$P(LIST(RN),U,8) I CHILD=2 Q
. S CHILD="Y"
. S II=II+1,@DATA@(II)=RTIEN_U_$P(LIST(RN),U,4)_U_CHILD_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
CHLD(DATA,TMPLIEN) ; EP -- BTPW GET TIU TEMP CHILD
;
NEW UID,II,HDR,TMCHILD,RTIEN,XDATA
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWTMPLC",UID)),XDATA=$NA(^XTMP("BTPWTEMPL"))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWLTMP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="I00010ROOT_IEN^T00001ROOT_TYPE^T00035ROOT_NAME^T00001CHILDREN"
S @DATA@(II)=HDR_$C(30)
K DOC
D GETITEMS^TIUSRVT(.DOC,TMPLIEN)
S DIEN=0
F S DIEN=$O(@DOC@(DIEN)) Q:'DIEN D
. I $P(@DOC@(DIEN),U,3)'="A" Q
. ; Has Children flag (0=NONE,1=ACTIVE,2=INACTIVE,3=BOTH
. S TMCHILD=$P(@DOC@(DIEN),U,8)
. I TMCHILD=2 Q
. S TMCHILD=$S(TMCHILD=0:"N",1:"Y")
. S RTIEN=$P(@DOC@(DIEN),U,1)
. I $D(@XDATA@(RTIEN)) Q
. S II=II+1,@DATA@(II)=$P(@DOC@(DIEN),U,1)_U_$P(@DOC@(DIEN),U,2)_U_$P(@DOC@(DIEN),U,4)_U_TMCHILD_$C(30)
K @DOC
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
;
UPD ;EP - Update templates with objects
; Set list for templates with |V | data objects
NEW XDATA
S XDATA=$NA(^XTMP("BTPWTEMPL"))
K @XDATA
S @XDATA@(0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"Templates containing |V | data objects"
NEW TMPN,BLN
S TMPN=0
F S TMPN=$O(^TIU(8927,TMPN)) Q:'TMPN D
. S BLN=0
. F S BLN=$O(^TIU(8927,TMPN,2,BLN)) Q:'BLN D
.. I ^TIU(8927,TMPN,2,BLN,0)["|V " S @XDATA@(TMPN)=""
Q
BTPWLTMP ;VNGT/HS/ALA-TIU Templates for CMET Letters ; 18 Mar 2009 11:16 AM
+1 ;;1.1;CARE MANAGEMENT EVENT TRACKING;**3**;Apr 01, 2015;Build 14
+2 ;
+3 ;
EN(DATA,FAKE) ; EP -- BTPW GET TIU LIST
+1 NEW UID,II,HDR,RN,RTIEN,LIST1,LIST,DOC,DIEN,TIUDA,ARRAY,CT,TMCHILD,TOP,CHILD,DOCA
+2 NEW L1,L2,L3,L4,L5,L6,LVL1,LVL2,LVL3,LVL4,LVL5,LVL6,ROOT,TIUDA1,TIUDA2,TIUDA3,TIUDA4,TIUDA5
+3 NEW LSNM
+4 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+5 SET DATA=$NAME(^TMP("BTPWLTMP",UID))
+6 KILL @DATA
+7 SET II=0
+8 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWLTMP D UNWIND^%ZTER"
+9 SET HDR="T00060TOP^T00001CHILDREN^T00060LEVEL1^T00060LEVEL2^T00060LEVEL3^T00060LEVEL4^T00060LEVEL5^T00060LEVEL6"_$CHAR(30)
+10 SET @DATA@(II)=HDR
+11 DO GETROOTS^TIUSRVT(.LIST,.DUZ)
+12 SET RN=0
+13 FOR
SET RN=$ORDER(LIST(RN))
IF RN=""
QUIT
Begin DoDot:1
+14 SET RTIEN=$PIECE(LIST(RN),U,1)
+15 DO TACCESS^TIUSRVT2(.LIST1,RTIEN,.DUZ)
+16 ; 0 = FULL ACCESS, 1 = READ ONLY, 2 = NO ACCESS,
+17 ; 3 = SHARED TEMPLATES EDITOR - ACCESS PARAMETERS DO NOT APPLY
+18 ;I $G(LIST1)=1!($G(LIST1)=2) K LIST(RN) Q
+19 IF $GET(LIST1)=2
KILL LIST(RN)
QUIT
+20 SET LSNM=$$UP^XLFSTR($PIECE(LIST(RN),U,4))
+21 IF LSNM'="SHARED TEMPLATES"&(LSNM'="MY TEMPLATES")
KILL LIST(RN)
QUIT
+22 ;I $P(LIST(RN),U,4)'="Shared Templates"&($P(LIST(RN),U,4)'="My Templates") K LIST(RN) Q
+23 KILL DOC
+24 ; one
+25 DO GETITEMS^TIUSRVT(.DOC,RTIEN)
+26 SET DIEN=0
+27 FOR
SET DIEN=$ORDER(@DOC@(DIEN))
IF 'DIEN
QUIT
Begin DoDot:2
+28 IF $PIECE(@DOC@(DIEN),U,3)'="A"
QUIT
+29 SET TIUDA=$PIECE(@DOC@(DIEN),U,1)
+30 SET ARRAY(RTIEN,TIUDA)=@DOC@(DIEN)
QUIT
End DoDot:2
+31 SET TIUDA=""
+32 FOR
SET TIUDA=$ORDER(ARRAY(RTIEN,TIUDA))
IF TIUDA=""
QUIT
Begin DoDot:2
+33 ; Has Children flag (0=NONE,1=ACTIVE,2=INACTIVE,3=BOTH
+34 SET TMCHILD=$PIECE(ARRAY(RTIEN,TIUDA),U,8)
IF TMCHILD=2
QUIT
+35 KILL @DOC
+36 ; two
+37 DO GETITEMS^TIUSRVT(.DOCA,TIUDA)
+38 SET DIEN=0
SET CT=0
+39 FOR
SET DIEN=$ORDER(@DOC@(DIEN))
IF 'DIEN
QUIT
Begin DoDot:3
+40 IF $PIECE(@DOC@(DIEN),U,3)'="A"
QUIT
+41 IF $PIECE(@DOC@(DIEN),U,8)=2
QUIT
+42 SET CT=CT+$PIECE(@DOC@(DIEN),U,8)
+43 SET TIUDA1=$PIECE(@DOC@(DIEN),U,1)
+44 SET ARRAY(RTIEN,TIUDA,TIUDA1)=@DOC@(DIEN)
End DoDot:3
+45 IF CT=0
QUIT
+46 SET TIUDA1=""
+47 FOR
SET TIUDA1=$ORDER(ARRAY(RTIEN,TIUDA,TIUDA1))
IF TIUDA1=""
QUIT
Begin DoDot:3
+48 SET TMCHILD=$PIECE(ARRAY(RTIEN,TIUDA,TIUDA1),U,8)
IF TMCHILD=2
QUIT
+49 KILL @DOC
+50 ; three
+51 DO GETITEMS^TIUSRVT(.DOCA,TIUDA1)
+52 SET DIEN=0
SET CT=0
+53 FOR
SET DIEN=$ORDER(@DOC@(DIEN))
IF 'DIEN
QUIT
Begin DoDot:4
+54 IF $PIECE(@DOC@(DIEN),U,3)'="A"
QUIT
+55 IF $PIECE(@DOC@(DIEN),U,8)=2
QUIT
+56 SET CT=CT+$PIECE(@DOC@(DIEN),U,8)
+57 SET TIUDA2=$PIECE(@DOC@(DIEN),U,1)
+58 SET ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2)=@DOC@(DIEN)
End DoDot:4
+59 IF CT=0
QUIT
+60 SET TIUDA2=""
+61 FOR
SET TIUDA2=$ORDER(ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2))
IF TIUDA2=""
QUIT
Begin DoDot:4
+62 SET TMCHILD=$PIECE(ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2),U,8)
IF TMCHILD=2
QUIT
+63 KILL @DOC
+64 ; four
+65 DO GETITEMS^TIUSRVT(.DOCA,TIUDA2)
+66 SET DIEN=0
SET CT=0
+67 FOR
SET DIEN=$ORDER(@DOC@(DIEN))
IF 'DIEN
QUIT
Begin DoDot:5
+68 IF $PIECE(@DOC@(DIEN),U,3)'="A"
QUIT
+69 IF $PIECE(@DOC@(DIEN),U,8)=2
QUIT
+70 SET CT=CT+$PIECE(@DOC@(DIEN),U,8)
+71 SET TIUDA3=$PIECE(@DOC@(DIEN),U,1)
+72 SET ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2,TIUDA3)=@DOC@(DIEN)
End DoDot:5
+73 IF CT=0
QUIT
+74 SET TIUDA3=""
+75 FOR
SET TIUDA3=$ORDER(ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2,TIUDA3))
IF TIUDA3=""
QUIT
Begin DoDot:5
+76 SET TMCHILD=$PIECE(ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2,TIUDA3),U,8)
IF TMCHILD=2
QUIT
+77 KILL @DOC
+78 ; five
+79 DO GETITEMS^TIUSRVT(.DOCA,TIUDA3)
+80 SET DIEN=0
SET CT=0
+81 FOR
SET DIEN=$ORDER(@DOC@(DIEN))
IF 'DIEN
QUIT
Begin DoDot:6
+82 IF $PIECE(@DOC@(DIEN),U,3)'="A"
QUIT
+83 IF $PIECE(@DOC@(DIEN),U,8)=2
QUIT
+84 SET CT=CT+$PIECE(@DOC@(DIEN),U,8)
+85 SET TIUDA4=$PIECE(@DOC@(DIEN),U,1)
+86 SET ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2,TIUDA3,TIUDA4)=@DOC@(DIEN)
End DoDot:6
+87 IF CT=0
QUIT
+88 SET TIUDA4=""
+89 FOR
SET TIUDA4=$ORDER(ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2,TIUDA3,TIUDA4))
IF TIUDA4=""
QUIT
Begin DoDot:6
+90 SET TMCHILD=$PIECE(ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2,TIUDA3,TIUDA4),U,8)
IF TMCHILD=2
QUIT
+91 KILL @DOC
+92 ; six
+93 DO GETITEMS^TIUSRVT(.DOCA,TIUDA4)
+94 SET DIEN=0
SET CT=0
+95 FOR
SET DIEN=$ORDER(@DOC@(DIEN))
IF 'DIEN
QUIT
Begin DoDot:7
+96 IF $PIECE(@DOC@(DIEN),U,3)'="A"
QUIT
+97 IF $PIECE(@DOC@(DIEN),U,8)=2
QUIT
+98 SET CT=CT+$PIECE(@DOC@(DIEN),U,8)
+99 SET TIUDA5=$PIECE(@DOC@(DIEN),U,1)
+100 SET ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2,TIUDA3,TIUDA4,TIUDA5)=@DOC@(DIEN)
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+101 ;
+102 SET TOP=$PIECE(LIST(RN),U,4)
SET CHILD=$SELECT($DATA(ARRAY(RTIEN))>1:"Y",1:"N")
+103 SET (LVL1,LVL2,LVL3,LVL4,LVL5,LVL6)=""
SET TOP=RTIEN_$CHAR(28)_TOP
+104 SET ROOT=TOP_U_CHILD_U_LVL1_U_LVL2_U_LVL3_U_LVL4_U_LVL5_U_LVL6
+105 SET II=II+1
SET @DATA@(II)=ROOT_$CHAR(30)
+106 SET L1=""
+107 FOR
SET L1=$ORDER(ARRAY(RTIEN,L1))
IF L1=""
QUIT
Begin DoDot:2
+108 SET CHILD=$SELECT($DATA(ARRAY(RTIEN,L1))>1:"Y",1:"N")
+109 SET LVL1=$PIECE(ARRAY(RTIEN,L1),U,1)_$CHAR(28)_$PIECE(ARRAY(RTIEN,L1),U,4)
+110 SET ROOT=TOP_U_CHILD_U_LVL1_U_LVL2_U_LVL3_U_LVL4_U_LVL5_U_LVL6
+111 SET II=II+1
SET @DATA@(II)=ROOT_$CHAR(30)
+112 SET L2=""
+113 FOR
SET L2=$ORDER(ARRAY(RTIEN,L1,L2))
IF L2=""
QUIT
Begin DoDot:3
+114 SET CHILD=$SELECT($DATA(ARRAY(RTIEN,L1,L2))>1:"Y",1:"N")
+115 SET LVL2=$PIECE(ARRAY(RTIEN,L1,L2),U,1)_$CHAR(28)_$PIECE(ARRAY(RTIEN,L1,L2),U,4)
+116 SET ROOT=TOP_U_CHILD_U_LVL1_U_LVL2_U_LVL3_U_LVL4_U_LVL5_U_LVL6
+117 SET II=II+1
SET @DATA@(II)=ROOT_$CHAR(30)
+118 SET L3=""
+119 FOR
SET L3=$ORDER(ARRAY(RTIEN,L1,L2,L3))
IF L3=""
QUIT
Begin DoDot:4
+120 SET CHILD=$SELECT($DATA(ARRAY(RTIEN,L1,L2,L3))>1:"Y",1:"N")
+121 SET LVL3=$PIECE(ARRAY(RTIEN,L1,L2,L3),U,1)_$CHAR(28)_$PIECE(ARRAY(RTIEN,L1,L2,L3),U,4)
+122 SET ROOT=TOP_U_CHILD_U_LVL1_U_LVL2_U_LVL3_U_LVL4_U_LVL5_U_LVL6
+123 SET II=II+1
SET @DATA@(II)=ROOT_$CHAR(30)
+124 SET L4=""
+125 FOR
SET L4=$ORDER(ARRAY(RTIEN,L1,L2,L3,L4))
IF L4=""
QUIT
Begin DoDot:5
+126 SET CHILD=$SELECT($DATA(ARRAY(RTIEN,L1,L2,L3,L4))>1:"Y",1:"N")
+127 SET LVL4=$PIECE(ARRAY(RTIEN,L1,L2,L3,L4),U,1)_$CHAR(28)_$PIECE(ARRAY(RTIEN,L1,L2,L3,L4),U,4)
+128 SET ROOT=TOP_U_CHILD_U_LVL1_U_LVL2_U_LVL3_U_LVL4_U_LVL5_U_LVL6
+129 SET II=II+1
SET @DATA@(II)=ROOT_$CHAR(30)
+130 SET L5=""
+131 FOR
SET L5=$ORDER(ARRAY(RTIEN,L1,L2,L3,L4,L5))
IF L5=""
QUIT
Begin DoDot:6
+132 SET CHILD=$SELECT($DATA(ARRAY(RTIEN,L1,L2,L3,L4,L5))>1:"Y",1:"N")
+133 SET LVL5=$PIECE(ARRAY(RTIEN,L1,L2,L3,L4,L5),U,1)_$CHAR(28)_$PIECE(ARRAY(RTIEN,L1,L2,L3,L4,L5),U,4)
+134 SET ROOT=TOP_U_CHILD_U_LVL1_U_LVL2_U_LVL3_U_LVL4_U_LVL5_U_LVL6
+135 SET II=II+1
SET @DATA@(II)=ROOT_$CHAR(30)
+136 SET L6=""
+137 FOR
SET L6=$ORDER(ARRAY(RTIEN,L1,L2,L3,L4,L5,L6))
IF L6=""
QUIT
Begin DoDot:7
+138 SET CHILD=$SELECT($DATA(ARRAY(RTIEN,L1,L2,L3,L4,L5,L6))>1:"Y",1:"N")
+139 SET LVL6=$PIECE(ARRAY(RTIEN,L1,L2,L3,L4,L5,L6),U,1)_$CHAR(28)_$PIECE(ARRAY(RTIEN,L1,L2,L3,L4,L5,L6),U,4)
+140 SET ROOT=TOP_U_CHILD_U_LVL1_U_LVL2_U_LVL3_U_LVL4_U_LVL5_U_LVL6
+141 SET II=II+1
SET @DATA@(II)=ROOT_$CHAR(30)
End DoDot:7
+142 SET LVL6=""
End DoDot:6
+143 SET LVL5=""
End DoDot:5
+144 SET LVL4=""
End DoDot:4
+145 SET LVL3=""
End DoDot:3
+146 SET LVL2=""
End DoDot:2
+147 SET LVL1=""
End DoDot:1
+148 KILL ARRAY
+149 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+150 QUIT
+151 ;
TOP(DATA,FAKE) ; EP -- BTPW GET TIU TEMP TOP
+1 NEW UID,II,HDR
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BTPWTMPL",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWLTMP D UNWIND^%ZTER"
+7 NEW TDATA,BQII,NDATA,RN,RTIEN,LIST1,LIST,DIEN,DOC,TMCHILD,NN,BWI,QFL,NTO,BTII,BTW
+8 NEW LSNM
+9 ;
+10 SET HDR="I00010ROOT_IEN^T00035ROOT_NAME^T00001CHILDREN"
+11 SET @DATA@(II)=HDR_$CHAR(30)
+12 ;
+13 DO GETROOTS^TIUSRVT(.LIST,.DUZ)
+14 SET RN=0
+15 FOR
SET RN=$ORDER(LIST(RN))
IF RN=""
QUIT
Begin DoDot:1
+16 SET RTIEN=$PIECE(LIST(RN),U,1)
+17 DO TACCESS^TIUSRVT2(.LIST1,RTIEN,.DUZ)
+18 ; 0 = FULL ACCESS, 1 = READ ONLY, 2 = NO ACCESS,
+19 ; 3 = SHARED TEMPLATES EDITOR - ACCESS PARAMETERS DO NOT APPLY
+20 ;I $G(LIST1)=1!($G(LIST1)=2) K LIST(RN) Q
+21 IF $GET(LIST1)=2
KILL LIST(RN)
QUIT
+22 SET LSNM=$$UP^XLFSTR($PIECE(LIST(RN),U,4))
+23 IF LSNM'="SHARED TEMPLATES"&(LSNM'="MY TEMPLATES")
KILL LIST(RN)
QUIT
+24 ;I $P(LIST(RN),U,4)'="Shared Templates"&($P(LIST(RN),U,4)'="My Templates") K LIST(RN) Q
+25 ; Has Children flag (0=NONE,1=ACTIVE,2=INACTIVE,3=BOTH
+26 SET CHILD=$PIECE(LIST(RN),U,8)
IF CHILD=2
QUIT
+27 SET CHILD="Y"
+28 SET II=II+1
SET @DATA@(II)=RTIEN_U_$PIECE(LIST(RN),U,4)_U_CHILD_$CHAR(30)
End DoDot:1
+29 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+30 QUIT
+31 ;
CHLD(DATA,TMPLIEN) ; EP -- BTPW GET TIU TEMP CHILD
+1 ;
+2 NEW UID,II,HDR,TMCHILD,RTIEN,XDATA
+3 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+4 SET DATA=$NAME(^TMP("BTPWTMPLC",UID))
SET XDATA=$NAME(^XTMP("BTPWTEMPL"))
+5 KILL @DATA
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWLTMP D UNWIND^%ZTER"
+8 ;
+9 SET HDR="I00010ROOT_IEN^T00001ROOT_TYPE^T00035ROOT_NAME^T00001CHILDREN"
+10 SET @DATA@(II)=HDR_$CHAR(30)
+11 KILL DOC
+12 DO GETITEMS^TIUSRVT(.DOC,TMPLIEN)
+13 SET DIEN=0
+14 FOR
SET DIEN=$ORDER(@DOC@(DIEN))
IF 'DIEN
QUIT
Begin DoDot:1
+15 IF $PIECE(@DOC@(DIEN),U,3)'="A"
QUIT
+16 ; Has Children flag (0=NONE,1=ACTIVE,2=INACTIVE,3=BOTH
+17 SET TMCHILD=$PIECE(@DOC@(DIEN),U,8)
+18 IF TMCHILD=2
QUIT
+19 SET TMCHILD=$SELECT(TMCHILD=0:"N",1:"Y")
+20 SET RTIEN=$PIECE(@DOC@(DIEN),U,1)
+21 IF $DATA(@XDATA@(RTIEN))
QUIT
+22 SET II=II+1
SET @DATA@(II)=$PIECE(@DOC@(DIEN),U,1)_U_$PIECE(@DOC@(DIEN),U,2)_U_$PIECE(@DOC@(DIEN),U,4)_U_TMCHILD_$CHAR(30)
End DoDot:1
+23 KILL @DOC
+24 QUIT
+25 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
UPD ;EP - Update templates with objects
+1 ; Set list for templates with |V | data objects
+2 NEW XDATA
+3 SET XDATA=$NAME(^XTMP("BTPWTEMPL"))
+4 KILL @XDATA
+5 SET @XDATA@(0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"Templates containing |V | data objects"
+6 NEW TMPN,BLN
+7 SET TMPN=0
+8 FOR
SET TMPN=$ORDER(^TIU(8927,TMPN))
IF 'TMPN
QUIT
Begin DoDot:1
+9 SET BLN=0
+10 FOR
SET BLN=$ORDER(^TIU(8927,TMPN,2,BLN))
IF 'BLN
QUIT
Begin DoDot:2
+11 IF ^TIU(8927,TMPN,2,BLN,0)["|V "
SET @XDATA@(TMPN)=""
End DoDot:2
End DoDot:1
+12 QUIT
