1 | KIDS Distribution saved on Mar 31, 2010@15:54:29
|
---|
2 | TMG-CPRS-TEXTOBJ-PARAM*1.0*1
|
---|
3 | **KIDS**:TMG-CPRS-TEXTOBJ-PARAM*1.0*1^
|
---|
4 |
|
---|
5 | **INSTALL NAME**
|
---|
6 | TMG-CPRS-TEXTOBJ-PARAM*1.0*1
|
---|
7 | "BLD",7629,0)
|
---|
8 | TMG-CPRS-TEXTOBJ-PARAM*1.0*1^^0^3100331^n
|
---|
9 | "BLD",7629,4,0)
|
---|
10 | ^9.64PA^^
|
---|
11 | "BLD",7629,6.3)
|
---|
12 | 1
|
---|
13 | "BLD",7629,"KRN",0)
|
---|
14 | ^9.67PA^8989.52^19
|
---|
15 | "BLD",7629,"KRN",.4,0)
|
---|
16 | .4
|
---|
17 | "BLD",7629,"KRN",.401,0)
|
---|
18 | .401
|
---|
19 | "BLD",7629,"KRN",.402,0)
|
---|
20 | .402
|
---|
21 | "BLD",7629,"KRN",.403,0)
|
---|
22 | .403
|
---|
23 | "BLD",7629,"KRN",.5,0)
|
---|
24 | .5
|
---|
25 | "BLD",7629,"KRN",.84,0)
|
---|
26 | .84
|
---|
27 | "BLD",7629,"KRN",3.6,0)
|
---|
28 | 3.6
|
---|
29 | "BLD",7629,"KRN",3.8,0)
|
---|
30 | 3.8
|
---|
31 | "BLD",7629,"KRN",9.2,0)
|
---|
32 | 9.2
|
---|
33 | "BLD",7629,"KRN",9.8,0)
|
---|
34 | 9.8
|
---|
35 | "BLD",7629,"KRN",9.8,"NM",0)
|
---|
36 | ^9.68A^1^1
|
---|
37 | "BLD",7629,"KRN",9.8,"NM",1,0)
|
---|
38 | TIUSRVD^^0^B93130374
|
---|
39 | "BLD",7629,"KRN",9.8,"NM","B","TIUSRVD",1)
|
---|
40 |
|
---|
41 | "BLD",7629,"KRN",19,0)
|
---|
42 | 19
|
---|
43 | "BLD",7629,"KRN",19.1,0)
|
---|
44 | 19.1
|
---|
45 | "BLD",7629,"KRN",101,0)
|
---|
46 | 101
|
---|
47 | "BLD",7629,"KRN",409.61,0)
|
---|
48 | 409.61
|
---|
49 | "BLD",7629,"KRN",771,0)
|
---|
50 | 771
|
---|
51 | "BLD",7629,"KRN",870,0)
|
---|
52 | 870
|
---|
53 | "BLD",7629,"KRN",8989.51,0)
|
---|
54 | 8989.51
|
---|
55 | "BLD",7629,"KRN",8989.52,0)
|
---|
56 | 8989.52
|
---|
57 | "BLD",7629,"KRN",8994,0)
|
---|
58 | 8994
|
---|
59 | "BLD",7629,"KRN","B",.4,.4)
|
---|
60 |
|
---|
61 | "BLD",7629,"KRN","B",.401,.401)
|
---|
62 |
|
---|
63 | "BLD",7629,"KRN","B",.402,.402)
|
---|
64 |
|
---|
65 | "BLD",7629,"KRN","B",.403,.403)
|
---|
66 |
|
---|
67 | "BLD",7629,"KRN","B",.5,.5)
|
---|
68 |
|
---|
69 | "BLD",7629,"KRN","B",.84,.84)
|
---|
70 |
|
---|
71 | "BLD",7629,"KRN","B",3.6,3.6)
|
---|
72 |
|
---|
73 | "BLD",7629,"KRN","B",3.8,3.8)
|
---|
74 |
|
---|
75 | "BLD",7629,"KRN","B",9.2,9.2)
|
---|
76 |
|
---|
77 | "BLD",7629,"KRN","B",9.8,9.8)
|
---|
78 |
|
---|
79 | "BLD",7629,"KRN","B",19,19)
|
---|
80 |
|
---|
81 | "BLD",7629,"KRN","B",19.1,19.1)
|
---|
82 |
|
---|
83 | "BLD",7629,"KRN","B",101,101)
|
---|
84 |
|
---|
85 | "BLD",7629,"KRN","B",409.61,409.61)
|
---|
86 |
|
---|
87 | "BLD",7629,"KRN","B",771,771)
|
---|
88 |
|
---|
89 | "BLD",7629,"KRN","B",870,870)
|
---|
90 |
|
---|
91 | "BLD",7629,"KRN","B",8989.51,8989.51)
|
---|
92 |
|
---|
93 | "BLD",7629,"KRN","B",8989.52,8989.52)
|
---|
94 |
|
---|
95 | "BLD",7629,"KRN","B",8994,8994)
|
---|
96 |
|
---|
97 | "MBREQ")
|
---|
98 | 0
|
---|
99 | "QUES","XPF1",0)
|
---|
100 | Y
|
---|
101 | "QUES","XPF1","??")
|
---|
102 | ^D REP^XPDH
|
---|
103 | "QUES","XPF1","A")
|
---|
104 | Shall I write over your |FLAG| File
|
---|
105 | "QUES","XPF1","B")
|
---|
106 | YES
|
---|
107 | "QUES","XPF1","M")
|
---|
108 | D XPF1^XPDIQ
|
---|
109 | "QUES","XPF2",0)
|
---|
110 | Y
|
---|
111 | "QUES","XPF2","??")
|
---|
112 | ^D DTA^XPDH
|
---|
113 | "QUES","XPF2","A")
|
---|
114 | Want my data |FLAG| yours
|
---|
115 | "QUES","XPF2","B")
|
---|
116 | YES
|
---|
117 | "QUES","XPF2","M")
|
---|
118 | D XPF2^XPDIQ
|
---|
119 | "QUES","XPI1",0)
|
---|
120 | YO
|
---|
121 | "QUES","XPI1","??")
|
---|
122 | ^D INHIBIT^XPDH
|
---|
123 | "QUES","XPI1","A")
|
---|
124 | Want KIDS to INHIBIT LOGONs during the install
|
---|
125 | "QUES","XPI1","B")
|
---|
126 | NO
|
---|
127 | "QUES","XPI1","M")
|
---|
128 | D XPI1^XPDIQ
|
---|
129 | "QUES","XPM1",0)
|
---|
130 | PO^VA(200,:EM
|
---|
131 | "QUES","XPM1","??")
|
---|
132 | ^D MG^XPDH
|
---|
133 | "QUES","XPM1","A")
|
---|
134 | Enter the Coordinator for Mail Group '|FLAG|'
|
---|
135 | "QUES","XPM1","B")
|
---|
136 |
|
---|
137 | "QUES","XPM1","M")
|
---|
138 | D XPM1^XPDIQ
|
---|
139 | "QUES","XPO1",0)
|
---|
140 | Y
|
---|
141 | "QUES","XPO1","??")
|
---|
142 | ^D MENU^XPDH
|
---|
143 | "QUES","XPO1","A")
|
---|
144 | Want KIDS to Rebuild Menu Trees Upon Completion of Install
|
---|
145 | "QUES","XPO1","B")
|
---|
146 | NO
|
---|
147 | "QUES","XPO1","M")
|
---|
148 | D XPO1^XPDIQ
|
---|
149 | "QUES","XPZ1",0)
|
---|
150 | Y
|
---|
151 | "QUES","XPZ1","??")
|
---|
152 | ^D OPT^XPDH
|
---|
153 | "QUES","XPZ1","A")
|
---|
154 | Want to DISABLE Scheduled Options, Menu Options, and Protocols
|
---|
155 | "QUES","XPZ1","B")
|
---|
156 | NO
|
---|
157 | "QUES","XPZ1","M")
|
---|
158 | D XPZ1^XPDIQ
|
---|
159 | "QUES","XPZ2",0)
|
---|
160 | Y
|
---|
161 | "QUES","XPZ2","??")
|
---|
162 | ^D RTN^XPDH
|
---|
163 | "QUES","XPZ2","A")
|
---|
164 | Want to MOVE routines to other CPUs
|
---|
165 | "QUES","XPZ2","B")
|
---|
166 | NO
|
---|
167 | "QUES","XPZ2","M")
|
---|
168 | D XPZ2^XPDIQ
|
---|
169 | "RTN")
|
---|
170 | 1
|
---|
171 | "RTN","TIUSRVD")
|
---|
172 | 0^1^B93130374
|
---|
173 | "RTN","TIUSRVD",1,0)
|
---|
174 | TIUSRVD ; SLC/JER - RPC's for document definition ; 09/12/2003 [6/8/05 8:07am]
|
---|
175 | "RTN","TIUSRVD",2,0)
|
---|
176 | ;;1.0;TEXT INTEGRATION UTILITIES;**1,7,22,47,103,100,115,164,112,186,201**;Jun 20, 1997;Build 1
|
---|
177 | "RTN","TIUSRVD",3,0)
|
---|
178 | NOTES(TIUY) ; Get list of PN Titles
|
---|
179 | "RTN","TIUSRVD",4,0)
|
---|
180 | D LIST(.TIUY,3)
|
---|
181 | "RTN","TIUSRVD",5,0)
|
---|
182 | Q
|
---|
183 | "RTN","TIUSRVD",6,0)
|
---|
184 | SUMMARY(TIUY) ; Get list of DS Titles
|
---|
185 | "RTN","TIUSRVD",7,0)
|
---|
186 | D LIST(.TIUY,244)
|
---|
187 | "RTN","TIUSRVD",8,0)
|
---|
188 | Q
|
---|
189 | "RTN","TIUSRVD",9,0)
|
---|
190 | LIST(TIUY,CLASS,TYPE,TIUK) ; Get list of document titles
|
---|
191 | "RTN","TIUSRVD",10,0)
|
---|
192 | N TIUDFLT
|
---|
193 | "RTN","TIUSRVD",11,0)
|
---|
194 | ; TIUK is STATIC
|
---|
195 | "RTN","TIUSRVD",12,0)
|
---|
196 | S TIUK=+$G(TIUK)
|
---|
197 | "RTN","TIUSRVD",13,0)
|
---|
198 | I $G(TYPE)']"" S TYPE="DOC"
|
---|
199 | "RTN","TIUSRVD",14,0)
|
---|
200 | ; If the user has a preferred list of titles for the CLASS, get it
|
---|
201 | "RTN","TIUSRVD",15,0)
|
---|
202 | I +$O(^TIU(8925.98,"AC",DUZ,CLASS,0)) D PERSLIST(.TIUY,DUZ,CLASS,.TIUK,1)
|
---|
203 | "RTN","TIUSRVD",16,0)
|
---|
204 | S TIUK=+$G(TIUK)+1 S TIUY(TIUK)="~LONG LIST"
|
---|
205 | "RTN","TIUSRVD",17,0)
|
---|
206 | D TRAVERSE(.TIUY,CLASS,$G(TYPE),.TIUK)
|
---|
207 | "RTN","TIUSRVD",18,0)
|
---|
208 | S TIUDFLT=$$PERSDOC^TIULE(DUZ,+CLASS)
|
---|
209 | "RTN","TIUSRVD",19,0)
|
---|
210 | I +TIUDFLT S TIUK=+$G(TIUK)+1,TIUY(TIUK)="d"_$P(TIUDFLT,U,2)
|
---|
211 | "RTN","TIUSRVD",20,0)
|
---|
212 | Q
|
---|
213 | "RTN","TIUSRVD",21,0)
|
---|
214 | TRAVERSE(TIUY,CLASS,TYPE,TIUK) ; Get all selectable titles for the CLASS
|
---|
215 | "RTN","TIUSRVD",22,0)
|
---|
216 | N I,J,X,CURTYP,Y,TIUI,TIUC,TYPMATCH S (TIUC,TIUI)=0
|
---|
217 | "RTN","TIUSRVD",23,0)
|
---|
218 | S TIUK=+$G(TIUK)
|
---|
219 | "RTN","TIUSRVD",24,0)
|
---|
220 | I $S(+$$CANENTR^TIULP(CLASS)'>0:1,+$$CANPICK^TIULP(CLASS)'>0:1,1:0) Q
|
---|
221 | "RTN","TIUSRVD",25,0)
|
---|
222 | S CURTYP=$P(^TIU(8925.1,+CLASS,0),U,4)
|
---|
223 | "RTN","TIUSRVD",26,0)
|
---|
224 | S TYPMATCH=$$TYPMATCH^TIULA1(TYPE,CURTYP)
|
---|
225 | "RTN","TIUSRVD",27,0)
|
---|
226 | I +TYPMATCH S TIUK=+$G(TIUK)+1
|
---|
227 | "RTN","TIUSRVD",28,0)
|
---|
228 | I S TIUY(TIUK)="i"_+CLASS_U_$$PNAME^TIULC1(+CLASS)
|
---|
229 | "RTN","TIUSRVD",29,0)
|
---|
230 | S I=0 F S I=$O(^TIU(8925.1,+CLASS,10,I)) Q:+I'>0 D
|
---|
231 | "RTN","TIUSRVD",30,0)
|
---|
232 | . N J
|
---|
233 | "RTN","TIUSRVD",31,0)
|
---|
234 | . S J=+$G(^TIU(8925.1,+CLASS,10,+I,0)) Q:+J'>0
|
---|
235 | "RTN","TIUSRVD",32,0)
|
---|
236 | . D TRAVERSE(.TIUY,+J,TYPE,.TIUK)
|
---|
237 | "RTN","TIUSRVD",33,0)
|
---|
238 | Q
|
---|
239 | "RTN","TIUSRVD",34,0)
|
---|
240 | PERSLIST(TIUY,DUZ,CLASS,TIUC,TIUFLG) ; Get personal list for a user
|
---|
241 | "RTN","TIUSRVD",35,0)
|
---|
242 | N TIUI,TIUDA,TIUDFLT,INLST
|
---|
243 | "RTN","TIUSRVD",36,0)
|
---|
244 | S TIUDA=+$O(^TIU(8925.98,"AC",DUZ,CLASS,0))
|
---|
245 | "RTN","TIUSRVD",37,0)
|
---|
246 | Q:+TIUDA'>0
|
---|
247 | "RTN","TIUSRVD",38,0)
|
---|
248 | I +$G(TIUFLG) S TIUC=1,TIUY(TIUC)="~SHORT LIST"
|
---|
249 | "RTN","TIUSRVD",39,0)
|
---|
250 | S TIUI=0,TIUC=+$G(TIUC)
|
---|
251 | "RTN","TIUSRVD",40,0)
|
---|
252 | F S TIUI=$O(^TIU(8925.98,TIUDA,10,TIUI)) Q:+TIUI'>0 D
|
---|
253 | "RTN","TIUSRVD",41,0)
|
---|
254 | . N TIUPL,TIUTNM,TIUDTYP,TIUSEQ
|
---|
255 | "RTN","TIUSRVD",42,0)
|
---|
256 | . S TIUPL=$G(^TIU(8925.98,TIUDA,10,TIUI,0))
|
---|
257 | "RTN","TIUSRVD",43,0)
|
---|
258 | . S TIUDTYP=$P(TIUPL,U)
|
---|
259 | "RTN","TIUSRVD",44,0)
|
---|
260 | . I $S(+$$CANENTR^TIULP(TIUDTYP)'>0:1,+$$CANPICK^TIULP(TIUDTYP)'>0:1,1:0) Q
|
---|
261 | "RTN","TIUSRVD",45,0)
|
---|
262 | . S TIUTNM=$S($P(TIUPL,U,3)]"":$P(TIUPL,U,3),1:$$PNAME^TIULC1(+TIUDTYP))
|
---|
263 | "RTN","TIUSRVD",46,0)
|
---|
264 | . S TIUSEQ=+$P(TIUPL,U,2),TIUC=+$G(TIUC)+1
|
---|
265 | "RTN","TIUSRVD",47,0)
|
---|
266 | . S TIUSEQ=$S(+TIUSEQ:$S('$D(TIUY(TIUSEQ)):TIUSEQ,1:(TIUSEQ+1)),1:TIUC)
|
---|
267 | "RTN","TIUSRVD",48,0)
|
---|
268 | . S TIUY(TIUSEQ)="i"_TIUDTYP_U_TIUTNM,TIUC=+TIUSEQ
|
---|
269 | "RTN","TIUSRVD",49,0)
|
---|
270 | I +$G(TIUFLG) Q
|
---|
271 | "RTN","TIUSRVD",50,0)
|
---|
272 | S TIUDFLT=$$PERSDOC^TIULE(DUZ,+CLASS)
|
---|
273 | "RTN","TIUSRVD",51,0)
|
---|
274 | S (TIUI,TIUC)=0
|
---|
275 | "RTN","TIUSRVD",52,0)
|
---|
276 | F S TIUI=$O(TIUY(TIUI)) Q:+TIUI'>0 D
|
---|
277 | "RTN","TIUSRVD",53,0)
|
---|
278 | . S TIUC=TIUI
|
---|
279 | "RTN","TIUSRVD",54,0)
|
---|
280 | . I +TIUDFLT,($P($G(TIUY(TIUI)),U)=("i"_+TIUDFLT)) S $P(TIUDFLT,U,2)=$P(TIUY(TIUI),U,2),INLST=TIUI
|
---|
281 | "RTN","TIUSRVD",55,0)
|
---|
282 | I +TIUDFLT D
|
---|
283 | "RTN","TIUSRVD",56,0)
|
---|
284 | . ;if default isn't in list, append it as an item
|
---|
285 | "RTN","TIUSRVD",57,0)
|
---|
286 | . I '$G(INLST) S TIUC=+$G(TIUC)+1,TIUY(TIUC)="i"_TIUDFLT
|
---|
287 | "RTN","TIUSRVD",58,0)
|
---|
288 | . ;otherwise, just append as default
|
---|
289 | "RTN","TIUSRVD",59,0)
|
---|
290 | . S TIUC=+$G(TIUC)+1,TIUY(TIUC)="d"_TIUDFLT
|
---|
291 | "RTN","TIUSRVD",60,0)
|
---|
292 | Q
|
---|
293 | "RTN","TIUSRVD",61,0)
|
---|
294 | BLRSHELL(TIUY,TITLE,DFN,VSTR) ; Shell for boilerplate RPC
|
---|
295 | "RTN","TIUSRVD",62,0)
|
---|
296 | K ^TMP("TIUBOIL",$J)
|
---|
297 | "RTN","TIUSRVD",63,0)
|
---|
298 | D BLRPLT(.TIUY,TITLE,DFN,$G(VSTR))
|
---|
299 | "RTN","TIUSRVD",64,0)
|
---|
300 | K ^TMP("TIUBOIL",$J,0)
|
---|
301 | "RTN","TIUSRVD",65,0)
|
---|
302 | Q
|
---|
303 | "RTN","TIUSRVD",66,0)
|
---|
304 | BLRPLT(TIUY,TITLE,DFN,VSTR,ROOT) ; Load/Execute the Boilerplate for TITLE
|
---|
305 | "RTN","TIUSRVD",67,0)
|
---|
306 | ; or ROOT
|
---|
307 | "RTN","TIUSRVD",68,0)
|
---|
308 | N TIU,TIUI,TIUJ,TIUK,TIUL,VADM,VAIN,VA,VAERR S TIUI=0
|
---|
309 | "RTN","TIUSRVD",69,0)
|
---|
310 | S:'$D(TIUY) TIUY=$NA(^TMP("TIUBOIL",$J))
|
---|
311 | "RTN","TIUSRVD",70,0)
|
---|
312 | S:'$D(ROOT) ROOT=$NA(^TIU(8925.1,+TITLE,"DFLT")) ; **47**
|
---|
313 | "RTN","TIUSRVD",71,0)
|
---|
314 | I $L($G(VSTR)) D PATVADPT^TIULV(.TIU,DFN,"",$G(VSTR)) ; **47**
|
---|
315 | "RTN","TIUSRVD",72,0)
|
---|
316 | S TIUJ=+$P($G(^TMP("TIUBOIL",$J,0)),U,3)+1
|
---|
317 | "RTN","TIUSRVD",73,0)
|
---|
318 | ; --- Set component header ---
|
---|
319 | "RTN","TIUSRVD",74,0)
|
---|
320 | I ROOT["^TIU(8925.1," D
|
---|
321 | "RTN","TIUSRVD",75,0)
|
---|
322 | . S ^TMP("TIUBOIL",$J,TIUJ,0)=$S($P($G(^TIU(8925.1,+TITLE,0)),U,4)="CO":$P(^TIU(8925.1,+TITLE,0),U)_": ",1:"")
|
---|
323 | "RTN","TIUSRVD",76,0)
|
---|
324 | I +TIUJ=1,($G(^TMP("TIUBOIL",$J,TIUJ,0))']"") K ^TMP("TIUBOIL",$J,TIUJ,0) S TIUJ=0
|
---|
325 | "RTN","TIUSRVD",77,0)
|
---|
326 | S ^TMP("TIUBOIL",$J,0)="^^"_TIUJ_U_TIUJ_U_DT_"^^"
|
---|
327 | "RTN","TIUSRVD",78,0)
|
---|
328 | F S TIUI=$O(@ROOT@(TIUI)) Q:+TIUI'>0 D
|
---|
329 | "RTN","TIUSRVD",79,0)
|
---|
330 | . S TIUJ=TIUJ+1,X=$G(@ROOT@(TIUI,0))
|
---|
331 | "RTN","TIUSRVD",80,0)
|
---|
332 | . I $L($T(DOLMLINE^TIUSRVF1)),'$D(XWBOS),(X["{FLD:") S X=$$DOLMLINE^TIUSRVF1(X)
|
---|
333 | "RTN","TIUSRVD",81,0)
|
---|
334 | . I X["|" S X=$$BOIL(X,TIUJ)
|
---|
335 | "RTN","TIUSRVD",82,0)
|
---|
336 | . I X["~@" D INSMULT(X,"^TMP(""TIUBOIL"",$J)",.TIUJ) I 1
|
---|
337 | "RTN","TIUSRVD",83,0)
|
---|
338 | . E S ^TMP("TIUBOIL",$J,TIUJ,0)=X
|
---|
339 | "RTN","TIUSRVD",84,0)
|
---|
340 | . S ^TMP("TIUBOIL",$J,0)="^^"_TIUJ_U_TIUJ_U_DT_"^^"
|
---|
341 | "RTN","TIUSRVD",85,0)
|
---|
342 | I ROOT["^TIU(8925.1,",+$O(^TIU(8925.1,+TITLE,10,0)) D
|
---|
343 | "RTN","TIUSRVD",86,0)
|
---|
344 | . N TIUFITEM,TIUI D ITEMS^TIUFLT(+TITLE)
|
---|
345 | "RTN","TIUSRVD",87,0)
|
---|
346 | . S TIUI=0 F S TIUI=$O(TIUFITEM(TIUI)) Q:+TIUI'>0 D
|
---|
347 | "RTN","TIUSRVD",88,0)
|
---|
348 | . . S TIUL=+$G(TIUFITEM(+TIUI)) D BLRPLT(.TIUY,TIUL,DFN,$G(VSTR))
|
---|
349 | "RTN","TIUSRVD",89,0)
|
---|
350 | Q
|
---|
351 | "RTN","TIUSRVD",90,0)
|
---|
352 | BOIL0(LINE,COUNT) ; Execute Boilerplates ;"//kt original function name was BOIL (mod is below)
|
---|
353 | "RTN","TIUSRVD",91,0)
|
---|
354 | N TIUNEWG,TIUNEWR,TIUOLDG,TIUOLDR
|
---|
355 | "RTN","TIUSRVD",92,0)
|
---|
356 | N TIUI,DIC,X,Y,TIUFPRIV S TIUFPRIV=1
|
---|
357 | "RTN","TIUSRVD",93,0)
|
---|
358 | S DIC=8925.1,DIC(0)="FMXZ"
|
---|
359 | "RTN","TIUSRVD",94,0)
|
---|
360 | S DIC("S")="I $P($G(^TIU(8925.1,+Y,0)),U,4)=""O"""
|
---|
361 | "RTN","TIUSRVD",95,0)
|
---|
362 | F TIUI=2:2:$L(LINE,"|") S X=$P(LINE,"|",TIUI) D
|
---|
363 | "RTN","TIUSRVD",96,0)
|
---|
364 | . D ^DIC
|
---|
365 | "RTN","TIUSRVD",97,0)
|
---|
366 | . I +Y'>0 S X="The OBJECT "_X_" was NOT found...Contact IRM."
|
---|
367 | "RTN","TIUSRVD",98,0)
|
---|
368 | . I +Y>0 D
|
---|
369 | "RTN","TIUSRVD",99,0)
|
---|
370 | . . I $D(^TIU(8925.1,+Y,9)),+$$CANXEC(+Y) X ^(9) S:X["~@" X=$$APPEND(X) I 1
|
---|
371 | "RTN","TIUSRVD",100,0)
|
---|
372 | . . E S X="The OBJECT "_X_" is INACTIVE...Contact IRM."
|
---|
373 | "RTN","TIUSRVD",101,0)
|
---|
374 | . . I X["~@" D
|
---|
375 | "RTN","TIUSRVD",102,0)
|
---|
376 | . . . I X'["^" D
|
---|
377 | "RTN","TIUSRVD",103,0)
|
---|
378 | . . . . S TIUOLDR=$P(X,"~@",2),TIUNEWR=TIUOLDR_TIUI
|
---|
379 | "RTN","TIUSRVD",104,0)
|
---|
380 | . . . . M @TIUNEWR=@TIUOLDR K @TIUOLDR
|
---|
381 | "RTN","TIUSRVD",105,0)
|
---|
382 | . . . . S $P(X,"~@",2)=TIUNEWR
|
---|
383 | "RTN","TIUSRVD",106,0)
|
---|
384 | . . . I X["^" D
|
---|
385 | "RTN","TIUSRVD",107,0)
|
---|
386 | . . . . S TIUOLDG=$P(X,"~@",2),TIUNEWG="^TMP("_"""TIU201"""_","_$J_","_TIUI_")"
|
---|
387 | "RTN","TIUSRVD",108,0)
|
---|
388 | . . . . M @TIUNEWG=@TIUOLDG K @TIUOLDG
|
---|
389 | "RTN","TIUSRVD",109,0)
|
---|
390 | . . . . S $P(X,"~@",2)=TIUNEWG
|
---|
391 | "RTN","TIUSRVD",110,0)
|
---|
392 | . S LINE=$$REPLACE(LINE,X,TIUI)
|
---|
393 | "RTN","TIUSRVD",111,0)
|
---|
394 | Q $TR(LINE,"|","")
|
---|
395 | "RTN","TIUSRVD",112,0)
|
---|
396 | ;
|
---|
397 | "RTN","TIUSRVD",113,0)
|
---|
398 | BOIL(LINE,COUNT) ; Execute Boilerplates ;"//kt modification
|
---|
399 | "RTN","TIUSRVD",114,0)
|
---|
400 | ;"Purpose: Resolve Text Objects. Function is modified to allow |TEXT OBJECT{Parameters}|
|
---|
401 | "RTN","TIUSRVD",115,0)
|
---|
402 | ;"Input: LINE -- One line of text that has one or more text objects
|
---|
403 | "RTN","TIUSRVD",116,0)
|
---|
404 | ;" COUNT -- (not used)
|
---|
405 | "RTN","TIUSRVD",117,0)
|
---|
406 | ;"Results: Returns line of text with text objects resolved.
|
---|
407 | "RTN","TIUSRVD",118,0)
|
---|
408 | ;"NOTE: [Parameter] may itself be a nested text object (arbitrary depth allowed)
|
---|
409 | "RTN","TIUSRVD",119,0)
|
---|
410 | ;"Usage -- in text object definition, code may be like this:
|
---|
411 | "RTN","TIUSRVD",120,0)
|
---|
412 | ;" S X=$$MYFN^MYMOD(X)
|
---|
413 | "RTN","TIUSRVD",121,0)
|
---|
414 | ;" The value for X being passed into the object's code will hold the
|
---|
415 | "RTN","TIUSRVD",122,0)
|
---|
416 | ;" parameter found between { }
|
---|
417 | "RTN","TIUSRVD",123,0)
|
---|
418 | ;" This is backwards compatible. If no parameter is specified, then X=""
|
---|
419 | "RTN","TIUSRVD",124,0)
|
---|
420 | N TIUNEWG,TIUNEWR,TIUOLDG,TIUOLDR,TMGX
|
---|
421 | "RTN","TIUSRVD",125,0)
|
---|
422 | N TIUI,DIC,X,Y,TIUFPRIV S TIUFPRIV=1
|
---|
423 | "RTN","TIUSRVD",126,0)
|
---|
424 | S DIC=8925.1,DIC(0)="FMXZ"
|
---|
425 | "RTN","TIUSRVD",127,0)
|
---|
426 | S DIC("S")="I $P($G(^TIU(8925.1,+Y,0)),U,4)=""O"""
|
---|
427 | "RTN","TIUSRVD",128,0)
|
---|
428 | F TIUI=2:2:$L(LINE,"|") D
|
---|
429 | "RTN","TIUSRVD",129,0)
|
---|
430 | . NEW SA,SB
|
---|
431 | "RTN","TIUSRVD",130,0)
|
---|
432 | . SET X=$$MXTRACT(LINE,"|",.SA,.SB)
|
---|
433 | "RTN","TIUSRVD",131,0)
|
---|
434 | . IF X["{" DO
|
---|
435 | "RTN","TIUSRVD",132,0)
|
---|
436 | . . NEW X1,X2
|
---|
437 | "RTN","TIUSRVD",133,0)
|
---|
438 | . . SET TMGX=$$MXTRACT(X,"{",.X1,.X2)
|
---|
439 | "RTN","TIUSRVD",134,0)
|
---|
440 | . . IF TMGX["|" SET TMGX=$$BOIL(TMGX)
|
---|
441 | "RTN","TIUSRVD",135,0)
|
---|
442 | . . SET X=X1_X2
|
---|
443 | "RTN","TIUSRVD",136,0)
|
---|
444 | . ELSE SET TMGX=""
|
---|
445 | "RTN","TIUSRVD",137,0)
|
---|
446 | . D ^DIC
|
---|
447 | "RTN","TIUSRVD",138,0)
|
---|
448 | . I +Y>0 DO
|
---|
449 | "RTN","TIUSRVD",139,0)
|
---|
450 | . . I $D(^TIU(8925.1,+Y,9)),+$$CANXEC(+Y) DO
|
---|
451 | "RTN","TIUSRVD",140,0)
|
---|
452 | . . . SET X=TMGX ;"Load passed parameter (or "" if none) into X
|
---|
453 | "RTN","TIUSRVD",141,0)
|
---|
454 | . . . X ^(9)
|
---|
455 | "RTN","TIUSRVD",142,0)
|
---|
456 | . . . S:X["~@" X=$$APPEND(X)
|
---|
457 | "RTN","TIUSRVD",143,0)
|
---|
458 | . . E S X="The OBJECT "_X_" is INACTIVE...Contact IRM."
|
---|
459 | "RTN","TIUSRVD",144,0)
|
---|
460 | . . I X["~@" D
|
---|
461 | "RTN","TIUSRVD",145,0)
|
---|
462 | . . . I X'["^" D
|
---|
463 | "RTN","TIUSRVD",146,0)
|
---|
464 | . . . . S TIUOLDR=$P(X,"~@",2),TIUNEWR=TIUOLDR_TIUI
|
---|
465 | "RTN","TIUSRVD",147,0)
|
---|
466 | . . . . M @TIUNEWR=@TIUOLDR K @TIUOLDR
|
---|
467 | "RTN","TIUSRVD",148,0)
|
---|
468 | . . . . S $P(X,"~@",2)=TIUNEWR
|
---|
469 | "RTN","TIUSRVD",149,0)
|
---|
470 | . . . I X["^" D
|
---|
471 | "RTN","TIUSRVD",150,0)
|
---|
472 | . . . . S TIUOLDG=$P(X,"~@",2),TIUNEWG="^TMP("_"""TIU201"""_","_$J_","_TIUI_")"
|
---|
473 | "RTN","TIUSRVD",151,0)
|
---|
474 | . . . . M @TIUNEWG=@TIUOLDG K @TIUOLDG
|
---|
475 | "RTN","TIUSRVD",152,0)
|
---|
476 | . . . . S $P(X,"~@",2)=TIUNEWG
|
---|
477 | "RTN","TIUSRVD",153,0)
|
---|
478 | . ELSE S X="The OBJECT "_X_" was NOT found...Contact IRM."
|
---|
479 | "RTN","TIUSRVD",154,0)
|
---|
480 | . SET LINE=SA_X_SB
|
---|
481 | "RTN","TIUSRVD",155,0)
|
---|
482 | Q LINE
|
---|
483 | "RTN","TIUSRVD",156,0)
|
---|
484 | ;
|
---|
485 | "RTN","TIUSRVD",157,0)
|
---|
486 | MXTRACT(S,DIVCH,SA,SB,MAP) ;"//kst added this function
|
---|
487 | "RTN","TIUSRVD",158,0)
|
---|
488 | ;" Extract matched encapsulators
|
---|
489 | "RTN","TIUSRVD",159,0)
|
---|
490 | ;" NOTE: see TMGSTUTL for a more robust version of function.
|
---|
491 | "RTN","TIUSRVD",160,0)
|
---|
492 | IF '$DATA(MAP) DO MAPMATCH(S,.MAP)
|
---|
493 | "RTN","TIUSRVD",161,0)
|
---|
494 | NEW RESULT SET RESULT=""
|
---|
495 | "RTN","TIUSRVD",162,0)
|
---|
496 | NEW I SET I=0
|
---|
497 | "RTN","TIUSRVD",163,0)
|
---|
498 | FOR S I=$O(MAP(1,I)) QUIT:(I="")!(RESULT'="") DO
|
---|
499 | "RTN","TIUSRVD",164,0)
|
---|
500 | . IF DIVCH'=$G(MAP(1,I)) QUIT
|
---|
501 | "RTN","TIUSRVD",165,0)
|
---|
502 | . NEW P,J
|
---|
503 | "RTN","TIUSRVD",166,0)
|
---|
504 | . FOR J=1,2 SET P(J)=+$G(MAP(1,I,"P",J))
|
---|
505 | "RTN","TIUSRVD",167,0)
|
---|
506 | . SET RESULT=$EXTRACT(S,P(1)+1,P(2)-1)
|
---|
507 | "RTN","TIUSRVD",168,0)
|
---|
508 | . SET SA=$EXTRACT(S,1,P(1)-1),SB=$EXTRACT(S,P(2)+1,9999)
|
---|
509 | "RTN","TIUSRVD",169,0)
|
---|
510 | IF RESULT="" SET SA=S,SB=""
|
---|
511 | "RTN","TIUSRVD",170,0)
|
---|
512 | QUIT RESULT
|
---|
513 | "RTN","TIUSRVD",171,0)
|
---|
514 | ;
|
---|
515 | "RTN","TIUSRVD",172,0)
|
---|
516 | MAPMATCH(S,MAP) ;"//kst added this function
|
---|
517 | "RTN","TIUSRVD",173,0)
|
---|
518 | ;" Map out a string for matched encapsulators
|
---|
519 | "RTN","TIUSRVD",174,0)
|
---|
520 | ;" NOTE: see TMGSTUTL.m for a more robust version of function.
|
---|
521 | "RTN","TIUSRVD",175,0)
|
---|
522 | N MATCH,DEPTH,I,GRP,CH
|
---|
523 | "RTN","TIUSRVD",176,0)
|
---|
524 | S MATCH("{")="}",MATCH("|")="|"
|
---|
525 | "RTN","TIUSRVD",177,0)
|
---|
526 | K MAP
|
---|
527 | "RTN","TIUSRVD",178,0)
|
---|
528 | S DEPTH=0,GRP=1
|
---|
529 | "RTN","TIUSRVD",179,0)
|
---|
530 | F I=1:1:$L(S) D Q:(GRP>1) ;"Only deal with 1st entry
|
---|
531 | "RTN","TIUSRVD",180,0)
|
---|
532 | . S CH=$EXTRACT(S,I)
|
---|
533 | "RTN","TIUSRVD",181,0)
|
---|
534 | . I CH=$G(MAP(GRP,DEPTH,"End")) D QUIT
|
---|
535 | "RTN","TIUSRVD",182,0)
|
---|
536 | . . S MAP(GRP,DEPTH,"P",2)=I
|
---|
537 | "RTN","TIUSRVD",183,0)
|
---|
538 | . . K MAP(GRP,DEPTH,"End")
|
---|
539 | "RTN","TIUSRVD",184,0)
|
---|
540 | . . S DEPTH=DEPTH-1
|
---|
541 | "RTN","TIUSRVD",185,0)
|
---|
542 | . . I DEPTH=0 S GRP=GRP+1
|
---|
543 | "RTN","TIUSRVD",186,0)
|
---|
544 | . I $D(MATCH(CH))=0 QUIT
|
---|
545 | "RTN","TIUSRVD",187,0)
|
---|
546 | . S DEPTH=DEPTH+1
|
---|
547 | "RTN","TIUSRVD",188,0)
|
---|
548 | . S MAP(GRP,DEPTH)=CH
|
---|
549 | "RTN","TIUSRVD",189,0)
|
---|
550 | . S MAP(GRP,DEPTH,"End")=MATCH(CH)
|
---|
551 | "RTN","TIUSRVD",190,0)
|
---|
552 | . S MAP(GRP,DEPTH,"P",1)=I
|
---|
553 | "RTN","TIUSRVD",191,0)
|
---|
554 | QUIT
|
---|
555 | "RTN","TIUSRVD",192,0)
|
---|
556 | ;
|
---|
557 | "RTN","TIUSRVD",193,0)
|
---|
558 | CANXEC(TIUODA) ; Evaluate Object Status
|
---|
559 | "RTN","TIUSRVD",194,0)
|
---|
560 | N TIUOST,TIUY S TIUOST=+$P($G(^TIU(8925.1,+TIUODA,0)),U,7)
|
---|
561 | "RTN","TIUSRVD",195,0)
|
---|
562 | S TIUY=$S(TIUOST=11:1,+$G(NOSAVE):1,1:0)
|
---|
563 | "RTN","TIUSRVD",196,0)
|
---|
564 | Q +$G(TIUY)
|
---|
565 | "RTN","TIUSRVD",197,0)
|
---|
566 | APPEND(X) ;
|
---|
567 | "RTN","TIUSRVD",198,0)
|
---|
568 | N TIUXL S TIUXL=$L(X)
|
---|
569 | "RTN","TIUSRVD",199,0)
|
---|
570 | I $E(X,TIUXL-1,TIUXL)'="~@" S X=X_"~@"
|
---|
571 | "RTN","TIUSRVD",200,0)
|
---|
572 | Q X
|
---|
573 | "RTN","TIUSRVD",201,0)
|
---|
574 | REPLACE(LINE,X,TIUI) ; Replace the TIUIth object in LINE w/X
|
---|
575 | "RTN","TIUSRVD",202,0)
|
---|
576 | S $P(LINE,"|",TIUI)=X
|
---|
577 | "RTN","TIUSRVD",203,0)
|
---|
578 | Q LINE
|
---|
579 | "RTN","TIUSRVD",204,0)
|
---|
580 | INSMULT(LINE,TARGET,TIULCNT) ; Mult-valued results
|
---|
581 | "RTN","TIUSRVD",205,0)
|
---|
582 | N TIUPC,TIULGTH
|
---|
583 | "RTN","TIUSRVD",206,0)
|
---|
584 | ; TIU*1*164 ;
|
---|
585 | "RTN","TIUSRVD",207,0)
|
---|
586 | S TIULGTH=73 ; 2 replacements of 73 below for TIULGTH
|
---|
587 | "RTN","TIUSRVD",208,0)
|
---|
588 | S:$$BROKER^XWBLIB TIULGTH=80
|
---|
589 | "RTN","TIUSRVD",209,0)
|
---|
590 | F TIUPC=2:2:$L(LINE,"~@") D
|
---|
591 | "RTN","TIUSRVD",210,0)
|
---|
592 | . N TIUI,TIULINE,TIUX,TIUSRC,TIUSCNT,TIUTAIL
|
---|
593 | "RTN","TIUSRVD",211,0)
|
---|
594 | . S TIUSRC=$P(LINE,"~@",TIUPC)
|
---|
595 | "RTN","TIUSRVD",212,0)
|
---|
596 | . S TIUTAIL=$P(LINE,"~@",TIUPC+1)
|
---|
597 | "RTN","TIUSRVD",213,0)
|
---|
598 | . S TIULINE=$P(LINE,"~@",(TIUPC-1)),(TIUI,TIUSCNT)=0
|
---|
599 | "RTN","TIUSRVD",214,0)
|
---|
600 | . I $E(TIULINE)=" ",(TIUPC>2) S $E(TIULINE)=""
|
---|
601 | "RTN","TIUSRVD",215,0)
|
---|
602 | . F S TIUI=$O(@TIUSRC@(TIUI)) Q:+TIUI'>0 D
|
---|
603 | "RTN","TIUSRVD",216,0)
|
---|
604 | . . N TIUSLINE
|
---|
605 | "RTN","TIUSRVD",217,0)
|
---|
606 | . . S TIUSCNT=TIUSCNT+1
|
---|
607 | "RTN","TIUSRVD",218,0)
|
---|
608 | . . S TIUSLINE=$G(@TIUSRC@(TIUI,0))
|
---|
609 | "RTN","TIUSRVD",219,0)
|
---|
610 | . . S:'+$O(@TIUSRC@(TIUI))&(TIUPC+2>$L(LINE,"~@")) TIUSLINE=TIUSLINE_TIUTAIL
|
---|
611 | "RTN","TIUSRVD",220,0)
|
---|
612 | . . I TIUSCNT=1,($L(TIULINE_TIUSLINE)>TIULGTH) D Q
|
---|
613 | "RTN","TIUSRVD",221,0)
|
---|
614 | . . . S:$D(@TARGET@(TIULCNT,0)) TIULCNT=TIULCNT+1
|
---|
615 | "RTN","TIUSRVD",222,0)
|
---|
616 | . . . S @TARGET@(TIULCNT,0)=TIULINE
|
---|
617 | "RTN","TIUSRVD",223,0)
|
---|
618 | . . . S TIULCNT=TIULCNT+1
|
---|
619 | "RTN","TIUSRVD",224,0)
|
---|
620 | . . . S @TARGET@(TIULCNT,0)=TIUSLINE
|
---|
621 | "RTN","TIUSRVD",225,0)
|
---|
622 | . . I TIUSCNT=1,($L(TIULINE_TIUSLINE)'>TIULGTH) D Q
|
---|
623 | "RTN","TIUSRVD",226,0)
|
---|
624 | . . . S:$D(@TARGET@(TIULCNT,0)) TIULCNT=TIULCNT+1
|
---|
625 | "RTN","TIUSRVD",227,0)
|
---|
626 | . . . S @TARGET@(TIULCNT,0)=TIULINE_TIUSLINE
|
---|
627 | "RTN","TIUSRVD",228,0)
|
---|
628 | . . S:$D(@TARGET@(TIULCNT,0)) TIULCNT=TIULCNT+1
|
---|
629 | "RTN","TIUSRVD",229,0)
|
---|
630 | . . S @TARGET@(TIULCNT,0)=$G(TIUSLINE)
|
---|
631 | "RTN","TIUSRVD",230,0)
|
---|
632 | . K @TIUSRC
|
---|
633 | "RTN","TIUSRVD",231,0)
|
---|
634 | Q
|
---|
635 | "RTN","TIUSRVD",232,0)
|
---|
636 | LNGCNSLT(Y,FROM,DIR) ; Handle long list of titles for CONSULTS
|
---|
637 | "RTN","TIUSRVD",233,0)
|
---|
638 | N CLASS S CLASS=+$$CLASS^TIUCNSLT Q:+CLASS'>0
|
---|
639 | "RTN","TIUSRVD",234,0)
|
---|
640 | D LONGLIST(.Y,CLASS,$G(FROM),$G(DIR,1))
|
---|
641 | "RTN","TIUSRVD",235,0)
|
---|
642 | Q
|
---|
643 | "RTN","TIUSRVD",236,0)
|
---|
644 | LNGSURG(Y,FROM,DIR,CLNAME) ; long list SURGICAL REPORT titles
|
---|
645 | "RTN","TIUSRVD",237,0)
|
---|
646 | ; CLNAME = "SURGICAL REPORTS" or "PROCEDURE REPORTS (NON-O.R.)"
|
---|
647 | "RTN","TIUSRVD",238,0)
|
---|
648 | ; depending on context
|
---|
649 | "RTN","TIUSRVD",239,0)
|
---|
650 | N CLASS S CLNAME=$S($G(CLNAME)]"":CLNAME,1:"OPERATION REPORTS")
|
---|
651 | "RTN","TIUSRVD",240,0)
|
---|
652 | S CLASS=$$CLASS^TIUSROI(CLNAME) Q:+CLASS'>0
|
---|
653 | "RTN","TIUSRVD",241,0)
|
---|
654 | D LONGLIST(.Y,CLASS,$G(FROM),$G(DIR,1))
|
---|
655 | "RTN","TIUSRVD",242,0)
|
---|
656 | Q
|
---|
657 | "RTN","TIUSRVD",243,0)
|
---|
658 | LONGLIST(Y,CLASS,FROM,DIR,IDNOTE) ; long list of titles for a class
|
---|
659 | "RTN","TIUSRVD",244,0)
|
---|
660 | ; .Y=returned list, CLASS=ptr to class in 8925.1, FROM=text to $O from,
|
---|
661 | "RTN","TIUSRVD",245,0)
|
---|
662 | ; DIR=$O direction, IDNOTE=flag to indicate selection for ID Entry
|
---|
663 | "RTN","TIUSRVD",246,0)
|
---|
664 | N I,DA,CNT S I=0,CNT=44,DIR=$G(DIR,1)
|
---|
665 | "RTN","TIUSRVD",247,0)
|
---|
666 | F Q:I'<CNT S FROM=$O(^TIU(8925.1,"ACL",CLASS,FROM),DIR) Q:FROM="" D
|
---|
667 | "RTN","TIUSRVD",248,0)
|
---|
668 | . S DA=0
|
---|
669 | "RTN","TIUSRVD",249,0)
|
---|
670 | . F Q:I'<CNT S DA=$O(^TIU(8925.1,"ACL",CLASS,FROM,DA)) Q:+DA'>0 D
|
---|
671 | "RTN","TIUSRVD",250,0)
|
---|
672 | . . I $S(+$$CANENTR^TIULP(DA)'>0:1,+$$CANPICK^TIULP(DA)'>0:1,1:0) Q
|
---|
673 | "RTN","TIUSRVD",251,0)
|
---|
674 | . . I +$L($T(CANLINK^TIULP)),+$G(IDNOTE),(+$$CANLINK^TIULP(DA)'>0) Q
|
---|
675 | "RTN","TIUSRVD",252,0)
|
---|
676 | . . S I=I+1,Y(I)=DA_"^"_FROM
|
---|
677 | "RTN","TIUSRVD",253,0)
|
---|
678 | Q
|
---|
679 | "RTN","TIUSRVD",254,0)
|
---|
680 | CNSLCLAS(Y) ; RPC to identify class CONSULTS
|
---|
681 | "RTN","TIUSRVD",255,0)
|
---|
682 | S Y=$$CLASS^TIUCNSLT
|
---|
683 | "RTN","TIUSRVD",256,0)
|
---|
684 | Q
|
---|
685 | "RTN","TIUSRVD",257,0)
|
---|
686 | SURGCLAS(Y,CLNAME) ; RPC to identify class
|
---|
687 | "RTN","TIUSRVD",258,0)
|
---|
688 | ; CLNAME = "SURGICAL REPORTS" or "PROCEDURE REPORTS (NON-O.R.)"
|
---|
689 | "RTN","TIUSRVD",259,0)
|
---|
690 | S CLNAME=$G(CLNAME,"SURGICAL REPORTS")
|
---|
691 | "RTN","TIUSRVD",260,0)
|
---|
692 | S Y=$$CLASS^TIUSROI(CLNAME)
|
---|
693 | "RTN","TIUSRVD",261,0)
|
---|
694 | Q
|
---|
695 | "RTN","TIUSRVD",262,0)
|
---|
696 | CANLINK(Y,TIUTTL) ; Wrap call to $$CANLINK^TIULP
|
---|
697 | "RTN","TIUSRVD",263,0)
|
---|
698 | S Y=$$CANLINK^TIULP(TIUTTL)
|
---|
699 | "RTN","TIUSRVD",264,0)
|
---|
700 | Q
|
---|
701 | "VER")
|
---|
702 | 8.0^22.0
|
---|
703 | **END**
|
---|
704 | **END**
|
---|