source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPS76.m@ 770

Last change on this file since 770 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.7 KB
Line 
1TIUPS76 ; SLC/JER - Post-install for TIU*1*76 ; 7/27/1999
2 ;;1.0;TEXT INTEGRATION UTILITIES;**76**;Jun 20, 1997
3MAIN ; Do it!
4 N ROOTDA,TITLDA,OBJDA,ITMLST,TREE
5 S TIUPOP=$$RUNCHECK
6 I +TIUPOP D Q
7 . D BMES^XPDUTL("This routine has already been run...")
8 D SETROOT(.ROOTDA) ; Create Primary Shared Templates Root
9 D SETITLE(.TITLDA) ; Create Inactive Folder for Boilerplated TITLES
10 D WRAPTTLS(TITLDA)
11 D SETOBJ(.OBJDA) ; Create Active Folder for all ACTIVE TIU OBJECTS
12 D WRAPOBJS(OBJDA)
13 ; Add Boilerplated Titles and Patient Data Objects as items to ROOT
14 D BMES^XPDUTL("Adding Boilerplated Titles and Patient Data Objects to Shared Templates...")
15 S ITMLST(1)=TITLDA,ITMLST(2)=OBJDA
16 D BLDTREE(.TREE,ROOTDA,.ITMLST)
17 S ^TIU(8927,"PS76")=""
18 Q
19RUNCHECK() ; Check whether this code has already run
20 I $D(^TIU(8927,"PS76")) Q 1
21 I +$O(^TIU(8927,"B","Shared Templates",0)) Q 1
22 I +$O(^TIU(8927,"B","Boilerplated Titles",0)) Q 1
23 I +$O(^TIU(8927,"B","Patient Data Objects",0)) Q 1
24 I +$O(^TIU(8927,"B","TIU Objects",0)) Q 1
25 I +$O(^TIU(8927,"B","Boilerplate Titles",0)) Q 1
26 Q 0
27SETROOT(SUCCESS) ; Create the primary Root called Shared Templates
28 N TIUDA,TIUX S TIUDA=+$O(^TIU(8927,"B","Shared Templates",0))
29 S TIUX(.01)="Shared Templates"
30 S TIUX(.03)="R"
31 S TIUX(.04)="A"
32 S TIUX(.07)=+$$CLPAC^TIUSRVT1
33 D SETTMPLT^TIUSRVT(.SUCCESS,TIUDA,.TIUX)
34 I '+SUCCESS D BMES^XPDUTL($P(SUCCESS,U,2)) Q
35 D BMES^XPDUTL("Shared Templates Root Created.")
36 Q
37SETITLE(SUCCESS) ; Create Inactive Folder for Boilerplated Titles
38 N TIUDA,TIUX S TIUDA=+$O(^TIU(8927,"B","Boilerplated Titles",0))
39 S TIUX(.01)="Boilerplated Titles"
40 S TIUX(.03)="C"
41 S TIUX(.04)="I"
42 D SETTMPLT^TIUSRVT(.SUCCESS,TIUDA,.TIUX)
43 I '+SUCCESS D BMES^XPDUTL($P(SUCCESS,U,2)) Q
44 D BMES^XPDUTL("Boilerplated Titles Folder Created.")
45 Q
46WRAPTTLS(TTLGRP) ; Create Template "wrappers" for Titles w/BP text
47 N TIUDA,DCTREE,DCINDX,ITMSEQ S (TTLSEQ,TIUDA)=0
48 F S TIUDA=$O(^TIU(8925.1,TIUDA)) Q:+TIUDA'>0 D
49 . N TIUX,TIUTNM,TIUD0,TTLTMP,CNTNR
50 . S TIUD0=$G(^TIU(8925.1,TIUDA,0))
51 . Q:+$P(TIUD0,U,7)'=11 ; Exclude INACTIVE DDEFS
52 . ; Only allow TITLES or COMPONENTS
53 . I $S($P(TIUD0,U,4)="DOC":0,$P(TIUD0,U,4)="CO":0,1:1) Q
54 . ; Quit if no Boilerplate Text is present
55 . I '+$O(^TIU(8925.1,TIUDA,"DFLT",0)) Q
56 . I $P(TIUD0,U,4)="CO" D MAKECONT(.CNTNR,TIUDA,$P(TIUD0,U,4))
57 . S TIUTNM=$P(TIUD0,U)
58 . M TIUX(2)=^TIU(8925.1,TIUDA,"DFLT")
59 . D MAKEWRAP(.TTLTMP,$$MIXED^TIULS(TIUTNM),.TIUX)
60 . I +TTLTMP>0 D
61 . . I +$G(CNTNR)'>0 D ADDITEM(TTLGRP,TTLTMP) Q
62 . . D ADDITEM(CNTNR,TTLTMP),ADDITEM(TTLGRP,CNTNR)
63 Q
64MAKECONT(CNTNR,TIUDA,TYPE) ; Find/Create folder
65 N MOMDA,MOMD0,MOMNM,MOMTTYPE
66 S MOMDA=+$O(^TIU(8925.1,"AD",TIUDA,0)) Q:'MOMDA
67 S MOMD0=$G(^TIU(8925.1,MOMDA,0)) Q:(MOMD0="")
68 S MOMNM=$$MIXED^TIULS($P(MOMD0,U)),MOMTTYPE=$S(TYPE="CO":"G",1:"C")
69 S MOMTDA=$O(^TIU(8927,"B",MOMNM,0))
70 ; If the appropriate folder exists, use it
71 I +MOMTDA,($P(^TIU(8927,MOMTDA,0),U,3)=MOMTTYPE) S CNTNR=MOMTDA Q
72 ; Otherwise, create it
73 S TIUX(.01)=MOMNM
74 S TIUX(.03)=MOMTTYPE
75 S TIUX(.04)="A"
76 D SETTMPLT^TIUSRVT(.CNTNR,MOMTDA,.TIUX)
77 I +CNTNR D BMES^XPDUTL(" "_MOMNM_" Folder added.")
78 Q
79ADDITEM(PARENT,ITEM) ; Add Item to Parent
80 N TIUSUCC,TIUI,TIUITEM
81 Q:+$O(^TIU(8927,"AD",ITEM,PARENT,0))
82 S TIUI=+$P($G(^TIU(8927,+PARENT,10,0)),U,3)+1
83 S TIUITEM(.01)=TIUI,TIUITEM(.02)=ITEM
84 D UPDATE^TIUSRVT1(.TIUSUCC,"""+"_TIUI_","_PARENT_",""",.TIUITEM)
85 Q
86SETOBJ(SUCCESS) ; Create Active Folder for all ACTIVE TIU OBJECTS
87 N TIUDA,TIUX S TIUDA=+$O(^TIU(8927,"B","Patient Data Objects",0))
88 S TIUX(.01)="Patient Data Objects"
89 S TIUX(.03)="C"
90 S TIUX(.04)="A"
91 D SETTMPLT^TIUSRVT(.SUCCESS,TIUDA,.TIUX)
92 I '+SUCCESS D BMES^XPDUTL($P(SUCCESS,U,2)) Q
93 D BMES^XPDUTL("Patient Data Objects Folder Created.")
94 Q
95WRAPOBJS(OBJGRP) ; Create Template "wrappers" for ACTIVE Objects
96 N TIUDA,ITMLST,ITMSEQ,OBJECTS,TIUONM S (ITMSEQ,TIUDA)=0
97 F S TIUDA=$O(^TIU(8925.1,"AT","O",TIUDA)) Q:+TIUDA'>0 D
98 . N TIUX,TIUTNM,TIUOD0,OBJTMP
99 . S TIUOD0=$G(^TIU(8925.1,TIUDA,0))
100 . Q:+$P(TIUOD0,U,7)'=11 ; Exclude INACTIVE OBJECTS
101 . S TIUTNM=$P(TIUOD0,U)
102 . S TIUX(2,1,0)="|"_TIUTNM_"|"
103 . D MAKEWRAP(.OBJTMP,$$MIXED^TIULS(TIUTNM),.TIUX)
104 . I +OBJTMP>0 D
105 . . S ITMLST($$UP^XLFSTR(TIUTNM))=OBJTMP
106 S TIUONM=""
107 F S TIUONM=$O(ITMLST(TIUONM)) Q:TIUONM="" D
108 . S ITMSEQ=ITMSEQ+1
109 . S ITMLST(ITMSEQ)=ITMLST(TIUONM)
110 . K ITMLST(TIUONM)
111 I +$O(ITMLST(0)) D SETITEMS^TIUSRVT(.OBJECTS,OBJGRP,.ITMLST)
112 Q
113MAKEWRAP(WRAPTEMP,TIUTNM,TIUX) ; Create a single wrapper
114 N TIUDA S TIUDA=+$O(^TIU(8927,"B",TIUTNM,0))
115 S TIUX(.01)=TIUTNM
116 S TIUX(.03)="T"
117 S TIUX(.04)="A"
118 D SETTMPLT^TIUSRVT(.WRAPTEMP,TIUDA,.TIUX)
119 I +WRAPTEMP D BMES^XPDUTL(" "_TIUTNM_" Template ""wrapper"" added.")
120 Q
121BLDTREE(TREE,ROOTDA,ITMLST) ; Add Boilerplated Titles and
122 ; Patient Data Objects as items to ROOT
123 D SETITEMS^TIUSRVT(.TREE,ROOTDA,.ITMLST)
124 Q
Note: See TracBrowser for help on using the repository browser.