1 | KIDS Distribution saved on Mar 08, 2017@13:41:25
|
---|
2 | Patch 3 to WorldVistA GUI Registration 03/08/2017
|
---|
3 | **KIDS**:VWREG_03082017*2.04T3*2^
|
---|
4 |
|
---|
5 | **INSTALL NAME**
|
---|
6 | VWREG_03082017*2.04T3*2
|
---|
7 | "BLD",8570,0)
|
---|
8 | VWREG_03082017*2.04T3*2^^0^3170308^n
|
---|
9 | "BLD",8570,1,0)
|
---|
10 | ^^6^6^3170308^^^^
|
---|
11 | "BLD",8570,1,1,0)
|
---|
12 | 3 Repairs found in Alpha Testing:
|
---|
13 | "BLD",8570,1,2,0)
|
---|
14 | Removing a testing stub that prevented filing of patient data
|
---|
15 | "BLD",8570,1,3,0)
|
---|
16 | in VWREGITS
|
---|
17 | "BLD",8570,1,4,0)
|
---|
18 | Adding a field 540001.1 HEALTH RECORD NUMBER to the PATIENT
|
---|
19 | "BLD",8570,1,5,0)
|
---|
20 | file (#2)
|
---|
21 | "BLD",8570,1,6,0)
|
---|
22 | Removed field 540001.1 from VW PT REGISTRATION template
|
---|
23 | "BLD",8570,4,0)
|
---|
24 | ^9.64PA^2^1
|
---|
25 | "BLD",8570,4,2,0)
|
---|
26 | 2
|
---|
27 | "BLD",8570,4,2,2,0)
|
---|
28 | ^9.641^2^1
|
---|
29 | "BLD",8570,4,2,2,2,0)
|
---|
30 | PATIENT (File-top level)
|
---|
31 | "BLD",8570,4,2,2,2,1,0)
|
---|
32 | ^9.6411^540001.1^1
|
---|
33 | "BLD",8570,4,2,2,2,1,540001.1,0)
|
---|
34 | HEALTH RECORD NUMBER
|
---|
35 | "BLD",8570,4,2,222)
|
---|
36 | y^n^p^^^^n^^n
|
---|
37 | "BLD",8570,4,2,224)
|
---|
38 |
|
---|
39 | "BLD",8570,4,"APDD",2,2)
|
---|
40 |
|
---|
41 | "BLD",8570,4,"APDD",2,2,540001.1)
|
---|
42 |
|
---|
43 | "BLD",8570,4,"B",2,2)
|
---|
44 |
|
---|
45 | "BLD",8570,6.3)
|
---|
46 | 2
|
---|
47 | "BLD",8570,"KRN",0)
|
---|
48 | ^9.67PA^779.2^20
|
---|
49 | "BLD",8570,"KRN",.4,0)
|
---|
50 | .4
|
---|
51 | "BLD",8570,"KRN",.401,0)
|
---|
52 | .401
|
---|
53 | "BLD",8570,"KRN",.402,0)
|
---|
54 | .402
|
---|
55 | "BLD",8570,"KRN",.402,"NM",0)
|
---|
56 | ^9.68A^1^1
|
---|
57 | "BLD",8570,"KRN",.402,"NM",1,0)
|
---|
58 | VW PT REGISTRATION FILE #2^2^0
|
---|
59 | "BLD",8570,"KRN",.402,"NM","B","VW PT REGISTRATION FILE #2",1)
|
---|
60 |
|
---|
61 | "BLD",8570,"KRN",.403,0)
|
---|
62 | .403
|
---|
63 | "BLD",8570,"KRN",.5,0)
|
---|
64 | .5
|
---|
65 | "BLD",8570,"KRN",.84,0)
|
---|
66 | .84
|
---|
67 | "BLD",8570,"KRN",3.6,0)
|
---|
68 | 3.6
|
---|
69 | "BLD",8570,"KRN",3.8,0)
|
---|
70 | 3.8
|
---|
71 | "BLD",8570,"KRN",9.2,0)
|
---|
72 | 9.2
|
---|
73 | "BLD",8570,"KRN",9.8,0)
|
---|
74 | 9.8
|
---|
75 | "BLD",8570,"KRN",9.8,"NM",0)
|
---|
76 | ^9.68A^2^2
|
---|
77 | "BLD",8570,"KRN",9.8,"NM",1,0)
|
---|
78 | VWREGIT^^0^B34467909
|
---|
79 | "BLD",8570,"KRN",9.8,"NM",2,0)
|
---|
80 | VWREGITS^^0^B15352111
|
---|
81 | "BLD",8570,"KRN",9.8,"NM","B","VWREGIT",1)
|
---|
82 |
|
---|
83 | "BLD",8570,"KRN",9.8,"NM","B","VWREGITS",2)
|
---|
84 |
|
---|
85 | "BLD",8570,"KRN",19,0)
|
---|
86 | 19
|
---|
87 | "BLD",8570,"KRN",19.1,0)
|
---|
88 | 19.1
|
---|
89 | "BLD",8570,"KRN",101,0)
|
---|
90 | 101
|
---|
91 | "BLD",8570,"KRN",409.61,0)
|
---|
92 | 409.61
|
---|
93 | "BLD",8570,"KRN",771,0)
|
---|
94 | 771
|
---|
95 | "BLD",8570,"KRN",779.2,0)
|
---|
96 | 779.2
|
---|
97 | "BLD",8570,"KRN",870,0)
|
---|
98 | 870
|
---|
99 | "BLD",8570,"KRN",8989.51,0)
|
---|
100 | 8989.51
|
---|
101 | "BLD",8570,"KRN",8989.52,0)
|
---|
102 | 8989.52
|
---|
103 | "BLD",8570,"KRN",8994,0)
|
---|
104 | 8994
|
---|
105 | "BLD",8570,"KRN","B",.4,.4)
|
---|
106 |
|
---|
107 | "BLD",8570,"KRN","B",.401,.401)
|
---|
108 |
|
---|
109 | "BLD",8570,"KRN","B",.402,.402)
|
---|
110 |
|
---|
111 | "BLD",8570,"KRN","B",.403,.403)
|
---|
112 |
|
---|
113 | "BLD",8570,"KRN","B",.5,.5)
|
---|
114 |
|
---|
115 | "BLD",8570,"KRN","B",.84,.84)
|
---|
116 |
|
---|
117 | "BLD",8570,"KRN","B",3.6,3.6)
|
---|
118 |
|
---|
119 | "BLD",8570,"KRN","B",3.8,3.8)
|
---|
120 |
|
---|
121 | "BLD",8570,"KRN","B",9.2,9.2)
|
---|
122 |
|
---|
123 | "BLD",8570,"KRN","B",9.8,9.8)
|
---|
124 |
|
---|
125 | "BLD",8570,"KRN","B",19,19)
|
---|
126 |
|
---|
127 | "BLD",8570,"KRN","B",19.1,19.1)
|
---|
128 |
|
---|
129 | "BLD",8570,"KRN","B",101,101)
|
---|
130 |
|
---|
131 | "BLD",8570,"KRN","B",409.61,409.61)
|
---|
132 |
|
---|
133 | "BLD",8570,"KRN","B",771,771)
|
---|
134 |
|
---|
135 | "BLD",8570,"KRN","B",779.2,779.2)
|
---|
136 |
|
---|
137 | "BLD",8570,"KRN","B",870,870)
|
---|
138 |
|
---|
139 | "BLD",8570,"KRN","B",8989.51,8989.51)
|
---|
140 |
|
---|
141 | "BLD",8570,"KRN","B",8989.52,8989.52)
|
---|
142 |
|
---|
143 | "BLD",8570,"KRN","B",8994,8994)
|
---|
144 |
|
---|
145 | "BLD",8570,"QDEF")
|
---|
146 | ^^^^NO^^^^NO^^NO
|
---|
147 | "BLD",8570,"QUES",0)
|
---|
148 | ^9.62^^
|
---|
149 | "BLD",8570,"REQB",0)
|
---|
150 | ^9.611^^
|
---|
151 | "FIA",2)
|
---|
152 | PATIENT
|
---|
153 | "FIA",2,0)
|
---|
154 | ^DPT(
|
---|
155 | "FIA",2,0,0)
|
---|
156 | 2I
|
---|
157 | "FIA",2,0,1)
|
---|
158 | y^n^p^^^^n^^n
|
---|
159 | "FIA",2,0,10)
|
---|
160 |
|
---|
161 | "FIA",2,0,11)
|
---|
162 |
|
---|
163 | "FIA",2,0,"RLRO")
|
---|
164 |
|
---|
165 | "FIA",2,2)
|
---|
166 | 1
|
---|
167 | "FIA",2,2,540001.1)
|
---|
168 |
|
---|
169 | "KRN",.402,1773,-1)
|
---|
170 | 0^1
|
---|
171 | "KRN",.402,1773,0)
|
---|
172 | VW PT REGISTRATION^3170308.0946^^2^^^3170308
|
---|
173 | "KRN",.402,1773,"%D",0)
|
---|
174 | ^^1^1^3160416^
|
---|
175 | "KRN",.402,1773,"%D",1,0)
|
---|
176 | Created via registration client
|
---|
177 | "KRN",.402,1773,"DIAB",5,0,2,0)
|
---|
178 | .363;"ID NUMBER"
|
---|
179 | "KRN",.402,1773,"DR",1,2)
|
---|
180 | .01;.02;.03;.05;.363ID NUMBER~;27.02;.111;.112;.1112;.114;.115;.117;.131;.132;.134;.133;.331;.339;.3121;.091;3;250043.1;
|
---|
181 | "KRN",.402,1773,"DR",2,2.001)
|
---|
182 | .01;1;
|
---|
183 | "KRN",.402,1773,"DR",2,2.312)
|
---|
184 | .01;
|
---|
185 | "KRN",.402,1773,"DR",3,2.011)
|
---|
186 | .01;1;
|
---|
187 | "MBREQ")
|
---|
188 | 0
|
---|
189 | "ORD",7,.402)
|
---|
190 | .402;7;;;EDEOUT^DIFROMSO(.402,DA,"",XPDA);FPRE^DIFROMSI(.402,"",XPDA);EPRE^DIFROMSI(.402,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.402,DA,"",XPDA);DEL^DIFROMSK(.402,"",%)
|
---|
191 | "ORD",7,.402,0)
|
---|
192 | INPUT TEMPLATE
|
---|
193 | "QUES","XPF1",0)
|
---|
194 | Y
|
---|
195 | "QUES","XPF1","??")
|
---|
196 | ^D REP^XPDH
|
---|
197 | "QUES","XPF1","A")
|
---|
198 | Shall I write over your |FLAG| File
|
---|
199 | "QUES","XPF1","B")
|
---|
200 | YES
|
---|
201 | "QUES","XPF1","M")
|
---|
202 | D XPF1^XPDIQ
|
---|
203 | "QUES","XPF2",0)
|
---|
204 | Y
|
---|
205 | "QUES","XPF2","??")
|
---|
206 | ^D DTA^XPDH
|
---|
207 | "QUES","XPF2","A")
|
---|
208 | Want my data |FLAG| yours
|
---|
209 | "QUES","XPF2","B")
|
---|
210 | YES
|
---|
211 | "QUES","XPF2","M")
|
---|
212 | D XPF2^XPDIQ
|
---|
213 | "QUES","XPI1",0)
|
---|
214 | YO
|
---|
215 | "QUES","XPI1","??")
|
---|
216 | ^D INHIBIT^XPDH
|
---|
217 | "QUES","XPI1","A")
|
---|
218 | Want KIDS to INHIBIT LOGONs during the install
|
---|
219 | "QUES","XPI1","B")
|
---|
220 | NO
|
---|
221 | "QUES","XPI1","M")
|
---|
222 | D XPI1^XPDIQ
|
---|
223 | "QUES","XPM1",0)
|
---|
224 | PO^VA(200,:EM
|
---|
225 | "QUES","XPM1","??")
|
---|
226 | ^D MG^XPDH
|
---|
227 | "QUES","XPM1","A")
|
---|
228 | Enter the Coordinator for Mail Group '|FLAG|'
|
---|
229 | "QUES","XPM1","B")
|
---|
230 |
|
---|
231 | "QUES","XPM1","M")
|
---|
232 | D XPM1^XPDIQ
|
---|
233 | "QUES","XPO1",0)
|
---|
234 | Y
|
---|
235 | "QUES","XPO1","??")
|
---|
236 | ^D MENU^XPDH
|
---|
237 | "QUES","XPO1","A")
|
---|
238 | Want KIDS to Rebuild Menu Trees Upon Completion of Install
|
---|
239 | "QUES","XPO1","B")
|
---|
240 | NO
|
---|
241 | "QUES","XPO1","M")
|
---|
242 | D XPO1^XPDIQ
|
---|
243 | "QUES","XPZ1",0)
|
---|
244 | Y
|
---|
245 | "QUES","XPZ1","??")
|
---|
246 | ^D OPT^XPDH
|
---|
247 | "QUES","XPZ1","A")
|
---|
248 | Want to DISABLE Scheduled Options, Menu Options, and Protocols
|
---|
249 | "QUES","XPZ1","B")
|
---|
250 | NO
|
---|
251 | "QUES","XPZ1","M")
|
---|
252 | D XPZ1^XPDIQ
|
---|
253 | "QUES","XPZ2",0)
|
---|
254 | Y
|
---|
255 | "QUES","XPZ2","??")
|
---|
256 | ^D RTN^XPDH
|
---|
257 | "QUES","XPZ2","A")
|
---|
258 | Want to MOVE routines to other CPUs
|
---|
259 | "QUES","XPZ2","B")
|
---|
260 | NO
|
---|
261 | "QUES","XPZ2","M")
|
---|
262 | D XPZ2^XPDIQ
|
---|
263 | "RTN")
|
---|
264 | 2
|
---|
265 | "RTN","VWREGIT")
|
---|
266 | 0^1^B34467909
|
---|
267 | "RTN","VWREGIT",1,0)
|
---|
268 | VWREGIT ;Portland,OR/Jim Bell, et al Patient Registration Utility August 2015
|
---|
269 | "RTN","VWREGIT",2,0)
|
---|
270 | ;;2.0;B/FProductions,LLC,WORLD VISTA;**LOCAL**;;Build 2
|
---|
271 | "RTN","VWREGIT",3,0)
|
---|
272 | ;*******************************************************************
|
---|
273 | "RTN","VWREGIT",4,0)
|
---|
274 | ;* VW Registration is designed for patient specific fields as *
|
---|
275 | "RTN","VWREGIT",5,0)
|
---|
276 | ;* defined in Fileman Input Templates or ad hoc field selection. *
|
---|
277 | "RTN","VWREGIT",6,0)
|
---|
278 | ;* Copyright Martius/MMXV ad infinitum (GNU License: See GPLv3.txt)*
|
---|
279 | "RTN","VWREGIT",7,0)
|
---|
280 | ;*******************************************************************
|
---|
281 | "RTN","VWREGIT",8,0)
|
---|
282 | ;;NO FALL THROUGH - JEB
|
---|
283 | "RTN","VWREGIT",9,0)
|
---|
284 | Q
|
---|
285 | "RTN","VWREGIT",10,0)
|
---|
286 | ;
|
---|
287 | "RTN","VWREGIT",11,0)
|
---|
288 | TFM(XF) ;TemplateField Management
|
---|
289 | "RTN","VWREGIT",12,0)
|
---|
290 | ;***********************************************
|
---|
291 | "RTN","VWREGIT",13,0)
|
---|
292 | ;* Check primary field entries for "parentage" *
|
---|
293 | "RTN","VWREGIT",14,0)
|
---|
294 | ;* Add an "*" to gain all sub-fields of the *
|
---|
295 | "RTN","VWREGIT",15,0)
|
---|
296 | ;* parent *
|
---|
297 | "RTN","VWREGIT",16,0)
|
---|
298 | ;* REMEMBER: All fields pertain to file 2 only *
|
---|
299 | "RTN","VWREGIT",17,0)
|
---|
300 | ;***********************************************
|
---|
301 | "RTN","VWREGIT",18,0)
|
---|
302 | N I,N,FIELD
|
---|
303 | "RTN","VWREGIT",19,0)
|
---|
304 | K FARRAY
|
---|
305 | "RTN","VWREGIT",20,0)
|
---|
306 | I '$L(XF),'$G(TNUM) Q ""
|
---|
307 | "RTN","VWREGIT",21,0)
|
---|
308 | I '$L(XF),+$G(TNUM) S XF=^DIE(TNUM,"DR",1,2)
|
---|
309 | "RTN","VWREGIT",22,0)
|
---|
310 | F I=1:1:$L(XF,";") S:$L($P(XF,";",I)) FARRAY(I)=+$P(XF,";",I)
|
---|
311 | "RTN","VWREGIT",23,0)
|
---|
312 | S N=0 F I=1:1 S N=$O(FARRAY(N)) Q:'+N D
|
---|
313 | "RTN","VWREGIT",24,0)
|
---|
314 | . S FIELD=FARRAY(N)
|
---|
315 | "RTN","VWREGIT",25,0)
|
---|
316 | . I +$P(^DD(2,FIELD,0),"^",2) S FIELD=FIELD_"*",FMARRAY(FIELD)=$P(^(0),"^",4) K FARRAY(N)
|
---|
317 | "RTN","VWREGIT",26,0)
|
---|
318 | S XF="",N=0 F S N=$O(FARRAY(N)) Q:'+N S XF=XF_FARRAY(N)_";"
|
---|
319 | "RTN","VWREGIT",27,0)
|
---|
320 | Q XF
|
---|
321 | "RTN","VWREGIT",28,0)
|
---|
322 | ;
|
---|
323 | "RTN","VWREGIT",29,0)
|
---|
324 | CHECK() ;
|
---|
325 | "RTN","VWREGIT",30,0)
|
---|
326 | Q ""
|
---|
327 | "RTN","VWREGIT",31,0)
|
---|
328 | ;
|
---|
329 | "RTN","VWREGIT",32,0)
|
---|
330 | INR() Q $O(RESULT(" "),-1)+1
|
---|
331 | "RTN","VWREGIT",33,0)
|
---|
332 | ;
|
---|
333 | "RTN","VWREGIT",34,0)
|
---|
334 | EN(RESULT) ;Template name and ID labels
|
---|
335 | "RTN","VWREGIT",35,0)
|
---|
336 | ;Get the input template list
|
---|
337 | "RTN","VWREGIT",36,0)
|
---|
338 | ;housekeeping
|
---|
339 | "RTN","VWREGIT",37,0)
|
---|
340 | S DTIME=99999
|
---|
341 | "RTN","VWREGIT",38,0)
|
---|
342 | ;ZSY "chmod 777 "_$ZD_"regparam/*.txt" ;Moved to post-install
|
---|
343 | "RTN","VWREGIT",39,0)
|
---|
344 | ;end housekeeping
|
---|
345 | "RTN","VWREGIT",40,0)
|
---|
346 | ;
|
---|
347 | "RTN","VWREGIT",41,0)
|
---|
348 | K AR,RESULT
|
---|
349 | "RTN","VWREGIT",42,0)
|
---|
350 | N N,HD,FILE,LOC,P4,P5,%ZISHF,%ZISHO,DEFST,XTMP,X
|
---|
351 | "RTN","VWREGIT",43,0)
|
---|
352 | S RESULT(0)=1
|
---|
353 | "RTN","VWREGIT",44,0)
|
---|
354 | S DEFST="";
|
---|
355 | "RTN","VWREGIT",45,0)
|
---|
356 | ;S DEFTMP=$O(^DIE("B","FAU_EDU",0)) ;For Florida College only
|
---|
357 | "RTN","VWREGIT",46,0)
|
---|
358 | S RESULT(0)=$$CONTROL^VWREGITU()
|
---|
359 | "RTN","VWREGIT",47,0)
|
---|
360 | S RESULT(1)="-1^No templates found"
|
---|
361 | "RTN","VWREGIT",48,0)
|
---|
362 | S DEFST=$$GET^XPAR("ALL","VW REG DEFAULT STATE")
|
---|
363 | "RTN","VWREGIT",49,0)
|
---|
364 | S DEFTMP=$$GET^XPAR("ALL","VW REG RDNPT")
|
---|
365 | "RTN","VWREGIT",50,0)
|
---|
366 | S HD=$$GET^XPAR("ALL","VW GUI REG TEMPLATE DIRECTORY")
|
---|
367 | "RTN","VWREGIT",51,0)
|
---|
368 | I '$L(HD) K RESULT D Q
|
---|
369 | "RTN","VWREGIT",52,0)
|
---|
370 | . S RESULT($$INR)="-1^NO HOME DIRECTORY - refer to IT support, if necessary."
|
---|
371 | "RTN","VWREGIT",53,0)
|
---|
372 | . S RESULT($$INR)="No home directory has been supplied which indicates"
|
---|
373 | "RTN","VWREGIT",54,0)
|
---|
374 | . S RESULT($$INR)="the VWREG installation is incomplete. See the Help manual"
|
---|
375 | "RTN","VWREGIT",55,0)
|
---|
376 | . S RESULT($$INR)="for installation and Enter/Editing parameter values."
|
---|
377 | "RTN","VWREGIT",56,0)
|
---|
378 | . S RESULT($$INR)="Thank you,"
|
---|
379 | "RTN","VWREGIT",57,0)
|
---|
380 | . S RESULT($$INR)=" The Management."
|
---|
381 | "RTN","VWREGIT",58,0)
|
---|
382 | S FILE="regit.txt"
|
---|
383 | "RTN","VWREGIT",59,0)
|
---|
384 | S P4=1
|
---|
385 | "RTN","VWREGIT",60,0)
|
---|
386 | S P5=""
|
---|
387 | "RTN","VWREGIT",61,0)
|
---|
388 | S X=$$FTG^%ZISH(HD,FILE,$NA(AR(1)),P4,P5)
|
---|
389 | "RTN","VWREGIT",62,0)
|
---|
390 | D:+RESULT(0)
|
---|
391 | "RTN","VWREGIT",63,0)
|
---|
392 | . S $P(RESULT(0),"^",2)=$G(HD)
|
---|
393 | "RTN","VWREGIT",64,0)
|
---|
394 | . S $P(RESULT(0),"^",3)=$S(DEFST:$P(^DIC(5,DEFST,0),"^")_"("_DEFST_")",1:"")
|
---|
395 | "RTN","VWREGIT",65,0)
|
---|
396 | . S $P(RESULT(0),"^",4)=$S(+DEFTMP:$P(^DIE(DEFTMP,0),"^")_"("_DEFTMP_")",1:DEFTMP)
|
---|
397 | "RTN","VWREGIT",66,0)
|
---|
398 | . S $P(RESULT(0),"^",5)=DUZ
|
---|
399 | "RTN","VWREGIT",67,0)
|
---|
400 | I $O(AR(0)) S RESULT(1)="[TEMPLATES]"
|
---|
401 | "RTN","VWREGIT",68,0)
|
---|
402 | S N=0 F S N=$O(AR(N)) Q:'+N D
|
---|
403 | "RTN","VWREGIT",69,0)
|
---|
404 | . Q:$E(AR(N))="*"
|
---|
405 | "RTN","VWREGIT",70,0)
|
---|
406 | . Q:'+$P(AR(N),"(",2)
|
---|
407 | "RTN","VWREGIT",71,0)
|
---|
408 | . Q:$P($G(^DIE(+$P(AR(N),"(",2),0)),"^",4)'=2 ;must be pat file
|
---|
409 | "RTN","VWREGIT",72,0)
|
---|
410 | . S RESULT($$INR)=AR(N)
|
---|
411 | "RTN","VWREGIT",73,0)
|
---|
412 | S RESULT($$INR)="[ID]"
|
---|
413 | "RTN","VWREGIT",74,0)
|
---|
414 | ;S N=0 F S N=$O(^DIZ(64850003,N)) Q:'+N S RESULT($$INR)=$P(^(N,0),"^",2)_"("_$P(^(0),"^")_")"
|
---|
415 | "RTN","VWREGIT",75,0)
|
---|
416 | ;S N=0 F S N=$O(RESULT(N)) Q:'+N K:RESULT(N)="" RESULT(N)
|
---|
417 | "RTN","VWREGIT",76,0)
|
---|
418 | I '$O(RESULT(0)) S RESULT(1)="-1^No PATIENT FILE templates found"
|
---|
419 | "RTN","VWREGIT",77,0)
|
---|
420 | K AR
|
---|
421 | "RTN","VWREGIT",78,0)
|
---|
422 | Q
|
---|
423 | "RTN","VWREGIT",79,0)
|
---|
424 | ;
|
---|
425 | "RTN","VWREGIT",80,0)
|
---|
426 | NPT(RESULT,TNAME) ;
|
---|
427 | "RTN","VWREGIT",81,0)
|
---|
428 | ; *************************************************
|
---|
429 | "RTN","VWREGIT",82,0)
|
---|
430 | ; * Incoming: DFN^TEMPLATE NAME(IEN) *
|
---|
431 | "RTN","VWREGIT",83,0)
|
---|
432 | ; * Process : Get template fields plus any help *
|
---|
433 | "RTN","VWREGIT",84,0)
|
---|
434 | ; * If +TNAME (a DFN), get DFN data for *
|
---|
435 | "RTN","VWREGIT",85,0)
|
---|
436 | ; * the template fields (Put data in *
|
---|
437 | "RTN","VWREGIT",86,0)
|
---|
438 | ; * $P(RESULT(N),"^",3)) *
|
---|
439 | "RTN","VWREGIT",87,0)
|
---|
440 | ; * Return : RESULT(N), etc *
|
---|
441 | "RTN","VWREGIT",88,0)
|
---|
442 | ; *************************************************
|
---|
443 | "RTN","VWREGIT",89,0)
|
---|
444 | ;W " ;Intentional bust for debugging
|
---|
445 | "RTN","VWREGIT",90,0)
|
---|
446 | N N,TNUM,FIELDS,F,FNAME,FVALUE,FHELP,FPSC,FNUM
|
---|
447 | "RTN","VWREGIT",91,0)
|
---|
448 | S TNUM=+$P(TNAME,"(",2),DFN=+TNAME
|
---|
449 | "RTN","VWREGIT",92,0)
|
---|
450 | I 'TNUM S RESULT(0)="0^new patient Template not found" Q
|
---|
451 | "RTN","VWREGIT",93,0)
|
---|
452 | S TNAME=$P($P(TNAME,"^",2),"(")
|
---|
453 | "RTN","VWREGIT",94,0)
|
---|
454 | S TNAME=$TR(TNAME,"$&*","") ;Clean out TMENU chars
|
---|
455 | "RTN","VWREGIT",95,0)
|
---|
456 | I TNAME="GENERIC INS. FRM [WorldVistA]" G GIF
|
---|
457 | "RTN","VWREGIT",96,0)
|
---|
458 | S FIELDS=$G(^DIE(TNUM,"DR",1,2))
|
---|
459 | "RTN","VWREGIT",97,0)
|
---|
460 | I '$L(FIELDS) Q
|
---|
461 | "RTN","VWREGIT",98,0)
|
---|
462 | K RESULT S (FNUM,FCAP)=""
|
---|
463 | "RTN","VWREGIT",99,0)
|
---|
464 | F I=1:1:$L(FIELDS,";")-1 D
|
---|
465 | "RTN","VWREGIT",100,0)
|
---|
466 | . S F=$P(FIELDS,";",I)
|
---|
467 | "RTN","VWREGIT",101,0)
|
---|
468 | . Q:'$D(^DD(2,F)) ;Not existing in this patient file
|
---|
469 | "RTN","VWREGIT",102,0)
|
---|
470 | . I F["~" S FNUM=+F,FNAME=$P($P(F,"~"),FNUM,2),F=FNUM K FNUM
|
---|
471 | "RTN","VWREGIT",103,0)
|
---|
472 | . S FNAME=$S($L($G(FNAME)):FNAME,$L($G(^DD(2,F,.1))):$P(^(.1),"^"),1:$P(^DD(2,F,0),"^"))
|
---|
473 | "RTN","VWREGIT",104,0)
|
---|
474 | . S FVALUE="" ;Patient Data
|
---|
475 | "RTN","VWREGIT",105,0)
|
---|
476 | . S FHELP=$G(^DD(2,F,3))
|
---|
477 | "RTN","VWREGIT",106,0)
|
---|
478 | . 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)
|
---|
479 | "RTN","VWREGIT",107,0)
|
---|
480 | . S FHELP=$TR(FHELP,"'","`")
|
---|
481 | "RTN","VWREGIT",108,0)
|
---|
482 | . S FPSC=$P(^DD(2,F,0),"^",3)
|
---|
483 | "RTN","VWREGIT",109,0)
|
---|
484 | . S SUBDIC=+$P(^DD(2,F,0),"^",2)
|
---|
485 | "RTN","VWREGIT",110,0)
|
---|
486 | . S RESULT($$INR)=FNAME_"^"_F_"^"_FVALUE_"^"_FHELP_"^"_FPSC_$S(SUBDIC:"^1",1:"^0")
|
---|
487 | "RTN","VWREGIT",111,0)
|
---|
488 | . S (FNAME,FVALUE,FHELP,FPSC)=""
|
---|
489 | "RTN","VWREGIT",112,0)
|
---|
490 | G NPTX:'DFN
|
---|
491 | "RTN","VWREGIT",113,0)
|
---|
492 | I DFN D GETS^DIQ(2,DFN_",","**","EN","AR") ;,RESULT(0)=$$DFNID^VWREGITU
|
---|
493 | "RTN","VWREGIT",114,0)
|
---|
494 | K FIELD S N=0 F S N=$O(RESULT(N)) Q:'+N S FIELD($P(RESULT(N),"^",2))=""
|
---|
495 | "RTN","VWREGIT",115,0)
|
---|
496 | S X="AR" F S X=$Q(@X) Q:X="" D
|
---|
497 | "RTN","VWREGIT",116,0)
|
---|
498 | . S FILE=+$P(X,"(",2)
|
---|
499 | "RTN","VWREGIT",117,0)
|
---|
500 | . S FIELD=+$P(X,",",$L(X,",")-1)
|
---|
501 | "RTN","VWREGIT",118,0)
|
---|
502 | . I $D(FIELD(FIELD)) S FIELD(FIELD)=@X
|
---|
503 | "RTN","VWREGIT",119,0)
|
---|
504 | S N=0 F S N=$O(FIELD(N)) Q:'+N D
|
---|
505 | "RTN","VWREGIT",120,0)
|
---|
506 | . S N2=0 F S N2=$O(RESULT(N2)) Q:'+N2 I $P(RESULT(N2),"^",2)=N S $P(RESULT(N2),"^",3)=FIELD(N)
|
---|
507 | "RTN","VWREGIT",121,0)
|
---|
508 | . S RESULT(0)=$$DFNID^VWREGITU()
|
---|
509 | "RTN","VWREGIT",122,0)
|
---|
510 | NPTX K FIELD,AR,FCAP,FILE,SUBDIC,N,N2,DFN
|
---|
511 | "RTN","VWREGIT",123,0)
|
---|
512 | Q
|
---|
513 | "RTN","VWREGIT",124,0)
|
---|
514 | ;
|
---|
515 | "RTN","VWREGIT",125,0)
|
---|
516 | PF(RESULT,XPF) ;Pointer file - get the stuff
|
---|
517 | "RTN","VWREGIT",126,0)
|
---|
518 | K RESULT,AR
|
---|
519 | "RTN","VWREGIT",127,0)
|
---|
520 | N X,N
|
---|
521 | "RTN","VWREGIT",128,0)
|
---|
522 | I '$L(XPF) S RESULT(0)="???" Q
|
---|
523 | "RTN","VWREGIT",129,0)
|
---|
524 | S XPF="^"_XPF
|
---|
525 | "RTN","VWREGIT",130,0)
|
---|
526 | I +$P(XPF,"(",2)=.85 G NAUTPF ;Naughty file!
|
---|
527 | "RTN","VWREGIT",131,0)
|
---|
528 | S N=0 F S N=$O(@(XPF_N_")")) Q:'+N S X=$P(^(N,0),"^"),AR(X,N)=X_"("_N_")"
|
---|
529 | "RTN","VWREGIT",132,0)
|
---|
530 | S X="AR" F S X=$Q(@X) Q:X="" S RESULT($$INR)=@X
|
---|
531 | "RTN","VWREGIT",133,0)
|
---|
532 | K AR
|
---|
533 | "RTN","VWREGIT",134,0)
|
---|
534 | Q
|
---|
535 | "RTN","VWREGIT",135,0)
|
---|
536 | ;
|
---|
537 | "RTN","VWREGIT",136,0)
|
---|
538 | NAUTPF ;The "NAUGHTY" pointer file - has a numeric .01 - Bad file !!!
|
---|
539 | "RTN","VWREGIT",137,0)
|
---|
540 | S N=0 F S N=$O(@(XPF_N_")")) Q:'+N S X=$P(^(N,0),"^") D
|
---|
541 | "RTN","VWREGIT",138,0)
|
---|
542 | . S LANG=$P(^(0),"^",2)
|
---|
543 | "RTN","VWREGIT",139,0)
|
---|
544 | . S AR(LANG,N)=LANG_"("_N_")"
|
---|
545 | "RTN","VWREGIT",140,0)
|
---|
546 | S X="AR" F S X=$Q(@X) Q:X="" S RESULT($$INR)=@X
|
---|
547 | "RTN","VWREGIT",141,0)
|
---|
548 | Q
|
---|
549 | "RTN","VWREGIT",142,0)
|
---|
550 | GIF ;Generic Insurance form
|
---|
551 | "RTN","VWREGIT",143,0)
|
---|
552 | K RESULT
|
---|
553 | "RTN","VWREGIT",144,0)
|
---|
554 | S RESULT($$INR)="Insurance Company^2.312;.01^^^DIC(36,^0"
|
---|
555 | "RTN","VWREGIT",145,0)
|
---|
556 | S RESULT($$INR)="Group Plan^2.312;.18^^^IBA(355.3,^0"
|
---|
557 | "RTN","VWREGIT",146,0)
|
---|
558 | S RESULT($$INR)="Policy No.^2.312;1^^^^0"
|
---|
559 | "RTN","VWREGIT",147,0)
|
---|
560 | ;S RESULT($$INR)="Type of Plan^^^^^0"
|
---|
561 | "RTN","VWREGIT",148,0)
|
---|
562 | S RESULT($$INR)="Coverage^355.33;40.09^^^IBE(355.1,^0"
|
---|
563 | "RTN","VWREGIT",149,0)
|
---|
564 | S RESULT($$INR)="Effective Date^2.312;8^^^^0"
|
---|
565 | "RTN","VWREGIT",150,0)
|
---|
566 | S RESULT($$INR)="Expiration Date^.3121;^^^^0"
|
---|
567 | "RTN","VWREGIT",151,0)
|
---|
568 | S RESULT($$INR)="Guarantor^^^^^0"
|
---|
569 | "RTN","VWREGIT",152,0)
|
---|
570 | S RESULT($$INR)="Signature on File^^^^0:NO;1:YES^0"
|
---|
571 | "RTN","VWREGIT",153,0)
|
---|
572 | S RESULT($$INR)="Employer^2.312;2.015^^^^0"
|
---|
573 | "RTN","VWREGIT",154,0)
|
---|
574 | S RESULT($$INR)="Billing Address^2.312;2.02^^^^0"
|
---|
575 | "RTN","VWREGIT",155,0)
|
---|
576 | S RESULT($$INR)="Billing Address(cont)^2.312;2.03^^^^0"
|
---|
577 | "RTN","VWREGIT",156,0)
|
---|
578 | S RESULT($$INR)="Postal Code^2.312;2.07^^^^0"
|
---|
579 | "RTN","VWREGIT",157,0)
|
---|
580 | S RESULT($$INR)="City^2.312;2.05^^^^0"
|
---|
581 | "RTN","VWREGIT",158,0)
|
---|
582 | S RESULT($$INR)="County/Region/Area^^^^^0"
|
---|
583 | "RTN","VWREGIT",159,0)
|
---|
584 | S RESULT($$INR)="State/Province/Region^2.312;2.06^^^DIC(5,^0"
|
---|
585 | "RTN","VWREGIT",160,0)
|
---|
586 | Q
|
---|
587 | "RTN","VWREGIT",161,0)
|
---|
588 | ;
|
---|
589 | "RTN","VWREGIT",162,0)
|
---|
590 |
|
---|
591 | "RTN","VWREGITS")
|
---|
592 | 0^2^B15352111
|
---|
593 | "RTN","VWREGITS",1,0)
|
---|
594 | VWREGITS ;Portland,OR/jeb et al Save utility for VWREG* routines 11/2015
|
---|
595 | "RTN","VWREGITS",2,0)
|
---|
596 | ;V.2;;**LOCAL**;;;Build 2
|
---|
597 | "RTN","VWREGITS",3,0)
|
---|
598 | ;c2014 ad infiniti, BellFelder Productions (BF Productions) & WorldVistA
|
---|
599 | "RTN","VWREGITS",4,0)
|
---|
600 | ;License: See License.txt that with install
|
---|
601 | "RTN","VWREGITS",5,0)
|
---|
602 | ;No fall thru - jeb
|
---|
603 | "RTN","VWREGITS",6,0)
|
---|
604 | Q
|
---|
605 | "RTN","VWREGITS",7,0)
|
---|
606 | ;
|
---|
607 | "RTN","VWREGITS",8,0)
|
---|
608 | ;* *****************************************************************
|
---|
609 | "RTN","VWREGITS",9,0)
|
---|
610 | ;* Data coming in may be for a new case or existing case *
|
---|
611 | "RTN","VWREGITS",10,0)
|
---|
612 | ;* Incoming: Array LDATA= *
|
---|
613 | "RTN","VWREGITS",11,0)
|
---|
614 | ;* LDATA(1)=Field^Field number^value^[optional]DFN *
|
---|
615 | "RTN","VWREGITS",12,0)
|
---|
616 | ;* LDATA(N...)=Field^Field number^value *
|
---|
617 | "RTN","VWREGITS",13,0)
|
---|
618 | ;* Exception for Multiples: *
|
---|
619 | "RTN","VWREGITS",14,0)
|
---|
620 | ;* LDATA(N)=Field(SUBDD;Field number):value(IEN)^...etc for every*
|
---|
621 | "RTN","VWREGITS",15,0)
|
---|
622 | ;* field that is a dependent of the parent *
|
---|
623 | "RTN","VWREGITS",16,0)
|
---|
624 | ;* Process: *
|
---|
625 | "RTN","VWREGITS",17,0)
|
---|
626 | ;* 1. call is at Label SAVE *
|
---|
627 | "RTN","VWREGITS",18,0)
|
---|
628 | ;* 2. Some housekeeping that this programmer needs to do proper *
|
---|
629 | "RTN","VWREGITS",19,0)
|
---|
630 | ;* string evaluations. *
|
---|
631 | "RTN","VWREGITS",20,0)
|
---|
632 | ;* 3. Filing of a new case with FILE^DICN. *
|
---|
633 | "RTN","VWREGITS",21,0)
|
---|
634 | ;* 4. Remaining major fields are filed with DIE *
|
---|
635 | "RTN","VWREGITS",22,0)
|
---|
636 | ;* 5. Multiples are filed with UPDATE^DIE *
|
---|
637 | "RTN","VWREGITS",23,0)
|
---|
638 | ;* 6. Existing entries will contain only edited data and will *
|
---|
639 | "RTN","VWREGITS",24,0)
|
---|
640 | ;* address those fields as in 4 & 5. *
|
---|
641 | "RTN","VWREGITS",25,0)
|
---|
642 | ;* Bon Appettit, et al. *
|
---|
643 | "RTN","VWREGITS",26,0)
|
---|
644 | ;*******************************************************************
|
---|
645 | "RTN","VWREGITS",27,0)
|
---|
646 | SAVE(RESULT,LDATA) ;
|
---|
647 | "RTN","VWREGITS",28,0)
|
---|
648 | K RESULT,^DIZ("DS",$J)
|
---|
649 | "RTN","VWREGITS",29,0)
|
---|
650 | M ^DIZ("DS",$J)=LDATA
|
---|
651 | "RTN","VWREGITS",30,0)
|
---|
652 | ;Q ;Testing
|
---|
653 | "RTN","VWREGITS",31,0)
|
---|
654 | N DFN,DIC,DA,DR,VAR,FIELD,N,N1,X,Y,DIE,DIK
|
---|
655 | "RTN","VWREGITS",32,0)
|
---|
656 | I $D(LDATA)<10 S RESULT(0)="-1: No data sent for filing. Please contact your IT dept." Q
|
---|
657 | "RTN","VWREGITS",33,0)
|
---|
658 | ;UPcase everyTHING
|
---|
659 | "RTN","VWREGITS",34,0)
|
---|
660 | S XDAT="LDATA" F S XDAT=$Q(@XDAT) Q:XDAT="" S @XDAT=$$UP^XLFSTR(@XDAT)
|
---|
661 | "RTN","VWREGITS",35,0)
|
---|
662 | ;
|
---|
663 | "RTN","VWREGITS",36,0)
|
---|
664 | ;Incoming housekeeping
|
---|
665 | "RTN","VWREGITS",37,0)
|
---|
666 | S X="LDATA" F I=1:1 S X=$Q(@X) Q:X="" I @X[":",@X[";" S ^DIZ("DS",$J,I)=@X K @X
|
---|
667 | "RTN","VWREGITS",38,0)
|
---|
668 | I +$P(@$Q(LDATA),"^",4)!(+$P(@$Q(LDATA),"(",2)) G EXP ;DFN sent by client
|
---|
669 | "RTN","VWREGITS",39,0)
|
---|
670 | S N=0 F S N=$O(LDATA(N)) Q:'+N I +$P($G(^DD(2,+$P(LDATA(N),"^",2),0)),"^",2) K LDATA(N)
|
---|
671 | "RTN","VWREGITS",40,0)
|
---|
672 | S DFN=$$FIND1^DIC(2,"","M",$P(LDATA(1),"^",3),"","","ERR")
|
---|
673 | "RTN","VWREGITS",41,0)
|
---|
674 | G EXP:DFN ;Found patient/client
|
---|
675 | "RTN","VWREGITS",42,0)
|
---|
676 | ;End housekeeping;
|
---|
677 | "RTN","VWREGITS",43,0)
|
---|
678 | ;
|
---|
679 | "RTN","VWREGITS",44,0)
|
---|
680 | S X=$P(LDATA(1),"^",3) D
|
---|
681 | "RTN","VWREGITS",45,0)
|
---|
682 | . S DIC="^DPT(",DIC(0)="LZ" K D0 D FILE^DICN S (DA,DFN)=+Y
|
---|
683 | "RTN","VWREGITS",46,0)
|
---|
684 | . S DIC="^AUPNPAT(",DIC(0)="LZ",X=DFN,DINUM=X,DIC(0)="L" D FILE^DICN
|
---|
685 | "RTN","VWREGITS",47,0)
|
---|
686 | . S DIE=DIC,DR=.03_"////^S X=DT" D ^DIE
|
---|
687 | "RTN","VWREGITS",48,0)
|
---|
688 | . S DR=.11_"////^S X=DUZ" D ^DIE
|
---|
689 | "RTN","VWREGITS",49,0)
|
---|
690 | LDPT L +^DPT(DFN):1 G LDPT:'$T
|
---|
691 | "RTN","VWREGITS",50,0)
|
---|
692 | S N=1 F S N=$O(LDATA(N)) Q:'+N D
|
---|
693 | "RTN","VWREGITS",51,0)
|
---|
694 | . Q:$P(LDATA(N),"^",2)[";"
|
---|
695 | "RTN","VWREGITS",52,0)
|
---|
696 | . Q:'+$P(LDATA(N),"^",2) ;Marker of some kind
|
---|
697 | "RTN","VWREGITS",53,0)
|
---|
698 | . S FIELD=$P(LDATA(N),"^",2)
|
---|
699 | "RTN","VWREGITS",54,0)
|
---|
700 | . S VAR=$P(LDATA(N),"^",3)
|
---|
701 | "RTN","VWREGITS",55,0)
|
---|
702 | . I FIELD=.03 D
|
---|
703 | "RTN","VWREGITS",56,0)
|
---|
704 | .. S VAR=$$DC(VAR)
|
---|
705 | "RTN","VWREGITS",57,0)
|
---|
706 | .. S VARTIME=$P(VAR,".",2),VAR=$P(VAR,".")
|
---|
707 | "RTN","VWREGITS",58,0)
|
---|
708 | .. I $L(VARTIME) D
|
---|
709 | "RTN","VWREGITS",59,0)
|
---|
710 | ... N FDA
|
---|
711 | "RTN","VWREGITS",60,0)
|
---|
712 | ... S FDA(2,DFN_",",540000.1)=VARTIME
|
---|
713 | "RTN","VWREGITS",61,0)
|
---|
714 | ... D FILE^DIE("E","FDA")
|
---|
715 | "RTN","VWREGITS",62,0)
|
---|
716 | ... D CLEAN^DILF
|
---|
717 | "RTN","VWREGITS",63,0)
|
---|
718 | . S:VAR["(" VAR=$S($L(VAR,"(")>2:+$P(VAR,"(",$L(VAR,"(")),1:+$P(VAR,"(",2))
|
---|
719 | "RTN","VWREGITS",64,0)
|
---|
720 | . S DIE="^DPT(",DR=FIELD_"///"_$S(+VAR:"/",1:"")_"^S X=VAR" D ^DIE
|
---|
721 | "RTN","VWREGITS",65,0)
|
---|
722 | L -^DPT(DFN)
|
---|
723 | "RTN","VWREGITS",66,0)
|
---|
724 | D M ;File any multiple fields
|
---|
725 | "RTN","VWREGITS",67,0)
|
---|
726 | S RESULT(0)="Filed..."
|
---|
727 | "RTN","VWREGITS",68,0)
|
---|
728 | K ^DIZ("DS",$J)
|
---|
729 | "RTN","VWREGITS",69,0)
|
---|
730 | Q
|
---|
731 | "RTN","VWREGITS",70,0)
|
---|
732 | ;
|
---|
733 | "RTN","VWREGITS",71,0)
|
---|
734 | EXP ;Existing Patient
|
---|
735 | "RTN","VWREGITS",72,0)
|
---|
736 | K X,FNAME,FFLD,FVALUE,AR,DIC,DA,DR,DIE,AR
|
---|
737 | "RTN","VWREGITS",73,0)
|
---|
738 | S X="LDATA" F S X=$Q(@X) Q:X="" I @X[":" S AR($O(AR(" "),-1)+1)=@X K @X
|
---|
739 | "RTN","VWREGITS",74,0)
|
---|
740 | S N=0 F S N=$O(LDATA(N)) Q:'+N S X=LDATA(N) D
|
---|
741 | "RTN","VWREGITS",75,0)
|
---|
742 | . S FNAME=$P(X,"^")
|
---|
743 | "RTN","VWREGITS",76,0)
|
---|
744 | . S FFLD=$P(X,"^",2)
|
---|
745 | "RTN","VWREGITS",77,0)
|
---|
746 | . S FVALUE=$S($P(X,"^",3)["(":+$P(X,"(",2),1:$P(X,"^",3))
|
---|
747 | "RTN","VWREGITS",78,0)
|
---|
748 | . S DFN=$P(X,"^",4)
|
---|
749 | "RTN","VWREGITS",79,0)
|
---|
750 | . S DIE="^DPT(",DA=DFN,DR=FFLD_"///^S X=FVALUE" D ^DIE
|
---|
751 | "RTN","VWREGITS",80,0)
|
---|
752 | D M
|
---|
753 | "RTN","VWREGITS",81,0)
|
---|
754 | S RESULT($I(RESULT))="Filed..."
|
---|
755 | "RTN","VWREGITS",82,0)
|
---|
756 | K X,FNAME,FFL,FVALUE,DFN,AR,DIE,DA,DR,DIC
|
---|
757 | "RTN","VWREGITS",83,0)
|
---|
758 | Q
|
---|
759 | "RTN","VWREGITS",84,0)
|
---|
760 | ;
|
---|
761 | "RTN","VWREGITS",85,0)
|
---|
762 | M ;File any multiples values; DFN should be defined above
|
---|
763 | "RTN","VWREGITS",86,0)
|
---|
764 | Q:'$D(^DIZ("DS",$J))
|
---|
765 | "RTN","VWREGITS",87,0)
|
---|
766 | M MULTS=^DIZ("DS",$J)
|
---|
767 | "RTN","VWREGITS",88,0)
|
---|
768 | K MAR S N=0 F S N=$O(MULTS(N)) Q:'+N D
|
---|
769 | "RTN","VWREGITS",89,0)
|
---|
770 | . F J=1:1:$L(MULTS(N),"^")-1 S MAR(J)=$P(MULTS(N),"^",J)
|
---|
771 | "RTN","VWREGITS",90,0)
|
---|
772 | . S MX=$O(MAR(0))
|
---|
773 | "RTN","VWREGITS",91,0)
|
---|
774 | . S MXFILE=+$P(MAR(MX),"(",2)
|
---|
775 | "RTN","VWREGITS",92,0)
|
---|
776 | . S MXFLD=+$P(MAR(MX),";",2)
|
---|
777 | "RTN","VWREGITS",93,0)
|
---|
778 | . S MXVAL=$P($P(MAR(MX),":",2),"(")
|
---|
779 | "RTN","VWREGITS",94,0)
|
---|
780 | . I MXFLD=.01 S MXDATA(MXFILE,"?+1,"_DFN_",",MXFLD)=MXVAL K IEN D UPDATE^DIE("E","MXDATA","IEN","ERROR") Q:$G(DIERR) D
|
---|
781 | "RTN","VWREGITS",95,0)
|
---|
782 | .. S RECORD=$G(IEN(1)),INC=$G(IEN(1,0))
|
---|
783 | "RTN","VWREGITS",96,0)
|
---|
784 | .. S J=MX F S J=$O(MAR(J)) Q:'+J D
|
---|
785 | "RTN","VWREGITS",97,0)
|
---|
786 | ... s MXFILE=+$P(MAR(J),"(",2)
|
---|
787 | "RTN","VWREGITS",98,0)
|
---|
788 | ... S MXFLD=+$P(MAR(J),";",2)
|
---|
789 | "RTN","VWREGITS",99,0)
|
---|
790 | ... S MXVAL=$P(MAR(J),":",2),MXVAL=$S(MXVAL["(":$P(MXVAL,"("),1:MXVAL)
|
---|
791 | "RTN","VWREGITS",100,0)
|
---|
792 | ... S MXDATA(MXFILE,$S(MXFLD=.01:INC,1:"")_"1,"_RECORD_","_DFN_",",MXFLD)=MXVAL
|
---|
793 | "RTN","VWREGITS",101,0)
|
---|
794 | ... K IEN,ERROR D UPDATE^DIE("E","MXDATA","IEN","ERROR")
|
---|
795 | "RTN","VWREGITS",102,0)
|
---|
796 | Q
|
---|
797 | "RTN","VWREGITS",103,0)
|
---|
798 | ;
|
---|
799 | "RTN","VWREGITS",104,0)
|
---|
800 | DC(XDATE) ;Convert DOB to internal
|
---|
801 | "RTN","VWREGITS",105,0)
|
---|
802 | N %DT,X
|
---|
803 | "RTN","VWREGITS",106,0)
|
---|
804 | S X=XDATE,%DT="T" D ^%DT
|
---|
805 | "RTN","VWREGITS",107,0)
|
---|
806 | Q Y
|
---|
807 | "RTN","VWREGITS",108,0)
|
---|
808 | ;
|
---|
809 | "RTN","VWREGITS",109,0)
|
---|
810 | INSUR ;Insurance/Billing
|
---|
811 | "RTN","VWREGITS",110,0)
|
---|
812 | Q
|
---|
813 | "RTN","VWREGITS",111,0)
|
---|
814 | ;
|
---|
815 | "RTN","VWREGITS",112,0)
|
---|
816 | K S DA=$P(^DPT(0),"^",3),DIK="^DPT(" D ^DIK
|
---|
817 | "RTN","VWREGITS",113,0)
|
---|
818 | S DIK="^AUPNPAT(" D ^DIK
|
---|
819 | "RTN","VWREGITS",114,0)
|
---|
820 | Q
|
---|
821 | "RTN","VWREGITS",115,0)
|
---|
822 | ;
|
---|
823 | "VER")
|
---|
824 | 8.0^22.2
|
---|
825 | "^DD",2,2,540001.1,0)
|
---|
826 | HEALTH RECORD NUMBER^F^^648HRN;1^K:$L(X)>30!($L(X)<1) X
|
---|
827 | "^DD",2,2,540001.1,3)
|
---|
828 | Enter patient/client's health record number (HRN), up to 30 characters
|
---|
829 | "^DD",2,2,540001.1,"DT")
|
---|
830 | 3160309
|
---|
831 | **END**
|
---|
832 | **END**
|
---|