1 | KIDS Distribution saved on Mar 02, 2017@12:25:03
|
---|
2 | Update to VWREGIT.m
|
---|
3 | **KIDS**:VWREG_PATCH*1.0T3*0^
|
---|
4 |
|
---|
5 | **INSTALL NAME**
|
---|
6 | VWREG_PATCH*1.0T3*0
|
---|
7 | "BLD",8568,0)
|
---|
8 | VWREG_PATCH*1.0T3*0^^^3170302^n
|
---|
9 | "BLD",8568,1,0)
|
---|
10 | ^^1^1^3170302^
|
---|
11 | "BLD",8568,1,1,0)
|
---|
12 | Update to VWREGIT.m to clear an <UNDEF> found during testing
|
---|
13 | "BLD",8568,4,0)
|
---|
14 | ^9.64PA^^
|
---|
15 | "BLD",8568,6.3)
|
---|
16 | 2
|
---|
17 | "BLD",8568,"KRN",0)
|
---|
18 | ^9.67PA^779.2^20
|
---|
19 | "BLD",8568,"KRN",.4,0)
|
---|
20 | .4
|
---|
21 | "BLD",8568,"KRN",.401,0)
|
---|
22 | .401
|
---|
23 | "BLD",8568,"KRN",.402,0)
|
---|
24 | .402
|
---|
25 | "BLD",8568,"KRN",.403,0)
|
---|
26 | .403
|
---|
27 | "BLD",8568,"KRN",.5,0)
|
---|
28 | .5
|
---|
29 | "BLD",8568,"KRN",.84,0)
|
---|
30 | .84
|
---|
31 | "BLD",8568,"KRN",3.6,0)
|
---|
32 | 3.6
|
---|
33 | "BLD",8568,"KRN",3.8,0)
|
---|
34 | 3.8
|
---|
35 | "BLD",8568,"KRN",9.2,0)
|
---|
36 | 9.2
|
---|
37 | "BLD",8568,"KRN",9.8,0)
|
---|
38 | 9.8
|
---|
39 | "BLD",8568,"KRN",9.8,"NM",0)
|
---|
40 | ^9.68A^1^1
|
---|
41 | "BLD",8568,"KRN",9.8,"NM",1,0)
|
---|
42 | VWREGIT^^0^B34639192
|
---|
43 | "BLD",8568,"KRN",9.8,"NM","B","VWREGIT",1)
|
---|
44 |
|
---|
45 | "BLD",8568,"KRN",19,0)
|
---|
46 | 19
|
---|
47 | "BLD",8568,"KRN",19.1,0)
|
---|
48 | 19.1
|
---|
49 | "BLD",8568,"KRN",101,0)
|
---|
50 | 101
|
---|
51 | "BLD",8568,"KRN",409.61,0)
|
---|
52 | 409.61
|
---|
53 | "BLD",8568,"KRN",771,0)
|
---|
54 | 771
|
---|
55 | "BLD",8568,"KRN",779.2,0)
|
---|
56 | 779.2
|
---|
57 | "BLD",8568,"KRN",870,0)
|
---|
58 | 870
|
---|
59 | "BLD",8568,"KRN",8989.51,0)
|
---|
60 | 8989.51
|
---|
61 | "BLD",8568,"KRN",8989.52,0)
|
---|
62 | 8989.52
|
---|
63 | "BLD",8568,"KRN",8994,0)
|
---|
64 | 8994
|
---|
65 | "BLD",8568,"KRN","B",.4,.4)
|
---|
66 |
|
---|
67 | "BLD",8568,"KRN","B",.401,.401)
|
---|
68 |
|
---|
69 | "BLD",8568,"KRN","B",.402,.402)
|
---|
70 |
|
---|
71 | "BLD",8568,"KRN","B",.403,.403)
|
---|
72 |
|
---|
73 | "BLD",8568,"KRN","B",.5,.5)
|
---|
74 |
|
---|
75 | "BLD",8568,"KRN","B",.84,.84)
|
---|
76 |
|
---|
77 | "BLD",8568,"KRN","B",3.6,3.6)
|
---|
78 |
|
---|
79 | "BLD",8568,"KRN","B",3.8,3.8)
|
---|
80 |
|
---|
81 | "BLD",8568,"KRN","B",9.2,9.2)
|
---|
82 |
|
---|
83 | "BLD",8568,"KRN","B",9.8,9.8)
|
---|
84 |
|
---|
85 | "BLD",8568,"KRN","B",19,19)
|
---|
86 |
|
---|
87 | "BLD",8568,"KRN","B",19.1,19.1)
|
---|
88 |
|
---|
89 | "BLD",8568,"KRN","B",101,101)
|
---|
90 |
|
---|
91 | "BLD",8568,"KRN","B",409.61,409.61)
|
---|
92 |
|
---|
93 | "BLD",8568,"KRN","B",771,771)
|
---|
94 |
|
---|
95 | "BLD",8568,"KRN","B",779.2,779.2)
|
---|
96 |
|
---|
97 | "BLD",8568,"KRN","B",870,870)
|
---|
98 |
|
---|
99 | "BLD",8568,"KRN","B",8989.51,8989.51)
|
---|
100 |
|
---|
101 | "BLD",8568,"KRN","B",8989.52,8989.52)
|
---|
102 |
|
---|
103 | "BLD",8568,"KRN","B",8994,8994)
|
---|
104 |
|
---|
105 | "BLD",8568,"QDEF")
|
---|
106 | ^^^^NO^^^^NO^^NO
|
---|
107 | "BLD",8568,"QUES",0)
|
---|
108 | ^9.62^^
|
---|
109 | "BLD",8568,"REQB",0)
|
---|
110 | ^9.611^^
|
---|
111 | "MBREQ")
|
---|
112 | 0
|
---|
113 | "QUES","XPF1",0)
|
---|
114 | Y
|
---|
115 | "QUES","XPF1","??")
|
---|
116 | ^D REP^XPDH
|
---|
117 | "QUES","XPF1","A")
|
---|
118 | Shall I write over your |FLAG| File
|
---|
119 | "QUES","XPF1","B")
|
---|
120 | YES
|
---|
121 | "QUES","XPF1","M")
|
---|
122 | D XPF1^XPDIQ
|
---|
123 | "QUES","XPF2",0)
|
---|
124 | Y
|
---|
125 | "QUES","XPF2","??")
|
---|
126 | ^D DTA^XPDH
|
---|
127 | "QUES","XPF2","A")
|
---|
128 | Want my data |FLAG| yours
|
---|
129 | "QUES","XPF2","B")
|
---|
130 | YES
|
---|
131 | "QUES","XPF2","M")
|
---|
132 | D XPF2^XPDIQ
|
---|
133 | "QUES","XPI1",0)
|
---|
134 | YO
|
---|
135 | "QUES","XPI1","??")
|
---|
136 | ^D INHIBIT^XPDH
|
---|
137 | "QUES","XPI1","A")
|
---|
138 | Want KIDS to INHIBIT LOGONs during the install
|
---|
139 | "QUES","XPI1","B")
|
---|
140 | NO
|
---|
141 | "QUES","XPI1","M")
|
---|
142 | D XPI1^XPDIQ
|
---|
143 | "QUES","XPM1",0)
|
---|
144 | PO^VA(200,:EM
|
---|
145 | "QUES","XPM1","??")
|
---|
146 | ^D MG^XPDH
|
---|
147 | "QUES","XPM1","A")
|
---|
148 | Enter the Coordinator for Mail Group '|FLAG|'
|
---|
149 | "QUES","XPM1","B")
|
---|
150 |
|
---|
151 | "QUES","XPM1","M")
|
---|
152 | D XPM1^XPDIQ
|
---|
153 | "QUES","XPO1",0)
|
---|
154 | Y
|
---|
155 | "QUES","XPO1","??")
|
---|
156 | ^D MENU^XPDH
|
---|
157 | "QUES","XPO1","A")
|
---|
158 | Want KIDS to Rebuild Menu Trees Upon Completion of Install
|
---|
159 | "QUES","XPO1","B")
|
---|
160 | NO
|
---|
161 | "QUES","XPO1","M")
|
---|
162 | D XPO1^XPDIQ
|
---|
163 | "QUES","XPZ1",0)
|
---|
164 | Y
|
---|
165 | "QUES","XPZ1","??")
|
---|
166 | ^D OPT^XPDH
|
---|
167 | "QUES","XPZ1","A")
|
---|
168 | Want to DISABLE Scheduled Options, Menu Options, and Protocols
|
---|
169 | "QUES","XPZ1","B")
|
---|
170 | NO
|
---|
171 | "QUES","XPZ1","M")
|
---|
172 | D XPZ1^XPDIQ
|
---|
173 | "QUES","XPZ2",0)
|
---|
174 | Y
|
---|
175 | "QUES","XPZ2","??")
|
---|
176 | ^D RTN^XPDH
|
---|
177 | "QUES","XPZ2","A")
|
---|
178 | Want to MOVE routines to other CPUs
|
---|
179 | "QUES","XPZ2","B")
|
---|
180 | NO
|
---|
181 | "QUES","XPZ2","M")
|
---|
182 | D XPZ2^XPDIQ
|
---|
183 | "RTN")
|
---|
184 | 1
|
---|
185 | "RTN","VWREGIT")
|
---|
186 | 0^1^B34639192
|
---|
187 | "RTN","VWREGIT",1,0)
|
---|
188 | VWREGIT ;Portland,OR/Jim Bell, et al Patient Registration Utility August 2015
|
---|
189 | "RTN","VWREGIT",2,0)
|
---|
190 | ;;2.0;B/FProductions,LLC,WORLD VISTA;**LOCAL**;;Build 2
|
---|
191 | "RTN","VWREGIT",3,0)
|
---|
192 | ;*******************************************************************
|
---|
193 | "RTN","VWREGIT",4,0)
|
---|
194 | ;* VW Registration is designed for patient specific fields as *
|
---|
195 | "RTN","VWREGIT",5,0)
|
---|
196 | ;* defined in Fileman Input Templates or ad hoc field selection. *
|
---|
197 | "RTN","VWREGIT",6,0)
|
---|
198 | ;* Copyright Martius/MMXV ad infinitum (GNU License: See GPLv3.txt)*
|
---|
199 | "RTN","VWREGIT",7,0)
|
---|
200 | ;*******************************************************************
|
---|
201 | "RTN","VWREGIT",8,0)
|
---|
202 | ;;NO FALL THROUGH - JEB
|
---|
203 | "RTN","VWREGIT",9,0)
|
---|
204 | Q
|
---|
205 | "RTN","VWREGIT",10,0)
|
---|
206 | ;
|
---|
207 | "RTN","VWREGIT",11,0)
|
---|
208 | TFM(XF) ;TemplateField Management
|
---|
209 | "RTN","VWREGIT",12,0)
|
---|
210 | ;***********************************************
|
---|
211 | "RTN","VWREGIT",13,0)
|
---|
212 | ;* Check primary field entries for "parentage" *
|
---|
213 | "RTN","VWREGIT",14,0)
|
---|
214 | ;* Add an "*" to gain all sub-fields of the *
|
---|
215 | "RTN","VWREGIT",15,0)
|
---|
216 | ;* parent *
|
---|
217 | "RTN","VWREGIT",16,0)
|
---|
218 | ;* REMEMBER: All fields pertain to file 2 only *
|
---|
219 | "RTN","VWREGIT",17,0)
|
---|
220 | ;***********************************************
|
---|
221 | "RTN","VWREGIT",18,0)
|
---|
222 | N I,N,FIELD
|
---|
223 | "RTN","VWREGIT",19,0)
|
---|
224 | K FARRAY
|
---|
225 | "RTN","VWREGIT",20,0)
|
---|
226 | I '$L(XF),'$G(TNUM) Q ""
|
---|
227 | "RTN","VWREGIT",21,0)
|
---|
228 | I '$L(XF),+$G(TNUM) S XF=^DIE(TNUM,"DR",1,2)
|
---|
229 | "RTN","VWREGIT",22,0)
|
---|
230 | F I=1:1:$L(XF,";") S:$L($P(XF,";",I)) FARRAY(I)=+$P(XF,";",I)
|
---|
231 | "RTN","VWREGIT",23,0)
|
---|
232 | S N=0 F I=1:1 S N=$O(FARRAY(N)) Q:'+N D
|
---|
233 | "RTN","VWREGIT",24,0)
|
---|
234 | . S FIELD=FARRAY(N)
|
---|
235 | "RTN","VWREGIT",25,0)
|
---|
236 | . I +$P(^DD(2,FIELD,0),"^",2) S FIELD=FIELD_"*",FMARRAY(FIELD)=$P(^(0),"^",4) K FARRAY(N)
|
---|
237 | "RTN","VWREGIT",26,0)
|
---|
238 | S XF="",N=0 F S N=$O(FARRAY(N)) Q:'+N S XF=XF_FARRAY(N)_";"
|
---|
239 | "RTN","VWREGIT",27,0)
|
---|
240 | Q XF
|
---|
241 | "RTN","VWREGIT",28,0)
|
---|
242 | ;
|
---|
243 | "RTN","VWREGIT",29,0)
|
---|
244 | CHECK() ;
|
---|
245 | "RTN","VWREGIT",30,0)
|
---|
246 | Q ""
|
---|
247 | "RTN","VWREGIT",31,0)
|
---|
248 | ;
|
---|
249 | "RTN","VWREGIT",32,0)
|
---|
250 | INR() Q $O(RESULT(" "),-1)+1
|
---|
251 | "RTN","VWREGIT",33,0)
|
---|
252 | ;
|
---|
253 | "RTN","VWREGIT",34,0)
|
---|
254 | EN(RESULT) ;Template name and ID labels
|
---|
255 | "RTN","VWREGIT",35,0)
|
---|
256 | ;Get the input template list
|
---|
257 | "RTN","VWREGIT",36,0)
|
---|
258 | ;housekeeping
|
---|
259 | "RTN","VWREGIT",37,0)
|
---|
260 | S DTIME=99999
|
---|
261 | "RTN","VWREGIT",38,0)
|
---|
262 | ZSY "chmod 777 "_$ZD_"regparam/*.txt"
|
---|
263 | "RTN","VWREGIT",39,0)
|
---|
264 | ;end housekeeping
|
---|
265 | "RTN","VWREGIT",40,0)
|
---|
266 | ;
|
---|
267 | "RTN","VWREGIT",41,0)
|
---|
268 | K AR,RESULT
|
---|
269 | "RTN","VWREGIT",42,0)
|
---|
270 | N N,HD,FILE,LOC,P4,P5,%ZISHF,%ZISHO,DEFST,XTMP,X
|
---|
271 | "RTN","VWREGIT",43,0)
|
---|
272 | S RESULT(0)=1
|
---|
273 | "RTN","VWREGIT",44,0)
|
---|
274 | S DEFST="";
|
---|
275 | "RTN","VWREGIT",45,0)
|
---|
276 | ;S DEFTMP=$O(^DIE("B","FAU_EDU",0)) ;For Florida College only
|
---|
277 | "RTN","VWREGIT",46,0)
|
---|
278 | S RESULT(0)=$$CONTROL^VWREGITU()
|
---|
279 | "RTN","VWREGIT",47,0)
|
---|
280 | S RESULT(1)="-1^No templates found"
|
---|
281 | "RTN","VWREGIT",48,0)
|
---|
282 | S DEFST=$$GET^XPAR("ALL","VW REG DEFAULT STATE")
|
---|
283 | "RTN","VWREGIT",49,0)
|
---|
284 | S DEFTMP=$$GET^XPAR("ALL","VW REG RDNPT")
|
---|
285 | "RTN","VWREGIT",50,0)
|
---|
286 | S HD=$$GET^XPAR("ALL","VW GUI REG TEMPLATE DIRECTORY")
|
---|
287 | "RTN","VWREGIT",51,0)
|
---|
288 | I '$L(HD) K RESULT D Q
|
---|
289 | "RTN","VWREGIT",52,0)
|
---|
290 | . S RESULT($$INR)="-1^NO HOME DIRECTORY - refer to IT support, if necessary."
|
---|
291 | "RTN","VWREGIT",53,0)
|
---|
292 | . S RESULT($$INR)="No home directory has been supplied which indicates"
|
---|
293 | "RTN","VWREGIT",54,0)
|
---|
294 | . S RESULT($$INR)="the VWREG installation is incomplete. See the Help manual"
|
---|
295 | "RTN","VWREGIT",55,0)
|
---|
296 | . S RESULT($$INR)="for installation and Enter/Editing parameter values."
|
---|
297 | "RTN","VWREGIT",56,0)
|
---|
298 | . S RESULT($$INR)="Thank you,"
|
---|
299 | "RTN","VWREGIT",57,0)
|
---|
300 | . S RESULT($$INR)=" The Management."
|
---|
301 | "RTN","VWREGIT",58,0)
|
---|
302 | S FILE="regit.txt"
|
---|
303 | "RTN","VWREGIT",59,0)
|
---|
304 | S P4=1
|
---|
305 | "RTN","VWREGIT",60,0)
|
---|
306 | S P5=""
|
---|
307 | "RTN","VWREGIT",61,0)
|
---|
308 | S X=$$FTG^%ZISH(HD,FILE,$NA(AR(1)),P4,P5)
|
---|
309 | "RTN","VWREGIT",62,0)
|
---|
310 | D:+RESULT(0)
|
---|
311 | "RTN","VWREGIT",63,0)
|
---|
312 | . S $P(RESULT(0),"^",2)=$G(HD)
|
---|
313 | "RTN","VWREGIT",64,0)
|
---|
314 | . S $P(RESULT(0),"^",3)=$S(DEFST:$P(^DIC(5,DEFST,0),"^")_"("_DEFST_")",1:"")
|
---|
315 | "RTN","VWREGIT",65,0)
|
---|
316 | . S $P(RESULT(0),"^",4)=$S(+DEFTMP:$P(^DIE(DEFTMP,0),"^")_"("_DEFTMP_")",1:DEFTMP)
|
---|
317 | "RTN","VWREGIT",66,0)
|
---|
318 | . S $P(RESULT(0),"^",5)=DUZ
|
---|
319 | "RTN","VWREGIT",67,0)
|
---|
320 | I $O(AR(0)) S RESULT(1)="[TEMPLATES]"
|
---|
321 | "RTN","VWREGIT",68,0)
|
---|
322 | S N=0 F S N=$O(AR(N)) Q:'+N D
|
---|
323 | "RTN","VWREGIT",69,0)
|
---|
324 | . Q:$E(AR(N))="*"
|
---|
325 | "RTN","VWREGIT",70,0)
|
---|
326 | . Q:'+$P(AR(N),"(",2)
|
---|
327 | "RTN","VWREGIT",71,0)
|
---|
328 | . Q:$P($G(^DIE(+$P(AR(N),"(",2),0)),"^",4)'=2 ;must be pat file
|
---|
329 | "RTN","VWREGIT",72,0)
|
---|
330 | . S RESULT($$INR)=AR(N)
|
---|
331 | "RTN","VWREGIT",73,0)
|
---|
332 | S RESULT($$INR)="[ID]"
|
---|
333 | "RTN","VWREGIT",74,0)
|
---|
334 | ;S N=0 F S N=$O(^DIZ(64850003,N)) Q:'+N S RESULT($$INR)=$P(^(N,0),"^",2)_"("_$P(^(0),"^")_")"
|
---|
335 | "RTN","VWREGIT",75,0)
|
---|
336 | ;S N=0 F S N=$O(RESULT(N)) Q:'+N K:RESULT(N)="" RESULT(N)
|
---|
337 | "RTN","VWREGIT",76,0)
|
---|
338 | I '$O(RESULT(0)) S RESULT(1)="-1^No PATIENT FILE templates found"
|
---|
339 | "RTN","VWREGIT",77,0)
|
---|
340 | K AR
|
---|
341 | "RTN","VWREGIT",78,0)
|
---|
342 | Q
|
---|
343 | "RTN","VWREGIT",79,0)
|
---|
344 | ;
|
---|
345 | "RTN","VWREGIT",80,0)
|
---|
346 | NPT(RESULT,TNAME) ;
|
---|
347 | "RTN","VWREGIT",81,0)
|
---|
348 | ; *************************************************
|
---|
349 | "RTN","VWREGIT",82,0)
|
---|
350 | ; * Incoming: DFN^TEMPLATE NAME(IEN) *
|
---|
351 | "RTN","VWREGIT",83,0)
|
---|
352 | ; * Process : Get template fields plus any help *
|
---|
353 | "RTN","VWREGIT",84,0)
|
---|
354 | ; * If +TNAME (a DFN), get DFN data for *
|
---|
355 | "RTN","VWREGIT",85,0)
|
---|
356 | ; * the template fields (Put data in *
|
---|
357 | "RTN","VWREGIT",86,0)
|
---|
358 | ; * $P(RESULT(N),"^",3)) *
|
---|
359 | "RTN","VWREGIT",87,0)
|
---|
360 | ; * Return : RESULT(N), etc *
|
---|
361 | "RTN","VWREGIT",88,0)
|
---|
362 | ; *************************************************
|
---|
363 | "RTN","VWREGIT",89,0)
|
---|
364 | ;W " ;Intentional bust for debugging
|
---|
365 | "RTN","VWREGIT",90,0)
|
---|
366 | N N,TNUM,FIELDS,F,FNAME,FVALUE,FHELP,FPSC,FNUM
|
---|
367 | "RTN","VWREGIT",91,0)
|
---|
368 | S TNUM=+$P(TNAME,"(",2),DFN=+TNAME
|
---|
369 | "RTN","VWREGIT",92,0)
|
---|
370 | I 'TNUM S RESULT(0)="0^new patient Template not found" Q
|
---|
371 | "RTN","VWREGIT",93,0)
|
---|
372 | S TNAME=$P($P(TNAME,"^",2),"(")
|
---|
373 | "RTN","VWREGIT",94,0)
|
---|
374 | S TNAME=$TR(TNAME,"$&*","") ;Clean out TMENU chars
|
---|
375 | "RTN","VWREGIT",95,0)
|
---|
376 | I TNAME="GENERIC INS. FRM [WorldVistA]" G GIF
|
---|
377 | "RTN","VWREGIT",96,0)
|
---|
378 | S FIELDS=$G(^DIE(TNUM,"DR",1,2))
|
---|
379 | "RTN","VWREGIT",97,0)
|
---|
380 | I '$L(FIELDS) Q
|
---|
381 | "RTN","VWREGIT",98,0)
|
---|
382 | K RESULT S (FNUM,FCAP)=""
|
---|
383 | "RTN","VWREGIT",99,0)
|
---|
384 | F I=1:1:$L(FIELDS,";")-1 D
|
---|
385 | "RTN","VWREGIT",100,0)
|
---|
386 | . S F=$P(FIELDS,";",I)
|
---|
387 | "RTN","VWREGIT",101,0)
|
---|
388 | . Q:'$D(^DD(2,F)) ;Not existing in this patient file
|
---|
389 | "RTN","VWREGIT",102,0)
|
---|
390 | . I F["~" S FNUM=+F,FNAME=$P($P(F,"~"),FNUM,2),F=FNUM K FNUM
|
---|
391 | "RTN","VWREGIT",103,0)
|
---|
392 | . S FNAME=$S($L($G(FNAME)):FNAME,$L($G(^DD(2,F,.1))):$P(^(.1),"^"),1:$P(^DD(2,F,0),"^"))
|
---|
393 | "RTN","VWREGIT",104,0)
|
---|
394 | . S FVALUE="" ;Patient Data
|
---|
395 | "RTN","VWREGIT",105,0)
|
---|
396 | . S FHELP=$G(^DD(2,F,3))
|
---|
397 | "RTN","VWREGIT",106,0)
|
---|
398 | . I F'=27.02,'$L(FHELP) S N=0 F S N=$O(^DD(2,F,21,N)) Q:'+N S FHELP=FHELP_^(N,0)
|
---|
399 | "RTN","VWREGIT",107,0)
|
---|
400 | . S FHELP=$TR(FHELP,"'","`")
|
---|
401 | "RTN","VWREGIT",108,0)
|
---|
402 | . S FPSC=$P(^DD(2,F,0),"^",3)
|
---|
403 | "RTN","VWREGIT",109,0)
|
---|
404 | . S SUBDIC=+$P(^DD(2,F,0),"^",2)
|
---|
405 | "RTN","VWREGIT",110,0)
|
---|
406 | . S RESULT($$INR)=FNAME_"^"_F_"^"_FVALUE_"^"_FHELP_"^"_FPSC_$S(SUBDIC:"^1",1:"^0")
|
---|
407 | "RTN","VWREGIT",111,0)
|
---|
408 | . S (FNAME,FVALUE,FHELP,FPSC)=""
|
---|
409 | "RTN","VWREGIT",112,0)
|
---|
410 | G NPTX:'DFN
|
---|
411 | "RTN","VWREGIT",113,0)
|
---|
412 | I DFN D GETS^DIQ(2,DFN_",","**","EN","AR") ;,RESULT(0)=$$DFNID^VWREGITU
|
---|
413 | "RTN","VWREGIT",114,0)
|
---|
414 | K FIELD S N=0 F S N=$O(RESULT(N)) Q:'+N S FIELD($P(RESULT(N),"^",2))=""
|
---|
415 | "RTN","VWREGIT",115,0)
|
---|
416 | S X="AR" F S X=$Q(@X) Q:X="" D
|
---|
417 | "RTN","VWREGIT",116,0)
|
---|
418 | . S FILE=+$P(X,"(",2)
|
---|
419 | "RTN","VWREGIT",117,0)
|
---|
420 | . S FIELD=+$P(X,",",$L(X,",")-1)
|
---|
421 | "RTN","VWREGIT",118,0)
|
---|
422 | . I $D(FIELD(FIELD)) S FIELD(FIELD)=@X
|
---|
423 | "RTN","VWREGIT",119,0)
|
---|
424 | S N=0 F S N=$O(FIELD(N)) Q:'+N D
|
---|
425 | "RTN","VWREGIT",120,0)
|
---|
426 | . S N2=0 F S N2=$O(RESULT(N2)) Q:'+N2 I $P(RESULT(N2),"^",2)=N S $P(RESULT(N2),"^",3)=FIELD(N)
|
---|
427 | "RTN","VWREGIT",121,0)
|
---|
428 | . S RESULT(0)=$$DFNID^VWREGITU()
|
---|
429 | "RTN","VWREGIT",122,0)
|
---|
430 | NPTX K FIELD,AR,FCAP,FILE,SUBDIC,N,N2,DFN
|
---|
431 | "RTN","VWREGIT",123,0)
|
---|
432 | Q
|
---|
433 | "RTN","VWREGIT",124,0)
|
---|
434 | ;
|
---|
435 | "RTN","VWREGIT",125,0)
|
---|
436 | PF(RESULT,XPF) ;Pointer file - get the stuff
|
---|
437 | "RTN","VWREGIT",126,0)
|
---|
438 | K RESULT,AR
|
---|
439 | "RTN","VWREGIT",127,0)
|
---|
440 | N X,N
|
---|
441 | "RTN","VWREGIT",128,0)
|
---|
442 | I '$L(XPF) S RESULT(0)="???" Q
|
---|
443 | "RTN","VWREGIT",129,0)
|
---|
444 | S XPF="^"_XPF
|
---|
445 | "RTN","VWREGIT",130,0)
|
---|
446 | I +$P(XPF,"(",2)=.85 G NAUTPF ;Naughty file!
|
---|
447 | "RTN","VWREGIT",131,0)
|
---|
448 | S N=0 F S N=$O(@(XPF_N_")")) Q:'+N S X=$P(^(N,0),"^"),AR(X,N)=X_"("_N_")"
|
---|
449 | "RTN","VWREGIT",132,0)
|
---|
450 | S X="AR" F S X=$Q(@X) Q:X="" S RESULT($$INR)=@X
|
---|
451 | "RTN","VWREGIT",133,0)
|
---|
452 | K AR
|
---|
453 | "RTN","VWREGIT",134,0)
|
---|
454 | Q
|
---|
455 | "RTN","VWREGIT",135,0)
|
---|
456 | ;
|
---|
457 | "RTN","VWREGIT",136,0)
|
---|
458 | NAUTPF ;The "NAUGHTY" pointer file - has a numeric .01 - Bad file !!!
|
---|
459 | "RTN","VWREGIT",137,0)
|
---|
460 | S N=0 F S N=$O(@(XPF_N_")")) Q:'+N S X=$P(^(N,0),"^") D
|
---|
461 | "RTN","VWREGIT",138,0)
|
---|
462 | . S LANG=$P(^(0),"^",2)
|
---|
463 | "RTN","VWREGIT",139,0)
|
---|
464 | . S AR(LANG,N)=LANG_"("_N_")"
|
---|
465 | "RTN","VWREGIT",140,0)
|
---|
466 | S X="AR" F S X=$Q(@X) Q:X="" S RESULT($$INR)=@X
|
---|
467 | "RTN","VWREGIT",141,0)
|
---|
468 | Q
|
---|
469 | "RTN","VWREGIT",142,0)
|
---|
470 | GIF ;Generic Insurance form
|
---|
471 | "RTN","VWREGIT",143,0)
|
---|
472 | K RESULT
|
---|
473 | "RTN","VWREGIT",144,0)
|
---|
474 | S RESULT($$INR)="Insurance Company^2.312;.01^^^DIC(36,^0"
|
---|
475 | "RTN","VWREGIT",145,0)
|
---|
476 | S RESULT($$INR)="Group Plan^2.312;.18^^^IBA(355.3,^0"
|
---|
477 | "RTN","VWREGIT",146,0)
|
---|
478 | S RESULT($$INR)="Policy No.^2.312;1^^^^0"
|
---|
479 | "RTN","VWREGIT",147,0)
|
---|
480 | ;S RESULT($$INR)="Type of Plan^^^^^0"
|
---|
481 | "RTN","VWREGIT",148,0)
|
---|
482 | S RESULT($$INR)="Coverage^355.33;40.09^^^IBE(355.1,^0"
|
---|
483 | "RTN","VWREGIT",149,0)
|
---|
484 | S RESULT($$INR)="Effective Date^2.312;8^^^^0"
|
---|
485 | "RTN","VWREGIT",150,0)
|
---|
486 | S RESULT($$INR)="Expiration Date^.3121;^^^^0"
|
---|
487 | "RTN","VWREGIT",151,0)
|
---|
488 | S RESULT($$INR)="Guarantor^^^^^0"
|
---|
489 | "RTN","VWREGIT",152,0)
|
---|
490 | S RESULT($$INR)="Signature on File^^^^0:NO;1:YES^0"
|
---|
491 | "RTN","VWREGIT",153,0)
|
---|
492 | S RESULT($$INR)="Employer^2.312;2.015^^^^0"
|
---|
493 | "RTN","VWREGIT",154,0)
|
---|
494 | S RESULT($$INR)="Billing Address^2.312;2.02^^^^0"
|
---|
495 | "RTN","VWREGIT",155,0)
|
---|
496 | S RESULT($$INR)="Billing Address(cont)^2.312;2.03^^^^0"
|
---|
497 | "RTN","VWREGIT",156,0)
|
---|
498 | S RESULT($$INR)="Postal Code^2.312;2.07^^^^0"
|
---|
499 | "RTN","VWREGIT",157,0)
|
---|
500 | S RESULT($$INR)="City^2.312;2.05^^^^0"
|
---|
501 | "RTN","VWREGIT",158,0)
|
---|
502 | S RESULT($$INR)="County/Region/Area^^^^^0"
|
---|
503 | "RTN","VWREGIT",159,0)
|
---|
504 | S RESULT($$INR)="State/Province/Region^2.312;2.06^^^DIC(5,^0"
|
---|
505 | "RTN","VWREGIT",160,0)
|
---|
506 | Q
|
---|
507 | "RTN","VWREGIT",161,0)
|
---|
508 | ;
|
---|
509 | "RTN","VWREGIT",162,0)
|
---|
510 |
|
---|
511 | "VER")
|
---|
512 | 8.0^22.2
|
---|
513 | **END**
|
---|
514 | **END**
|
---|