TIUPS76 ; SLC/JER - Post-install for TIU*1*76 ; 7/27/1999
;;1.0;TEXT INTEGRATION UTILITIES;**76**;Jun 20, 1997
MAIN ; Do it!
N ROOTDA,TITLDA,OBJDA,ITMLST,TREE
S TIUPOP=$$RUNCHECK
I +TIUPOP D Q
. D BMES^XPDUTL("This routine has already been run...")
D SETROOT(.ROOTDA) ; Create Primary Shared Templates Root
D SETITLE(.TITLDA) ; Create Inactive Folder for Boilerplated TITLES
D WRAPTTLS(TITLDA)
D SETOBJ(.OBJDA) ; Create Active Folder for all ACTIVE TIU OBJECTS
D WRAPOBJS(OBJDA)
; Add Boilerplated Titles and Patient Data Objects as items to ROOT
D BMES^XPDUTL("Adding Boilerplated Titles and Patient Data Objects to Shared Templates...")
S ITMLST(1)=TITLDA,ITMLST(2)=OBJDA
D BLDTREE(.TREE,ROOTDA,.ITMLST)
S ^TIU(8927,"PS76")=""
Q
RUNCHECK() ; Check whether this code has already run
I $D(^TIU(8927,"PS76")) Q 1
I +$O(^TIU(8927,"B","Shared Templates",0)) Q 1
I +$O(^TIU(8927,"B","Boilerplated Titles",0)) Q 1
I +$O(^TIU(8927,"B","Patient Data Objects",0)) Q 1
I +$O(^TIU(8927,"B","TIU Objects",0)) Q 1
I +$O(^TIU(8927,"B","Boilerplate Titles",0)) Q 1
Q 0
SETROOT(SUCCESS) ; Create the primary Root called Shared Templates
N TIUDA,TIUX S TIUDA=+$O(^TIU(8927,"B","Shared Templates",0))
S TIUX(.01)="Shared Templates"
S TIUX(.03)="R"
S TIUX(.04)="A"
S TIUX(.07)=+$$CLPAC^TIUSRVT1
D SETTMPLT^TIUSRVT(.SUCCESS,TIUDA,.TIUX)
I '+SUCCESS D BMES^XPDUTL($P(SUCCESS,U,2)) Q
D BMES^XPDUTL("Shared Templates Root Created.")
Q
SETITLE(SUCCESS) ; Create Inactive Folder for Boilerplated Titles
N TIUDA,TIUX S TIUDA=+$O(^TIU(8927,"B","Boilerplated Titles",0))
S TIUX(.01)="Boilerplated Titles"
S TIUX(.03)="C"
S TIUX(.04)="I"
D SETTMPLT^TIUSRVT(.SUCCESS,TIUDA,.TIUX)
I '+SUCCESS D BMES^XPDUTL($P(SUCCESS,U,2)) Q
D BMES^XPDUTL("Boilerplated Titles Folder Created.")
Q
WRAPTTLS(TTLGRP) ; Create Template "wrappers" for Titles w/BP text
N TIUDA,DCTREE,DCINDX,ITMSEQ S (TTLSEQ,TIUDA)=0
F S TIUDA=$O(^TIU(8925.1,TIUDA)) Q:+TIUDA'>0 D
. N TIUX,TIUTNM,TIUD0,TTLTMP,CNTNR
. S TIUD0=$G(^TIU(8925.1,TIUDA,0))
. Q:+$P(TIUD0,U,7)'=11 ; Exclude INACTIVE DDEFS
. ; Only allow TITLES or COMPONENTS
. I $S($P(TIUD0,U,4)="DOC":0,$P(TIUD0,U,4)="CO":0,1:1) Q
. ; Quit if no Boilerplate Text is present
. I '+$O(^TIU(8925.1,TIUDA,"DFLT",0)) Q
. I $P(TIUD0,U,4)="CO" D MAKECONT(.CNTNR,TIUDA,$P(TIUD0,U,4))
. S TIUTNM=$P(TIUD0,U)
. M TIUX(2)=^TIU(8925.1,TIUDA,"DFLT")
. D MAKEWRAP(.TTLTMP,$$MIXED^TIULS(TIUTNM),.TIUX)
. I +TTLTMP>0 D
. . I +$G(CNTNR)'>0 D ADDITEM(TTLGRP,TTLTMP) Q
. . D ADDITEM(CNTNR,TTLTMP),ADDITEM(TTLGRP,CNTNR)
Q
MAKECONT(CNTNR,TIUDA,TYPE) ; Find/Create folder
N MOMDA,MOMD0,MOMNM,MOMTTYPE
S MOMDA=+$O(^TIU(8925.1,"AD",TIUDA,0)) Q:'MOMDA
S MOMD0=$G(^TIU(8925.1,MOMDA,0)) Q:(MOMD0="")
S MOMNM=$$MIXED^TIULS($P(MOMD0,U)),MOMTTYPE=$S(TYPE="CO":"G",1:"C")
S MOMTDA=$O(^TIU(8927,"B",MOMNM,0))
; If the appropriate folder exists, use it
I +MOMTDA,($P(^TIU(8927,MOMTDA,0),U,3)=MOMTTYPE) S CNTNR=MOMTDA Q
; Otherwise, create it
S TIUX(.01)=MOMNM
S TIUX(.03)=MOMTTYPE
S TIUX(.04)="A"
D SETTMPLT^TIUSRVT(.CNTNR,MOMTDA,.TIUX)
I +CNTNR D BMES^XPDUTL(" "_MOMNM_" Folder added.")
Q
ADDITEM(PARENT,ITEM) ; Add Item to Parent
N TIUSUCC,TIUI,TIUITEM
Q:+$O(^TIU(8927,"AD",ITEM,PARENT,0))
S TIUI=+$P($G(^TIU(8927,+PARENT,10,0)),U,3)+1
S TIUITEM(.01)=TIUI,TIUITEM(.02)=ITEM
D UPDATE^TIUSRVT1(.TIUSUCC,"""+"_TIUI_","_PARENT_",""",.TIUITEM)
Q
SETOBJ(SUCCESS) ; Create Active Folder for all ACTIVE TIU OBJECTS
N TIUDA,TIUX S TIUDA=+$O(^TIU(8927,"B","Patient Data Objects",0))
S TIUX(.01)="Patient Data Objects"
S TIUX(.03)="C"
S TIUX(.04)="A"
D SETTMPLT^TIUSRVT(.SUCCESS,TIUDA,.TIUX)
I '+SUCCESS D BMES^XPDUTL($P(SUCCESS,U,2)) Q
D BMES^XPDUTL("Patient Data Objects Folder Created.")
Q
WRAPOBJS(OBJGRP) ; Create Template "wrappers" for ACTIVE Objects
N TIUDA,ITMLST,ITMSEQ,OBJECTS,TIUONM S (ITMSEQ,TIUDA)=0
F S TIUDA=$O(^TIU(8925.1,"AT","O",TIUDA)) Q:+TIUDA'>0 D
. N TIUX,TIUTNM,TIUOD0,OBJTMP
. S TIUOD0=$G(^TIU(8925.1,TIUDA,0))
. Q:+$P(TIUOD0,U,7)'=11 ; Exclude INACTIVE OBJECTS
. S TIUTNM=$P(TIUOD0,U)
. S TIUX(2,1,0)="|"_TIUTNM_"|"
. D MAKEWRAP(.OBJTMP,$$MIXED^TIULS(TIUTNM),.TIUX)
. I +OBJTMP>0 D
. . S ITMLST($$UP^XLFSTR(TIUTNM))=OBJTMP
S TIUONM=""
F S TIUONM=$O(ITMLST(TIUONM)) Q:TIUONM="" D
. S ITMSEQ=ITMSEQ+1
. S ITMLST(ITMSEQ)=ITMLST(TIUONM)
. K ITMLST(TIUONM)
I +$O(ITMLST(0)) D SETITEMS^TIUSRVT(.OBJECTS,OBJGRP,.ITMLST)
Q
MAKEWRAP(WRAPTEMP,TIUTNM,TIUX) ; Create a single wrapper
N TIUDA S TIUDA=+$O(^TIU(8927,"B",TIUTNM,0))
S TIUX(.01)=TIUTNM
S TIUX(.03)="T"
S TIUX(.04)="A"
D SETTMPLT^TIUSRVT(.WRAPTEMP,TIUDA,.TIUX)
I +WRAPTEMP D BMES^XPDUTL(" "_TIUTNM_" Template ""wrapper"" added.")
Q
BLDTREE(TREE,ROOTDA,ITMLST) ; Add Boilerplated Titles and
; Patient Data Objects as items to ROOT
D SETITEMS^TIUSRVT(.TREE,ROOTDA,.ITMLST)
Q
TIUPS76 ; SLC/JER - Post-install for TIU*1*76 ; 7/27/1999
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**76**;Jun 20, 1997
MAIN ; Do it!
+1 NEW ROOTDA,TITLDA,OBJDA,ITMLST,TREE
+2 SET TIUPOP=$$RUNCHECK
+3 IF +TIUPOP
Begin DoDot:1
+4 DO BMES^XPDUTL("This routine has already been run...")
End DoDot:1
QUIT
+5 ; Create Primary Shared Templates Root
DO SETROOT(.ROOTDA)
+6 ; Create Inactive Folder for Boilerplated TITLES
DO SETITLE(.TITLDA)
+7 DO WRAPTTLS(TITLDA)
+8 ; Create Active Folder for all ACTIVE TIU OBJECTS
DO SETOBJ(.OBJDA)
+9 DO WRAPOBJS(OBJDA)
+10 ; Add Boilerplated Titles and Patient Data Objects as items to ROOT
+11 DO BMES^XPDUTL("Adding Boilerplated Titles and Patient Data Objects to Shared Templates...")
+12 SET ITMLST(1)=TITLDA
SET ITMLST(2)=OBJDA
+13 DO BLDTREE(.TREE,ROOTDA,.ITMLST)
+14 SET ^TIU(8927,"PS76")=""
+15 QUIT
RUNCHECK() ; Check whether this code has already run
+1 IF $DATA(^TIU(8927,"PS76"))
QUIT 1
+2 IF +$ORDER(^TIU(8927,"B","Shared Templates",0))
QUIT 1
+3 IF +$ORDER(^TIU(8927,"B","Boilerplated Titles",0))
QUIT 1
+4 IF +$ORDER(^TIU(8927,"B","Patient Data Objects",0))
QUIT 1
+5 IF +$ORDER(^TIU(8927,"B","TIU Objects",0))
QUIT 1
+6 IF +$ORDER(^TIU(8927,"B","Boilerplate Titles",0))
QUIT 1
+7 QUIT 0
SETROOT(SUCCESS) ; Create the primary Root called Shared Templates
+1 NEW TIUDA,TIUX
SET TIUDA=+$ORDER(^TIU(8927,"B","Shared Templates",0))
+2 SET TIUX(.01)="Shared Templates"
+3 SET TIUX(.03)="R"
+4 SET TIUX(.04)="A"
+5 SET TIUX(.07)=+$$CLPAC^TIUSRVT1
+6 DO SETTMPLT^TIUSRVT(.SUCCESS,TIUDA,.TIUX)
+7 IF '+SUCCESS
DO BMES^XPDUTL($PIECE(SUCCESS,U,2))
QUIT
+8 DO BMES^XPDUTL("Shared Templates Root Created.")
+9 QUIT
SETITLE(SUCCESS) ; Create Inactive Folder for Boilerplated Titles
+1 NEW TIUDA,TIUX
SET TIUDA=+$ORDER(^TIU(8927,"B","Boilerplated Titles",0))
+2 SET TIUX(.01)="Boilerplated Titles"
+3 SET TIUX(.03)="C"
+4 SET TIUX(.04)="I"
+5 DO SETTMPLT^TIUSRVT(.SUCCESS,TIUDA,.TIUX)
+6 IF '+SUCCESS
DO BMES^XPDUTL($PIECE(SUCCESS,U,2))
QUIT
+7 DO BMES^XPDUTL("Boilerplated Titles Folder Created.")
+8 QUIT
WRAPTTLS(TTLGRP) ; Create Template "wrappers" for Titles w/BP text
+1 NEW TIUDA,DCTREE,DCINDX,ITMSEQ
SET (TTLSEQ,TIUDA)=0
+2 FOR
SET TIUDA=$ORDER(^TIU(8925.1,TIUDA))
IF +TIUDA'>0
QUIT
Begin DoDot:1
+3 NEW TIUX,TIUTNM,TIUD0,TTLTMP,CNTNR
+4 SET TIUD0=$GET(^TIU(8925.1,TIUDA,0))
+5 ; Exclude INACTIVE DDEFS
IF +$PIECE(TIUD0,U,7)'=11
QUIT
+6 ; Only allow TITLES or COMPONENTS
+7 IF $SELECT($PIECE(TIUD0,U,4)="DOC":0,$PIECE(TIUD0,U,4)="CO":0,1:1)
QUIT
+8 ; Quit if no Boilerplate Text is present
+9 IF '+$ORDER(^TIU(8925.1,TIUDA,"DFLT",0))
QUIT
+10 IF $PIECE(TIUD0,U,4)="CO"
DO MAKECONT(.CNTNR,TIUDA,$PIECE(TIUD0,U,4))
+11 SET TIUTNM=$PIECE(TIUD0,U)
+12 MERGE TIUX(2)=^TIU(8925.1,TIUDA,"DFLT")
+13 DO MAKEWRAP(.TTLTMP,$$MIXED^TIULS(TIUTNM),.TIUX)
+14 IF +TTLTMP>0
Begin DoDot:2
+15 IF +$GET(CNTNR)'>0
DO ADDITEM(TTLGRP,TTLTMP)
QUIT
+16 DO ADDITEM(CNTNR,TTLTMP)
DO ADDITEM(TTLGRP,CNTNR)
End DoDot:2
End DoDot:1
+17 QUIT
MAKECONT(CNTNR,TIUDA,TYPE) ; Find/Create folder
+1 NEW MOMDA,MOMD0,MOMNM,MOMTTYPE
+2 SET MOMDA=+$ORDER(^TIU(8925.1,"AD",TIUDA,0))
IF 'MOMDA
QUIT
+3 SET MOMD0=$GET(^TIU(8925.1,MOMDA,0))
IF (MOMD0="")
QUIT
+4 SET MOMNM=$$MIXED^TIULS($PIECE(MOMD0,U))
SET MOMTTYPE=$SELECT(TYPE="CO":"G",1:"C")
+5 SET MOMTDA=$ORDER(^TIU(8927,"B",MOMNM,0))
+6 ; If the appropriate folder exists, use it
+7 IF +MOMTDA
IF ($PIECE(^TIU(8927,MOMTDA,0),U,3)=MOMTTYPE)
SET CNTNR=MOMTDA
QUIT
+8 ; Otherwise, create it
+9 SET TIUX(.01)=MOMNM
+10 SET TIUX(.03)=MOMTTYPE
+11 SET TIUX(.04)="A"
+12 DO SETTMPLT^TIUSRVT(.CNTNR,MOMTDA,.TIUX)
+13 IF +CNTNR
DO BMES^XPDUTL(" "_MOMNM_" Folder added.")
+14 QUIT
ADDITEM(PARENT,ITEM) ; Add Item to Parent
+1 NEW TIUSUCC,TIUI,TIUITEM
+2 IF +$ORDER(^TIU(8927,"AD",ITEM,PARENT,0))
QUIT
+3 SET TIUI=+$PIECE($GET(^TIU(8927,+PARENT,10,0)),U,3)+1
+4 SET TIUITEM(.01)=TIUI
SET TIUITEM(.02)=ITEM
+5 DO UPDATE^TIUSRVT1(.TIUSUCC,"""+"_TIUI_","_PARENT_",""",.TIUITEM)
+6 QUIT
SETOBJ(SUCCESS) ; Create Active Folder for all ACTIVE TIU OBJECTS
+1 NEW TIUDA,TIUX
SET TIUDA=+$ORDER(^TIU(8927,"B","Patient Data Objects",0))
+2 SET TIUX(.01)="Patient Data Objects"
+3 SET TIUX(.03)="C"
+4 SET TIUX(.04)="A"
+5 DO SETTMPLT^TIUSRVT(.SUCCESS,TIUDA,.TIUX)
+6 IF '+SUCCESS
DO BMES^XPDUTL($PIECE(SUCCESS,U,2))
QUIT
+7 DO BMES^XPDUTL("Patient Data Objects Folder Created.")
+8 QUIT
WRAPOBJS(OBJGRP) ; Create Template "wrappers" for ACTIVE Objects
+1 NEW TIUDA,ITMLST,ITMSEQ,OBJECTS,TIUONM
SET (ITMSEQ,TIUDA)=0
+2 FOR
SET TIUDA=$ORDER(^TIU(8925.1,"AT","O",TIUDA))
IF +TIUDA'>0
QUIT
Begin DoDot:1
+3 NEW TIUX,TIUTNM,TIUOD0,OBJTMP
+4 SET TIUOD0=$GET(^TIU(8925.1,TIUDA,0))
+5 ; Exclude INACTIVE OBJECTS
IF +$PIECE(TIUOD0,U,7)'=11
QUIT
+6 SET TIUTNM=$PIECE(TIUOD0,U)
+7 SET TIUX(2,1,0)="|"_TIUTNM_"|"
+8 DO MAKEWRAP(.OBJTMP,$$MIXED^TIULS(TIUTNM),.TIUX)
+9 IF +OBJTMP>0
Begin DoDot:2
+10 SET ITMLST($$UP^XLFSTR(TIUTNM))=OBJTMP
End DoDot:2
End DoDot:1
+11 SET TIUONM=""
+12 FOR
SET TIUONM=$ORDER(ITMLST(TIUONM))
IF TIUONM=""
QUIT
Begin DoDot:1
+13 SET ITMSEQ=ITMSEQ+1
+14 SET ITMLST(ITMSEQ)=ITMLST(TIUONM)
+15 KILL ITMLST(TIUONM)
End DoDot:1
+16 IF +$ORDER(ITMLST(0))
DO SETITEMS^TIUSRVT(.OBJECTS,OBJGRP,.ITMLST)
+17 QUIT
MAKEWRAP(WRAPTEMP,TIUTNM,TIUX) ; Create a single wrapper
+1 NEW TIUDA
SET TIUDA=+$ORDER(^TIU(8927,"B",TIUTNM,0))
+2 SET TIUX(.01)=TIUTNM
+3 SET TIUX(.03)="T"
+4 SET TIUX(.04)="A"
+5 DO SETTMPLT^TIUSRVT(.WRAPTEMP,TIUDA,.TIUX)
+6 IF +WRAPTEMP
DO BMES^XPDUTL(" "_TIUTNM_" Template ""wrapper"" added.")
+7 QUIT
BLDTREE(TREE,ROOTDA,ITMLST) ; Add Boilerplated Titles and
+1 ; Patient Data Objects as items to ROOT
+2 DO SETITEMS^TIUSRVT(.TREE,ROOTDA,.ITMLST)
+3 QUIT
