source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUSRVT.m@ 1003

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

initial load of WorldVistAEHR
File size: 7.9 KB
Line 
1TIUSRVT ; SLC/JM - Server functions for templates 8/23/2001 [8/19/04 1:57pm]
2 ;;1.0;TEXT INTEGRATION UTILITIES;**76,80,102,105,119,125,166**;Jun 20, 1997
3 ;
4 ; Nodes Returned by GETROOTS and GETITEMS
5 ;
6 ; Piece Data
7 ; ----- ---------------------
8 ; 1 IEN
9 ; 2 TYPE
10 ; 3 STATUS
11 ; 4 NAME
12 ; 5 EXCLUDE FROM GROUP BOILERPLATE
13 ; 6 BLANK LINES
14 ; 7 PERSONAL OWNER
15 ; 8 HAS CHILDREN FLAG (0=NONE, 1=ACTIVE, 2=INACTIVE, 3=BOTH)
16 ; 9 DIALOG
17 ; 10 DISPLAY ONLY
18 ; 11 FIRST LINE
19 ; 12 ONE ITEM ONLY
20 ; 13 HIDE DIALOG ITEMS
21 ; 14 HIDE TREE ITEMS
22 ; 15 INDENT ITEMS
23 ; 16 REMINDER DIALOG IEN
24 ; 17 REMINDER DIALOG NAME
25 ; 18 LOCKED
26 ; 19 COM OBJECT POINTER
27 ; 20 COM OBJECT PARAMETER
28 ; 21 LINK POINTER
29 ; 22 REMINDER DIALOG PATIENT SPECIFIC VALUE
30GETROOTS(TIUY,USER) ;Get template root info
31 N IDX,TYPE
32 I +$G(USER) D ADDNODE(.IDX,$O(^TIU(8927,"AROOT",USER,0)),1)
33 F TYPE="R","TF","CF","OF" D
34 .D ADDNODE(.IDX,$O(^TIU(8927,"AROOT",$$ROOTIDX^TIUDDT(TYPE),0)),1)
35 Q
36 ;
37GETPROOT(TIUY,USER) ;Get personal template root info only
38 N IDX
39 I +$G(USER) D ADDNODE(.IDX,$O(^TIU(8927,"AROOT",USER,0)),1)
40 Q
41 ;
42GETITEMS(TIUY,TIUDA) ; Returns all children of a non-Template Node
43 N IDX,ITEM,SEQ,ITEMNODE
44 K ^TMP("TIU TEMPLATE",$J)
45 S TIUY=$NA(^TMP("TIU TEMPLATE",$J))
46 I $P($G(^TIU(8927,TIUDA,0)),U,3)'="T" D
47 .S (IDX,SEQ)=0
48 .F S SEQ=$O(^TIU(8927,TIUDA,10,"B",SEQ)) Q:'SEQ D
49 ..S ITEM=0
50 ..F S ITEM=$O(^TIU(8927,TIUDA,10,"B",SEQ,ITEM)) Q:'ITEM D
51 ...S ITEMNODE=$G(^TIU(8927,TIUDA,10,ITEM,0))
52 ...D ADDNODE(.IDX,$P(ITEMNODE,U,2))
53 Q
54 ;
55GETBOIL(TIUY,TIUDA) ;Returns a Template's Unexpanded Boilerplate Text
56 N IDX,LINE,TYPE
57 K ^TMP("TIU TEMPLATE",$J)
58 S TIUY=$NA(^TMP("TIU TEMPLATE",$J))
59 S (IDX,LINE)=0
60 S TYPE=$P($G(^TIU(8927,TIUDA,0)),U,3)
61 I (TYPE="T")!(TYPE="G") D
62 .F S LINE=$O(^TIU(8927,TIUDA,2,LINE)) Q:'LINE D
63 ..S IDX=IDX+1
64 ..S ^TMP("TIU TEMPLATE",$J,IDX)=$G(^TIU(8927,TIUDA,2,LINE,0))
65 Q
66 ;
67GETTEXT(TIUY,DFN,VSTR,TIUX) ; Expand Boilerplate
68 D BLRPLT^TIUSRVD(.TIUY,"",DFN,VSTR,"TIUX")
69 Q
70ISEDITOR(TIUY,ROOT,USER) ; Returns TRUE if user is a Template Editor
71 N CLASS,TIUERR
72 S CLASS=$P($G(^TIU(8927,ROOT,0)),U,7)
73 I 'CLASS S TIUY="^NO CLASS OWNER DEFINED"
74 E D
75 .S TIUY=$$ISA^USRLM(USER,CLASS,.TIUERR)
76 .I 'TIUY,$D(TIUERR) S TIUY=U_TIUERR
77 Q
78LISTOWNR(TIUY,TIUFROM,DIR) ; Return subset of personal owners
79 N FILE,IENS,FIELDS,FLAGS,NUMBER,TIUPART,INDEX,SCREEN,ID,TIU,TIUERR
80 S FILE=200,FIELDS="@;.01",FLAGS="PB",INDEX="B",NUMBER=44
81 S (IENS,TIUPART,ID,TIU,TIUERR)=""
82 I DIR=1 S FLAGS="P"
83 S SCREEN="I $O(^TIU(8927,""AROOT"",Y,0))"
84 D LIST^DIC(FILE,IENS,FIELDS,FLAGS,NUMBER,.TIUFROM,.TIUPART,INDEX,SCREEN,ID,"TIU","TIUERR")
85 K TIU("DILIST",0)
86 N DA,I
87 S DA="",I=0
88 F S DA=$O(TIU("DILIST",DA),DIR) Q:'DA D
89 . S I=I+1
90 . S TIUY(I)=$G(TIU("DILIST",DA,0))
91 Q
92 ;
93 ; Internal Routines
94 ;
95ADDNODE(IDX,TIUDA,INTIUY) ;Adds template node info
96 N DATA
97 S DATA=$$NODEDATA(TIUDA)
98 I DATA'="" D
99 .S IDX=$G(IDX)+1
100 .I $G(INTIUY) S TIUY(IDX)=DATA
101 .E S ^TMP("TIU TEMPLATE",$J,IDX)=DATA
102 Q
103 ;
104NODEDATA(TIUDA) ;Returns template node data
105 N NODE,DATA,RDIEN
106 S DATA=""
107 I +TIUDA D
108 .S NODE=$G(^TIU(8927,TIUDA,0))
109 .S DATA=TIUDA_$$NP(3)_$$NP(4)_$$NP(1)_$$NP(5)_$$NP(2)_$$NP(6)_U_$$HASITEMS(TIUDA)_U_$P(NODE,U,8,14)
110 .S RDIEN=$P(NODE,U,15)
111 .I +RDIEN D
112 ..N RDN
113 ..S RDN=$G(^PXRMD(801.41,+RDIEN,0))
114 ..; TIU*166
115 ..I RDN'="" D
116 ...S $P(DATA,U,16)=RDIEN_U_$P(RDN,U,1)
117 ...S $P(DATA,U,22)=$S($P($G(RDN),U,17)=1:1,1:0)
118 .S $P(DATA,U,18)=$P(NODE,U,16,19)
119 Q DATA
120 ;
121NP(PNUM) ;Returns the piece of the node
122 Q U_$P(NODE,U,PNUM)
123 ;
124HASITEMS(TIUDA) ; Returns Has Children flag (0=NONE,1=ACTIVE,2=INACTIVE,3=BOTH)
125 N FLAG,FLAGA,FLAGI,ITEM,ITEMNODE
126 S (FLAG,FLAGA,FLAGI,ITEM)=0
127 I $P($G(^TIU(8927,TIUDA,0)),U,3)'="T" D
128 .F S ITEM=$O(^TIU(8927,TIUDA,10,ITEM)) Q:'ITEM D Q:(FLAG=3)
129 ..S ITEMNODE=$P($G(^TIU(8927,TIUDA,10,ITEM,0)),U,2)
130 ..I +ITEMNODE D
131 ...I $P($G(^TIU(8927,ITEMNODE,0)),U,4)="A" S FLAGA=1
132 ...E S FLAGI=2
133 ..S FLAG=FLAGA+FLAGI
134 Q FLAG
135SETTMPLT(SUCCESS,TIUDA,TIUX) ; Create/update a TEMPLATE
136 N FLD
137 S:'+TIUDA TIUDA=$$CREATE($G(TIUX(.01)),$G(TIUX(.03)))
138 S SUCCESS=TIUDA Q:'+SUCCESS
139 I $G(TIUX(.03))="R" S TIUX(.07)=+$$CLPAC^TIUSRVT1
140 F FLD=2,5 D Q:$D(TIUX)'>9
141 . I +$O(TIUX(FLD,0)) D Q:$D(TIUX)'>9
142 . . K ^TIU(8927,TIUDA,FLD)
143 . . I $G(TIUX(FLD,1))="@" K TIUX(FLD) Q
144 . . M ^TIU(8927,TIUDA,FLD)=TIUX(FLD) K TIUX(FLD)
145 . . D SETXT0^TIUSRVT1(TIUDA,FLD)
146 D FILE^TIUSRVT1(.SUCCESS,""""_TIUDA_",""",.TIUX)
147 Q
148CREATE(NAME,TYPE) ; Get or create TEMPLATE record
149 N DIC,DLAYGO,DR,X,Y
150 S (DIC,DLAYGO)=8927,DIC(0)="FL"
151 S X=""""_NAME_"""" D ^DIC
152 I +Y'>0 Q "0^ Unable to create a new TEMPLATE record."
153 Q +Y
154DELETE(SUCCESS,TIUDA) ; Delete TEMPLATES
155 ; Pass TIUDA as array of record numbers to be deleted by reference
156 ; SUCCESS will be returned as the actual number of templates deleted
157 N TIUI S (SUCCESS,TIUI)=0
158 F S TIUI=$O(TIUDA(TIUI)) Q:+TIUI'>0 D
159 . N DA
160 . S DA=+TIUDA(TIUI)
161 . I 'DA Q
162 . L -^TIU(8927,DA,0):1 ; Unlock before deleting
163 . ; Quit if the Template is NOT an ORPHAN
164 . I +$O(^TIU(8927,"AD",DA,0)) Q
165 . ; Otherwise, call FileMan to DELETE the record
166 . D ZAP(DA) S SUCCESS=SUCCESS+1
167 Q
168ZAP(DA) ; Call ^DIK to remove an entry - CAREFUL...NO CHECKS
169 N DIK
170 S DIK="^TIU(8927," D ^DIK
171 Q
172SETITEMS(SUCCESS,TIUDA,TIUX) ; Change ITEMs of a group, class, or root
173 ; Receives:
174 ; TIUDA=IEN of TEMPLATE record
175 ; TIUX(SEQ)=IEN of item
176 ; Returns:
177 ; SUCCESS(SEQ)=IEN of item if successful, or
178 ; 0^ Explanatory message if not
179 N TIUI S TIUI=0
180 D CLRITMS(TIUDA) ; Remove ITEMS
181 ; Iterate through TIUX and file items
182 F S TIUI=$O(TIUX(TIUI)) Q:+TIUI'>0 D
183 . N TIUITEM,TIUSUCC
184 . S TIUITEM(.01)=TIUI,TIUITEM(.02)=TIUX(TIUI),TIUSUCC=TIUI
185 . D UPDATE^TIUSRVT1(.TIUSUCC,"""+"_TIUI_","_TIUDA_",""",.TIUITEM)
186 . S SUCCESS(TIUI)=TIUSUCC
187 Q
188CLRITMS(TIUDA) ; Remove all items from a group, class, or root
189 N DA S DA=0
190 F S DA=$O(^TIU(8927,TIUDA,10,DA)) Q:+DA'>0 D
191 . N DIK S DIK="^TIU(8927,TIUDA,10,",DA(1)=TIUDA D ^DIK
192 Q
193OBJLST(TIUY) ; Get the list of active objects
194 N TIUDA,TIUD0,TIUI
195 S (TIUDA,TIUI)=0,TIUY=$NA(^TMP("TIU OBJECTS",$J)) K @TIUY
196 F S TIUDA=$O(^TIU(8925.1,"AT","O",TIUDA)) Q:+TIUDA'>0 D
197 . S TIUD0=$G(^TIU(8925.1,TIUDA,0)) Q:'+$$CANPICK^TIULP(+TIUDA)
198 . S TIUI=TIUI+1
199 . S @TIUY@(TIUI)=TIUDA_U_$P(TIUD0,U,1,3)
200 Q
201BPCHECK(TIUTY,TIUX) ; Checks objects in boilerplate text.
202 N LINE,TIUI,TIUFWHO,TIUFPRIV,TIUY
203 S TIUI=0,TIUY=1,TIUFPRIV=1,TIUFWHO="M"
204 K ^TMP("TIUF",$J)
205 F S TIUI=$O(TIUX(2,TIUI)) Q:+TIUI'>0 D Q:'+TIUY
206 . S LINE=$G(TIUX(2,TIUI,0))
207 . I LINE["|" D
208 . . I ($L(LINE,"|")+1)#2 D Q
209 . . . S TIUY=0
210 . . . S TIUTY(1)="Object split between lines, rest of line not checked:"
211 . . . S TIUTY(2)=LINE
212 . . N PIECE
213 . . F PIECE=2:2:$L(LINE,"|") D Q:TIUY=0
214 . . . N OBJNM
215 . . . S OBJNM=$P(LINE,"|",PIECE)
216 . . . I OBJNM="" D Q
217 . . . . S TIUY=0
218 . . . . S TIUTY(1)="Brackets are there, but there's no name inside ||:"
219 . . . . S TIUTY(2)=LINE
220 . . . N XREF,ARR
221 . . . F XREF="B","C","D" D Q:'+TIUY
222 . . . . N ODA S ODA=0
223 . . . . F S ODA=$O(^TIU(8925.1,XREF,OBJNM,ODA)) Q:+ODA'>0 D Q:'+TIUY
224 . . . . . S:$D(^TIU(8925.1,"AT","O",ODA)) ARR(ODA)=""
225 . . . . . I $O(ARR($O(ARR(0)))) D
226 . . . . . . S TIUY=0
227 . . . . . . S TIUTY(1)="Object |"_OBJNM_"| is ambiguous."
228 . . . . . . S TIUTY(2)="It could be any of SEVERAL objects. Please contact IRM."
229 . . . I '$D(ARR) D Q
230 . . . . S TIUY=0
231 . . . . S TIUTY(1)="Object |"_OBJNM_"| cannot be found in the file."
232 . . . . S TIUTY(2)="Use UPPERCASE and object's exact NAME, PRINT NAME, or ABBREVIATION."
233 . . . . S TIUTY(3)="Any of these may have changed since |"_OBJNM_"| was embedded."
234 . . . S ODA=$O(ARR(0)) N OBJCK D CHECK^TIUFLF3(ODA,0,0,.OBJCK)
235 . . . I '+OBJCK D Q:'+TIUY
236 . . . . N SUBS
237 . . . . F SUBS="F","T","O","S","J" D
238 . . . . . I $D(OBJCK(SUBS)) D
239 . . . . . . S TIUY=0
240 . . . . . . S TIUTY(1)="Object |"_OBJNM_"| is faulty: "
241 . . . . . . S TIUTY(2)=OBJCK(SUBS)_"."
242 . . . I $P(^TIU(8925.1,ODA,0),U,7)'=11 D
243 . . . . S TIUY=0
244 . . . . S TIUTY(1)="Object |"_OBJNM_"| is NOT ACTIVE."
245 K ^TMP("TIUF",$J)
246 Q
Note: See TracBrowser for help on using the repository browser.