Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BTPWLTMP

BTPWLTMP.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;
  1. 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
  1.  NEW L1,L2,L3,L4,L5,L6,LVL1,LVL2,LVL3,LVL4,LVL5,LVL6,ROOT,TIUDA1,TIUDA2,TIUDA3,TIUDA4,TIUDA5
  1.  NEW LSNM
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWLTMP",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWLTMP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S HDR="T00060TOP^T00001CHILDREN^T00060LEVEL1^T00060LEVEL2^T00060LEVEL3^T00060LEVEL4^T00060LEVEL5^T00060LEVEL6"_$C(30)
  1.  S @DATA@(II)=HDR
  1.  D GETROOTS^TIUSRVT(.LIST,.DUZ)
  1.  S RN=0
  1.  F  S RN=$O(LIST(RN)) Q:RN=""  D
  1.  . S RTIEN=$P(LIST(RN),U,1)
  1.  . D TACCESS^TIUSRVT2(.LIST1,RTIEN,.DUZ)
  1.  . ; 0 = FULL ACCESS, 1 = READ ONLY, 2 = NO ACCESS, 
  1.  . ; 3 = SHARED TEMPLATES EDITOR - ACCESS PARAMETERS DO NOT APPLY
  1.  . ;I $G(LIST1)=1!($G(LIST1)=2) K LIST(RN) Q
  1.  . I $G(LIST1)=2 K LIST(RN) Q
  1.  . S LSNM=$$UP^XLFSTR($P(LIST(RN),U,4))
  1.  . I LSNM'="SHARED TEMPLATES"&(LSNM'="MY TEMPLATES") K LIST(RN) Q
  1.  . ;I $P(LIST(RN),U,4)'="Shared Templates"&($P(LIST(RN),U,4)'="My Templates") K LIST(RN) Q
  1.  . K DOC
  1.  . ; one
  1.  . D GETITEMS^TIUSRVT(.DOC,RTIEN)
  1.  . S DIEN=0
  1.  . F  S DIEN=$O(@DOC@(DIEN)) Q:'DIEN  D
  1.  .. I $P(@DOC@(DIEN),U,3)'="A" Q
  1.  .. S TIUDA=$P(@DOC@(DIEN),U,1)
  1.  .. S ARRAY(RTIEN,TIUDA)=@DOC@(DIEN) Q
  1.  . S TIUDA=""
  1.  . F  S TIUDA=$O(ARRAY(RTIEN,TIUDA)) Q:TIUDA=""  D
  1.  .. ; Has Children flag (0=NONE,1=ACTIVE,2=INACTIVE,3=BOTH
  1.  .. S TMCHILD=$P(ARRAY(RTIEN,TIUDA),U,8) I TMCHILD=2 Q
  1.  .. K @DOC
  1.  .. ; two
  1.  .. D GETITEMS^TIUSRVT(.DOCA,TIUDA)
  1.  .. S DIEN=0,CT=0
  1.  .. F  S DIEN=$O(@DOC@(DIEN)) Q:'DIEN  D
  1.  ... I $P(@DOC@(DIEN),U,3)'="A" Q
  1.  ... I $P(@DOC@(DIEN),U,8)=2 Q
  1.  ... S CT=CT+$P(@DOC@(DIEN),U,8)
  1.  ... S TIUDA1=$P(@DOC@(DIEN),U,1)
  1.  ... S ARRAY(RTIEN,TIUDA,TIUDA1)=@DOC@(DIEN)
  1.  .. I CT=0 Q
  1.  .. S TIUDA1=""
  1.  .. F  S TIUDA1=$O(ARRAY(RTIEN,TIUDA,TIUDA1)) Q:TIUDA1=""  D
  1.  ... S TMCHILD=$P(ARRAY(RTIEN,TIUDA,TIUDA1),U,8) I TMCHILD=2 Q
  1.  ... K @DOC
  1.  ... ; three
  1.  ... D GETITEMS^TIUSRVT(.DOCA,TIUDA1)
  1.  ... S DIEN=0,CT=0
  1.  ... F  S DIEN=$O(@DOC@(DIEN)) Q:'DIEN  D
  1.  .... I $P(@DOC@(DIEN),U,3)'="A" Q
  1.  .... I $P(@DOC@(DIEN),U,8)=2 Q
  1.  .... S CT=CT+$P(@DOC@(DIEN),U,8)
  1.  .... S TIUDA2=$P(@DOC@(DIEN),U,1)
  1.  .... S ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2)=@DOC@(DIEN)
  1.  ... I CT=0 Q
  1.  ... S TIUDA2=""
  1.  ... F  S TIUDA2=$O(ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2)) Q:TIUDA2=""  D
  1.  .... S TMCHILD=$P(ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2),U,8) I TMCHILD=2 Q
  1.  .... K @DOC
  1.  .... ; four
  1.  .... D GETITEMS^TIUSRVT(.DOCA,TIUDA2)
  1.  .... S DIEN=0,CT=0
  1.  .... F  S DIEN=$O(@DOC@(DIEN)) Q:'DIEN  D
  1.  ..... I $P(@DOC@(DIEN),U,3)'="A" Q
  1.  ..... I $P(@DOC@(DIEN),U,8)=2 Q
  1.  ..... S CT=CT+$P(@DOC@(DIEN),U,8)
  1.  ..... S TIUDA3=$P(@DOC@(DIEN),U,1)
  1.  ..... S ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2,TIUDA3)=@DOC@(DIEN)
  1.  .... I CT=0 Q
  1.  .... S TIUDA3=""
  1.  .... F  S TIUDA3=$O(ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2,TIUDA3)) Q:TIUDA3=""  D
  1.  ..... S TMCHILD=$P(ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2,TIUDA3),U,8) I TMCHILD=2 Q
  1.  ..... K @DOC
  1.  ..... ; five
  1.  ..... D GETITEMS^TIUSRVT(.DOCA,TIUDA3)
  1.  ..... S DIEN=0,CT=0
  1.  ..... F  S DIEN=$O(@DOC@(DIEN)) Q:'DIEN  D
  1.  ...... I $P(@DOC@(DIEN),U,3)'="A" Q
  1.  ...... I $P(@DOC@(DIEN),U,8)=2 Q
  1.  ...... S CT=CT+$P(@DOC@(DIEN),U,8)
  1.  ...... S TIUDA4=$P(@DOC@(DIEN),U,1)
  1.  ...... S ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2,TIUDA3,TIUDA4)=@DOC@(DIEN)
  1.  ..... I CT=0 Q
  1.  ..... S TIUDA4=""
  1.  ..... F  S TIUDA4=$O(ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2,TIUDA3,TIUDA4)) Q:TIUDA4=""  D
  1.  ...... S TMCHILD=$P(ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2,TIUDA3,TIUDA4),U,8) I TMCHILD=2 Q
  1.  ...... K @DOC
  1.  ...... ; six
  1.  ...... D GETITEMS^TIUSRVT(.DOCA,TIUDA4)
  1.  ...... S DIEN=0,CT=0
  1.  ...... F  S DIEN=$O(@DOC@(DIEN)) Q:'DIEN  D
  1.  ....... I $P(@DOC@(DIEN),U,3)'="A" Q
  1.  ....... I $P(@DOC@(DIEN),U,8)=2 Q
  1.  ....... S CT=CT+$P(@DOC@(DIEN),U,8)
  1.  ....... S TIUDA5=$P(@DOC@(DIEN),U,1)
  1.  ....... S ARRAY(RTIEN,TIUDA,TIUDA1,TIUDA2,TIUDA3,TIUDA4,TIUDA5)=@DOC@(DIEN)
  1.  . ;
  1.  . S TOP=$P(LIST(RN),U,4),CHILD=$S($D(ARRAY(RTIEN))>1:"Y",1:"N")
  1.  . S (LVL1,LVL2,LVL3,LVL4,LVL5,LVL6)="",TOP=RTIEN_$C(28)_TOP
  1.  . S ROOT=TOP_U_CHILD_U_LVL1_U_LVL2_U_LVL3_U_LVL4_U_LVL5_U_LVL6
  1.  . S II=II+1,@DATA@(II)=ROOT_$C(30)
  1.  . S L1=""
  1.  . F  S L1=$O(ARRAY(RTIEN,L1)) Q:L1=""  D
  1.  .. S CHILD=$S($D(ARRAY(RTIEN,L1))>1:"Y",1:"N")
  1.  .. S LVL1=$P(ARRAY(RTIEN,L1),U,1)_$C(28)_$P(ARRAY(RTIEN,L1),U,4)
  1.  .. S ROOT=TOP_U_CHILD_U_LVL1_U_LVL2_U_LVL3_U_LVL4_U_LVL5_U_LVL6
  1.  .. S II=II+1,@DATA@(II)=ROOT_$C(30)
  1.  .. S L2=""
  1.  .. F  S L2=$O(ARRAY(RTIEN,L1,L2)) Q:L2=""  D
  1.  ... S CHILD=$S($D(ARRAY(RTIEN,L1,L2))>1:"Y",1:"N")
  1.  ... S LVL2=$P(ARRAY(RTIEN,L1,L2),U,1)_$C(28)_$P(ARRAY(RTIEN,L1,L2),U,4)
  1.  ... S ROOT=TOP_U_CHILD_U_LVL1_U_LVL2_U_LVL3_U_LVL4_U_LVL5_U_LVL6
  1.  ... S II=II+1,@DATA@(II)=ROOT_$C(30)
  1.  ... S L3=""
  1.  ... F  S L3=$O(ARRAY(RTIEN,L1,L2,L3)) Q:L3=""  D
  1.  .... S CHILD=$S($D(ARRAY(RTIEN,L1,L2,L3))>1:"Y",1:"N")
  1.  .... S LVL3=$P(ARRAY(RTIEN,L1,L2,L3),U,1)_$C(28)_$P(ARRAY(RTIEN,L1,L2,L3),U,4)
  1.  .... S ROOT=TOP_U_CHILD_U_LVL1_U_LVL2_U_LVL3_U_LVL4_U_LVL5_U_LVL6
  1.  .... S II=II+1,@DATA@(II)=ROOT_$C(30)
  1.  .... S L4=""
  1.  .... F  S L4=$O(ARRAY(RTIEN,L1,L2,L3,L4)) Q:L4=""  D
  1.  ..... S CHILD=$S($D(ARRAY(RTIEN,L1,L2,L3,L4))>1:"Y",1:"N")
  1.  ..... S LVL4=$P(ARRAY(RTIEN,L1,L2,L3,L4),U,1)_$C(28)_$P(ARRAY(RTIEN,L1,L2,L3,L4),U,4)
  1.  ..... S ROOT=TOP_U_CHILD_U_LVL1_U_LVL2_U_LVL3_U_LVL4_U_LVL5_U_LVL6
  1.  ..... S II=II+1,@DATA@(II)=ROOT_$C(30)
  1.  ..... S L5=""
  1.  ..... F  S L5=$O(ARRAY(RTIEN,L1,L2,L3,L4,L5)) Q:L5=""  D
  1.  ...... S CHILD=$S($D(ARRAY(RTIEN,L1,L2,L3,L4,L5))>1:"Y",1:"N")
  1.  ...... S LVL5=$P(ARRAY(RTIEN,L1,L2,L3,L4,L5),U,1)_$C(28)_$P(ARRAY(RTIEN,L1,L2,L3,L4,L5),U,4)
  1.  ...... S ROOT=TOP_U_CHILD_U_LVL1_U_LVL2_U_LVL3_U_LVL4_U_LVL5_U_LVL6
  1.  ...... S II=II+1,@DATA@(II)=ROOT_$C(30)
  1.  ...... S L6=""
  1.  ...... F  S L6=$O(ARRAY(RTIEN,L1,L2,L3,L4,L5,L6)) Q:L6=""  D
  1.  ....... S CHILD=$S($D(ARRAY(RTIEN,L1,L2,L3,L4,L5,L6))>1:"Y",1:"N")
  1.  ....... 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)
  1.  ....... S ROOT=TOP_U_CHILD_U_LVL1_U_LVL2_U_LVL3_U_LVL4_U_LVL5_U_LVL6
  1.  ....... S II=II+1,@DATA@(II)=ROOT_$C(30)
  1.  ...... S LVL6=""
  1.  ..... S LVL5=""
  1.  .... S LVL4=""
  1.  ... S LVL3=""
  1.  .. S LVL2=""
  1.  . S LVL1=""
  1.  K ARRAY
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. TOP(DATA,FAKE) ; EP -- BTPW GET TIU TEMP TOP
  1.  NEW UID,II,HDR
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWTMPL",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWLTMP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  NEW TDATA,BQII,NDATA,RN,RTIEN,LIST1,LIST,DIEN,DOC,TMCHILD,NN,BWI,QFL,NTO,BTII,BTW
  1.  NEW LSNM
  1.  ;
  1.  S HDR="I00010ROOT_IEN^T00035ROOT_NAME^T00001CHILDREN"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  ;
  1.  D GETROOTS^TIUSRVT(.LIST,.DUZ)
  1.  S RN=0
  1.  F  S RN=$O(LIST(RN)) Q:RN=""  D
  1.  . S RTIEN=$P(LIST(RN),U,1)
  1.  . D TACCESS^TIUSRVT2(.LIST1,RTIEN,.DUZ)
  1.  . ; 0 = FULL ACCESS, 1 = READ ONLY, 2 = NO ACCESS, 
  1.  . ; 3 = SHARED TEMPLATES EDITOR - ACCESS PARAMETERS DO NOT APPLY
  1.  . ;I $G(LIST1)=1!($G(LIST1)=2) K LIST(RN) Q
  1.  . I $G(LIST1)=2 K LIST(RN) Q
  1.  . S LSNM=$$UP^XLFSTR($P(LIST(RN),U,4))
  1.  . I LSNM'="SHARED TEMPLATES"&(LSNM'="MY TEMPLATES") K LIST(RN) Q
  1.  . ;I $P(LIST(RN),U,4)'="Shared Templates"&($P(LIST(RN),U,4)'="My Templates") K LIST(RN) Q
  1.  . ; Has Children flag (0=NONE,1=ACTIVE,2=INACTIVE,3=BOTH
  1.  . S CHILD=$P(LIST(RN),U,8) I CHILD=2 Q
  1.  . S CHILD="Y"
  1.  . S II=II+1,@DATA@(II)=RTIEN_U_$P(LIST(RN),U,4)_U_CHILD_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. CHLD(DATA,TMPLIEN) ; EP -- BTPW GET TIU TEMP CHILD
  1.  ;
  1.  NEW UID,II,HDR,TMCHILD,RTIEN,XDATA
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWTMPLC",UID)),XDATA=$NA(^XTMP("BTPWTEMPL"))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWLTMP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S HDR="I00010ROOT_IEN^T00001ROOT_TYPE^T00035ROOT_NAME^T00001CHILDREN"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  K DOC
  1.  D GETITEMS^TIUSRVT(.DOC,TMPLIEN)
  1.  S DIEN=0
  1.  F  S DIEN=$O(@DOC@(DIEN)) Q:'DIEN  D
  1.  . I $P(@DOC@(DIEN),U,3)'="A" Q
  1.  . ; Has Children flag (0=NONE,1=ACTIVE,2=INACTIVE,3=BOTH
  1.  . S TMCHILD=$P(@DOC@(DIEN),U,8)
  1.  . I TMCHILD=2 Q
  1.  . S TMCHILD=$S(TMCHILD=0:"N",1:"Y")
  1.  . S RTIEN=$P(@DOC@(DIEN),U,1)
  1.  . I $D(@XDATA@(RTIEN)) Q
  1.  . 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)
  1.  K @DOC
  1.  Q
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. UPD ;EP - Update templates with objects
  1.  ; Set list for templates with |V | data objects
  1.  NEW XDATA
  1.  S XDATA=$NA(^XTMP("BTPWTEMPL"))
  1.  K @XDATA
  1.  S @XDATA@(0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"Templates containing |V | data objects"
  1.  NEW TMPN,BLN
  1.  S TMPN=0
  1.  F  S TMPN=$O(^TIU(8927,TMPN)) Q:'TMPN  D
  1.  . S BLN=0
  1.  . F  S BLN=$O(^TIU(8927,TMPN,2,BLN)) Q:'BLN  D
  1.  .. I ^TIU(8927,TMPN,2,BLN,0)["|V " S @XDATA@(TMPN)=""
  1.  Q