source: VWGUIRegistration/trunk/VWREG_07242016_2_0T1.KID

Last change on this file was 1798, checked in by Jim B., 4 years ago
File size: 139.7 KB
Line 
1KIDS Distribution saved on Jul 24, 2016@09:54:56
2WorldVistA/BFProductions,LLC GUI Registration
3**KIDS**:VWREG_07242106*2.0T1*0^
4
5**INSTALL NAME**
6VWREG_07242106*2.0T1*0
7"BLD",8558,0)
8VWREG_07242106*2.0T1*0^^0^3160724^n
9"BLD",8558,1,0)
10^^1^1^3160705^^
11"BLD",8558,1,1,0)
12Server (M) side of GUI patient registration
13"BLD",8558,4,0)
14^9.64PA^64850003^3
15"BLD",8558,4,64850001,0)
1664850001
17"BLD",8558,4,64850001,222)
18y^n^f^^n^^y^m^n
19"BLD",8558,4,64850002,0)
2064850002
21"BLD",8558,4,64850002,222)
22y^n^f^^n^^y^m^n
23"BLD",8558,4,64850003,0)
2464850003
25"BLD",8558,4,64850003,222)
26y^n^f^^n^^y^m^n
27"BLD",8558,4,"B",64850001,64850001)
28
29"BLD",8558,4,"B",64850002,64850002)
30
31"BLD",8558,4,"B",64850003,64850003)
32
33"BLD",8558,6.3)
344
35"BLD",8558,"INIT")
36PI^VWREGIT2
37"BLD",8558,"KRN",0)
38^9.67PA^779.2^20
39"BLD",8558,"KRN",.4,0)
40.4
41"BLD",8558,"KRN",.401,0)
42.401
43"BLD",8558,"KRN",.402,0)
44.402
45"BLD",8558,"KRN",.402,"NM",0)
46^9.68A^7^7
47"BLD",8558,"KRN",.402,"NM",1,0)
48VW PT REGISTRATION    FILE #2^2^0
49"BLD",8558,"KRN",.402,"NM",2,0)
50VW WESTVIRGINIA TEST    FILE #2^2^0
51"BLD",8558,"KRN",.402,"NM",3,0)
52ADDRESS [WorldVistA]    FILE #2^2^0
53"BLD",8558,"KRN",.402,"NM",4,0)
54NEXT OF KIN [WorldVistA]    FILE #2^2^0
55"BLD",8558,"KRN",.402,"NM",5,0)
56EMERG. CONTACT [WorldVistA]    FILE #2^2^0
57"BLD",8558,"KRN",.402,"NM",6,0)
58REPORTED DEATH [WorldVistA]    FILE #2^2^0
59"BLD",8558,"KRN",.402,"NM",7,0)
60GENERIC INS. FRM [WorldVistA]    FILE #2^2^0
61"BLD",8558,"KRN",.402,"NM","B","ADDRESS [WorldVistA]    FILE #2",3)
62
63"BLD",8558,"KRN",.402,"NM","B","EMERG. CONTACT [WorldVistA]    FILE #2",5)
64
65"BLD",8558,"KRN",.402,"NM","B","GENERIC INS. FRM [WorldVistA]    FILE #2",7)
66
67"BLD",8558,"KRN",.402,"NM","B","NEXT OF KIN [WorldVistA]    FILE #2",4)
68
69"BLD",8558,"KRN",.402,"NM","B","REPORTED DEATH [WorldVistA]    FILE #2",6)
70
71"BLD",8558,"KRN",.402,"NM","B","VW PT REGISTRATION    FILE #2",1)
72
73"BLD",8558,"KRN",.402,"NM","B","VW WESTVIRGINIA TEST    FILE #2",2)
74
75"BLD",8558,"KRN",.403,0)
76.403
77"BLD",8558,"KRN",.5,0)
78.5
79"BLD",8558,"KRN",.84,0)
80.84
81"BLD",8558,"KRN",3.6,0)
823.6
83"BLD",8558,"KRN",3.8,0)
843.8
85"BLD",8558,"KRN",3.8,"NM",0)
86^9.68A^1^1
87"BLD",8558,"KRN",3.8,"NM",1,0)
88VW REG ERROR REPORT^^0
89"BLD",8558,"KRN",3.8,"NM","B","VW REG ERROR REPORT",1)
90
91"BLD",8558,"KRN",9.2,0)
929.2
93"BLD",8558,"KRN",9.8,0)
949.8
95"BLD",8558,"KRN",9.8,"NM",0)
96^9.68A^11^9
97"BLD",8558,"KRN",9.8,"NM",1,0)
98VWREGIT^^0^B34500673
99"BLD",8558,"KRN",9.8,"NM",3,0)
100VWREGIT3^^0^B4498
101"BLD",8558,"KRN",9.8,"NM",4,0)
102VWREGITP^^0^B5382212
103"BLD",8558,"KRN",9.8,"NM",5,0)
104VWREGITS^^0^B13044192
105"BLD",8558,"KRN",9.8,"NM",7,0)
106VWREGITU^^0^B34064749
107"BLD",8558,"KRN",9.8,"NM",8,0)
108VWREGITX^^0^B69339357
109"BLD",8558,"KRN",9.8,"NM",9,0)
110BFPMAIL^^0^B2204040
111"BLD",8558,"KRN",9.8,"NM",10,0)
112VWREGITT^^0^B60617803
113"BLD",8558,"KRN",9.8,"NM",11,0)
114VWREGIT2^^0^B4385801
115"BLD",8558,"KRN",9.8,"NM","B","BFPMAIL",9)
116
117"BLD",8558,"KRN",9.8,"NM","B","VWREGIT",1)
118
119"BLD",8558,"KRN",9.8,"NM","B","VWREGIT2",11)
120
121"BLD",8558,"KRN",9.8,"NM","B","VWREGIT3",3)
122
123"BLD",8558,"KRN",9.8,"NM","B","VWREGITP",4)
124
125"BLD",8558,"KRN",9.8,"NM","B","VWREGITS",5)
126
127"BLD",8558,"KRN",9.8,"NM","B","VWREGITT",10)
128
129"BLD",8558,"KRN",9.8,"NM","B","VWREGITU",7)
130
131"BLD",8558,"KRN",9.8,"NM","B","VWREGITX",8)
132
133"BLD",8558,"KRN",19,0)
13419
135"BLD",8558,"KRN",19,"NM",0)
136^9.68A^2^2
137"BLD",8558,"KRN",19,"NM",1,0)
138VW REG IT CONTROL^^0
139"BLD",8558,"KRN",19,"NM",2,0)
140VW PATIENT REGISTRATION^^0
141"BLD",8558,"KRN",19,"NM","B","VW PATIENT REGISTRATION",2)
142
143"BLD",8558,"KRN",19,"NM","B","VW REG IT CONTROL",1)
144
145"BLD",8558,"KRN",19.1,0)
14619.1
147"BLD",8558,"KRN",19.1,"NM",0)
148^9.68A^^
149"BLD",8558,"KRN",101,0)
150101
151"BLD",8558,"KRN",409.61,0)
152409.61
153"BLD",8558,"KRN",771,0)
154771
155"BLD",8558,"KRN",779.2,0)
156779.2
157"BLD",8558,"KRN",870,0)
158870
159"BLD",8558,"KRN",8989.51,0)
1608989.51
161"BLD",8558,"KRN",8989.51,"NM",0)
162^9.68A^3^3
163"BLD",8558,"KRN",8989.51,"NM",1,0)
164VW GUI REG TEMPLATE DIRECTORY^^0
165"BLD",8558,"KRN",8989.51,"NM",2,0)
166VW REG DEFAULT STATE^^0
167"BLD",8558,"KRN",8989.51,"NM",3,0)
168VW REG RDNPT^^0
169"BLD",8558,"KRN",8989.51,"NM","B","VW GUI REG TEMPLATE DIRECTORY",1)
170
171"BLD",8558,"KRN",8989.51,"NM","B","VW REG DEFAULT STATE",2)
172
173"BLD",8558,"KRN",8989.51,"NM","B","VW REG RDNPT",3)
174
175"BLD",8558,"KRN",8989.52,0)
1768989.52
177"BLD",8558,"KRN",8989.52,"NM",0)
178^9.68A^^
179"BLD",8558,"KRN",8994,0)
1808994
181"BLD",8558,"KRN",8994,"NM",0)
182^9.68A^24^23
183"BLD",8558,"KRN",8994,"NM",1,0)
184VW REG AHF^^0
185"BLD",8558,"KRN",8994,"NM",2,0)
186VW REG ALIST^^0
187"BLD",8558,"KRN",8994,"NM",3,0)
188VW REG CF^^0
189"BLD",8558,"KRN",8994,"NM",4,0)
190VW REG FLD BY GRP^^0
191"BLD",8558,"KRN",8994,"NM",5,0)
192VW REG GPD^^0
193"BLD",8558,"KRN",8994,"NM",6,0)
194VW REG GPDM^^0
195"BLD",8558,"KRN",8994,"NM",7,0)
196VW REG GRP LIST^^0
197"BLD",8558,"KRN",8994,"NM",8,0)
198VW REG MAIN^^0
199"BLD",8558,"KRN",8994,"NM",9,0)
200VW REG MANUL^^0
201"BLD",8558,"KRN",8994,"NM",10,0)
202VW REG MF^^0
203"BLD",8558,"KRN",8994,"NM",11,0)
204VW REG MISC^^0
205"BLD",8558,"KRN",8994,"NM",12,0)
206VW REG MOD regit^^0
207"BLD",8558,"KRN",8994,"NM",13,0)
208VW REG MU^^0
209"BLD",8558,"KRN",8994,"NM",14,0)
210VW REG NEW PT^^0
211"BLD",8558,"KRN",8994,"NM",15,0)
212VW REG PARTIAL PT LIST^^0
213"BLD",8558,"KRN",8994,"NM",16,0)
214VW REG PF^^0
215"BLD",8558,"KRN",8994,"NM",17,0)
216VW REG SAVE^^0
217"BLD",8558,"KRN",8994,"NM",19,0)
218VW REG SPI^^0
219"BLD",8558,"KRN",8994,"NM",20,0)
220VW REG TFILE^^0
221"BLD",8558,"KRN",8994,"NM",21,0)
222VW REG TLIST^^0
223"BLD",8558,"KRN",8994,"NM",22,0)
224VW REG TM^^0
225"BLD",8558,"KRN",8994,"NM",23,0)
226VW REG UL^^0
227"BLD",8558,"KRN",8994,"NM",24,0)
228VW REG ZIP^^0
229"BLD",8558,"KRN",8994,"NM","B","VW REG AHF",1)
230
231"BLD",8558,"KRN",8994,"NM","B","VW REG ALIST",2)
232
233"BLD",8558,"KRN",8994,"NM","B","VW REG CF",3)
234
235"BLD",8558,"KRN",8994,"NM","B","VW REG FLD BY GRP",4)
236
237"BLD",8558,"KRN",8994,"NM","B","VW REG GPD",5)
238
239"BLD",8558,"KRN",8994,"NM","B","VW REG GPDM",6)
240
241"BLD",8558,"KRN",8994,"NM","B","VW REG GRP LIST",7)
242
243"BLD",8558,"KRN",8994,"NM","B","VW REG MAIN",8)
244
245"BLD",8558,"KRN",8994,"NM","B","VW REG MANUL",9)
246
247"BLD",8558,"KRN",8994,"NM","B","VW REG MF",10)
248
249"BLD",8558,"KRN",8994,"NM","B","VW REG MISC",11)
250
251"BLD",8558,"KRN",8994,"NM","B","VW REG MOD regit",12)
252
253"BLD",8558,"KRN",8994,"NM","B","VW REG MU",13)
254
255"BLD",8558,"KRN",8994,"NM","B","VW REG NEW PT",14)
256
257"BLD",8558,"KRN",8994,"NM","B","VW REG PARTIAL PT LIST",15)
258
259"BLD",8558,"KRN",8994,"NM","B","VW REG PF",16)
260
261"BLD",8558,"KRN",8994,"NM","B","VW REG SAVE",17)
262
263"BLD",8558,"KRN",8994,"NM","B","VW REG SPI",19)
264
265"BLD",8558,"KRN",8994,"NM","B","VW REG TFILE",20)
266
267"BLD",8558,"KRN",8994,"NM","B","VW REG TLIST",21)
268
269"BLD",8558,"KRN",8994,"NM","B","VW REG TM",22)
270
271"BLD",8558,"KRN",8994,"NM","B","VW REG UL",23)
272
273"BLD",8558,"KRN",8994,"NM","B","VW REG ZIP",24)
274
275"BLD",8558,"KRN","B",.4,.4)
276
277"BLD",8558,"KRN","B",.401,.401)
278
279"BLD",8558,"KRN","B",.402,.402)
280
281"BLD",8558,"KRN","B",.403,.403)
282
283"BLD",8558,"KRN","B",.5,.5)
284
285"BLD",8558,"KRN","B",.84,.84)
286
287"BLD",8558,"KRN","B",3.6,3.6)
288
289"BLD",8558,"KRN","B",3.8,3.8)
290
291"BLD",8558,"KRN","B",9.2,9.2)
292
293"BLD",8558,"KRN","B",9.8,9.8)
294
295"BLD",8558,"KRN","B",19,19)
296
297"BLD",8558,"KRN","B",19.1,19.1)
298
299"BLD",8558,"KRN","B",101,101)
300
301"BLD",8558,"KRN","B",409.61,409.61)
302
303"BLD",8558,"KRN","B",771,771)
304
305"BLD",8558,"KRN","B",779.2,779.2)
306
307"BLD",8558,"KRN","B",870,870)
308
309"BLD",8558,"KRN","B",8989.51,8989.51)
310
311"BLD",8558,"KRN","B",8989.52,8989.52)
312
313"BLD",8558,"KRN","B",8994,8994)
314
315"BLD",8558,"QDEF")
316^^^^NO^^^^NO^^NO
317"BLD",8558,"QUES",0)
318^9.62^^
319"BLD",8558,"REQB",0)
320^9.611^^
321"DATA",64850001,.081,0)
322DUPLICATE STATUS^SX^0:NO UNRESOLVED DUPLICATES;1:CHECK DUPLICATE RECORDS FILE;^0;18
323"DATA",64850001,.082,0)
324PATIENT MERGED TO^P2'^DPT(^0;19
325"DATA",64850001,.083,0)
326CHECK FOR DUPLICATE^S^1:YES;^0;20
327"DATA",64850001,.09,0)
328SOCIAL SECURITY NUMBER^FXa^^0;9
329"DATA",64850001,.0906,0)
330PSEUDO SSN REASON^S^R:REFUSED TO PROVIDE;S:SSN UNKNOWN/FOLLOW-UP REQUIRED;N:NO SSN ASSIGNED;^SSN;1
331"DATA",64850001,.0907,0)
332SSN VERIFICATION STATUS^S^4:VERIFIED;2:INVALID;^SSN;2
333"DATA",64850001,.096,0)
334WHO ENTERED PATIENT^P200'I^VA(200,^0;15
335"DATA",64850001,.097,0)
336DATE ENTERED INTO FILE^DI^^0;16
337"DATA",64850001,.098,0)
338HOW WAS PATIENT ENTERED?^S^1:10-10T REGISTRATION;^0;17
339"DATA",64850001,.1,0)
340WARD LOCATION^FX^^.1;E1,30
341"DATA",64850001,.101,0)
342ROOM-BED^F^^.101;1
343"DATA",64850001,.102,0)
344CURRENT MOVEMENT^*P405'^DGPM(^.102;1
345"DATA",64850001,.103,0)
346TREATING SPECIALTY^P45.7'^DIC(45.7,^.103;1
347"DATA",64850001,.104,0)
348PROVIDER^*P200'^VA(200,^.104;1
349"DATA",64850001,.1041,0)
350ATTENDING PHYSICIAN^*P200'^VA(200,^.1041;1
351"DATA",64850001,.105,0)
352CURRENT ADMISSION^*P405'^DGPM(^.105;1
353"DATA",64850001,.106,0)
354LAST DMMS EPISODE NUMBER^NJ5,0^^.106;1
355"DATA",64850001,.108,0)
356CURRENT ROOM^P405.4'^DG(405.4,^.108;1
357"DATA",64850001,.109,0)
358EXCLUDE FROM FACILITY DIR^S^0:NO;1:YES;^.109;1
359"DATA",64850001,.118,0)
360ADDRESS CHANGE DT/TM^D^^.11;13
361"DATA",64850001,.119,0)
362ADDRESS CHANGE SOURCE^S^HEC:HEC;VAMC:VAMC;HBSC:HBSC;NCOA:NCOA;BVA:BVA;VAINS:VAINS;USPS:USPS;LACS:LACS;VOA:VOA;^.11;14
363"DATA",64850001,.12,0)
364ADDRESS CHANGE SITE^P4'^DIC(4,^.11;15
365"DATA",64850001,.121,0)
366BAD ADDRESS INDICATOR^*S^1:UNDELIVERABLE;2:HOMELESS;3:OTHER;4:ADDRESS NOT FOUND;^.11;16
367"DATA",64850001,.12105,0)
368TEMPORARY ADDRESS ACTIVE?^RSX^Y:YES;N:NO;^.121;9
369"DATA",64850001,.122,0)
370ADDRESS CHANGE USER^P200'^VA(200,^.11;17
371"DATA",64850001,.1311,0)
372CELLULAR NUMBER CHANGE SOURCE^S^HEC:HEC;VAMC:VAMC;HBSC:HBSC;VOA:VOA;^.13;10
373"DATA",64850001,.13111,0)
374CELLULAR NUMBER CHANGE SITE^P4'^DIC(4,^.13;11
375"DATA",64850001,.132,0)
376PHONE NUMBER [WORK]^Fa^^.13;2
377"DATA",64850001,.135,0)
378PAGER NUMBER^FX^^.13;5
379"DATA",64850001,.136,0)
380EMAIL ADDRESS CHANGE DT/TM^D^^.13;6
381"DATA",64850001,.137,0)
382EMAIL ADDRESS CHANGE SOURCE^S^HEC:HEC;VAMC:VAMC;HBSC:HBSC;VOA:VOA;^.13;7
383"DATA",64850001,.138,0)
384EMAIL ADDRESS CHANGE SITE^P4'^DIC(4,^.13;8
385"DATA",64850001,.139,0)
386CELLULAR NUMBER CHANGE DT/TM^D^^.13;9
387"DATA",64850001,.14,0)
388CURRENT MEANS TEST STATUS^P408.32'I^DG(408.32,^0;14
389"DATA",64850001,.141,0)
390CONFIDENTIAL ADDRESS CATEGORY^2.141S^^.14;0
391"DATA",64850001,.14112,0)
392CONFIDENTIAL ADDR CHANGE DT/TM^DX^^.141;12
393"DATA",64850001,.14113,0)
394CONFIDENTIAL ADDR CHANGE SITE^P4'^DIC(4,^.141;13
395"DATA",64850001,.152,0)
396INELIGIBLE DATE^DX^^.15;2
397"DATA",64850001,.153,0)
398MISSING PERSON DATE^DX^^.15;3
399"DATA",64850001,.16,0)
400MISSING OR INELIGIBLE^2.16A^^.16;0
401"DATA",64850001,.1651,0)
402INELIGIBLE TWX SOURCE^RSX^1:VAMC;2:REGIONAL OFFICE;3:RPC;^INE;1
403"DATA",64850001,.1653,0)
404INELIGIBLE TWX CITY^FX^^INE;3
405"DATA",64850001,.1654,0)
406INELIGIBLE TWX STATE^P5'X^DIC(5,^INE;4
407"DATA",64850001,.1656,0)
408INELIGIBLE VARO DECISION^FX^^INE;6
409"DATA",64850001,.1657,0)
410MISSING PERSON TWX SOURCE^S^1:VAMC;2:REGIONAL OFFICE;3:RPC;^INE;7
411"DATA",64850001,.1658,0)
412MISSING PERSON TWX CITY^F^^INE;8
413"DATA",64850001,.1659,0)
414MISSING PERSON TWX STATE^P5'^DIC(5,^INE;9
415"DATA",64850001,.172,0)
416FEE HOSPITAL I.D.^S^I:ISSUED;C:CANCELLED;^.17;2
417"DATA",64850001,.181,0)
418EMERGENCY RESPONSE INDICATOR^S^K:HURRICANE KATRINA;^.18;1
419"DATA",64850001,.21012,0)
420PRIMARY NOK CHANGE DATE/TIME^DX^^.212;1
421"DATA",64850001,.211012,0)
422SECONDARY NOK CHANGE DATE/TIME^DX^^.212;2
423"DATA",64850001,.301,0)
424SERVICE CONNECTED?^SXa^Y:YES;N:NO;^.3;1
425"DATA",64850001,.3012,0)
426SC AWARD DATE^DX^^.3;12
427"DATA",64850001,.3013,0)
428P&T EFFECTIVE DATE^DX^^.3;13
429"DATA",64850001,.3014,0)
430EFF. DATE COMBINED SC% EVAL.^DX^^.3;14
431"DATA",64850001,.302,0)
432SERVICE CONNECTED PERCENTAGE^NJ3,0Xa^^.3;2
433"DATA",64850001,.3025,0)
434RECEIVING VA DISABILITY?^SX^Y:YES;N:NO;U:UNKNOWN;^.3;11
435"DATA",64850001,.303,0)
436AMOUNT OF VA DISABILITY^NJ7,0X^^.3;3
437"DATA",64850001,.304,0)
438P&T^SX^Y:YES;N:NO;^.3;4
439"DATA",64850001,.305,0)
440UNEMPLOYABLE^S^Y:YES;N:NO;^.3;5
441"DATA",64850001,.306,0)
442MONETARY BEN. VERIFY DATE^DX^^.3;6
443"DATA",64850001,.307,0)
444INELIGIBLE REASON^FX^^.3;7
445"DATA",64850001,.309,0)
446AGENCY/ALLIED COUNTRY^*P35'X^DIC(35,^.3;9
447"DATA",64850001,.31,0)
448*CATEGORY OF BENEFICIARY^P45.82'X^DIC(45.82,^.3;10
449"DATA",64850001,.31116,0)
450DATE OF RETIREMENT^DX^^.311;16
451"DATA",64850001,.313,0)
452CLAIM NUMBER^FXOa^^.31;3
453"DATA",64850001,.314,0)
454CLAIM FOLDER LOCATION^*P4'X^DIC(4,^.31;4
455"DATA",64850001,.3192,0)
456COVERED BY HEALTH INSURANCE?^RS^Y:YES;N:NO;U:UNKNOWN;^.31;11
457"DATA",64850001,.32101,0)
458VIETNAM SERVICE INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.321;1
459"DATA",64850001,.32102,0)
460AGENT ORANGE EXPOS. INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.321;2
461"DATA",64850001,.32103,0)
462RADIATION EXPOSURE INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.321;3
463"DATA",64850001,.32104,0)
464VIETNAM FROM DATE^RDX^^.321;4
465"DATA",64850001,.32105,0)
466VIETNAM TO DATE^RDX^^.321;5
467"DATA",64850001,.32107,0)
468AGENT ORANGE REGISTRATION DATE^DX^^.321;7
469"DATA",64850001,.32108,0)
470AGENT ORANGE REPORTED TO C.O.^DX^^.321;8
471"DATA",64850001,.32109,0)
472AGENT ORANGE EXAM DATE^DX^^.321;9
473"DATA",64850001,.3211,0)
474AGENT ORANGE REGISTRATION #^NJ6,0X^^.321;10
475"DATA",64850001,.32111,0)
476RADIATION REGISTRATION DATE^DX^^.321;11
477"DATA",64850001,.32115,0)
478PROJ 112/SHAD^S^1:YES;0:NO;^.321;15
479"DATA",64850001,.3212,0)
480RADIATION EXPOSURE METHOD^SX^2:HIROSHIMA/NAGASAKI;3:ATMOSPHERIC NUCLEAR TESTING;4:H/N AND ATMOSPHERIC TESTING;5:UNDERGROUND NUCLEAR TESTING;6:EXPOSURE AT NUCLEAR FACILITY;7:OTHER;^.321;12
481"DATA",64850001,.3213,0)
482AGENT ORANGE EXPOSURE LOCATION^RSX^K:KOREAN DMZ;V:VIETNAM;O:OTHER;^.321;13
483"DATA",64850001,.3214,0)
484FILIPINO VETERAN PROOF^S^PP:US PASSPORT;BC:US BIRTH CERTIFICATE;BA:REPORT OF BIRTH ABROAD OF US CITIZEN;NA:VERIFICATION OF NATURALIZATION;PR:VERIFICATION OF PERMANENT RESIDENCY;VA:VA COMPENSATION AT FULL DOLLAR RATE;NO:NO PROOF;^.321;14
485"DATA",64850001,.3215,0)
486SERVICE [OEF OR OIF]^2.3215IS^^.3215;0
487"DATA",64850001,.322,0)
488SERVICE VERIFICATION DATE^DX^^.32;2
489"DATA",64850001,.32201,0)
490PERSIAN GULF SERVICE?^RSX^Y:YES;N:NO;U:UNKNOWN;^.322;10
491"DATA",64850001,.322011,0)
492PERSIAN GULF FROM DATE^RDX^^.322;11
493"DATA",64850001,.322012,0)
494PERSIAN GULF TO DATE^RDX^^.322;12
495"DATA",64850001,.322013,0)
496SOUTHWEST ASIA CONDITIONS?^RSX^Y:YES;N:NO;U:UNKNOWN;^.322;13
497"DATA",64850001,.322014,0)
498SW ASIA COND REGISTRATION DATE^DX^^.322;14
499"DATA",64850001,.322015,0)
500SW ASIA COND EXAM DATE^DX^^.322;15
501"DATA",64850001,.322016,0)
502SOMALIA SERVICE INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.322;16
503"DATA",64850001,.322017,0)
504SOMALIA FROM DATE^RDX^^.322;17
505"DATA",64850001,.322018,0)
506SOMALIA TO DATE^RDX^^.322;18
507"DATA",64850001,.322019,0)
508YUGOSLAVIA SERVICE INDICATED?^SX^Y:YES;N:NO;U:UNKNOWN;^.322;19
509"DATA",64850001,.32202,0)
510YUGOSLAVIA FROM DATE^RDX^^.322;20
511"DATA",64850001,.322021,0)
512YUGOSLAVIA TO DATE^RDX^^.322;21
513"DATA",64850001,.3221,0)
514LEBANON SERVICE INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.322;1
515"DATA",64850001,.3222,0)
516LEBANON FROM DATE^RDX^^.322;2
517"DATA",64850001,.3223,0)
518LEBANON TO DATE^RDX^^.322;3
519"DATA",64850001,.3224,0)
520GRENADA SERVICE INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.322;4
521"DATA",64850001,.3225,0)
522GRENADA FROM DATE^RDX^^.322;5
523"DATA",64850001,.3226,0)
524GRENADA TO DATE^RDX^^.322;6
525"DATA",64850001,.3227,0)
526PANAMA SERVICE INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.322;7
527"DATA",64850001,.3228,0)
528PANAMA FROM DATE^RDX^^.322;8
529"DATA",64850001,.3229,0)
530PANAMA TO DATE^RDX^^.322;9
531"DATA",64850001,.323,0)
532PERIOD OF SERVICE^*P21'Xa^DIC(21,^.32;3
533"DATA",64850001,.324,0)
534SERVICE DISCHARGE TYPE [LAST]^RP25'X^DIC(25,^.32;4
535"DATA",64850001,.325,0)
536SERVICE BRANCH [LAST]^P23'X^DIC(23,^.32;5
537"DATA",64850001,.326,0)
538SERVICE ENTRY DATE [LAST]^RDX^^.32;6
539"DATA",64850001,.327,0)
540SERVICE SEPARATION DATE [LAST]^RDX^^.32;7
541"DATA",64850001,.328,0)
542SERVICE NUMBER [LAST]^FX^^.32;8
543"DATA",64850001,.3285,0)
544SERVICE SECOND EPISODE?^RSX^Y:YES;N:NO;^.32;19
545"DATA",64850001,.329,0)
546SERVICE DISCHARGE TYPE [NTL]^RP25'X^DIC(25,^.32;9
547"DATA",64850001,.3291,0)
548SERVICE BRANCH [NTL]^P23'X^DIC(23,^.32;10
549"DATA",64850001,.32911,0)
550SERVICE COMPONENT [LAST]^*S^R:REGULAR;V:ACTIVATED RESERVE;G:ACTIVATED NG;^.3291;1
551"DATA",64850001,.32912,0)
552SERVICE COMPONENT [NTL]^*SX^R:REGULAR;V:ACTIVATED RESERVE;G:ACTIVATED NG;^.3291;2
553"DATA",64850001,.32913,0)
554SERVICE COMPONENT [NNTL]^*SX^R:REGULAR;V:ACTIVATED RESERVE;G:ACTIVATED NG;^.3291;3
555"DATA",64850001,.3292,0)
556SERVICE ENTRY DATE [NTL]^RDX^^.32;11
557"DATA",64850001,.3293,0)
558SERVICE SEPARATION DATE [NTL]^RDX^^.32;12
559"DATA",64850001,.3294,0)
560SERVICE NUMBER [NTL]^FX^^.32;13
561"DATA",64850001,.32945,0)
562SERVICE THIRD EPISODE?^RSX^Y:YES;N:NO;^.32;20
563"DATA",64850001,.3295,0)
564SERVICE DISCHARGE TYPE [NNTL]^RP25'X^DIC(25,^.32;14
565"DATA",64850001,.3296,0)
566SERVICE BRANCH [NNTL]^P23'X^DIC(23,^.32;15
567"DATA",64850001,.3297,0)
568SERVICE ENTRY DATE [NNTL]^RDX^^.32;16
569"DATA",64850001,.3298,0)
570SERVICE SEPARATION DATE [NNTL]^RDX^^.32;17
571"DATA",64850001,.3299,0)
572SERVICE NUMBER [NNTL]^FX^^.32;18
573"DATA",64850001,.3412,0)
574DESIGNEE CHANGE DATE/TIME^DX^^.332;3
575"DATA",64850001,.352,0)
576DEATH ENTERED BY^P200'^VA(200,^.35;2
577"DATA",64850001,.353,0)
578SOURCE OF NOTIFICATION^S^1:INPATIENT AT VAMC;2:NON-VA MEDICAL FACILITY;3:DEATH CERTIFICATE ON FILE;4:VBA;5:VA INSURANCE;6:SSA;7:NCA;8:NEXT OF KIN/FAMILY/FRIEND;9:OTHER;^.35;3
579"DATA",64850001,.355,0)
580LAST EDITED BY^P200'^VA(200,^.35;5
581"DATA",64850001,.3601,0)
582COLLATERAL SPONSOR'S NAME^R*P2'^DPT(^.36;11
583"DATA",64850001,.3602,0)
584MILITARY DISABILITY RETIREMENT^SX^1:YES;0:NO;^.36;12
585"DATA",64850001,.3603,0)
586DISCHARGE DUE TO DISABILITY^SX^1:YES;0:NO;^.36;13
587"DATA",64850001,.361,0)
588PRIMARY ELIGIBILITY CODE^*P8'Xa^DIC(8,^.36;1
589"DATA",64850001,.3611,0)
590ELIGIBILITY STATUS^SX^P:PENDING VERIFICATION;R:PENDING RE-VERIFICATION;V:VERIFIED;^.361;1
591"DATA",64850001,.3612,0)
592ELIGIBILITY STATUS DATE^DX^^.361;2
593"DATA",64850001,.3613,0)
594ELIGIBILITY VERIF. SOURCE^S^H:HEC;V:VISTA;^.361;3
595"DATA",64850001,.3614,0)
596ELIGIBILITY INTERIM RESPONSE^DX^^.361;4
597"DATA",64850001,.3615,0)
598ELIGIBILITY VERIF. METHOD^FX^^.361;5
599"DATA",64850001,.3616,0)
600ELIGIBILITY STATUS ENTERED BY^P200'^VA(200,^.361;6
601"DATA",64850001,.3617,0)
602USER ENROLLEE VALID THROUGH^DX^^.361;7
603"DATA",64850001,.3618,0)
604USER ENROLLEE SITE^P4'^DIC(4,^.361;8
605"DATA",64850001,.362,0)
606DISABILITY RET. FROM MILITARY?^RSX^0:NO;1:YES, RECEIVING MILITARY RETIREMENT;2:YES, RECEIVING MILITARY RETIREMENT IN LIEU OF VA COMPENSATION;3:UNKNOWN;^.36;2
607"DATA",64850001,.36205,0)
608RECEIVING A&A BENEFITS?^SX^Y:YES;N:NO;U:UNKNOWN;^.362;12
609"DATA",64850001,.3621,0)
610AMOUNT OF AID & ATTENDANCE^NJ10,2X^^.362;1
611"DATA",64850001,.36215,0)
612RECEIVING HOUSEBOUND BENEFITS?^SX^Y:YES;N:NO;U:UNKNOWN;^.362;13
613"DATA",64850001,.3622,0)
614AMOUNT OF HOUSEBOUND^NJ10,2X^^.362;2
615"DATA",64850001,.36225,0)
616RECEIVING SOCIAL SECURITY?^SX^Y:YES;N:NO;U:UNKNOWN;^.362;15
617"DATA",64850001,.36235,0)
618RECEIVING A VA PENSION?^SX^Y:YES;N:NO;U:UNKNOWN;^.362;14
619"DATA",64850001,.3624,0)
620AMOUNT OF VA PENSION^NJ10,2X^^.362;4
621"DATA",64850001,.3625,0)
622*AMOUNT OF MILITARY RETIREMENT^NJ10,2X^^.362;5
623"DATA",64850001,.36255,0)
624RECEIVING MILITARY RETIREMENT?^SX^Y:YES;N:NO;U:UNKNOWN;^.362;16
625"DATA",64850001,.3626,0)
626AMOUNT OF GI INSURANCE^NJ8,2X^^.362;6
627"DATA",64850001,.36265,0)
628GI INSURANCE POLICY?^SX^Y:YES;N:NO;U:UNKNOWN;^.362;17
629"DATA",64850001,.36275,0)
630RECEIVING SUP. SECURITY (SSI)?^S^Y:YES;N:NO;U:UNKNOWN;^.362;19
631"DATA",64850001,.3628,0)
632AMOUNT OF OTHER RETIREMENT^NJ8,2X^^.362;8
633"DATA",64850001,.36285,0)
634TYPE OF OTHER RETIREMENT^SX^B:BLACK LUNG;M:MILITARY;C:CIVIL;R:RAILROAD;O:OTHER;X:COMBINATIONS OF TYPES;^.362;18
635"DATA",64850001,.3629,0)
636AMOUNT OF OTHER INCOME^NJ8,2X^^.362;9
637"DATA",64850001,.36295,0)
638TOTAL ANNUAL VA CHECK AMOUNT^NJ8,2X^^.362;20
639"DATA",64850001,.364,0)
640PRIMARY SHORT ID^F^^.36;4
641"DATA",64850001,.368,0)
642SERVICE DENTAL INJURY?^S^Y:YES;N:NO;^.36;8
643"DATA",64850001,.369,0)
644SERVICE TEETH EXTRACTED?^S^Y:YES;N:NO;^.36;9
645"DATA",64850001,.37,0)
646DATE OF DENTAL TREATMENT^2.11D^^.37;0
647"DATA",64850001,.3721,0)
648RATED DISABILITIES (VA)^2.04P^^.372;0
649"DATA",64850001,.3731,0)
650SERVICE CONNECTED CONDITIONS^2.05A^^.373;0
651"DATA",64850001,.381,0)
652ELIGIBLE FOR MEDICAID?^RS^1:YES;0:NO;^.38;1
653"DATA",64850001,.382,0)
654DATE MEDICAID LAST ASKED^RD^^.38;2
655"DATA",64850001,.39,0)
656VETERAN CATASTROPHICALLY DISABLED?^S^Y:YES;N:NO;^.39;6
657"DATA",64850001,.391,0)
658DECIDED BY^F^^.39;1
659"DATA",64850001,.392,0)
660DATE OF DECISION^DX^^.39;2
661"DATA",64850001,.393,0)
662FACILITY MAKING DETERMINATION^P4'^DIC(4,^.39;3
663"DATA",64850001,.394,0)
664REVIEW DATE^D^^.39;4
665"DATA",64850001,.395,0)
666METHOD OF DETERMINATION^S^2:MEDICAL RECORD REVIEW;3:PHYSICAL EXAMINATION;^.39;5
667"DATA",64850001,.3951,0)
668DATE VETERAN REQUESTED CD EVAL^D^^.39;7
669"DATA",64850001,.3952,0)
670DATE FACILITY INITIATED REVIEW^D^^.39;8
671"DATA",64850001,.3953,0)
672DATE VETERAN WAS NOTIFIED^D^^.39;9
673"DATA",64850001,.396,0)
674CD STATUS DIAGNOSES^2.396P^^.396;0
675"DATA",64850001,.397,0)
676CD STATUS PROCEDURES^2.397P^^.397;0
677"DATA",64850001,.398,0)
678CD STATUS CONDITIONS^2.398P^^.398;0
679"DATA",64850001,.399,0)
680CD HISTORY DATE^2.399DA^^.399;0
681"DATA",64850001,.525,0)
682POW STATUS INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.52;5
683"DATA",64850001,.526,0)
684POW CONFINEMENT LOCATION^RP22'X^DIC(22,^.52;6
685"DATA",64850001,.527,0)
686POW FROM DATE^RDX^^.52;7
687"DATA",64850001,.528,0)
688POW TO DATE^RDX^^.52;8
689"DATA",64850001,.529,0)
690POW STATUS VERIFIED^D^^.52;9
691"DATA",64850001,.5291,0)
692COMBAT SERVICE INDICATED?^RSX^Y:YES;N:NO;^.52;11
693"DATA",64850001,.5292,0)
694COMBAT SERVICE LOCATION^RP22'X^DIC(22,^.52;12
695"DATA",64850001,.5293,0)
696COMBAT FROM DATE^RDX^^.52;13
697"DATA",64850001,.5294,0)
698COMBAT TO DATE^RDX^^.52;14
699"DATA",64850001,.5295,0)
700COMBAT VETERAN END DATE^D^^.52;15
701"DATA",64850001,.5296,0)
702CV DATE EDITED^D^^.52;16
703"DATA",64850001,.531,0)
704CURRENT PH INDICATOR^SX^Y:YES;N:NO;^.53;1
705"DATA",64850001,.532,0)
706CURRENT PURPLE HEART STATUS^S^1:PENDING;2:IN PROCESS;3:CONFIRMED;^.53;2
707"DATA",64850001,.533,0)
708CURRENT PURPLE HEART REMARKS^S^1:UNACCEPTABLE DOCUMENTATION;2:NO DOCUMENTATION REC'D;3:ENTERED IN ERROR;4:UNSUPPORTED PURPLE HEART;5:VAMC;6:UNDELIVERABLE MAIL;^.53;3
709"DATA",64850001,.535,0)
710PH DIVISION^P4'^DIC(4,^.53;4
711"DATA",64850001,.6,0)
712TEST PATIENT INDICATOR^SI^1:YES;0:NO;^0;21
713"DATA",64850001,1.01,0)
714NAME COMPONENTS
715"DATA",64850001,2.0361,0)
716PATIENT ELIGIBILITIES
717"DATA",64850001,27.01,0)
718CURRENT ENROLLMENT^P27.11'I^DGEN(27.11,^ENR;1
719"DATA",64850001,53,0)
720*REACTIONS^S^Y:YES;N:NO;^PI;1
721"DATA",64850001,57.1,0)
722*HEIGHT(cm)^NJ3,0^^57;1
723"DATA",64850001,57.2,0)
724*WEIGHT(kg)^NJ3,0^^57;2
725"DATA",64850001,57.4,0)
726SPINAL CORD INJURY^S^1:PARAPLEGIA-TRAUMATIC;2:QUADRIPLEGIA-TRAUMATIC;3:PARAPLEGIA-NONTRAUMATIC;4:QUADRIPLEGIA-NONTRAUMATIC;X:NOT APPLICABLE;^57;4
727"DATA",64850001,63,0)
728LABORATORY REFERENCE^IP63X^LR(^LR;1
729"DATA",64850001,67,0)
730LAB REFERRAL REF^P67'X^LRT(67,^LRT;1
731"DATA",64850001,148,0)
732CNH CURRENT^S^Y:YES;N:NO;^NHC;1
733"DATA",64850001,220,0)
734DENTAL CLASSIFICATION^P220.2'^DIC(220.2,^DENT;1
735"DATA",64850001,220.1,0)
736DENTAL ELIGIBILITY EXPIRATION^D^^DENT;2
737"DATA",64850001,361,0)
738PATIENT ELIGIBILITIES^2.0361IP^^E;0
739"DATA",64850001,391,0)
740TYPE^P391'a^DG(391,^TYPE;1
741"DATA",64850001,401.3,0)
742CONDITION^S^S:SERIOUSLY ILL;^DAC;1
743"DATA",64850001,401.4,0)
744DATE ENTERED ON SI LIST^RDX^^DAC;2
745"DATA",64850001,534,0)
746PH DATE/TIME UPDATED^2.0534DA^^PH;0
747"DATA",64850001,991.01,0)
748INTEGRATION CONTROL NUMBER^NJ12,0Xa^^MPI;1
749"DATA",64850001,991.02,0)
750ICN CHECKSUM^Fa^^MPI;2
751"DATA",64850001,991.03,0)
752COORDINATING MASTER OF RECORD^P4'a^DIC(4,^MPI;3
753"DATA",64850001,991.04,0)
754LOCALLY ASSIGNED ICN^Sa^1:YES;^MPI;4
755"DATA",64850001,991.05,0)
756SUBSCRIPTION CONTROL NUMBER^P774'Ia^HLS(774,^MPI;5
757"DATA",64850001,991.06,0)
758CMOR ACTIVITY SCORE^NJ7,0a^^MPI;6
759"DATA",64850001,991.07,0)
760SCORE CALCULATION DATE^Da^^MPI;7
761"DATA",64850001,992,0)
762ICN HISTORY^2.0992A^^MPIFHIS;0
763"DATA",64850001,993,0)
764CMOR HISTORY^2.0993A^^MPICMOR;0
765"DATA",64850001,1010.15,0)
766RECEIVED VA CARE PREVIOUSLY?^RS^Y:YES;N:NO;^1010.15;5
767"DATA",64850001,1010.151,0)
768MOST RECENT DATE OF CARE^DX^^1010.15;1
769"DATA",64850001,1010.1511,0)
770APPOINTMENT REQUEST DATE^D^^1010.15;11
771"DATA",64850001,1010.152,0)
772MOST RECENT LOCATION OF CARE^P4'^DIC(4,^1010.15;2
773"DATA",64850001,1010.153,0)
7742ND MOST RECENT DATE OF CARE^DX^^1010.15;3
775"DATA",64850001,1010.154,0)
7762ND MOST RECENT LOCATION^P4'^DIC(4,^1010.15;4
777"DATA",64850001,1010.156,0)
778MOST RECENT 1010EZ^P712'I^EAS(712,^1010.15;6
779"DATA",64850001,1010.157,0)
780COMBAT INDICATED ON 1010EZ^S^0:NO;1:YES;^1010.15;7
781"DATA",64850001,1010.158,0)
782DISABILITY DISCHARGE ON 1010EZ^S^0:NO;1:YES;^1010.15;8
783"DATA",64850001,1010.159,0)
784APPOINTMENT REQUEST ON 1010EZ^S^0:NO;1:YES;^1010.15;9
785"DATA",64850001,1010.161,0)
786APPOINTMENT REQUEST STATUS^S^C:CANCELLED;E:EWL;F:FILLED;I:IN PROCESS/VETERAN CONTACTED;^1010.16;1
787"DATA",64850001,1010.162,0)
788DATE STATUS LAST EDITED^D^^1010.16;2
789"DATA",64850001,1010.163,0)
790APPOINTMENT REQUEST COMMENT^F^^1010.16;3
791"DATA",64850001,1010.164,0)
792DATE COMMENT LAST EDITED^D^^1010.16;4
793"DATA",64850001,1100.02,0)
794FFF ENTERED BY^P200'^VA(200,^FFP;2
795"DATA",64850001,1100.03,0)
796FFF DATE ENTERED^D^^FFP;3
797"DATA",64850001,1100.04,0)
798FFF REMOVED BY^P200'^VA(200,^FFP;4
799"DATA",64850001,1100.05,0)
800FFF DATE REMOVED^D^^FFP;5
801"DATA",64850001,1100.09,0)
802FFF REMOVAL REMARKS^F^^FFP;9
803"DATA",64850001,1900,0)
804APPOINTMENT^2.98P^^S;0
805"DATA",64850001,1901,0)
806VETERAN (Y/N)?^SXa^Y:YES;N:NO;^VET;1
807"DATA",64850001,1903,0)
808ARCHIVED DATA^2.12SA^^ARCH;0
809"DATA",64850001,11500.01,0)
810INITIAL ODS TREATMENT RECEIVED^D^^ODS;1
811"DATA",64850001,11500.02,0)
812RECALLED TO ACTIVE DUTY^S^0:NO;1:NATIONAL GUARD;2:RESERVES;^ODS;2
813"DATA",64850001,11500.03,0)
814RANK^*P25002.1'^DIC(25002.1,^ODS;3
815"DATA",64850001,19900,0)
816ALTERNATE PHONE NUMBER^F^^19900;1
817"DATA",64850001,19902,0)
818IS PATIENT A VETERAN^S^Y:YES;N:NO;^19900;3
819"DATA",64850001,19905,0)
820YEAR ARRIVED IN COUNTRY^NJ4,0^^19900;6
821"DATA",64850001,537025,0)
822NETWORK IDENTIFIER^F^^537025;1
823"DATA",64850002,1,0)
824ALIAS^1^DEMOG
825"DATA",64850002,1,"M",1,0)
826ALIAS^.01;2.01^
827"DATA",64850002,1,"M",2,0)
828ALIAS SSN^1;2.01^
829"DATA",64850002,2,0)
830AMOUNT OF SSI^.3627^MB
831"DATA",64850002,3,0)
832CITY^.114^DEMOG
833"DATA",64850002,4,0)
834CONFIDENTIAL ADDR COUNTRY^.14116^
835"DATA",64850002,5,0)
836CONFIDENTIAL ADDR POSTAL CODE^.14115^
837"DATA",64850002,6,0)
838CONFIDENTIAL ADDR PROVINCE^.14114^
839"DATA",64850002,7,0)
840CONFIDENTIAL ADDRESS ACTIVE?^.14105^
841"DATA",64850002,8,0)
842CONFIDENTIAL ADDRESS CITY^.1414^
843"DATA",64850002,9,0)
844CONFIDENTIAL ADDRESS COUNTY^.14111^
845"DATA",64850002,10,0)
846CONFIDENTIAL ADDRESS STATE^.1415^
847"DATA",64850002,11,0)
848CONFIDENTIAL ADDRESS ZIP CODE^.1416^
849"DATA",64850002,12,0)
850CONFIDENTIAL END DATE^.1418^
851"DATA",64850002,13,0)
852CONFIDENTIAL PHONE NUMBER^.1315^
853"DATA",64850002,14,0)
854CONFIDENTIAL START DATE^.1417^
855"DATA",64850002,15,0)
856CONFIDENTIAL STREET [LINE 1]^.1411^
857"DATA",64850002,16,0)
858CONFIDENTIAL STREET [LINE 2]^.1412^
859"DATA",64850002,17,0)
860CONFIDENTIAL STREET [LINE 3]^.1413^
861"DATA",64850002,18,0)
862COUNTRY^.1173^DEMOG
863"DATA",64850002,19,0)
864COUNTY^.117^DEMOG
865"DATA",64850002,20,0)
866Cell Phone^.134^DEMOG
867"DATA",64850002,21,0)
868D-CITY^.346^D1
869"DATA",64850002,22,0)
870D-DESIGNEE SAME AS NOK?^.3405^D1
871"DATA",64850002,23,0)
872D-PHONE NUMBER^.349^D1
873"DATA",64850002,24,0)
874D-RELATIONSHIP TO PATIENT^.342^D1
875"DATA",64850002,25,0)
876D-STATE^.347^D1
877"DATA",64850002,26,0)
878D-STREET ADDRESS [LINE 1]^.343^D1
879"DATA",64850002,27,0)
880D-STREET ADDRESS [LINE 2]^.344^D1
881"DATA",64850002,28,0)
882D-STREET ADDRESS [LINE 3]^.345^D1
883"DATA",64850002,29,0)
884D-WORK PHONE NUMBER^.34011^
885"DATA",64850002,30,0)
886D-ZIP CODE^.348^D1
887"DATA",64850002,31,0)
888D-ZIP+4^.2202^D1
889"DATA",64850002,32,0)
890DATE OF DEATH^.351^
891"DATA",64850002,33,0)
892DATE OF DEATH LAST UPDATED^.354^
893"DATA",64850002,34,0)
894DISPOSITION LOG-IN DATE/TIME^1000^
895"DATA",64850002,34,"M",1,0)
896A-ADDRESS 1^31;2.101
897"DATA",64850002,34,"M",2,0)
898A-ADDRESS 2^32;2.101
899"DATA",64850002,34,"M",3,0)
900A-ADDRESS 3^33;2.101
901"DATA",64850002,34,"M",4,0)
902A-CITY^34;2.101
903"DATA",64850002,34,"M",5,0)
904A-PHONE^37;2.101
905"DATA",64850002,34,"M",6,0)
906A-STATE^35;2.101
907"DATA",64850002,34,"M",7,0)
908A-ZIP CODE^36;2.101
909"DATA",64850002,34,"M",8,0)
910A-ZIP+4^38;2.101
911"DATA",64850002,34,"M",9,0)
912ACTIVE^50;2.101
913"DATA",64850002,34,"M",10,0)
914ATTORNEY'S NAME^30;2.101
915"DATA",64850002,34,"M",11,0)
916DESCRIPTION OF INCIDENT^10;2.101
917"DATA",64850002,34,"M",12,0)
918DISPOSITION^6;2.101
919"DATA",64850002,34,"M",13,0)
920FACILITY APPLYING TO^3;2.101
921"DATA",64850002,34,"M",14,0)
922FILED AGAINST INJURING PARTY^26;2.101
923"DATA",64850002,34,"M",15,0)
924INJURING PARTIES INSURANCE^25;2.101
925"DATA",64850002,34,"M",16,0)
926INJURY CAUSED BY^24;2.101
927"DATA",64850002,34,"M",17,0)
928LOG IN DATE/TIME^.01;2.101
929"DATA",64850002,34,"M",18,0)
930LOG OUT DATE TIME^5;2.101
931"DATA",64850002,34,"M",19,0)
932NEED RELATED TO AN ACCIDENT^23;2.101
933"DATA",64850002,34,"M",20,0)
934NEED RELATED TO OCCUPATION^20;2.101
935"DATA",64850002,34,"M",21,0)
936OUTPATIENT ENCOUNTER^18;2.101
937"DATA",64850002,34,"M",22,0)
938REASON FOR LATE DISPOSITION^8;2.101
939"DATA",64850002,34,"M",23,0)
940REGISTRATION ELIGIBILITY CODE^13;2.101
941"DATA",64850002,34,"M",24,0)
942STATUS^1;2.101
943"DATA",64850002,34,"M",25,0)
944TYPE OF BENEFIT APPLIED FOR^2;2.101
945"DATA",64850002,34,"M",26,0)
946TYPE OF CARE APPLIED FOR^2.1;2.101
947"DATA",64850002,34,"M",27,0)
948WORKMEN'S COMP CLAIM FILED^21;2.101
949"DATA",64850002,34,"M",28,0)
950WORKMEN'S COMP CLAIM NUMBER^22;2.101
951"DATA",64850002,35,0)
952E-CITY^.336^EC1
953"DATA",64850002,36,0)
954E-CONTACT CHANGE DATE/TIME^.33012^
955"DATA",64850002,37,0)
956E-EMER. CONTACT SAME AS NOK?^.3305^EC1
957"DATA",64850002,38,0)
958E-NAME^.331^EC1
959"DATA",64850002,39,0)
960E-PHONE NUMBER^.339^EC1
961"DATA",64850002,40,0)
962E-RELATIONSHIP TO PATIENT^.332^EC1
963"DATA",64850002,41,0)
964E-STATE^.337^EC1
965"DATA",64850002,42,0)
966E-STREET ADDRESS [LINE 1]^.333^EC1
967"DATA",64850002,43,0)
968E-STREET ADDRESS [LINE 2]^.334^EC1
969"DATA",64850002,44,0)
970E-STREET ADDRESS [LINE 3]^.335^EC1
971"DATA",64850002,45,0)
972E-WORK PHONE NUMBER^.33011^
973"DATA",64850002,46,0)
974E-ZIP CODE^.338^EC1
975"DATA",64850002,47,0)
976E-ZIP+4^.2201^EC1
977"DATA",64850002,48,0)
978E2-CITY^.3316^EC2
979"DATA",64850002,49,0)
980E2-CONTACT CHANGE DATE/TIME^.33112^
981"DATA",64850002,50,0)
982E2-NAME OF SECONDARY CONTACT^.3311^EC2
983"DATA",64850002,51,0)
984E2-PHONE NUMBER^.3319^EC2
985"DATA",64850002,52,0)
986E2-RELATIONSHIP TO PATIENT^.3312^EC2
987"DATA",64850002,53,0)
988E2-STATE^.3317^EC2
989"DATA",64850002,54,0)
990E2-STREET ADDRESS [LINE 1]^.3313^EC2
991"DATA",64850002,55,0)
992E2-STREET ADDRESS [LINE 2]^.3314^EC2
993"DATA",64850002,56,0)
994E2-STREET ADDRESS [LINE 3]^.3315^EC2
995"DATA",64850002,57,0)
996E2-WORK PHONE NUMBER^.331011^
997"DATA",64850002,58,0)
998E2-ZIP CODE^.3318^EC2
999"DATA",64850002,59,0)
1000E2-ZIP+4^.2204^EC2
1001"DATA",64850002,60,0)
1002EMAIL ADDRESS^.133^
1003"DATA",64850002,61,0)
1004EMERGENCY CONTACT^.331^EC1
1005"DATA",64850002,62,0)
1006EMERGENCY CONTACT-2^.3311^EC2
1007"DATA",64850002,63,0)
1008EMPLOYER CITY^.3116^EM1
1009"DATA",64850002,64,0)
1010EMPLOYER NAME^.3111^EM1
1011"DATA",64850002,65,0)
1012EMPLOYER PHONE NUMBER^.3119^EM1
1013"DATA",64850002,66,0)
1014EMPLOYER STATE^.3117^EM1
1015"DATA",64850002,67,0)
1016EMPLOYER STREET [LINE 1]^.3113^EM1
1017"DATA",64850002,68,0)
1018EMPLOYER STREET [LINE 2]^.3114^EM1
1019"DATA",64850002,69,0)
1020EMPLOYER STREET [LINE 3]^.3115^EM1
1021"DATA",64850002,70,0)
1022EMPLOYER ZIP CODE^.3118^EM1
1023"DATA",64850002,71,0)
1024EMPLOYER ZIP+4^.2205^EM1
1025"DATA",64850002,72,0)
1026EMPLOYMENT STATUS^.31115^PEMP
1027"DATA",64850002,73,0)
1028END DATE OF TEMP ADDRESS^.1218^TAD
1029"DATA",64850002,74,0)
1030ENROLLMENT CLINIC^3^
1031"DATA",64850002,74,"M",0)
10322.001P^^^
1033"DATA",64850002,74,"M",1,0)
1034CURRENT STATUS^2;2.001
1035"DATA",64850002,74,"M",2,0)
1036ENROLLMENT CLINIC^.01;2.001
1037"DATA",64850002,74,"M",3,0)
1038ENROLLMENT DATA^1;2.001
1039"DATA",64850002,74,"M",3,"MM",0)
10402.011DA^^^
1041"DATA",64850002,74,"M",3,"MM",1,0)
1042DATE OF ENROLLMENT^3;2.011
1043"DATA",64850002,74,"M",3,"MM",2,0)
1044OPT OR AC^1;2.011
1045"DATA",64850002,74,"M",3,"MM",3,0)
1046DATE OF DISCHARGE^3;2.011
1047"DATA",64850002,74,"M",3,"MM",4,0)
1048REASON FOR DISCHARGE^4;2.011
1049"DATA",64850002,74,"M",3,"MM",5,0)
1050REVIEW DATE^5;2.011
1051"DATA",64850002,75,0)
1052ETHNICITY INFORMATION^6^
1053"DATA",64850002,75,"M",0)
10542.06PA^^
1055"DATA",64850002,75,"M",1,0)
1056ETHNICITY INFORMATION^.01;2.06
1057"DATA",64850002,76,0)
1058Email Address^.133^
1059"DATA",64850002,77,0)
1060FATHER'S COUNTRY OF BIRTH^19904^
1061"DATA",64850002,78,0)
1062FATHER'S NAME^.2401^
1063"DATA",64850002,79,0)
1064FUGITIVE FELON FLAG^1100.01^FFP
1065"DATA",64850002,80,0)
1066GOVERNMENT AGENCY^.3112^
1067"DATA",64850002,81,0)
1068HEALTH RECORD NO.^64850001^
1069"DATA",64850002,82,0)
1070INSURANCE TYPE^.3121^II
1071"DATA",64850002,82,"M",0)
10722.312IPA^^
1073"DATA",64850002,82,"M",1,0)
1074COMMENT - PATIENT POLICY^1.08;2.312
1075"DATA",64850002,82,"M",2,0)
1076COORDINATION OF BENEFITS^.2;2.312
1077"DATA",64850002,82,"M",3,0)
1078DATE ENTERED^1.01;2.312
1079"DATA",64850002,82,"M",4,0)
1080DATE LAST EDITED^1.05;2.312
1081"DATA",64850002,82,"M",5,0)
1082DATE LAST VERIFIED^1.03;2.312
1083"DATA",64850002,82,"M",6,0)
1084DATE OF SOURCE OF INFORMATION^1.1;2.312
1085"DATA",64850002,82,"M",7,0)
1086EFFECTIVE DATE OF POLICY^8;2.312
1087"DATA",64850002,82,"M",8,0)
1088EIV AUTO-UPDATE^4.04;2.312
1089"DATA",64850002,82,"M",9,0)
1090ELIGIBILITY/BENEFIT^60;2.312
1091"DATA",64850002,82,"M",10,0)
1092EMPLOY CLAIM ST ADDRESS LINE 2^2.03;2.312
1093"DATA",64850002,82,"M",11,0)
1094EMPLOY CLAIM ST ADDRESS LINE 3^2.04;2.312
1095"DATA",64850002,82,"M",12,0)
1096EMPLOYER CLAIMS CITY^2.05;2.312
1097"DATA",64850002,82,"M",13,0)
1098EMPLOYER CLAIMS PHONE^2.08;2.312
1099"DATA",64850002,82,"M",14,0)
1100EMPLOYER CLAIMS STATE^2.06;2.312
1101"DATA",64850002,82,"M",15,0)
1102EMPLOYER CLAIMS STREET ADDRESS^2.02;2.312
1103"DATA",64850002,82,"M",16,0)
1104EMPLOYER CLAIMS ZIP CODE^2.07;2.312
1105"DATA",64850002,82,"M",17,0)
1106EMPLOYMENT STATUS^2.11;2.312
1107"DATA",64850002,82,"M",18,0)
1108ENTERED BY^1.02;2.312
1109"DATA",64850002,82,"M",19,0)
1110ESGHP^2.1;2.312
1111"DATA",64850002,82,"M",20,0)
1112GROUP PLAN^.18;2.312
1113"DATA",64850002,82,"M",21,0)
1114INSURANCE EXPIRATION DATE^3;2.312
1115"DATA",64850002,82,"M",22,0)
1116INSURANCE NUMBER^1;2.312
1117"DATA",64850002,82,"M",23,0)
1118INSURANCE TYPE^.01;2.312
1119"DATA",64850002,82,"M",24,0)
1120INSURED'S BRANCH^3.02;2.312
1121"DATA",64850002,82,"M",25,0)
1122INSURED'S CITY^3.08;2.312
1123"DATA",64850002,82,"M",26,0)
1124INSURED'S DOB^3.01;2.312
1125"DATA",64850002,82,"M",27,0)
1126INSURED'S PHONE^3.11;2.312
1127"DATA",64850002,82,"M",28,0)
1128INSURED'S RANK^3.03;2.312
1129"DATA",64850002,82,"M",29,0)
1130INSURED'S SEX^3.12;2.312
1131"DATA",64850002,82,"M",30,0)
1132INSURED'S SSN^3.05;2.312
1133"DATA",64850002,82,"M",31,0)
1134INSURED'S STATE^3.09;2.312
1135"DATA",64850002,82,"M",32,0)
1136INSURED'S STREET 1^3.06;2.312
1137"DATA",64850002,82,"M",33,0)
1138INSURED'S STREET 2^3.07;2.312
1139"DATA",64850002,82,"M",34,0)
1140INSURED'S ZIP^3.1;2.312
1141"DATA",64850002,82,"M",35,0)
1142LAST EDITED BY^1.06;2.312
1143"DATA",64850002,82,"M",36,0)
1144NAME OF INSURED^17;2.312
1145"DATA",64850002,82,"M",37,0)
1146NEW GROUP NAME^20;2.312
1147"DATA",64850002,82,"M",38,0)
1148NEW GROUP NUMBER^21;2.312
1149"DATA",64850002,82,"M",39,0)
1150PATIENT ID^5.01;2.312
1151"DATA",64850002,82,"M",40,0)
1152PATIENT'S SEC QUALIFIER^1
1153"DATA",64850002,82,"M",41,0)
1154PATIENT'S SEC QUALIFIER^2
1155"DATA",64850002,82,"M",42,0)
1156PATIENT'S SEC QUALIFIER^3
1157"DATA",64850002,82,"M",43,0)
1158PATIENT'S SECONDARY ID^1
1159"DATA",64850002,82,"M",44,0)
1160PATIENT'S SECONDARY ID^2
1161"DATA",64850002,82,"M",45,0)
1162PATIENT'S SECONDARY ID^3
1163"DATA",64850002,82,"M",46,0)
1164POLICY NOT BILLABLE^3.04;2.312
1165"DATA",64850002,82,"M",47,0)
1166PRIMARY CARE PROVIDER^4.01;2.312
1167"DATA",64850002,82,"M",48,0)
1168PRIMARY PROVIDER PHONE^4.02;2.312
1169"DATA",64850002,82,"M",49,0)
1170PT. RELATIONSHIP - HIPAA^4.03;2.312
1171"DATA",64850002,82,"M",50,0)
1172PT. RELATIONSHIP TO INSURED^16;2.312
1173"DATA",64850002,82,"M",51,0)
1174RETIREMENT DATE^2.12;2.312
1175"DATA",64850002,82,"M",52,0)
1176SEND BILL TO EMPLOYER^2.01;2.312
1177"DATA",64850002,82,"M",53,0)
1178SOURCE OF INFORMATION^1.09;2.312
1179"DATA",64850002,82,"M",54,0)
1180SUBSCRIBER ID^1;2.312
1181"DATA",64850002,82,"M",55,0)
1182SUBSCRIBER'S EMPLOYER NAME^2.015;2.312
1183"DATA",64850002,82,"M",56,0)
1184SUBSCRIBER'S SEC ID^1
1185"DATA",64850002,82,"M",57,0)
1186SUBSCRIBER'S SEC ID^2
1187"DATA",64850002,82,"M",58,0)
1188SUBSCRIBER'S SEC ID^3
1189"DATA",64850002,82,"M",59,0)
1190SUBSCRIBER'S SEC QUALIFIER^1
1191"DATA",64850002,82,"M",60,0)
1192SUBSCRIBER'S SEC QUALIFIER^2
1193"DATA",64850002,82,"M",61,0)
1194SUBSCRIBER'S SEC QUALIFIER^3
1195"DATA",64850002,82,"M",62,0)
1196VERIFIED BY^1.04;2.312
1197"DATA",64850002,82,"M",63,0)
1198WHOSE INSURANCE^6;2.312
1199"DATA",64850002,83,0)
1200INTERPRETER LANGUAGE^19906^
1201"DATA",64850002,83,"M",0)
12022.019906P^^
1203"DATA",64850002,83,"M",1,0)
1204INTERPRETER LANGUAGE^.01;2.019906
1205"DATA",64850002,84,0)
1206K-CITY^.216^NK1
1207"DATA",64850002,85,0)
1208K-NAME OF PRIMARY NOK^.211^NK1
1209"DATA",64850002,86,0)
1210K-PHONE NUMBER^.219^NK1
1211"DATA",64850002,87,0)
1212K-RELATIONSHIP TO PATIENT^.212^NK1
1213"DATA",64850002,88,0)
1214K-STATE^.217^NK1
1215"DATA",64850002,89,0)
1216K-STREET ADDRESS [LINE 1]^.213^NK1
1217"DATA",64850002,90,0)
1218K-STREET ADDRESS [LINE 2]^.214^NK1
1219"DATA",64850002,91,0)
1220K-STREET ADDRESS [LINE 3]^.215^NK1
1221"DATA",64850002,92,0)
1222K-WORK PHONE NUMBER^.21011^
1223"DATA",64850002,93,0)
1224K-ZIP CODE^.218^NK1
1225"DATA",64850002,94,0)
1226K-ZIP+4^.2207^NK1
1227"DATA",64850002,95,0)
1228K2-ADDRESS SAME AS PATIENT'S?^.21925^NK2
1229"DATA",64850002,96,0)
1230K2-CITY^.2196^NK2
1231"DATA",64850002,97,0)
1232K2-NAME OF SECONDARY NOK^.2191^NK2
1233"DATA",64850002,98,0)
1234K2-PHONE NUMBER^.2199^NK2
1235"DATA",64850002,99,0)
1236K2-RELATIONSHIP TO PATIENT^.2192^NK2
1237"DATA",64850002,100,0)
1238K2-STATE^.2197^NK2
1239"DATA",64850002,101,0)
1240K2-STREET ADDRESS [LINE 1]^.2193^NK2
1241"DATA",64850002,102,0)
1242K2-STREET ADDRESS [LINE 2]^.2194^NK2
1243"DATA",64850002,103,0)
1244K2-STREET ADDRESS [LINE 3]^.2195^NK2
1245"DATA",64850002,104,0)
1246K2-WORK PHONE NUMBER^.211011^
1247"DATA",64850002,105,0)
1248K2-ZIP CODE^.2198^NK2
1249"DATA",64850002,106,0)
1250K2-ZIP+4^.2203^NK2
1251"DATA",64850002,107,0)
1252LANGUAGE PREFERENCE^256000^
1253"DATA",64850002,108,0)
1254LANGUAGE SKILLS^256001^
1255"DATA",64850002,108,"M",0)
12562.0256001P^^
1257"DATA",64850002,108,"M",1,0)
1258LANGUAGE SKILLS^.01;2.0256001
1259"DATA",64850002,108,"M",2,0)
1260READING SKILL LEVEL^3;2.0256001
1261"DATA",64850002,108,"M",3,0)
1262SPEAKING SKILL LEVEL^2;2.0256001
1263"DATA",64850002,108,"M",4,0)
1264UNDERSTANDING SKILL LEVEL^1;2.0256001
1265"DATA",64850002,108,"M",5,0)
1266WRITTEN SKILL LEVEL^4;2.0256001
1267"DATA",64850002,109,0)
1268LODGER WARD LOCATION^.107^
1269"DATA",64850002,110,0)
1270MARITAL STATUS^.05^DEMOG
1271"DATA",64850002,111,0)
1272MEDICAID NUMBER^.383^
1273"DATA",64850002,112,0)
1274MOTHER'S COUNTRY OF BIRTH^19903^
1275"DATA",64850002,113,0)
1276MOTHER'S MAIDEN NAME^.2403^
1277"DATA",64850002,114,0)
1278MOTHER'S NAME^.2402^
1279"DATA",64850002,115,0)
1280MULTIPLE BIRTH INDICATOR^994^
1281"DATA",64850002,116,0)
1282NAME^.01^DEMOG
1283"DATA",64850002,117,0)
1284NEXT OF KIN^.211^NK1
1285"DATA",64850002,118,0)
1286NEXT OF KIN-2^.2191^NK2
1287"DATA",64850002,119,0)
1288PAGER NUMBER CHANGE DT/TM^.1312^
1289"DATA",64850002,120,0)
1290PAGER NUMBER CHANGE SITE^.1314^
1291"DATA",64850002,121,0)
1292PAGER NUMBER CHANGE SOURCE^.1313^
1293"DATA",64850002,122,0)
1294PHONE NUMBER [CELLULAR]^.134^
1295"DATA",64850002,123,0)
1296PHONE NUMBER [RESIDENCE]^.131^DEMOG
1297"DATA",64850002,124,0)
1298PLACE OF BIRTH [CITY]^.092^
1299"DATA",64850002,125,0)
1300PLACE OF BIRTH [STATE]^.093^
1301"DATA",64850002,126,0)
1302POB CITY^.092^
1303"DATA",64850002,127,0)
1304POB STATE^.093^
1305"DATA",64850002,128,0)
1306POSTAL CODE^.1172^
1307"DATA",64850002,129,0)
1308PREFERRED FACILITY^27.02^
1309"DATA",64850002,130,0)
1310PRELIMINARY CAUSE OF DEATH^250043.1^
1311"DATA",64850002,130,"M",0)
13122.250043^^^
1313"DATA",64850002,130,"M",1,0)
1314PRELIMINARY CAUSE OF DEATH^2.250043
1315"DATA",64850002,131,0)
1316D-NAME OF DESIGNEE^.341^D1
1317"DATA",64850002,132,0)
1318PROVINCE^.1171^
1319"DATA",64850002,133,0)
1320RACE^.06^DEMOG
1321"DATA",64850002,134,0)
1322RACE INFORMATION^2^
1323"DATA",64850002,134,"M",0)
13242.02P^^
1325"DATA",64850002,134,"M",1,0)
1326RACE INFORMATION^.01;2.02
1327"DATA",64850002,135,0)
1328RATED INCOMPETENT?^.293^
1329"DATA",64850002,136,0)
1330RELIGION^.08^DEMOG
1331"DATA",64850002,137,0)
1332RELIGIOUS PREFERENCE^.08^DEMOG
1333"DATA",64850002,138,0)
1334REMARKS^.091^
1335"DATA",64850002,139,0)
1336SEXUAL ORIENTATION^19901^
1337"DATA",64850002,140,0)
1338SOCIAL SECURITY AMOUNT^.3623^MB
1339"DATA",64850002,141,0)
1340SPOUSE'S EMP PHONE NUMBER^.258^SP1
1341"DATA",64850002,142,0)
1342SPOUSE'S EMP STREET [LINE 1]^.252^SP1
1343"DATA",64850002,143,0)
1344SPOUSE'S EMP STREET [LINE 2]^.253^SP1
1345"DATA",64850002,144,0)
1346SPOUSE'S EMP STREET [LINE 3]^.254^SP1
1347"DATA",64850002,145,0)
1348SPOUSE'S EMP ZIP CODE^.257^SP1
1349"DATA",64850002,146,0)
1350SPOUSE'S EMP ZIP+4^.2206^SP1
1351"DATA",64850002,147,0)
1352SPOUSE'S EMPLOYER NAME^.251^SP1
1353"DATA",64850002,148,0)
1354SPOUSE'S EMPLOYER'S CITY^.255^SP1
1355"DATA",64850002,149,0)
1356SPOUSE'S EMPLOYER'S STATE^.256^SP1
1357"DATA",64850002,150,0)
1358SPOUSE'S EMPLOYMENT STATUS^.2515^
1359"DATA",64850002,151,0)
1360SPOUSE'S OCCUPATION^.2514^
1361"DATA",64850002,152,0)
1362SPOUSE'S RETIREMENT DATE^.2516^
1363"DATA",64850002,153,0)
1364START DATE OF TEMP ADDRESS^.1217^TAD
1365"DATA",64850002,154,0)
1366STATE^.115^DEMOG
1367"DATA",64850002,155,0)
1368STREET ADDRESS [LINE 1]^.111^DEMOG
1369"DATA",64850002,156,0)
1370STREET ADDRESS [LINE 2]^.112^DEMOG
1371"DATA",64850002,157,0)
1372STREET ADDRESS [LINE 3]^.113^DEMOG
1373"DATA",64850002,158,0)
1374TEMPORARY ADDRESS CHANGE DT/TM^.12113^
1375"DATA",64850002,159,0)
1376TEMPORARY ADDRESS CHANGE SITE^.12114^
1377"DATA",64850002,160,0)
1378TEMPORARY ADDRESS COUNTRY^.1223^
1379"DATA",64850002,161,0)
1380TEMPORARY ADDRESS COUNTY^.12111^TAD
1381"DATA",64850002,162,0)
1382TEMPORARY ADDRESS END DATE^.1218^TAD
1383"DATA",64850002,163,0)
1384TEMPORARY ADDRESS POSTAL CODE^.1222^
1385"DATA",64850002,164,0)
1386TEMPORARY ADDRESS PROVINCE^.1221^
1387"DATA",64850002,165,0)
1388TEMPORARY ADDRESS START DATE^.1217^TAD
1389"DATA",64850002,166,0)
1390TEMPORARY CITY^.1214^TAD
1391"DATA",64850002,167,0)
1392TEMPORARY PHONE NUMBER^.1219^TAD
1393"DATA",64850002,168,0)
1394TEMPORARY STATE^.1215^TAD
1395"DATA",64850002,169,0)
1396TEMPORARY STREET [LINE 1]^.1211^TAD
1397"DATA",64850002,170,0)
1398TEMPORARY STREET [LINE 2]^.1212^TAD
1399"DATA",64850002,171,0)
1400TEMPORARY STREET [LINE 3]^.1213^TAD
1401"DATA",64850002,172,0)
1402TEMPORARY ZIP CODE^.1216^TAD
1403"DATA",64850002,173,0)
1404TEMPORARY ZIP+4^.12112^TAD
1405"DATA",64850002,174,0)
1406TIME OF BIRTH^540000.1^
1407"DATA",64850002,175,0)
1408ZIP CODE^.116^DEMOG
1409"DATA",64850002,176,0)
1410ZIP+4^.1112^DEMOG
1411"DATA",64850002,177,0)
1412OCCUPATION^.07
1413"DATA",64850003,1,0)
1414DEMOG^Demographics
1415"DATA",64850003,1,"F",0)
1416^64850003.02^21^1
1417"DATA",64850003,1,"F",1,0)
1418.01
1419"DATA",64850003,1,"F",2,0)
1420.02
1421"DATA",64850003,1,"F",3,0)
1422.03
1423"DATA",64850003,1,"F",4,0)
1424.05
1425"DATA",64850003,1,"F",5,0)
1426.06
1427"DATA",64850003,1,"F",6,0)
1428.08
1429"DATA",64850003,1,"F",7,0)
1430.09
1431"DATA",64850003,1,"F",8,0)
1432.111
1433"DATA",64850003,1,"F",9,0)
1434.1112
1435"DATA",64850003,1,"F",10,0)
1436.112
1437"DATA",64850003,1,"F",11,0)
1438.113
1439"DATA",64850003,1,"F",12,0)
1440.114
1441"DATA",64850003,1,"F",13,0)
1442.115
1443"DATA",64850003,1,"F",14,0)
1444.116
1445"DATA",64850003,1,"F",15,0)
1446.117
1447"DATA",64850003,1,"F",16,0)
1448.131
1449"DATA",64850003,1,"F",17,0)
1450.132
1451"DATA",64850003,1,"F",18,0)
1452.363
1453"DATA",64850003,1,"F",19,0)
14541
1455"DATA",64850003,1,"F",20,0)
1456256000
1457"DATA",64850003,1,"F",21,0)
1458.1172
1459"DATA",64850003,2,0)
1460D1^Designee
1461"DATA",64850003,2,"F",0)
1462^64850003.02^^0
1463"DATA",64850003,2,"F",1,0)
1464.2202
1465"DATA",64850003,2,"F",2,0)
1466.2202
1467"DATA",64850003,2,"F",3,0)
1468.3405
1469"DATA",64850003,2,"F",4,0)
1470.341
1471"DATA",64850003,2,"F",5,0)
1472.342
1473"DATA",64850003,2,"F",6,0)
1474.343
1475"DATA",64850003,2,"F",7,0)
1476.344
1477"DATA",64850003,2,"F",8,0)
1478.345
1479"DATA",64850003,2,"F",9,0)
1480.346
1481"DATA",64850003,2,"F",10,0)
1482.347
1483"DATA",64850003,2,"F",11,0)
1484.348
1485"DATA",64850003,2,"F",13,0)
1486.115
1487"DATA",64850003,2,"F",14,0)
1488.116
1489"DATA",64850003,2,"F",15,0)
1490.117
1491"DATA",64850003,2,"F",16,0)
1492.131
1493"DATA",64850003,2,"F",17,0)
1494.132
1495"DATA",64850003,2,"F",18,0)
1496.363
1497"DATA",64850003,2,"F",19,0)
14981
1499"DATA",64850003,2,"F",21,0)
1500.1172
1501"DATA",64850003,3,0)
1502EC1^Emergency contact
1503"DATA",64850003,3,"F",0)
1504^64850003.02^11^11
1505"DATA",64850003,3,"F",1,0)
1506.2201
1507"DATA",64850003,3,"F",2,0)
1508.3305
1509"DATA",64850003,3,"F",3,0)
1510.331
1511"DATA",64850003,3,"F",4,0)
1512.332
1513"DATA",64850003,3,"F",5,0)
1514.333
1515"DATA",64850003,3,"F",6,0)
1516.334
1517"DATA",64850003,3,"F",7,0)
1518.335
1519"DATA",64850003,3,"F",8,0)
1520.336
1521"DATA",64850003,3,"F",9,0)
1522.337
1523"DATA",64850003,3,"F",10,0)
1524.338
1525"DATA",64850003,3,"F",11,0)
1526.339
1527"DATA",64850003,4,0)
1528EC2^Emergency Contact
1529"DATA",64850003,4,"F",0)
1530^64850003.02^10^10
1531"DATA",64850003,4,"F",1,0)
1532.2204
1533"DATA",64850003,4,"F",2,0)
1534.3311
1535"DATA",64850003,4,"F",3,0)
1536.3312
1537"DATA",64850003,4,"F",4,0)
1538.3313
1539"DATA",64850003,4,"F",5,0)
1540.3314
1541"DATA",64850003,4,"F",6,0)
1542.3315
1543"DATA",64850003,4,"F",7,0)
1544.3316
1545"DATA",64850003,4,"F",8,0)
1546.3317
1547"DATA",64850003,4,"F",9,0)
1548.3318
1549"DATA",64850003,4,"F",10,0)
1550.3319
1551"DATA",64850003,5,0)
1552SP1^Spousal Info
1553"DATA",64850003,5,"F",0)
1554^64850003.02^.258^9
1555"DATA",64850003,5,"F",1,0)
1556.2206
1557"DATA",64850003,5,"F",2,0)
1558.251
1559"DATA",64850003,5,"F",3,0)
1560.252
1561"DATA",64850003,5,"F",4,0)
1562.253
1563"DATA",64850003,5,"F",5,0)
1564.254
1565"DATA",64850003,5,"F",6,0)
1566.255
1567"DATA",64850003,5,"F",7,0)
1568.256
1569"DATA",64850003,5,"F",8,0)
1570.257
1571"DATA",64850003,5,"F",9,0)
1572.258
1573"DATA",64850003,8,0)
1574II^Insurance
1575"DATA",64850003,8,"F",0)
1576^64850003.02^2^2
1577"DATA",64850003,8,"F",1,0)
1578.3121
1579"DATA",64850003,8,"F",2,0)
1580.3192
1581"DATA",64850003,9,0)
1582IRD^Radiation Exposure
1583"DATA",64850003,9,"F",0)
1584^64850003.02^3^3
1585"DATA",64850003,9,"F",1,0)
1586.32103
1587"DATA",64850003,9,"F",2,0)
1588.32111
1589"DATA",64850003,9,"F",3,0)
1590.3212
1591"DATA",64850003,10,0)
1592NK1^Next of kin
1593"DATA",64850003,10,"F",0)
1594^64850003.02^11^11
1595"DATA",64850003,10,"F",1,0)
1596.211
1597"DATA",64850003,10,"F",2,0)
1598.212
1599"DATA",64850003,10,"F",3,0)
1600.2125
1601"DATA",64850003,10,"F",4,0)
1602.213
1603"DATA",64850003,10,"F",5,0)
1604.214
1605"DATA",64850003,10,"F",6,0)
1606.215
1607"DATA",64850003,10,"F",7,0)
1608.216
1609"DATA",64850003,10,"F",8,0)
1610.217
1611"DATA",64850003,10,"F",9,0)
1612.218
1613"DATA",64850003,10,"F",10,0)
1614.219
1615"DATA",64850003,10,"F",11,0)
1616.2207
1617"DATA",64850003,11,0)
1618NK2^Next of kin
1619"DATA",64850003,11,"F",0)
1620^64850003.02^11^11
1621"DATA",64850003,11,"F",1,0)
1622.2191
1623"DATA",64850003,11,"F",2,0)
1624.2192
1625"DATA",64850003,11,"F",3,0)
1626.21925
1627"DATA",64850003,11,"F",4,0)
1628.2193
1629"DATA",64850003,11,"F",5,0)
1630.2194
1631"DATA",64850003,11,"F",6,0)
1632.2195
1633"DATA",64850003,11,"F",7,0)
1634.2196
1635"DATA",64850003,11,"F",8,0)
1636.2197
1637"DATA",64850003,11,"F",9,0)
1638.2198
1639"DATA",64850003,11,"F",10,0)
1640.2199
1641"DATA",64850003,11,"F",11,0)
1642.2203
1643"DATA",64850003,13,0)
1644TAD^Temp address
1645"DATA",64850003,13,"F",0)
1646^64850003.02^12^12
1647"DATA",64850003,13,"F",1,0)
1648.12105
1649"DATA",64850003,13,"F",2,0)
1650.1211
1651"DATA",64850003,13,"F",3,0)
1652.12111
1653"DATA",64850003,13,"F",4,0)
1654.12112
1655"DATA",64850003,13,"F",5,0)
1656.1212
1657"DATA",64850003,13,"F",6,0)
1658.1213
1659"DATA",64850003,13,"F",7,0)
1660.1214
1661"DATA",64850003,13,"F",8,0)
1662.1215
1663"DATA",64850003,13,"F",9,0)
1664.1216
1665"DATA",64850003,13,"F",10,0)
1666.1217
1667"DATA",64850003,13,"F",11,0)
1668.1218
1669"DATA",64850003,13,"F",12,0)
1670.1219
1671"FIA",64850001)
1672PATIENT FILE FIELD EXCLUSIONS
1673"FIA",64850001,0)
1674^DIZ(64850001,
1675"FIA",64850001,0,0)
167664850001
1677"FIA",64850001,0,1)
1678y^n^f^^n^^y^m^n
1679"FIA",64850001,0,10)
1680
1681"FIA",64850001,0,11)
1682
1683"FIA",64850001,0,"RLRO")
1684
1685"FIA",64850001,64850001)
16860
1687"FIA",64850002)
1688CIVILIAN PATIENT FIELDS
1689"FIA",64850002,0)
1690^DIZ(64850002,
1691"FIA",64850002,0,0)
169264850002
1693"FIA",64850002,0,1)
1694y^n^f^^n^^y^m^n
1695"FIA",64850002,0,10)
1696
1697"FIA",64850002,0,11)
1698
1699"FIA",64850002,0,"RLRO")
1700
1701"FIA",64850002,64850002)
17020
1703"FIA",64850002,64850002.01)
17040
1705"FIA",64850002,64850002.13)
17060
1707"FIA",64850003)
1708FIELD GROUPS
1709"FIA",64850003,0)
1710^DIZ(64850003,
1711"FIA",64850003,0,0)
171264850003
1713"FIA",64850003,0,1)
1714y^n^f^^n^^y^m^n
1715"FIA",64850003,0,10)
1716
1717"FIA",64850003,0,11)
1718
1719"FIA",64850003,0,"RLRO")
1720
1721"FIA",64850003,64850003)
17220
1723"FIA",64850003,64850003.02)
17240
1725"INIT")
1726PI^VWREGIT2
1727"KRN",.402,1771,-1)
17280^2
1729"KRN",.402,1771,0)
1730VW WESTVIRGINIA TEST^3150408.103^@^2^^@^3150408
1731"KRN",.402,1771,"DIAB",1,1,2.06,0)
1732ALL
1733"KRN",.402,1771,"DR",1,2)
1734540000.1;6;.111;.112;.2926;.2927;.1172;.117;.08;
1735"KRN",.402,1771,"DR",2,2.06)
1736.01:.02
1737"KRN",.402,1773,-1)
17380^1
1739"KRN",.402,1773,0)
1740VW PT REGISTRATION^3160606.101^^2^^^3160606
1741"KRN",.402,1773,"%D",0)
1742^^1^1^3160416^
1743"KRN",.402,1773,"%D",1,0)
1744Created via registration client
1745"KRN",.402,1773,"DIAB",6,0,2,0)
1746.363;"ID NUMBER"
1747"KRN",.402,1773,"DIAB",10,0,2,0)
1748.1172;"ZIP/POSTAL CODE"
1749"KRN",.402,1773,"DR",1,2)
1750.01;.02;.03;.05;540001.1;.363ID NUMBER~;27.02;.111;.112;.1172ZIP/POSTAL CODE~;.114;.115;.117;.131;.132;.134;.133;.331;.339;.3121;.091;3;250043.1;
1751"KRN",.402,1773,"DR",2,2.001)
1752.01;1;
1753"KRN",.402,1773,"DR",2,2.312)
1754.01;
1755"KRN",.402,1773,"DR",3,2.011)
1756.01;1;
1757"KRN",.402,1774,-1)
17580^3
1759"KRN",.402,1774,0)
1760ADDRESS [WorldVistA]^3160323.1111^^2^^^3160323
1761"KRN",.402,1774,"DR",1,2)
1762.111;.112;.1172;.114;.115;.117;.1173;.131;.132;.134;
1763"KRN",.402,1776,-1)
17640^4
1765"KRN",.402,1776,0)
1766NEXT OF KIN [WorldVistA]^3160323.1123^@^2^^@^3160323
1767"KRN",.402,1776,"DR",1,2)
1768.211;.212;.2125;.213;.214;.2207;.216;.217;.219;.21011;
1769"KRN",.402,1777,-1)
17700^5
1771"KRN",.402,1777,0)
1772EMERG. CONTACT [WorldVistA]^3160323.1143^@^2^^@^3160323
1773"KRN",.402,1777,"DR",1,2)
1774.331;.332;.333;.334;.338;.336;.337;.339;.33011;
1775"KRN",.402,1778,-1)
17760^6
1777"KRN",.402,1778,0)
1778REPORTED DEATH [WorldVistA]^3160327.0944^@^2^^@^3160328
1779"KRN",.402,1778,"DR",1,2)
1780.351;
1781"KRN",.402,1783,-1)
17820^7
1783"KRN",.402,1783,0)
1784GENERIC INS. FRM [WorldVistA]^3160607.0844^^2^^^3160607
1785"KRN",3.8,278,-1)
17860^1
1787"KRN",3.8,278,0)
1788VW REG ERROR REPORT^PU^n^^^^
1789"KRN",3.8,278,2,0)
1790^^1^1^3160705^
1791"KRN",3.8,278,2,1,0)
1792[Optional] Report any GUI registration errors
1793"KRN",3.8,278,3)
1794
1795"KRN",19,11341,-1)
17960^1
1797"KRN",19,11341,0)
1798VW REG IT CONTROL^VW GUI REGISTRATION SET UP ACCESS^^M^^^^^^^^
1799"KRN",19,11341,99)
180064030,52494
1801"KRN",19,11341,99.1)
180264123,28222
1803"KRN",19,11341,"U")
1804VW GUI REGISTRATION SET UP ACC
1805"KRN",19,11342,-1)
18060^2
1807"KRN",19,11342,0)
1808VW PATIENT REGISTRATION^VW PATIENT REGISTRATION^^^^^^^^^^
1809"KRN",19,11342,"U")
1810VW PATIENT REGISTRATION
1811"KRN",8989.51,1344,-1)
18120^1
1813"KRN",8989.51,1344,0)
1814VW GUI REG TEMPLATE DIRECTORY^Host Home Directory^0^^Path for local Home Directory^
1815"KRN",8989.51,1344,1)
1816F^1:100^Enter your home directory (i.e., a Linux vista directory might be: /home/vista/)
1817"KRN",8989.51,1344,4,0)
1818^8989.514^^0
1819"KRN",8989.51,1344,6)
1820N^1:1
1821"KRN",8989.51,1344,20,0)
1822^8989.512^1^1^3160118^^^^
1823"KRN",8989.51,1344,20,1,0)
1824Asked to find the home directory for application parameter files
1825"KRN",8989.51,1344,30,0)
1826^8989.513I^5^2
1827"KRN",8989.51,1344,30,3,0)
18289^4.2
1829"KRN",8989.51,1344,30,5,0)
18303^4
1831"KRN",8989.51,1345,-1)
18320^2
1833"KRN",8989.51,1345,0)
1834VW REG DEFAULT STATE^DEFAULT HOME STATE^0^^Select your home state
1835"KRN",8989.51,1345,1)
1836P^5
1837"KRN",8989.51,1345,6)
1838^
1839"KRN",8989.51,1345,30,0)
1840^8989.513I^1^1
1841"KRN",8989.51,1345,30,1,0)
18429^4.2
1843"KRN",8989.51,1347,-1)
18440^3
1845"KRN",8989.51,1347,0)
1846VW REG RDNPT^DEFAULT NEW PT TEMPLATE^0^^Default template for new pt registration
1847"KRN",8989.51,1347,1)
1848P^.402^Select the input template that is your default for new pt registration.
1849"KRN",8989.51,1347,6)
1850^
1851"KRN",8989.51,1347,30,0)
1852^8989.513I^1^1
1853"KRN",8989.51,1347,30,1,0)
18549^4.2
1855"KRN",8994,2853,-1)
18560^8
1857"KRN",8994,2853,0)
1858VW REG MAIN^EN^VWREGIT^2^P^^^0^.9
1859"KRN",8994,2853,1,0)
1860^8994.01^1^1^3131007^^^^
1861"KRN",8994,2853,1,1,0)
1862Called by client to get template names from the server/site working directory
1863"KRN",8994,2853,2,0)
1864^8994.02A^^0
1865"KRN",8994,2853,3,0)
1866^8994.03^1^1^3150506^^^^
1867"KRN",8994,2853,3,1,0)
1868Returns template names(IEN)
1869"KRN",8994,2854,-1)
18700^14
1871"KRN",8994,2854,0)
1872VW REG NEW PT^NPT^VWREGIT^2^P^^^0^2
1873"KRN",8994,2854,2,0)
1874^8994.02A^1^1
1875"KRN",8994,2854,2,1,0)
1876TIEN^1^^1^2
1877"KRN",8994,2854,2,"B","TIEN",1)
1878
1879"KRN",8994,2854,2,"PARAMSEQ",2,1)
1880
1881"KRN",8994,2868,-1)
18820^19
1883"KRN",8994,2868,0)
1884VW REG SPI^SPI^VWREGITU^2^P^^^0^2
1885"KRN",8994,2868,1,0)
1886^^1^1^3150605^
1887"KRN",8994,2868,1,1,0)
1888Simple Patient Inquiry for GUI roll-over
1889"KRN",8994,2868,2,0)
1890^8994.02A^2^1
1891"KRN",8994,2868,2,2,0)
1892DFN^1^^1^2
1893"KRN",8994,2868,2,"B","DFN",2)
1894
1895"KRN",8994,2868,2,"PARAMSEQ",2,2)
1896
1897"KRN",8994,2869,-1)
18980^15
1899"KRN",8994,2869,0)
1900VW REG PARTIAL PT LIST^GPL^VWREGITX^2^P^^^0^2
1901"KRN",8994,2869,1,0)
1902^8994.01^1^1^3151103^^^
1903"KRN",8994,2869,1,1,0)
1904Returns the called for alpha list of patients
1905"KRN",8994,2869,2,0)
1906^8994.02A^1^1
1907"KRN",8994,2869,2,1,0)
1908IDDATA^1^^1^2
1909"KRN",8994,2869,2,1,1,0)
1910^8994.021^1^1^3151103^^
1911"KRN",8994,2869,2,1,1,1,0)
1912Segmented alphabetic (A^D, E^H, U^Z, etc)
1913"KRN",8994,2869,2,"B","IDDATA",1)
1914
1915"KRN",8994,2869,2,"PARAMSEQ",2,1)
1916
1917"KRN",8994,2870,-1)
19180^16
1919"KRN",8994,2870,0)
1920VW REG PF^PF^VWREGIT^2^P^^^0^2
1921"KRN",8994,2870,1,0)
1922^^1^1^3150528^
1923"KRN",8994,2870,1,1,0)
1924Returns .01(.001) to GUI
1925"KRN",8994,2870,2,0)
1926^8994.02A^1^1
1927"KRN",8994,2870,2,1,0)
1928XPF^1^^1^2
1929"KRN",8994,2870,2,"B","XPF",1)
1930
1931"KRN",8994,2870,2,"PARAMSEQ",2,1)
1932
1933"KRN",8994,2871,-1)
19340^7
1935"KRN",8994,2871,0)
1936VW REG GRP LIST^RETGRP^VWREGITX^2^P^^^0^2
1937"KRN",8994,2871,1,0)
1938^8994.01^11^11^3160411^^^
1939"KRN",8994,2871,1,1,0)
1940Returns Patient file (#2) Field Groups:
1941"KRN",8994,2871,1,2,0)
1942RESULT(1)="Demographics(1)"
1943"KRN",8994,2871,1,3,0)
1944RESULT(2)="Designee(2)"
1945"KRN",8994,2871,1,4,0)
1946RESULT(3)="Emergency contact(3)"
1947"KRN",8994,2871,1,5,0)
1948RESULT(4)="Emergency Contact(4)"
1949"KRN",8994,2871,1,6,0)
1950RESULT(5)="SPOUSAL INFO(5)"
1951"KRN",8994,2871,1,7,0)
1952RESULT(6)="Insurance(8)"
1953"KRN",8994,2871,1,8,0)
1954RESULT(7)="Radiation Exposure(9)"
1955"KRN",8994,2871,1,9,0)
1956RESULT(8)="Next of kin(10)"
1957"KRN",8994,2871,1,10,0)
1958RESULT(9)="Next of kin(11)"
1959"KRN",8994,2871,1,11,0)
1960RESULT(10)="Temp address(13)"
1961"KRN",8994,2872,-1)
19620^4
1963"KRN",8994,2872,0)
1964VW REG FLD BY GRP^LF^VWREGITX^2^P^^^0^2
1965"KRN",8994,2872,1,0)
1966^8994.01^1^1^3151009^^^
1967"KRN",8994,2872,1,1,0)
1968Returns the patient file fields identified by their group assignment
1969"KRN",8994,2872,2,0)
1970^8994.02A^1^1
1971"KRN",8994,2872,2,1,0)
1972FTYPE^1^^^2
1973"KRN",8994,2872,2,1,1,0)
1974^8994.021^1^1^3151009^^^
1975"KRN",8994,2872,2,1,1,1,0)
1976The caption of the menu selection
1977"KRN",8994,2872,2,"B","FTYPE",1)
1978
1979"KRN",8994,2872,2,"PARAMSEQ",2,1)
1980
1981"KRN",8994,2873,-1)
19820^1
1983"KRN",8994,2873,0)
1984VW REG AHF^AHF^VWREGITX^2^P^^^0^2
1985"KRN",8994,2873,1,0)
1986^8994.01^8^8^3151017^^
1987"KRN",8994,2873,1,1,0)
1988GUI client sends a list of individual fields selected in the
1989"KRN",8994,2873,1,2,0)
1990"ad hoc" process. This app returns all the necessary field data
1991"KRN",8994,2873,1,3,0)
1992to the client: FIELD NAME^NO;SUBDIC^EXISTING VALUE^HELP^P/SC
1993"KRN",8994,2873,1,4,0)
1994  FIELD NAME     : TEXT NAME OF THE FIELD (.01)
1995"KRN",8994,2873,1,5,0)
1996  FIELD NO/SUBDIC: FIELD OF FILE 2 OR SUB-FIELD DICTIONARY
1997"KRN",8994,2873,1,6,0)
1998  EXISTING VALUE : IF PATIENT SELECTED, VALUE OF THE FIELD
1999"KRN",8994,2873,1,7,0)
2000  HELP           : HELP TEXT OF THE FIELD
2001"KRN",8994,2873,1,8,0)
2002  P/SC           : POINTER OR SET OF CODES
2003"KRN",8994,2873,2,0)
2004^8994.02A^1^1
2005"KRN",8994,2873,2,1,0)
2006AHF^2^^^2
2007"KRN",8994,2873,2,"B","AHF",1)
2008
2009"KRN",8994,2873,2,"PARAMSEQ",2,1)
2010
2011"KRN",8994,2874,-1)
20120^10
2013"KRN",8994,2874,0)
2014VW REG MF^M^VWREGITU^2^P^^^0^2
2015"KRN",8994,2874,1,0)
2016^8994.01^1^1^3160130^^^^
2017"KRN",8994,2874,1,1,0)
2018Displays Multiple Field Input form.
2019"KRN",8994,2874,2,0)
2020^8994.02A^1^1
2021"KRN",8994,2874,2,1,0)
2022XMF^1^^^2
2023"KRN",8994,2874,2,"B","XMF",1)
2024
2025"KRN",8994,2874,2,"PARAMSEQ",2,1)
2026
2027"KRN",8994,2875,-1)
20280^11
2029"KRN",8994,2875,0)
2030VW REG MISC^MISC^VWREGITU^2^P^^^0^2
2031"KRN",8994,2875,1,0)
2032^8994.01^1^1^3150623^
2033"KRN",8994,2875,1,1,0)
2034Takes in DD#, returns simple list .01TEXT(DIC#/FIELD#)
2035"KRN",8994,2875,2,0)
2036^8994.02A^1^1
2037"KRN",8994,2875,2,1,0)
2038VWDD^1^^1^2
2039"KRN",8994,2875,2,1,1,0)
2040^^1^1^3150623^
2041"KRN",8994,2875,2,1,1,1,0)
2042DD number (i.e., DD(355.1))
2043"KRN",8994,2875,2,"B","VWDD",1)
2044
2045"KRN",8994,2875,2,"PARAMSEQ",2,1)
2046
2047"KRN",8994,2876,-1)
20480^24
2049"KRN",8994,2876,0)
2050VW REG ZIP^ZPC^VWREGITU^2^P^^^0^2
2051"KRN",8994,2876,1,0)
2052^8994.01^1^1^3150701^^^^
2053"KRN",8994,2876,1,1,0)
2054Returns city,state,zip,county
2055"KRN",8994,2876,2,0)
2056^8994.02A^1^1
2057"KRN",8994,2876,2,1,0)
2058ZIP^1^^^1
2059"KRN",8994,2876,2,1,1,0)
2060^8994.021^1^1^3150701^^^^
2061"KRN",8994,2876,2,1,1,1,0)
2062Postal code
2063"KRN",8994,2876,2,"B","ZIP",1)
2064
2065"KRN",8994,2876,2,"PARAMSEQ",1,1)
2066
2067"KRN",8994,2878,-1)
20680^2
2069"KRN",8994,2878,0)
2070VW REG ALIST^ALIST^VWREGITX^2^P^^^0^2
2071"KRN",8994,2878,1,0)
2072^8994.01^21^21^3160123^^^^
2073"KRN",8994,2878,1,1,0)
2074ALIST will take two args but the 3rd (CALLERID) can be empty.
2075"KRN",8994,2878,1,2,0)
2076If CALLERID is sent and ALIST contains pieces(^) then @subroutine
2077"KRN",8994,2878,1,3,0)
2078of CALLERID is executed.
2079"KRN",8994,2878,1,4,0)
2080Otherwise,
2081"KRN",8994,2878,1,5,0)
2082Returns a listing of the required alphabetic (2nd arg)
2083"KRN",8994,2878,1,6,0)
2084           ID/HRN    ^CLIENT NAME(DFN)   ^DOB@TIME          ^PHONE (.131)
2085"KRN",8994,2878,1,7,0)
2086RESULT(1)="----------^BARNES,DANIEL(10)^OCT 21, 1945^"
2087"KRN",8994,2878,1,8,0)
2088RESULT(2)="----------^BARNES,PAUL(102)^JAN 04, 1988^"
2089"KRN",8994,2878,1,9,0)
2090RESULT(3)="----------^BARTLET,DAVID(124)^JUL 12, 1942^"
2091"KRN",8994,2878,1,10,0)
2092RESULT(4)="----------^BENSON,ALBERT(144)^AUG 24, 1953^"
2093"KRN",8994,2878,1,11,0)
2094RESULT(5)="8876 23 24^BLACK,EDWARD D(11)^APR 07, 2015@09:43^"
2095"KRN",8994,2878,1,12,0)
2096RESULT(6)="----------^BLACK,GEORGE(12)^MAR 03, 2007^"
2097"KRN",8994,2878,1,13,0)
2098RESULT(7)="----------^BOKHARI,ZAHID(99)^JAN 01, 1963^"
2099"KRN",8994,2878,1,14,0)
2100RESULT(8)="----------^BOND,JAMES(96)^JAN 30, 1958^"
2101"KRN",8994,2878,1,15,0)
2102RESULT(9)="----------^BRENT,NORA(13)^FEB 15, 2009^"
2103"KRN",8994,2878,1,16,0)
2104RESULT(10)="----------^BROOKS,MARIA(14)^APR 09, 2006^"
2105"KRN",8994,2878,1,17,0)
2106RESULT(11)="----------^BROOKS,RICHARD(15)^MAY 16, 1956^"
2107"KRN",8994,2878,1,18,0)
2108RESULT(12)="----------^BROWN,MARK DOUGLAS(80)^JAN 01, 1960^207 959-2228"
2109"KRN",8994,2878,1,19,0)
2110RESULT(13)="----------^BUICK,BERNADETTE P(219)^AUG 20, 1980^448-887-9999"
2111"KRN",8994,2878,1,20,0)
2112RESULT(14)="----------^BUICK,RALPH P(208)^MAR 29, 1980^448-887-9999"
2113"KRN",8994,2878,1,21,0)
2114RESULT(15)="----------^BUICK,WILLYS P(220)^JUN 20, 2007@13:46^448-887-9999"
2115"KRN",8994,2878,2,0)
2116^8994.02A^2^2
2117"KRN",8994,2878,2,1,0)
2118ALIST^1^^1^2
2119"KRN",8994,2878,2,2,0)
2120CALLERID^1^^0^3
2121"KRN",8994,2878,2,"B","ALIST",1)
2122
2123"KRN",8994,2878,2,"B","CALLERID",2)
2124
2125"KRN",8994,2878,2,"PARAMSEQ",2,1)
2126
2127"KRN",8994,2878,2,"PARAMSEQ",3,2)
2128
2129"KRN",8994,2880,-1)
21300^5
2131"KRN",8994,2880,0)
2132VW REG GPD^GPD^VWREGITP^2^P^^^0^2
2133"KRN",8994,2880,1,0)
2134^^2^2^3160213^
2135"KRN",8994,2880,1,1,0)
2136Returns data for an existing patient. Sub-routine GPD is contained
2137"KRN",8994,2880,1,2,0)
2138in the patient utility routine VWREGITP
2139"KRN",8994,2880,2,0)
2140^8994.02A^1^1
2141"KRN",8994,2880,2,1,0)
2142DATA^1^^1^2
2143"KRN",8994,2880,2,1,1,0)
2144^^1^1^3160213^
2145"KRN",8994,2880,2,1,1,1,0)
2146TEMPLATENAME(IEN)^FIELDSET(as in .01,.03, etc)^PATIENT NAME(IEN of file2)
2147"KRN",8994,2880,2,"B","DATA",1)
2148
2149"KRN",8994,2880,2,"PARAMSEQ",2,1)
2150
2151"KRN",8994,2880,3,0)
2152^8994.03^23^23^3160213^^
2153"KRN",8994,2880,3,1,0)
2154Example: DATA="(1773^^(208"
2155"KRN",8994,2880,3,2,0)
2156RESULT(1)=".01^BUICK,RALPH P"
2157"KRN",8994,2880,3,3,0)
2158RESULT(2)=".02^MALE"
2159"KRN",8994,2880,3,4,0)
2160RESULT(3)=".03^03/29/1980"
2161"KRN",8994,2880,3,5,0)
2162RESULT(4)=".05^MARRIED"
2163"KRN",8994,2880,3,6,0)
2164RESULT(5)="64850001^4545 67 89AZ"
2165"KRN",8994,2880,3,7,0)
2166RESULT(6)=".363^4545 65 89AZ"
2167"KRN",8994,2880,3,8,0)
2168RESULT(7)="27.02^BOSTON HCS (523)"
2169"KRN",8994,2880,3,9,0)
2170RESULT(8)=".111^12735 WINCHESTER BLVD"
2171"KRN",8994,2880,3,10,0)
2172RESULT(9)=".112^APT 3G"
2173"KRN",8994,2880,3,11,0)
2174RESULT(10)=".1172^48005"
2175"KRN",8994,2880,3,12,0)
2176RESULT(11)=".114^ARMADA"
2177"KRN",8994,2880,3,13,0)
2178RESULT(12)=".115^MICHIGAN"
2179"KRN",8994,2880,3,14,0)
2180RESULT(13)=".117^099"
2181"KRN",8994,2880,3,15,0)
2182RESULT(14)=".131^448-887-9999"
2183"KRN",8994,2880,3,16,0)
2184RESULT(15)=".132^"
2185"KRN",8994,2880,3,17,0)
2186RESULT(16)=".134^971-555-5567"
2187"KRN",8994,2880,3,18,0)
2188RESULT(17)=".133^RALPHYTHEBUICK@SOMEWHERE.NET"
2189"KRN",8994,2880,3,19,0)
2190RESULT(18)=".331^"
2191"KRN",8994,2880,3,20,0)
2192RESULT(19)=".339^"
2193"KRN",8994,2880,3,21,0)
2194RESULT(20)=".091^"
2195"KRN",8994,2880,3,22,0)
2196RESULT(21)="1^"
2197"KRN",8994,2880,3,23,0)
2198RESULT(22)="3^"
2199"KRN",8994,2881,-1)
22000^6
2201"KRN",8994,2881,0)
2202VW REG GPDM^GPDM^VWREGITP^2^P^^^0^2
2203"KRN",8994,2881,1,0)
2204^8994.01^1^1^3160217^
2205"KRN",8994,2881,1,1,0)
2206Returns multiple data values for a patient
2207"KRN",8994,2881,2,0)
2208^8994.02A^1^1
2209"KRN",8994,2881,2,1,0)
2210DATA^1^^1^2
2211"KRN",8994,2881,2,1,1,0)
2212^^1^1^3160217^
2213"KRN",8994,2881,2,1,1,1,0)
2214DATA=PARENT FIELD LABEL^PARENT FIELD#^DFN
2215"KRN",8994,2881,2,"B","DATA",1)
2216
2217"KRN",8994,2881,2,"PARAMSEQ",2,1)
2218
2219"KRN",8994,2881,3,0)
2220^8994.03^4^4^3160217^^
2221"KRN",8994,2881,3,1,0)
2222Example: ENROLLMENT CLINIC^3^208
2223"KRN",8994,2881,3,2,0)
2224 RESULT(1)="ENROLLMENT CLINIC(s)"
2225"KRN",8994,2881,3,3,0)
2226 RESULT(2)="CARDIOLOGY^NOV 29, 2015@09:51^AC^CLINIC^"
2227"KRN",8994,2881,3,4,0)
2228 RESULT(3)="DERMATOLOGY PROCEDURE^DEC 10, 2015@09:38^AC^CLINIC^"
2229"KRN",8994,2882,-1)
22300^17
2231"KRN",8994,2882,0)
2232VW REG SAVE^SAVE^VWREGITS^2^P^^^0^2
2233"KRN",8994,2882,1,0)
2234^8994.01^3^3^3160326^^^^
2235"KRN",8994,2882,1,1,0)
2236Saves patient/client data to the Patient file (#2) and the
2237"KRN",8994,2882,1,2,0)
2238IHS Patient file (#9000001). If a DFN is empty, the routine
2239"KRN",8994,2882,1,3,0)
2240will check for an entry anyway.
2241"KRN",8994,2882,2,0)
2242^8994.02A^1^1
2243"KRN",8994,2882,2,1,0)
2244LDATA^2^^1^2
2245"KRN",8994,2882,2,1,1,0)
2246^8994.021^16^16^3160318^^^
2247"KRN",8994,2882,2,1,1,1,0)
2248Incoming data from the client example:
2249"KRN",8994,2882,2,1,1,2,0)
2250S LDATA=""
2251"KRN",8994,2882,2,1,1,3,0)
2252S LDATA(1)="NAME^.01^buick,ralphinia"
2253"KRN",8994,2882,2,1,1,4,0)
2254S LDATA(3)="SEX^.02^fEMALE"
2255"KRN",8994,2882,2,1,1,5,0)
2256S LDATA(5)="DOB^.03^2009"
2257"KRN",8994,2882,2,1,1,6,0)
2258S LDATA(7)="MARITAL STATUS^.05^NEVER MARRIED(6)"
2259"KRN",8994,2882,2,1,1,7,0)
2260S LDATA(9)="OCCUPATION^.07^child"
2261"KRN",8994,2882,2,1,1,8,0)
2262S LDATA(11)="RELIGION^.08^OTHER(22)"
2263"KRN",8994,2882,2,1,1,9,0)
2264S LDATA(13)="SSN^64850001^p"
2265"KRN",8994,2882,2,1,1,10,0)
2266S LDATA(15)="STREET ADDRESS [LINE 1]^.111^1430 Winchester Blvd"
2267"KRN",8994,2882,2,1,1,11,0)
2268S LDATA(17)="STREET ADDRESS [LINE 2]^.112^apt 3g"
2269"KRN",8994,2882,2,1,1,12,0)
2270S LDATA(19)="ZIP+4^.1112^48005"
2271"KRN",8994,2882,2,1,1,13,0)
2272S LDATA(21)="CITY^.114^ARMADA"
2273"KRN",8994,2882,2,1,1,14,0)
2274S LDATA(23)="STATE^.115^MICHIGAN(26)"
2275"KRN",8994,2882,2,1,1,15,0)
2276S LDATA(25)="COUNTY^.117^MACOMB(5)"
2277"KRN",8994,2882,2,1,1,16,0)
2278S LDATA(27)="EMERGENCY CONTACT^.331^buick,ralph"
2279"KRN",8994,2882,2,"B","LDATA",1)
2280
2281"KRN",8994,2882,2,"PARAMSEQ",2,1)
2282
2283"KRN",8994,2882,3,0)
2284^8994.03^1^1^3160318^^^
2285"KRN",8994,2882,3,1,0)
2286RESULT(N) will contain warning message of "Filed..."
2287"KRN",8994,2883,-1)
22880^22
2289"KRN",8994,2883,0)
2290VW REG TM^EN^VWREGITT^2^P^^^0^2
2291"KRN",8994,2883,1,0)
2292^^1^1^3160418^
2293"KRN",8994,2883,1,1,0)
2294Add, Edit, Delete Templates for DUZ
2295"KRN",8994,2883,2,0)
2296^8994.02A^1^1
2297"KRN",8994,2883,2,1,0)
2298TDATA^2^^1^2
2299"KRN",8994,2883,2,"B","TDATA",1)
2300
2301"KRN",8994,2883,2,"PARAMSEQ",2,1)
2302
2303"KRN",8994,2885,-1)
23040^13
2305"KRN",8994,2885,0)
2306VW REG MU^MU^VWREGITT^2^P^^^0^2
2307"KRN",8994,2885,1,0)
2308^8994.01^5^5^3160425^^^
2309"KRN",8994,2885,1,1,0)
2310Returns a list of standard VWREG users and managers:
2311"KRN",8994,2885,1,2,0)
2312RESULT(1)="^ADMINISTRATOR,SYSTEM(1)"
2313"KRN",8994,2885,1,3,0)
2314RESULT(2)="*^BELL,JIM(94)"
2315"KRN",8994,2885,1,4,0)
2316RESULT(3)="^CLERK,FIFTEEN(54)"
2317"KRN",8994,2885,1,5,0)
2318RESULT(4)="^DOCTOR,TEST(11)"
2319"KRN",8994,2886,-1)
23200^23
2321"KRN",8994,2886,0)
2322VW REG UL^UL^VWREGITT^2^P^^^0^2
2323"KRN",8994,2886,1,0)
2324^8994.01^11^11^3160428^^
2325"KRN",8994,2886,1,1,0)
2326Returns a user list from VA(200:
2327"KRN",8994,2886,1,2,0)
2328RESULT(1)="ADMINISTRATOR,SYSTEM(1)"
2329"KRN",8994,2886,1,3,0)
2330RESULT(2)="ANALYST,FOUR(90)"
2331"KRN",8994,2886,1,4,0)
2332RESULT(3)="ANALYST,ONE(65)"
2333"KRN",8994,2886,1,5,0)
2334RESULT(4)="ANALYST,THREE(66)"
2335"KRN",8994,2886,1,6,0)
2336RESULT(5)="ANALYST,TWO(69)"
2337"KRN",8994,2886,1,7,0)
2338RESULT(6)="AUTHORIZER,IB MRA(57)"
2339"KRN",8994,2886,1,8,0)
2340RESULT(7)="AUTOFINISH,RX(83)"
2341"KRN",8994,2886,1,9,0)
2342RESULT(8)="BATCH,ERX(78)"
2343"KRN",8994,2886,1,10,0)
2344RESULT(9)="BELL,JIM(94)"
2345"KRN",8994,2886,1,11,0)
2346etc
2347"KRN",8994,2887,-1)
23480^9
2349"KRN",8994,2887,0)
2350VW REG MANUL^MANUL^VWREGITT^2^P^^^0^2
2351"KRN",8994,2887,2,0)
2352^8994.02A^1^1
2353"KRN",8994,2887,2,1,0)
2354TDATA^2^^1^2
2355"KRN",8994,2887,2,"B","TDATA",1)
2356
2357"KRN",8994,2887,2,"PARAMSEQ",2,1)
2358
2359"KRN",8994,2888,-1)
23600^20
2361"KRN",8994,2888,0)
2362VW REG TFILE^TFILE^VWREGITT^2^P^^^0^2
2363"KRN",8994,2888,1,0)
2364^^16^16^3160429^
2365"KRN",8994,2888,1,1,0)
2366Returns current active templates in regit.txt and then all templates
2367"KRN",8994,2888,1,2,0)
2368in the system:
2369"KRN",8994,2888,1,3,0)
2370RESULT(1)="PT REGISTRATION [WorldVistA](1773)"
2371"KRN",8994,2888,1,4,0)
2372RESULT(2)="ADDRESS [WorldVistA](1774)"
2373"KRN",8994,2888,1,5,0)
2374RESULT(3)="NEXT OF KIN [WorldVistA](1776)"
2375"KRN",8994,2888,1,6,0)
2376RESULT(4)="EMERG. CONTACT [WorldVistA](1777)"
2377"KRN",8994,2888,1,7,0)
2378RESULT(5)="REPORTED DEATH [WorldVistA](1778)"
2379"KRN",8994,2888,1,8,0)
2380RESULT(6)="[ID]"
2381"KRN",8994,2888,1,9,0)
2382RESULT(7)="[ALL]"
2383"KRN",8994,2888,1,10,0)
2384RESULT(8)="*XUFILERANGE(12)"
2385"KRN",8994,2888,1,11,0)
2386RESULT(9)="*XUFILESINGLE(11)"
2387"KRN",8994,2888,1,12,0)
2388RESULT(10)="A1CK VARO/DHCP(1505)"
2389"KRN",8994,2888,1,13,0)
2390RESULT(11)="A4CG AMS4 BMS CONTRACT HRS(152)"
2391"KRN",8994,2888,1,14,0)
2392RESULT(12)="A4CG AMS4 BMS ENVIR CARE(154)"
2393"KRN",8994,2888,1,15,0)
2394RESULT(13)="A4CG AMS4 BMS HRS WORKED(153)"
2395"KRN",8994,2888,1,16,0)
2396etc.
2397"KRN",8994,2889,-1)
23980^21
2399"KRN",8994,2889,0)
2400VW REG TLIST^TLIST^VWREGITT^2^P^^^0^2
2401"KRN",8994,2889,1,0)
2402^^26^26^3160430^
2403"KRN",8994,2889,1,1,0)
2404Returns the full listing of templates from file .402
2405"KRN",8994,2889,1,2,0)
2406RESULT(1)="*XUFILERANGE(12)"
2407"KRN",8994,2889,1,3,0)
2408RESULT(2)="*XUFILESINGLE(11)"
2409"KRN",8994,2889,1,4,0)
2410RESULT(3)="A1CK VARO/DHCP(1505)"
2411"KRN",8994,2889,1,5,0)
2412RESULT(4)="A4CG AMS4 BMS CONTRACT HRS(152)"
2413"KRN",8994,2889,1,6,0)
2414RESULT(5)="A4CG AMS4 BMS ENVIR CARE(154)"
2415"KRN",8994,2889,1,7,0)
2416RESULT(6)="A4CG AMS4 BMS HRS WORKED(153)"
2417"KRN",8994,2889,1,8,0)
2418RESULT(7)="A4CG AMS4 BMS TEXTILE CARE(155)"
2419"KRN",8994,2889,1,9,0)
2420RESULT(8)="A4CG AMS4 CHAP FUNDS(157)"
2421"KRN",8994,2889,1,10,0)
2422RESULT(9)="A4CG AMS4 CHAP MONTHLY(156)"
2423"KRN",8994,2889,1,11,0)
2424RESULT(10)="A4CG AMS4 MMP QUARTERLY(158)"
2425"KRN",8994,2889,1,12,0)
2426RESULT(11)="A4CG AMS4 NURS FTEE(163)"
2427"KRN",8994,2889,1,13,0)
2428RESULT(12)="A4CG AMS4 NURS MANHOURS(162)"
2429"KRN",8994,2889,1,14,0)
2430RESULT(13)="A4CG AMS4 NURS MANPOWER(161)"
2431"KRN",8994,2889,1,15,0)
2432RESULT(14)="A4CG AMS4 REC DIRECT(159)"
2433"KRN",8994,2889,1,16,0)
2434RESULT(15)="A4CG AMS4 REC INDIRECT(160)"
2435"KRN",8994,2889,1,17,0)
2436RESULT(16)="AAQJ DOC/NOTES/MSG EDIT(1699)"
2437"KRN",8994,2889,1,18,0)
2438RESULT(17)="AAQJ EDIT PATCH RECORD(1698)"
2439"KRN",8994,2889,1,19,0)
2440RESULT(18)="ABSV ADD/EDIT MASTER(1334)"
2441"KRN",8994,2889,1,20,0)
2442RESULT(19)="ABSV COMBINATION EDIT(1335)"
2443"KRN",8994,2889,1,21,0)
2444RESULT(20)="ABSV CREATE(1327)"
2445"KRN",8994,2889,1,22,0)
2446RESULT(21)="ABSV DELAY/RELEASE TIMECARD(1329)"
2447"KRN",8994,2889,1,23,0)
2448RESULT(22)="ABSV DIRECTORY EDIT(1526)"
2449"KRN",8994,2889,1,24,0)
2450RESULT(23)="ABSV DON EDIT(1629)"
2451"KRN",8994,2889,1,25,0)
2452RESULT(24)="ABSV DON EDIT LETTER(1611)"
2453"KRN",8994,2889,1,26,0)
2454etc
2455"KRN",8994,2890,-1)
24560^12
2457"KRN",8994,2890,0)
2458VW REG MOD regit^DEL^VWREGITT^2^P^^^0^2
2459"KRN",8994,2890,1,0)
2460^8994.01^2^2^3160513^^
2461"KRN",8994,2890,1,1,0)
2462Takes in modified template list to file in
2463"KRN",8994,2890,1,2,0)
2464home directory/regit.txt
2465"KRN",8994,2890,2,0)
2466^8994.02A^1^1
2467"KRN",8994,2890,2,1,0)
2468TDATA^2^^1^2
2469"KRN",8994,2890,2,1,1,0)
2470^^1^1^3160513^
2471"KRN",8994,2890,2,1,1,1,0)
2472New listing of selectable templates
2473"KRN",8994,2890,2,"B","TDATA",1)
2474
2475"KRN",8994,2890,2,"PARAMSEQ",2,1)
2476
2477"KRN",8994,2891,-1)
24780^3
2479"KRN",8994,2891,0)
2480VW REG CF^CF^VWREGITX^2^P^^^0^2
2481"KRN",8994,2891,1,0)
2482^^2^2^3160622^
2483"KRN",8994,2891,1,1,0)
2484Returns the arbitrarily selected "civilian" fields located in
2485"KRN",8994,2891,1,2,0)
2486^DIZ(64850003) CIVILIAN PATIENT FIELDS
2487"MBREQ")
24880
2489"ORD",7,.402)
2490.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,"",%)
2491"ORD",7,.402,0)
2492INPUT TEMPLATE
2493"ORD",11,3.8)
24943.8;11;;;MAILG^XPDTA1;MAILGF1^XPDIA1;MAILGE1^XPDIA1;MAILGF2^XPDIA1;;MAILGDEL^XPDIA1(%)
2495"ORD",11,3.8,0)
2496MAIL GROUP
2497"ORD",16,8994)
24988994;16;1;;;;;;;RPCDEL^XPDIA1
2499"ORD",16,8994,0)
2500REMOTE PROCEDURE
2501"ORD",18,19)
250219;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA
2503"ORD",18,19,0)
2504OPTION
2505"ORD",20,8989.51)
25068989.51;20;;;PAR1E1^XPDTA2;PAR1F1^XPDIA3;PAR1E1^XPDIA3;PAR1F2^XPDIA3;;PAR1DEL^XPDIA3(%)
2507"ORD",20,8989.51,0)
2508PARAMETER DEFINITION
2509"QUES","XPF1",0)
2510Y
2511"QUES","XPF1","??")
2512^D REP^XPDH
2513"QUES","XPF1","A")
2514Shall I write over your |FLAG| File
2515"QUES","XPF1","B")
2516YES
2517"QUES","XPF1","M")
2518D XPF1^XPDIQ
2519"QUES","XPF2",0)
2520Y
2521"QUES","XPF2","??")
2522^D DTA^XPDH
2523"QUES","XPF2","A")
2524Want my data |FLAG| yours
2525"QUES","XPF2","B")
2526YES
2527"QUES","XPF2","M")
2528D XPF2^XPDIQ
2529"QUES","XPI1",0)
2530YO
2531"QUES","XPI1","??")
2532^D INHIBIT^XPDH
2533"QUES","XPI1","A")
2534Want KIDS to INHIBIT LOGONs during the install
2535"QUES","XPI1","B")
2536NO
2537"QUES","XPI1","M")
2538D XPI1^XPDIQ
2539"QUES","XPM1",0)
2540PO^VA(200,:EM
2541"QUES","XPM1","??")
2542^D MG^XPDH
2543"QUES","XPM1","A")
2544Enter the Coordinator for Mail Group '|FLAG|'
2545"QUES","XPM1","B")
2546
2547"QUES","XPM1","M")
2548D XPM1^XPDIQ
2549"QUES","XPO1",0)
2550Y
2551"QUES","XPO1","??")
2552^D MENU^XPDH
2553"QUES","XPO1","A")
2554Want KIDS to Rebuild Menu Trees Upon Completion of Install
2555"QUES","XPO1","B")
2556NO
2557"QUES","XPO1","M")
2558D XPO1^XPDIQ
2559"QUES","XPZ1",0)
2560Y
2561"QUES","XPZ1","??")
2562^D OPT^XPDH
2563"QUES","XPZ1","A")
2564Want to DISABLE Scheduled Options, Menu Options, and Protocols
2565"QUES","XPZ1","B")
2566NO
2567"QUES","XPZ1","M")
2568D XPZ1^XPDIQ
2569"QUES","XPZ2",0)
2570Y
2571"QUES","XPZ2","??")
2572^D RTN^XPDH
2573"QUES","XPZ2","A")
2574Want to MOVE routines to other CPUs
2575"QUES","XPZ2","B")
2576NO
2577"QUES","XPZ2","M")
2578D XPZ2^XPDIQ
2579"RTN")
25809
2581"RTN","BFPMAIL")
25820^9^B2204040
2583"RTN","BFPMAIL",1,0)
2584BJMAIL ; PTLD/JEB       ; Generic mail message  ; January 1990
2585"RTN","BFPMAIL",2,0)
2586 ;;3.0;WORLD VISTA/JEB;** **;;Build 4
2587"RTN","BFPMAIL",3,0)
2588 ;; General Public License: See WVLCI.txt
2589"RTN","BFPMAIL",4,0)
2590 ;User program sets variables calls MSG^BJMAIL (See variable List)
2591"RTN","BFPMAIL",5,0)
2592 ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2593"RTN","BFPMAIL",6,0)
2594 ; | VARIABLE LIST:                                                           |
2595"RTN","BFPMAIL",7,0)
2596 ; |  SET 'GROUP' TO THE MAIL GROUP NAME OR NUMBER                            |
2597"RTN","BFPMAIL",8,0)
2598 ; |  or                                                                      |
2599"RTN","BFPMAIL",9,0)
2600 ; |  K GROUP AND SET UP A 'TO()' ARRAY WITH THE DUZ AS THE SUBSCRIPT OF      |
2601"RTN","BFPMAIL",10,0)
2602 ; |   THE 'TO' ARRAY IF YOU WANT TO SEND A MSG TO AN INDIVIDUAL OR GROUP     |
2603"RTN","BFPMAIL",11,0)
2604 ; |   OF INDIVIDUALS WHO ARE NOT IN AN ESTABLISHED MAIL GROUP                |
2605"RTN","BFPMAIL",12,0)
2606 ; |  or                                                                      |
2607"RTN","BFPMAIL",13,0)
2608 ; |  SET 'GROUP' AND INDIVIDUAL 'T()' ARRAY NODES TO SEND TO THE             |
2609"RTN","BFPMAIL",14,0)
2610 ; |   ESTABLISHED GROUP AND INDIVIDUALS NOT IN THE GROUP                     |
2611"RTN","BFPMAIL",15,0)
2612 ; |  SET 'TITLE'=TO THE TITLE YOU WANT DISPLAYED                             |
2613"RTN","BFPMAIL",16,0)
2614 ; |  SET 'FROM' AS THE PERSON WHO IS SENDING THE MESSAGE ( A NULL 'FROM'     |
2615"RTN","BFPMAIL",17,0)
2616 ; |   WILL USE THE POSTMASTER).                                              |
2617"RTN","BFPMAIL",18,0)
2618 ; |  SET THE TEXT OF THE MESSAGE IN ARRAY USING 'T' AND SUBSCRIPT OF A NUMBER|
2619"RTN","BFPMAIL",19,0)
2620 ; |   I.,E                                                                   |
2621"RTN","BFPMAIL",20,0)
2622 ; |    T(1)="This is the first line of the message"                          |
2623"RTN","BFPMAIL",21,0)
2624 ; |    T(2)="This is the second line of the message, etc.                    |
2625"RTN","BFPMAIL",22,0)
2626 ; |  SET 'CONFIRM'=1 FOR A CONFIRMATION                                      |
2627"RTN","BFPMAIL",23,0)
2628 ; |  SET 'INFO'=1 FOR INFORMATION ONLYH (NO REPLIES ALLOWED) MESSAGE         |
2629"RTN","BFPMAIL",24,0)
2630 ; |  SET 'PRIO'=1 FOR PRIORITY DELIVERY                                      |
2631"RTN","BFPMAIL",25,0)
2632MSG ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2633"RTN","BFPMAIL",26,0)
2634 N XMINSTR
2635"RTN","BFPMAIL",27,0)
2636 D GROUP
2637"RTN","BFPMAIL",28,0)
2638 Q:$O(TO(""))=""
2639"RTN","BFPMAIL",29,0)
2640 ;
2641"RTN","BFPMAIL",30,0)
2642 I $G(CONFIRM) S XMINSTR("FLAGS")=$G(XMINSTR("FLAGS"))_"R"
2643"RTN","BFPMAIL",31,0)
2644 I $G(PRIO) S XMINSTR("FLAGS")=$G(XMINSTR("FLAGS"))_"P"
2645"RTN","BFPMAIL",32,0)
2646 I $G(INFO) S XMINSTR("FLAGS")=$G(XMINSTR("FLAGS"))_"I"
2647"RTN","BFPMAIL",33,0)
2648 I '$D(FROM) S FROM=.5
2649"RTN","BFPMAIL",34,0)
2650 D SETFROM^XMD(.FROM,.XMINSTR)
2651"RTN","BFPMAIL",35,0)
2652 I '$D(TITLE) S TITLE="Title not specified by sender"
2653"RTN","BFPMAIL",36,0)
2654 I $L(TITLE)>65 S TITLE=$E(TITLE,1,65)
2655"RTN","BFPMAIL",37,0)
2656 I $L(TITLE)<3 S TITLE=TITLE_"..."
2657"RTN","BFPMAIL",38,0)
2658 D SENDMSG^XMXAPI(FROM,TITLE,"T",.TO,.XMINSTR)
2659"RTN","BFPMAIL",39,0)
2660 K CONFIRM,FROM,GROUP,INFO,PRIO,T,TITLE,TO
2661"RTN","BFPMAIL",40,0)
2662 Q
2663"RTN","BFPMAIL",41,0)
2664GROUP ;
2665"RTN","BFPMAIL",42,0)
2666 Q:$G(GROUP)=""
2667"RTN","BFPMAIL",43,0)
2668 I +GROUP=GROUP S GROUP=$P($G(^XMB(3.8,GROUP,0)),"^")
2669"RTN","BFPMAIL",44,0)
2670 S TO("G."_GROUP)=""
2671"RTN","BFPMAIL",45,0)
2672 Q
2673"RTN","BFPMAIL",46,0)
2674 ;
2675"RTN","BFPMAIL",47,0)
2676 
2677"RTN","VWREGIT")
26780^1^B34500673
2679"RTN","VWREGIT",1,0)
2680VWREGIT ;Portland,OR/Jim Bell, et al Patient Registration Utility August 2015
2681"RTN","VWREGIT",2,0)
2682 ;;2.0;B/FProductions,LLC,WORLD VISTA;**LOCAL**;;Build 4
2683"RTN","VWREGIT",3,0)
2684 ;*******************************************************************
2685"RTN","VWREGIT",4,0)
2686 ;* VW Registration is designed for patient specific fields as      *
2687"RTN","VWREGIT",5,0)
2688 ;* defined in Fileman Input Templates or ad hoc field selection.   *
2689"RTN","VWREGIT",6,0)
2690 ;* Copyright Martius/MMXV ad infinitum (GNU License: See GPLv3.txt)*
2691"RTN","VWREGIT",7,0)
2692 ;*******************************************************************
2693"RTN","VWREGIT",8,0)
2694 ;;NO FALL THROUGH - JEB
2695"RTN","VWREGIT",9,0)
2696 Q
2697"RTN","VWREGIT",10,0)
2698 ;
2699"RTN","VWREGIT",11,0)
2700TFM(XF) ;TemplateField Management
2701"RTN","VWREGIT",12,0)
2702 ;***********************************************
2703"RTN","VWREGIT",13,0)
2704 ;* Check primary field entries for "parentage" *
2705"RTN","VWREGIT",14,0)
2706 ;* Add an "*" to gain all sub-fields of the    *
2707"RTN","VWREGIT",15,0)
2708 ;* parent                                      *
2709"RTN","VWREGIT",16,0)
2710 ;* REMEMBER: All fields pertain to file 2 only *
2711"RTN","VWREGIT",17,0)
2712 ;***********************************************
2713"RTN","VWREGIT",18,0)
2714 N I,N,FIELD
2715"RTN","VWREGIT",19,0)
2716 K FARRAY
2717"RTN","VWREGIT",20,0)
2718 I '$L(XF),'$G(TNUM) Q ""
2719"RTN","VWREGIT",21,0)
2720 I '$L(XF),+$G(TNUM) S XF=^DIE(TNUM,"DR",1,2)
2721"RTN","VWREGIT",22,0)
2722 F I=1:1:$L(XF,";") S:$L($P(XF,";",I)) FARRAY(I)=+$P(XF,";",I)
2723"RTN","VWREGIT",23,0)
2724 S N=0 F I=1:1 S N=$O(FARRAY(N)) Q:'+N  D
2725"RTN","VWREGIT",24,0)
2726 . S FIELD=FARRAY(N)
2727"RTN","VWREGIT",25,0)
2728 . I +$P(^DD(2,FIELD,0),"^",2) S FIELD=FIELD_"*",FMARRAY(FIELD)=$P(^(0),"^",4) K FARRAY(N)
2729"RTN","VWREGIT",26,0)
2730 S XF="",N=0 F  S N=$O(FARRAY(N)) Q:'+N  S XF=XF_FARRAY(N)_";"
2731"RTN","VWREGIT",27,0)
2732 Q XF
2733"RTN","VWREGIT",28,0)
2734 ;
2735"RTN","VWREGIT",29,0)
2736CHECK() ;
2737"RTN","VWREGIT",30,0)
2738 Q ""
2739"RTN","VWREGIT",31,0)
2740 ;
2741"RTN","VWREGIT",32,0)
2742INR() Q $O(RESULT(" "),-1)+1
2743"RTN","VWREGIT",33,0)
2744 ;
2745"RTN","VWREGIT",34,0)
2746EN(RESULT)    ;Template name and ID labels
2747"RTN","VWREGIT",35,0)
2748 ;Get the input template list
2749"RTN","VWREGIT",36,0)
2750 ;housekeeping
2751"RTN","VWREGIT",37,0)
2752 S DTIME=99999
2753"RTN","VWREGIT",38,0)
2754 ;end housekeeping
2755"RTN","VWREGIT",39,0)
2756 ;
2757"RTN","VWREGIT",40,0)
2758 K AR,RESULT
2759"RTN","VWREGIT",41,0)
2760 N N,HD,FILE,LOC,P4,P5,%ZISHF,%ZISHO,DEFST,XTMP,X
2761"RTN","VWREGIT",42,0)
2762 S RESULT(0)=1
2763"RTN","VWREGIT",43,0)
2764 S DEFST="";
2765"RTN","VWREGIT",44,0)
2766 ;S DEFTMP=$O(^DIE("B","FAU_EDU",0)) ;For Florida College only
2767"RTN","VWREGIT",45,0)
2768 S RESULT(0)=$$CONTROL^VWREGITU()
2769"RTN","VWREGIT",46,0)
2770 S RESULT(1)="-1^No templates found"
2771"RTN","VWREGIT",47,0)
2772 S DEFST=$$GET^XPAR("ALL","VW REG DEFAULT STATE")
2773"RTN","VWREGIT",48,0)
2774 S DEFTMP=$$GET^XPAR("ALL","VW REG RDNPT")
2775"RTN","VWREGIT",49,0)
2776 S HD=$$GET^XPAR("ALL","VW GUI REG TEMPLATE DIRECTORY")
2777"RTN","VWREGIT",50,0)
2778 I '$L(HD) K RESULT D  Q
2779"RTN","VWREGIT",51,0)
2780 . S RESULT($$INR)="-1^NO HOME DIRECTORY - refer to IT support, if necessary."
2781"RTN","VWREGIT",52,0)
2782 . S RESULT($$INR)="No home directory has been supplied which indicates"
2783"RTN","VWREGIT",53,0)
2784 . S RESULT($$INR)="the VWREG installation is incomplete. See the Help manual"
2785"RTN","VWREGIT",54,0)
2786 . S RESULT($$INR)="for installation and Enter/Editing parameter values."
2787"RTN","VWREGIT",55,0)
2788 . S RESULT($$INR)="Thank you,"
2789"RTN","VWREGIT",56,0)
2790 . S RESULT($$INR)="      The Management."
2791"RTN","VWREGIT",57,0)
2792 S FILE="regit.txt"
2793"RTN","VWREGIT",58,0)
2794 S P4=1
2795"RTN","VWREGIT",59,0)
2796 S P5=""
2797"RTN","VWREGIT",60,0)
2798 S X=$$FTG^%ZISH(HD,FILE,$NA(AR(1)),P4,P5)
2799"RTN","VWREGIT",61,0)
2800 D:+RESULT(0)
2801"RTN","VWREGIT",62,0)
2802 . S $P(RESULT(0),"^",2)=$G(HD)
2803"RTN","VWREGIT",63,0)
2804 . S $P(RESULT(0),"^",3)=$S(DEFST:$P(^DIC(5,DEFST,0),"^")_"("_DEFST_")",1:"")
2805"RTN","VWREGIT",64,0)
2806 . S $P(RESULT(0),"^",4)=$S(+DEFTMP:$P(^DIE(DEFTMP,0),"^")_"("_DEFTMP_")",1:DEFTMP)
2807"RTN","VWREGIT",65,0)
2808 . S $P(RESULT(0),"^",5)=DUZ
2809"RTN","VWREGIT",66,0)
2810 I $O(AR(0)) S RESULT(1)="[TEMPLATES]"
2811"RTN","VWREGIT",67,0)
2812 S N=0 F  S N=$O(AR(N)) Q:'+N  D
2813"RTN","VWREGIT",68,0)
2814 . Q:$E(AR(N))="*"
2815"RTN","VWREGIT",69,0)
2816 . Q:'+$P(AR(N),"(",2)
2817"RTN","VWREGIT",70,0)
2818 . Q:$P(^DIE(+$P(AR(N),"(",2),0),"^",4)'=2  ;must be pat file
2819"RTN","VWREGIT",71,0)
2820 . S RESULT($$INR)=AR(N)
2821"RTN","VWREGIT",72,0)
2822 S RESULT($$INR)="[ID]"
2823"RTN","VWREGIT",73,0)
2824 S N=0 F  S N=$O(^DIZ(64850003,N)) Q:'+N  S RESULT($$INR)=$P(^(N,0),"^",2)_"("_$P(^(0),"^")_")"
2825"RTN","VWREGIT",74,0)
2826 S N=0 F  S N=$O(RESULT(N)) Q:'+N  K:RESULT(N)="" RESULT(N)
2827"RTN","VWREGIT",75,0)
2828 I '$O(RESULT(0)) S RESULT(1)="-1^No PATIENT FILE templates found"
2829"RTN","VWREGIT",76,0)
2830 K AR
2831"RTN","VWREGIT",77,0)
2832 Q
2833"RTN","VWREGIT",78,0)
2834 ;
2835"RTN","VWREGIT",79,0)
2836NPT(RESULT,TNAME) ;
2837"RTN","VWREGIT",80,0)
2838 ; *************************************************
2839"RTN","VWREGIT",81,0)
2840 ; * Incoming: DFN^TEMPLATE NAME(IEN)              *
2841"RTN","VWREGIT",82,0)
2842 ; * Process : Get template fields plus any help   *
2843"RTN","VWREGIT",83,0)
2844 ; *           If +TNAME (a DFN), get DFN data for *
2845"RTN","VWREGIT",84,0)
2846 ; *           the template fields (Put data in    *
2847"RTN","VWREGIT",85,0)
2848 ; *           $P(RESULT(N),"^",3))                *
2849"RTN","VWREGIT",86,0)
2850 ; * Return  : RESULT(N), etc                      *
2851"RTN","VWREGIT",87,0)
2852 ; *************************************************
2853"RTN","VWREGIT",88,0)
2854 ;W "  ;Intentional bust for debugging
2855"RTN","VWREGIT",89,0)
2856 N N,TNUM,FIELDS,F,FNAME,FVALUE,FHELP,FPSC,FNUM
2857"RTN","VWREGIT",90,0)
2858 S TNUM=+$P(TNAME,"(",2),DFN=+TNAME
2859"RTN","VWREGIT",91,0)
2860 I 'TNUM S RESULT(0)="0^new patient Template not found" Q
2861"RTN","VWREGIT",92,0)
2862 S TNAME=$P($P(TNAME,"^",2),"(")
2863"RTN","VWREGIT",93,0)
2864 S TNAME=$TR(TNAME,"$&*","")  ;Clean out TMENU chars
2865"RTN","VWREGIT",94,0)
2866 I TNAME="GENERIC INS. FRM [WorldVistA]" G GIF
2867"RTN","VWREGIT",95,0)
2868 S FIELDS=$G(^DIE(TNUM,"DR",1,2))
2869"RTN","VWREGIT",96,0)
2870 I '$L(FIELDS) Q
2871"RTN","VWREGIT",97,0)
2872 K RESULT S (FNUM,FCAP)=""
2873"RTN","VWREGIT",98,0)
2874 F I=1:1:$L(FIELDS,";")-1 D
2875"RTN","VWREGIT",99,0)
2876 . S F=$P(FIELDS,";",I)
2877"RTN","VWREGIT",100,0)
2878 . I F["~" S FNUM=+F,FNAME=$P($P(F,"~"),FNUM,2),F=FNUM K FNUM
2879"RTN","VWREGIT",101,0)
2880 . S FNAME=$S($L($G(FNAME)):FNAME,$L($G(^DD(2,F,.1))):$P(^(.1),"^"),1:$P(^DD(2,F,0),"^"))
2881"RTN","VWREGIT",102,0)
2882 . S FVALUE=""  ;Patient Data
2883"RTN","VWREGIT",103,0)
2884 . S FHELP=$G(^DD(2,F,3))
2885"RTN","VWREGIT",104,0)
2886 . 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)
2887"RTN","VWREGIT",105,0)
2888 . S FHELP=$TR(FHELP,"'","`")
2889"RTN","VWREGIT",106,0)
2890 . S FPSC=$P(^DD(2,F,0),"^",3)
2891"RTN","VWREGIT",107,0)
2892 . S SUBDIC=+$P(^DD(2,F,0),"^",2)
2893"RTN","VWREGIT",108,0)
2894 . S RESULT($$INR)=FNAME_"^"_F_"^"_FVALUE_"^"_FHELP_"^"_FPSC_$S(SUBDIC:"^1",1:"^0")
2895"RTN","VWREGIT",109,0)
2896 . S (FNAME,FVALUE,FHELP,FPSC)=""
2897"RTN","VWREGIT",110,0)
2898 G NPTX:'DFN
2899"RTN","VWREGIT",111,0)
2900 I DFN D GETS^DIQ(2,DFN_",","**","EN","AR")  ;,RESULT(0)=$$DFNID^VWREGITU
2901"RTN","VWREGIT",112,0)
2902 K FIELD S N=0 F  S N=$O(RESULT(N)) Q:'+N  S FIELD($P(RESULT(N),"^",2))=""
2903"RTN","VWREGIT",113,0)
2904 S X="AR" F  S X=$Q(@X) Q:X=""  D
2905"RTN","VWREGIT",114,0)
2906 . S FILE=+$P(X,"(",2)
2907"RTN","VWREGIT",115,0)
2908 . S FIELD=+$P(X,",",$L(X,",")-1)
2909"RTN","VWREGIT",116,0)
2910 . I $D(FIELD(FIELD)) S FIELD(FIELD)=@X
2911"RTN","VWREGIT",117,0)
2912 S N=0 F  S N=$O(FIELD(N)) Q:'+N  D
2913"RTN","VWREGIT",118,0)
2914 . S N2=0 F  S N2=$O(RESULT(N2)) Q:'+N2  I $P(RESULT(N2),"^",2)=N S $P(RESULT(N2),"^",3)=FIELD(N)
2915"RTN","VWREGIT",119,0)
2916 . S RESULT(0)=$$DFNID^VWREGITU()
2917"RTN","VWREGIT",120,0)
2918NPTX K FIELD,AR,FCAP,FILE,SUBDIC,N,N2,DFN
2919"RTN","VWREGIT",121,0)
2920 Q
2921"RTN","VWREGIT",122,0)
2922 ;
2923"RTN","VWREGIT",123,0)
2924PF(RESULT,XPF) ;Pointer file - get the stuff
2925"RTN","VWREGIT",124,0)
2926 K RESULT,AR
2927"RTN","VWREGIT",125,0)
2928 N X,N
2929"RTN","VWREGIT",126,0)
2930 I '$L(XPF) S RESULT(0)="???" Q
2931"RTN","VWREGIT",127,0)
2932 S XPF="^"_XPF
2933"RTN","VWREGIT",128,0)
2934 I +$P(XPF,"(",2)=.85 G NAUTPF  ;Naughty file!
2935"RTN","VWREGIT",129,0)
2936 S N=0 F  S N=$O(@(XPF_N_")")) Q:'+N  S X=$P(^(N,0),"^"),AR(X,N)=X_"("_N_")"
2937"RTN","VWREGIT",130,0)
2938 S X="AR" F  S X=$Q(@X) Q:X=""  S RESULT($$INR)=@X
2939"RTN","VWREGIT",131,0)
2940 K AR
2941"RTN","VWREGIT",132,0)
2942 Q
2943"RTN","VWREGIT",133,0)
2944 ;
2945"RTN","VWREGIT",134,0)
2946NAUTPF ;The "NAUGHTY" pointer file - has a numeric .01 - Bad file !!!
2947"RTN","VWREGIT",135,0)
2948 S N=0 F  S N=$O(@(XPF_N_")")) Q:'+N  S X=$P(^(N,0),"^") D
2949"RTN","VWREGIT",136,0)
2950 . S LANG=$P(^(0),"^",2)
2951"RTN","VWREGIT",137,0)
2952 . S AR(LANG,N)=LANG_"("_N_")"
2953"RTN","VWREGIT",138,0)
2954 S X="AR" F  S X=$Q(@X) Q:X=""  S RESULT($$INR)=@X
2955"RTN","VWREGIT",139,0)
2956 Q
2957"RTN","VWREGIT",140,0)
2958GIF ;Generic Insurance form
2959"RTN","VWREGIT",141,0)
2960 K RESULT
2961"RTN","VWREGIT",142,0)
2962 S RESULT($$INR)="Insurance Company^2.312;.01^^^DIC(36,^0"
2963"RTN","VWREGIT",143,0)
2964 S RESULT($$INR)="Group Plan^2.312;.18^^^IBA(355.3,^0"
2965"RTN","VWREGIT",144,0)
2966 S RESULT($$INR)="Policy No.^2.312;1^^^^0"
2967"RTN","VWREGIT",145,0)
2968 ;S RESULT($$INR)="Type of Plan^^^^^0"
2969"RTN","VWREGIT",146,0)
2970 S RESULT($$INR)="Coverage^355.33;40.09^^^IBE(355.1,^0"
2971"RTN","VWREGIT",147,0)
2972 S RESULT($$INR)="Effective Date^2.312;8^^^^0"
2973"RTN","VWREGIT",148,0)
2974 S RESULT($$INR)="Expiration Date^.3121;^^^^0"
2975"RTN","VWREGIT",149,0)
2976 S RESULT($$INR)="Guarantor^^^^^0"
2977"RTN","VWREGIT",150,0)
2978 S RESULT($$INR)="Signature on File^^^^0:NO;1:YES^0"
2979"RTN","VWREGIT",151,0)
2980 S RESULT($$INR)="Employer^2.312;2.015^^^^0"
2981"RTN","VWREGIT",152,0)
2982 S RESULT($$INR)="Billing Address^2.312;2.02^^^^0"
2983"RTN","VWREGIT",153,0)
2984 S RESULT($$INR)="Billing Address(cont)^2.312;2.03^^^^0"
2985"RTN","VWREGIT",154,0)
2986 S RESULT($$INR)="Postal Code^2.312;2.07^^^^0"
2987"RTN","VWREGIT",155,0)
2988 S RESULT($$INR)="City^2.312;2.05^^^^0"
2989"RTN","VWREGIT",156,0)
2990 S RESULT($$INR)="County/Region/Area^^^^^0"
2991"RTN","VWREGIT",157,0)
2992 S RESULT($$INR)="State/Province/Region^2.312;2.06^^^DIC(5,^0"
2993"RTN","VWREGIT",158,0)
2994 Q
2995"RTN","VWREGIT",159,0)
2996 ;
2997"RTN","VWREGIT",160,0)
2998 
2999"RTN","VWREGIT2")
30000^11^B4385801
3001"RTN","VWREGIT2",1,0)
3002VWREGIT2 ;Portland/WorldVista/BFP,LLC/Jim Bell, et al... - Post-Install for VWREG       
3003"RTN","VWREGIT2",2,0)
3004 ;;1.0;WORLD VISTA;**HOME **;;Build 4
3005"RTN","VWREGIT2",3,0)
3006 ;
3007"RTN","VWREGIT2",4,0)
3008 ;Continued from VWREGIT
3009"RTN","VWREGIT2",5,0)
3010 ;
3011"RTN","VWREGIT2",6,0)
3012 ;GNU License: See WVLIC.txt
3013"RTN","VWREGIT2",7,0)
3014 ;Modified FOIA VISTA,
3015"RTN","VWREGIT2",8,0)
3016 ;Copyright 2013 WorldVistA.  Licensed under the terms of the GNU
3017"RTN","VWREGIT2",9,0)
3018 Q
3019"RTN","VWREGIT2",10,0)
3020 ;
3021"RTN","VWREGIT2",11,0)
3022PI ;Post Installation install
3023"RTN","VWREGIT2",12,0)
3024 ;Checking for a home directory & file
3025"RTN","VWREGIT2",13,0)
3026 ZSY "source vwreg_postinstall.sh"
3027"RTN","VWREGIT2",14,0)
3028 S AR=1,AR(1)="[TEMPLATES]"
3029"RTN","VWREGIT2",15,0)
3030 S N=0 F  S N=$O(^DIE(N)) Q:'+N  S X=$P(^(N,0),"^") D
3031"RTN","VWREGIT2",16,0)
3032 . I X["VW " S AR($I(AR))=X_"("_N_")"
3033"RTN","VWREGIT2",17,0)
3034 . I X["[World" S AR($I(AR))=X_"("_N_")"
3035"RTN","VWREGIT2",18,0)
3036 S AR($I(AR))="[ID]"
3037"RTN","VWREGIT2",19,0)
3038 S P4=1,P5="",HD=$ZDIRECTORY_"regparam/",FILE="regit.txt"
3039"RTN","VWREGIT2",20,0)
3040 S X=$$GTF^%ZISH($NA(AR(1)),1,HD,"regit.txt")
3041"RTN","VWREGIT2",21,0)
3042 ;
3043"RTN","VWREGIT2",22,0)
3044 ;; NOTE: The parameter definition is installed but there is no installation for
3045"RTN","VWREGIT2",23,0)
3046 ;;the actual parameter and value. Do it here.
3047"RTN","VWREGIT2",24,0)
3048 ;parameter value attempt
3049"RTN","VWREGIT2",25,0)
3050 ;Set a home directory for editing; SYSTEM (DIC(4,) and DOMAIN (DIC(4.2,) only:"/home/vista/regparam/"
3051"RTN","VWREGIT2",26,0)
3052 S PARD=$O(^XTV(8989.51,"B","VW GUI REG TEMPLATE DIRECTORY",0))
3053"RTN","VWREGIT2",27,0)
3054 I PARD D
3055"RTN","VWREGIT2",28,0)
3056 . L +^XTV(8989.5,0):1 D  L -^XTV(8989.5,0)
3057"RTN","VWREGIT2",29,0)
3058 .. S NEW=$O(^XTV(8989.5," "),-1)+1
3059"RTN","VWREGIT2",30,0)
3060 .. S $P(^XTV(8989.5,0),"^",3)=NEW
3061"RTN","VWREGIT2",31,0)
3062 .. S $P(^XTV(8989.5,0),"^",4)=$P(^(0),"^",4)+1
3063"RTN","VWREGIT2",32,0)
3064 .. S $P(^XTV(8989.5,NEW,0),"^")="1;DIC(4,"
3065"RTN","VWREGIT2",33,0)
3066 .. S $P(^XTV(8989.5,NEW,0),"^",2)=PARD
3067"RTN","VWREGIT2",34,0)
3068 .. S $P(^XTV(8989.5,NEW,0),"^",3)=1
3069"RTN","VWREGIT2",35,0)
3070 .. S ^XTV(8989.5,NEW,1)=HD
3071"RTN","VWREGIT2",36,0)
3072 .. S DA=NEW,DIK="^XTV(8989.5," D IX^DIK
3073"RTN","VWREGIT2",37,0)
3074 .. S NEW2=$O(^XTV(8989.5," "),-1)+1
3075"RTN","VWREGIT2",38,0)
3076 .. S $P(^XTV(8989.5,0),"^",3)=NEW2
3077"RTN","VWREGIT2",39,0)
3078 .. S $P(^XTV(8989.5,0),"^",4)=$P(^(0),"^",4)+1
3079"RTN","VWREGIT2",40,0)
3080 .. S $P(^XTV(8989.5,NEW2,0),"^")="9;DIC(4.2,"
3081"RTN","VWREGIT2",41,0)
3082 .. S $P(^XTV(8989.5,NEW2,0),"^",2)=PARD
3083"RTN","VWREGIT2",42,0)
3084 .. S $P(^XTV(8989.5,NEW2,0),"^",3)=1
3085"RTN","VWREGIT2",43,0)
3086 .. S ^XTV(8989.5,NEW2,1)=HD
3087"RTN","VWREGIT2",44,0)
3088 .. S DA=NEW2,DIK="^XTV(8989.5," D IX^DIK
3089"RTN","VWREGIT2",45,0)
3090 ;
3091"RTN","VWREGIT2",46,0)
3092 ;Mailgroup VW REG ERROR REPORT - add programmer's email
3093"RTN","VWREGIT2",47,0)
3094 S DA(1)=$O(^XMB(3.8,"B","VW REG ERROR REPORT",0))
3095"RTN","VWREGIT2",48,0)
3096 Q:'DA(1)
3097"RTN","VWREGIT2",49,0)
3098 S DIC="^XMB(3.8,"_DA(1)_",6,"
3099"RTN","VWREGIT2",50,0)
3100 S X="jbellco65@gmail.com"
3101"RTN","VWREGIT2",51,0)
3102 S DIC(0)="LZ"
3103"RTN","VWREGIT2",52,0)
3104 D FILE^DICN
3105"RTN","VWREGIT2",53,0)
3106 Q
3107"RTN","VWREGIT2",54,0)
3108 ;
3109"RTN","VWREGIT3")
31100^3^B4498
3111"RTN","VWREGIT3",1,0)
3112VWREGIT3 ;VWEHR/BFProd-Jim Bell, et al - World VistA GUI Pat Reg Utility
3113"RTN","VWREGIT3",2,0)
3114 ;;1.0;WORLD VISTA;** **;;Build 4
3115"RTN","VWREGIT3",3,0)
3116 ;
3117"RTN","VWREGIT3",4,0)
3118 ;This routine utility is for patient specific fields and
3119"RTN","VWREGIT3",5,0)
3120 ;is used to build input templates for registration
3121"RTN","VWREGIT3",6,0)
3122 ;
3123"RTN","VWREGIT3",7,0)
3124 ;GNU License: See WVLIC.txt
3125"RTN","VWREGIT3",8,0)
3126 ;Modified FOIA VISTA,
3127"RTN","VWREGIT3",9,0)
3128 ;Copyright 2013 WorldVistA.  Licensed under the terms of the GNU
3129"RTN","VWREGIT3",10,0)
3130 Q
3131"RTN","VWREGIT3",11,0)
3132 ;
3133"RTN","VWREGITP")
31340^4^B5382212
3135"RTN","VWREGITP",1,0)
3136VWREGITP ;BFP/Portland,OR-Jim Bell,et al - Client Registration Utility
3137"RTN","VWREGITP",2,0)
3138        ;2.0;BFP for WorldVistA;**LOCAL**;;;Build 4
3139"RTN","VWREGITP",3,0)
3140 ; *******************************************
3141"RTN","VWREGITP",4,0)
3142 ; * Copyright 2015 ad infinitum et ultra    *
3143"RTN","VWREGITP",5,0)
3144 ; * Gets data for existing clients/patients *
3145"RTN","VWREGITP",6,0)
3146 ; * GPL License: See License.txt            *
3147"RTN","VWREGITP",7,0)
3148 ; *******************************************
3149"RTN","VWREGITP",8,0)
3150 Q  ;No fall through - jeb
3151"RTN","VWREGITP",9,0)
3152 ;
3153"RTN","VWREGITP",10,0)
3154GPD(RESULT,DATA) ;Get patient data
3155"RTN","VWREGITP",11,0)
3156 ; ********************************* 8888***
3157"RTN","VWREGITP",12,0)
3158 ; * DATA_____TEMPLATE(IEN)^FIELDSET^DFN   *
3159"RTN","VWREGITP",13,0)
3160 ; * TEMPLATE__The name(IEN) of a          *
3161"RTN","VWREGITP",14,0)
3162 ; *            stored template            *
3163"RTN","VWREGITP",15,0)
3164 ; * FIELDSET_Adhoc fields in a string     *
3165"RTN","VWREGITP",16,0)
3166 ; *          as ".01;3;5;.131", etc       *
3167"RTN","VWREGITP",17,0)
3168 ; * DFN______IEN of patient file(#2)      *
3169"RTN","VWREGITP",18,0)
3170 ; * NOTE: TEMPLATE takes precedence       *
3171"RTN","VWREGITP",19,0)
3172 ; *       over FIELDSET                   *
3173"RTN","VWREGITP",20,0)
3174 ; *****************************************
3175"RTN","VWREGITP",21,0)
3176 ;
3177"RTN","VWREGITP",22,0)
3178 K RESULT,AR
3179"RTN","VWREGITP",23,0)
3180 N VAR,TNUM,FSET,F,DFN
3181"RTN","VWREGITP",24,0)
3182 I '$L(DATA) S RESULT(0)="No information relayed. Please try again" Q
3183"RTN","VWREGITP",25,0)
3184 I $P(DATA,"^",3)="" S RESULT(0)="Patient info not relayed. Please try again" Q
3185"RTN","VWREGITP",26,0)
3186 S VAR="TNUM^ADHOC^DFN" F I=1:1:3 S @$P(VAR,"^",I)=$P(DATA,"^",I)
3187"RTN","VWREGITP",27,0)
3188 S TNUM=$S(TNUM["(":+$P(TNUM,"(",2),1:TNUM)
3189"RTN","VWREGITP",28,0)
3190 S DFN=+$P($P(DATA,"^",3),"(",2)
3191"RTN","VWREGITP",29,0)
3192 S FSET=$S(TNUM:^DIE(TNUM,"DR",1,2),'TNUM&($L(ADHOC)):ADHOC,1:"")
3193"RTN","VWREGITP",30,0)
3194 D GETS^DIQ(2,DFN_",","**","N","AR")
3195"RTN","VWREGITP",31,0)
3196 F I=1:1:$L(FSET,";") D
3197"RTN","VWREGITP",32,0)
3198 . Q:'$L($P(FSET,";",I))
3199"RTN","VWREGITP",33,0)
3200 . S F=+$P(FSET,";",I)
3201"RTN","VWREGITP",34,0)
3202 . S RESULT($$INR^VWREGIT)=F_"^"_$G(AR(2,DFN_",",F))
3203"RTN","VWREGITP",35,0)
3204 Q
3205"RTN","VWREGITP",36,0)
3206GPDM(RESULT,DATA) ;
3207"RTN","VWREGITP",37,0)
3208 ; ****************************************************************
3209"RTN","VWREGITP",38,0)
3210 ; * DATA____Parent Text^Parent field #^PATIENT IEN^TEMPLATE(IEN) *
3211"RTN","VWREGITP",39,0)
3212 ; ****************************************************************
3213"RTN","VWREGITP",40,0)
3214 N F,SUBD,DFN,PIEN,X,RIND,FILE,X,Y,TNUM
3215"RTN","VWREGITP",41,0)
3216 K MX,MAR,RESULT,AR
3217"RTN","VWREGITP",42,0)
3218 S DFN=+$P(DATA,"^",3)
3219"RTN","VWREGITP",43,0)
3220 S F=+$P(DATA,"^",2)
3221"RTN","VWREGITP",44,0)
3222 S TNUM=+$P($P(DATA,"^",4),"(",2)
3223"RTN","VWREGITP",45,0)
3224 D GETS^DIQ(2,DFN_",",F_"*;","E","AR")
3225"RTN","VWREGITP",46,0)
3226 S SUBD=+$P(^DD(2,F,0),"^",2) D:+SUBD  ;Multiple field values
3227"RTN","VWREGITP",47,0)
3228 . S MX="AR("_SUBD_")" F  S MX=$Q(@MX) Q:MX=""!(+$P(MX,"(",2)'=SUBD)  D:$P(MX,",",$L(MX,",")-1)'=.01
3229"RTN","VWREGITP",48,0)
3230 .. S FILE=SUBD,PIEN=$P(MX,",",2,$L(MX,",")-1),PIEN=$TR(PIEN,"""","")
3231"RTN","VWREGITP",49,0)
3232 .. K MAR,IMAR
3233"RTN","VWREGITP",50,0)
3234 .. D GETS^DIQ(FILE,PIEN,"**","E","MAR")
3235"RTN","VWREGITP",51,0)
3236 .. D GETS^DIQ(FILE,PIEN,"**","I","IMAR")
3237"RTN","VWREGITP",52,0)
3238 .. S X=$Q(@"MAR"),Y=$Q(@"IMAR")
3239"RTN","VWREGITP",53,0)
3240 .. I @X'=@Y S @X=@X_"("_@Y_")"
3241"RTN","VWREGITP",54,0)
3242 .. S X="MAR"  ;,RIND=$$INR^VWREGIT
3243"RTN","VWREGITP",55,0)
3244 .. S RIND=$$INR^VWREGIT,RESULT(RIND)="" F  S X=$Q(@X) Q:X=""  S RESULT(RIND)=RESULT(RIND)_@X_"^"
3245"RTN","VWREGITP",56,0)
3246 K AR,MAR,IMAR,MX
3247"RTN","VWREGITP",57,0)
3248 Q
3249"RTN","VWREGITS")
32500^5^B13044192
3251"RTN","VWREGITS",1,0)
3252VWREGITS ;Portland,OR/jeb et al Save utility for VWREG* routines 11/2015
3253"RTN","VWREGITS",2,0)
3254 ;V.2;;**LOCAL**;;;Build 4
3255"RTN","VWREGITS",3,0)
3256 ;c2014 ad infiniti, BellFelder Productions (BF Productions) & WorldVistA
3257"RTN","VWREGITS",4,0)
3258 ;License: See License.txt that with install
3259"RTN","VWREGITS",5,0)
3260 ;No fall thru - jeb
3261"RTN","VWREGITS",6,0)
3262 Q
3263"RTN","VWREGITS",7,0)
3264 ;
3265"RTN","VWREGITS",8,0)
3266 ;* *****************************************************************
3267"RTN","VWREGITS",9,0)
3268 ;* Data coming in may be for a new case or existing case           *
3269"RTN","VWREGITS",10,0)
3270 ;* Incoming: Array LDATA=                                          *
3271"RTN","VWREGITS",11,0)
3272 ;*   LDATA(1)=Field^Field number^value^[optional]DFN               *
3273"RTN","VWREGITS",12,0)
3274 ;*                       LDATA(N...)=Field^Field number^value      *
3275"RTN","VWREGITS",13,0)
3276 ;* Exception for Multiples:                                        *
3277"RTN","VWREGITS",14,0)
3278 ;*   LDATA(N)=Field(SUBDD;Field number):value(IEN)^...etc for every*
3279"RTN","VWREGITS",15,0)
3280 ;*            field that is a dependent of the parent              *
3281"RTN","VWREGITS",16,0)
3282 ;* Process:                                                        *
3283"RTN","VWREGITS",17,0)
3284 ;*  1. call is at Label SAVE                                       *
3285"RTN","VWREGITS",18,0)
3286 ;*  2. Some housekeeping that this programmer needs to do proper   *
3287"RTN","VWREGITS",19,0)
3288 ;*     string evaluations.                                         *
3289"RTN","VWREGITS",20,0)
3290 ;*  3. Filing of a new case with FILE^DICN.                        *
3291"RTN","VWREGITS",21,0)
3292 ;*  4. Remaining major fields are filed with DIE                   *
3293"RTN","VWREGITS",22,0)
3294 ;*  5. Multiples are filed with UPDATE^DIE                         *
3295"RTN","VWREGITS",23,0)
3296 ;*  6. Existing entries will contain only edited data and will     *
3297"RTN","VWREGITS",24,0)
3298 ;*     address those fields as in 4 & 5.                           *
3299"RTN","VWREGITS",25,0)
3300 ;* Bon Appettit, et al.                                            *
3301"RTN","VWREGITS",26,0)
3302 ;*******************************************************************
3303"RTN","VWREGITS",27,0)
3304SAVE(RESULT,LDATA) ;
3305"RTN","VWREGITS",28,0)
3306 K RESULT,^DIZ("DS",$J)
3307"RTN","VWREGITS",29,0)
3308 ;N DFN,DIC,DA,DR,VAR,FIELD,N,N1,X,Y,DIE,DIK
3309"RTN","VWREGITS",30,0)
3310 I $D(LDATA)<10 S RESULT(0)="-1: No data sent for filing. Please contact your IT dept." Q
3311"RTN","VWREGITS",31,0)
3312 ;UPcase everyTHING
3313"RTN","VWREGITS",32,0)
3314 S XDAT="LDATA" F  S XDAT=$Q(@XDAT) Q:XDAT=""  S @XDAT=$$UP^XLFSTR(@XDAT)
3315"RTN","VWREGITS",33,0)
3316 ;
3317"RTN","VWREGITS",34,0)
3318 ;Incoming housekeeping
3319"RTN","VWREGITS",35,0)
3320 S X="LDATA" F I=1:1 S X=$Q(@X) Q:X=""  I @X[":",@X[";" S ^DIZ("DS",$J,I)=@X K @X
3321"RTN","VWREGITS",36,0)
3322 I +$P(@$Q(LDATA),"^",4)!(+$P(@$Q(LDATA),"(",2)) G EXP ;DFN sent by client
3323"RTN","VWREGITS",37,0)
3324 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)
3325"RTN","VWREGITS",38,0)
3326 S DFN=$$FIND1^DIC(2,"","M",$P(LDATA(1),"^",3),"","","ERR")
3327"RTN","VWREGITS",39,0)
3328 G EXP:DFN  ;Found patient/client
3329"RTN","VWREGITS",40,0)
3330 ;End housekeeping;
3331"RTN","VWREGITS",41,0)
3332 ;
3333"RTN","VWREGITS",42,0)
3334 S X=$P(LDATA(1),"^",3) D
3335"RTN","VWREGITS",43,0)
3336 . S DIC="^DPT(",DIC(0)="LZ" K D0 D FILE^DICN S (DA,DFN)=+Y
3337"RTN","VWREGITS",44,0)
3338 . S DIC="^AUPNPAT(",DIC(0)="LZ",X=DFN,DINUM=X,DIC(0)="L" D FILE^DICN
3339"RTN","VWREGITS",45,0)
3340 . S DIE=DIC,DR=.02_"////^S X=DT" D ^DIE
3341"RTN","VWREGITS",46,0)
3342 . S DR=.11_"////^S X=DUZ" D ^DIE
3343"RTN","VWREGITS",47,0)
3344LDPT L +^DPT(DFN):1 G LDPT:'$T
3345"RTN","VWREGITS",48,0)
3346 S N=1 F  S N=$O(LDATA(N)) Q:'+N  D
3347"RTN","VWREGITS",49,0)
3348 . Q:$P(LDATA(N),"^",2)[";"
3349"RTN","VWREGITS",50,0)
3350 . Q:'+$P(LDATA(N),"^",2)  ;Marker of some kind
3351"RTN","VWREGITS",51,0)
3352 . S FIELD=$P(LDATA(N),"^",2)
3353"RTN","VWREGITS",52,0)
3354 . S VAR=$P(LDATA(N),"^",3)
3355"RTN","VWREGITS",53,0)
3356 . S:VAR["(" VAR=$S($L(VAR,"(")>2:+$P(VAR,"(",$L(VAR,"(")),1:+$P(VAR,"(",2))
3357"RTN","VWREGITS",54,0)
3358 . S DIE="^DPT(",DR=FIELD_"///"_$S(+VAR:"/",1:"")_"^S X=VAR" D ^DIE
3359"RTN","VWREGITS",55,0)
3360 L -^DPT(DFN)
3361"RTN","VWREGITS",56,0)
3362 D M  ;File any multiple fields
3363"RTN","VWREGITS",57,0)
3364 S RESULT(0)="Filed..."
3365"RTN","VWREGITS",58,0)
3366 K ^DIZ("DS",$J)
3367"RTN","VWREGITS",59,0)
3368 Q
3369"RTN","VWREGITS",60,0)
3370 ;
3371"RTN","VWREGITS",61,0)
3372EXP ;Existing Patient
3373"RTN","VWREGITS",62,0)
3374 K X,FNAME,FFLD,FVALUE,AR,DIC,DA,DR,DIE,AR
3375"RTN","VWREGITS",63,0)
3376 S X="LDATA" F  S X=$Q(@X) Q:X=""  I @X[":" S AR($O(AR(" "),-1)+1)=@X K @X
3377"RTN","VWREGITS",64,0)
3378 S N=0 F  S N=$O(LDATA(N)) Q:'+N  S X=LDATA(N) D
3379"RTN","VWREGITS",65,0)
3380 . S FNAME=$P(X,"^")
3381"RTN","VWREGITS",66,0)
3382 . S FFLD=$P(X,"^",2)
3383"RTN","VWREGITS",67,0)
3384 . S FVALUE=$S($P(X,"^",3)["(":+$P(X,"(",2),1:$P(X,"^",3))
3385"RTN","VWREGITS",68,0)
3386 . S DFN=$P(X,"^",4)
3387"RTN","VWREGITS",69,0)
3388 . S DIE="^DPT(",DA=DFN,DR=FFLD_"///^S X=FVALUE" D ^DIE
3389"RTN","VWREGITS",70,0)
3390 D M
3391"RTN","VWREGITS",71,0)
3392 S RESULT($I(RESULT))="Filed..."
3393"RTN","VWREGITS",72,0)
3394 K X,FNAME,FFL,FVALUE,DFN,AR,DIE,DA,DR,DIC
3395"RTN","VWREGITS",73,0)
3396 Q
3397"RTN","VWREGITS",74,0)
3398 ;
3399"RTN","VWREGITS",75,0)
3400M ;File any multiples values; DFN should be defined above
3401"RTN","VWREGITS",76,0)
3402 Q:'$D(^DIZ("DS",$J))
3403"RTN","VWREGITS",77,0)
3404 M MULTS=^DIZ("DS",$J)
3405"RTN","VWREGITS",78,0)
3406 K MAR S N=0 F  S N=$O(MULTS(N)) Q:'+N  D
3407"RTN","VWREGITS",79,0)
3408 . F J=1:1:$L(MULTS(N),"^")-1 S MAR(J)=$P(MULTS(N),"^",J)
3409"RTN","VWREGITS",80,0)
3410 . S MX=$O(MAR(0))
3411"RTN","VWREGITS",81,0)
3412 . S MXFILE=+$P(MAR(MX),"(",2)
3413"RTN","VWREGITS",82,0)
3414 . S MXFLD=+$P(MAR(MX),";",2)
3415"RTN","VWREGITS",83,0)
3416 . S MXVAL=$P($P(MAR(MX),":",2),"(")
3417"RTN","VWREGITS",84,0)
3418 . I MXFLD=.01 S MXDATA(MXFILE,"?+1,"_DFN_",",MXFLD)=MXVAL K IEN D UPDATE^DIE("E","MXDATA","IEN","ERROR") Q:$G(DIERR)  D
3419"RTN","VWREGITS",85,0)
3420 .. S RECORD=$G(IEN(1)),INC=$G(IEN(1,0))
3421"RTN","VWREGITS",86,0)
3422 .. S J=MX F  S J=$O(MAR(J)) Q:'+J  D
3423"RTN","VWREGITS",87,0)
3424 ... s MXFILE=+$P(MAR(J),"(",2)
3425"RTN","VWREGITS",88,0)
3426 ... S MXFLD=+$P(MAR(J),";",2)
3427"RTN","VWREGITS",89,0)
3428 ... S MXVAL=$P(MAR(J),":",2),MXVAL=$S(MXVAL["(":$P(MXVAL,"("),1:MXVAL)
3429"RTN","VWREGITS",90,0)
3430 ... S MXDATA(MXFILE,$S(MXFLD=.01:INC,1:"")_"1,"_RECORD_","_DFN_",",MXFLD)=MXVAL
3431"RTN","VWREGITS",91,0)
3432 ... K IEN,ERROR D UPDATE^DIE("E","MXDATA","IEN","ERROR")
3433"RTN","VWREGITS",92,0)
3434 Q
3435"RTN","VWREGITS",93,0)
3436 ;
3437"RTN","VWREGITS",94,0)
3438INSUR ;Insurance/Billing
3439"RTN","VWREGITS",95,0)
3440 Q
3441"RTN","VWREGITS",96,0)
3442 ;
3443"RTN","VWREGITS",97,0)
3444K S DA=$P(^DPT(0),"^",3),DIK="^DPT(" D ^DIK
3445"RTN","VWREGITS",98,0)
3446 S DIK="^AUPNPAT(" D ^DIK
3447"RTN","VWREGITS",99,0)
3448 Q
3449"RTN","VWREGITS",100,0)
3450 ;
3451"RTN","VWREGITT")
34520^10^B60617803
3453"RTN","VWREGITT",1,0)
3454VWREGITT ;Portland\Jim Bell, BFP,LLC Input Template Management 2016
3455"RTN","VWREGITT",2,0)
3456 ;2.0**LOCAL** Copyright April 2016 ad infinitum;;;;;Build 4
3457"RTN","VWREGITT",3,0)
3458 ;*****************************************************************
3459"RTN","VWREGITT",4,0)
3460 ;* Licensed under GNU 2.0 or greater - see license.txt file      *
3461"RTN","VWREGITT",5,0)
3462 ;* Program/application is for the management of input templates  *
3463"RTN","VWREGITT",6,0)
3464 ;* owned by the user (DUZ).                                      *
3465"RTN","VWREGITT",7,0)
3466 ;* REMINDER: All actions Pertains only to the Patient File (#2)! *
3467"RTN","VWREGITT",8,0)
3468 ;*****************************************************************
3469"RTN","VWREGITT",9,0)
3470 ;
3471"RTN","VWREGITT",10,0)
3472 Q  ;No fall through
3473"RTN","VWREGITT",11,0)
3474 ;
3475"RTN","VWREGITT",12,0)
3476INR() Q $O(RESULT(" "),-1)+1
3477"RTN","VWREGITT",13,0)
3478 ;
3479"RTN","VWREGITT",14,0)
3480ITCNTRL(USER) ;Check for control capability and user authorization
3481"RTN","VWREGITT",15,0)
3482 N ITCNTRL
3483"RTN","VWREGITT",16,0)
3484        S ITCNTRL=$O(^DIC(19,"B","VW REG IT CONTROL",0))
3485"RTN","VWREGITT",17,0)
3486        I 'ITCNTRL D  Q 0
3487"RTN","VWREGITT",18,0)
3488 . S VAL=0
3489"RTN","VWREGITT",19,0)
3490        . S RESULT(0)="-1^VW REGISTRATION does not appear to be complete."
3491"RTN","VWREGITT",20,0)
3492        . S RESULT(1)="Please contact your Supervisor or IT support."
3493"RTN","VWREGITT",21,0)
3494        . S RESULT(2)="Thank you,"
3495"RTN","VWREGITT",22,0)
3496        . S RESULT(3)="The Management"
3497"RTN","VWREGITT",23,0)
3498 I '$D(^VA(200,USER,203,"B",ITCNTRL)) D  Q 0
3499"RTN","VWREGITT",24,0)
3500 . S RESULT(0)="-1^User does not have authorization to modify/create"
3501"RTN","VWREGITT",25,0)
3502 . S RESULT(1)="input templates. Please contact your Supervisor or"
3503"RTN","VWREGITT",26,0)
3504 . S RESULT(2)="IT support. Or, questions can be referred to Jim"
3505"RTN","VWREGITT",27,0)
3506 . S RESULT(3)="Bell at jbellco65@gmail.com"
3507"RTN","VWREGITT",28,0)
3508 . S RESULT(4)="Thank you."
3509"RTN","VWREGITT",29,0)
3510 Q 1
3511"RTN","VWREGITT",30,0)
3512 ;
3513"RTN","VWREGITT",31,0)
3514FIELDS ;
3515"RTN","VWREGITT",32,0)
3516 Q:'$O(TDATA(0))  ;Nothing but a name?
3517"RTN","VWREGITT",33,0)
3518 N N,N2,X,SUBD,SUBF
3519"RTN","VWREGITT",34,0)
3520 S N=0,F="" F  S N=$O(TDATA(N)) Q:'+N  D
3521"RTN","VWREGITT",35,0)
3522 . S X=TDATA(N)
3523"RTN","VWREGITT",36,0)
3524 . I $E(X,1,4)'=" SF " S F=F_+$P(X,"(",2)_";"
3525"RTN","VWREGITT",37,0)
3526 . E  S (SUBD,SUBF)="",SUBD=+$P(X,";",2),SUBF=+$P($P(X,"(",2),";"),SUBDD(SUBD,SUBF)=""
3527"RTN","VWREGITT",38,0)
3528 S N=0 F  S N=$O(SUBDD(N)) Q:'+N  D  S SUBDIC(N)=SUBF
3529"RTN","VWREGITT",39,0)
3530 . S SUBF="",N2=0 F  S N2=$O(SUBDD(N,N2)) Q:'+N2  S SUBF=SUBF_N2_";"
3531"RTN","VWREGITT",40,0)
3532 K SUBDD
3533"RTN","VWREGITT",41,0)
3534 Q
3535"RTN","VWREGITT",42,0)
3536 ;
3537"RTN","VWREGITT",43,0)
3538EN(RESULT,TDATA) ;
3539"RTN","VWREGITT",44,0)
3540 ;**********************************************
3541"RTN","VWREGITT",45,0)
3542 ;* @EN -Incoming in TDATA Array:              *
3543"RTN","VWREGITT",46,0)
3544 ;*  0___template name(IEN)^*MANAGER^DUZ^ACTION*
3545"RTN","VWREGITT",47,0)
3546 ;*  1-n_Field name(field #)                   *
3547"RTN","VWREGITT",48,0)
3548 ;*  Multiples(Sub-DDs) lead with: spSFsp      *
3549"RTN","VWREGITT",49,0)
3550 ;**********************************************
3551"RTN","VWREGITT",50,0)
3552 ;
3553"RTN","VWREGITT",51,0)
3554ENM L +^DIZ("TM"):1 G ENM:'$T M ^DIZ("TM",$J,$$JD^XMRPCTS0())=TDATA L -^DIZ("TM")
3555"RTN","VWREGITT",52,0)
3556 ;Q
3557"RTN","VWREGITT",53,0)
3558 K RESULT
3559"RTN","VWREGITT",54,0)
3560 ;N X,ACTION,TNUM,WHO
3561"RTN","VWREGITT",55,0)
3562 ;;upcase EVERYTHING!!!!!
3563"RTN","VWREGITT",56,0)
3564 S X="TDATA" F  S X=$Q(@X) Q:X=""  S @X=$$UP^XLFSTR(@X)
3565"RTN","VWREGITT",57,0)
3566 S IDATA=TDATA($O(TDATA(-1))) K TDATA($O(TDATA(-1)))
3567"RTN","VWREGITT",58,0)
3568 S TNUM=+$P($P(IDATA,"^"),"(",2) I TNUM,$D(^DIZ(64850004,"C",TNUM)) S RESULT(0)="-1^Unauthorized template" Q
3569"RTN","VWREGITT",59,0)
3570 I 'TNUM D  G ENA
3571"RTN","VWREGITT",60,0)
3572 . S TNAME=$p(IDATA,"^")
3573"RTN","VWREGITT",61,0)
3574 . S MANAGER=$P(IDATA,"^",2)
3575"RTN","VWREGITT",62,0)
3576 . S WHO=$S($P(IDATA,"^",3)["(":+$P($P(IDATA,"^",3),"(",2),1:$P(IDATA,"^",3))
3577"RTN","VWREGITT",63,0)
3578 . S ACTION=$P(IDATA,"^",4)
3579"RTN","VWREGITT",64,0)
3580 . D FIELDS
3581"RTN","VWREGITT",65,0)
3582 S TNAME=$P($P(IDATA,"("),"^")
3583"RTN","VWREGITT",66,0)
3584 S WHO=$P(IDATA,"^",2),WHO=$S(+WHO:WHO,1:+$P(WHO,"(",2))
3585"RTN","VWREGITT",67,0)
3586 S ACTION=$P(IDATA,"^",3)
3587"RTN","VWREGITT",68,0)
3588 S ACTION=$S(ACTION=1:"CREATE",ACTION=2:"EDIT",ACTION=3:"DEL",ACTION=5:"MGRS",1:"MANTL")
3589"RTN","VWREGITT",69,0)
3590 D FIELDS
3591"RTN","VWREGITT",70,0)
3592 ;W !,$J(TNAME,15),$J(TNUM,7),$J(WHO,6),$J(ACTION,12)
3593"RTN","VWREGITT",71,0)
3594ENA D @ACTION
3595"RTN","VWREGITT",72,0)
3596 Q
3597"RTN","VWREGITT",73,0)
3598 ;
3599"RTN","VWREGITT",74,0)
3600LIST ;List templates by user (DUZ) or, if manager, by employee
3601"RTN","VWREGITT",75,0)
3602 K RESULT
3603"RTN","VWREGITT",76,0)
3604 N N,FIELDS,F,J
3605"RTN","VWREGITT",77,0)
3606 I '$L(WHO) S WHO=DUZ
3607"RTN","VWREGITT",78,0)
3608 E  I '+WHO S XWHO=$$FIND1^DIC(200,,"C","WHO",,,"ERROR"),WHO=XWHO K XWHO
3609"RTN","VWREGITT",79,0)
3610 I '$$ITCNTRL(WHO) S RESULT(0)="-1^User not authorized to template access" Q
3611"RTN","VWREGITT",80,0)
3612 S N=0 F  S N=$O(^DIE(N)) Q:'+N  S X=^(N,0) D
3613"RTN","VWREGITT",81,0)
3614 . Q:$P(X,"^",4)'=2
3615"RTN","VWREGITT",82,0)
3616 . Q:$P(X,"^",5)'=WHO
3617"RTN","VWREGITT",83,0)
3618 . S RESULT($$INR)=$P(X,"^")_"("_N_")"
3619"RTN","VWREGITT",84,0)
3620 . S FIELDS=$G(^DIE(N,"DR",1,2)) D
3621"RTN","VWREGITT",85,0)
3622 .. F J=1:1:$L(FIELDS,";")-1 S F=+$P(FIELDS,";",J) D
3623"RTN","VWREGITT",86,0)
3624 ... S RESULT($$INR)="->"_$P(^DD(2,F,0),"^")_"("_F_")"
3625"RTN","VWREGITT",87,0)
3626 ... I +$P(^DD(2,F,0),"^",2) S M(+$P(^(0),"^",2))=""
3627"RTN","VWREGITT",88,0)
3628 . Q:'$O(M(0))
3629"RTN","VWREGITT",89,0)
3630 . S RESULT($$INR)="---"
3631"RTN","VWREGITT",90,0)
3632 Q
3633"RTN","VWREGITT",91,0)
3634 ;
3635"RTN","VWREGITT",92,0)
3636LM(XFN) ;Update the regit.txt file in the Linux home directory
3637"RTN","VWREGITT",93,0)
3638 K AR
3639"RTN","VWREGITT",94,0)
3640 N XFILED,P4,P5,FILE,HD
3641"RTN","VWREGITT",95,0)
3642 S HD=$$GET^XPAR("ALL","VW GUI REG TEMPLATE DIRECTORY")
3643"RTN","VWREGITT",96,0)
3644 S FILE="regit.txt"
3645"RTN","VWREGITT",97,0)
3646 ZSY "cp "_HD_"/"_FILE_" "_HD_"/regitbu.txt"
3647"RTN","VWREGITT",98,0)
3648 S P4=1
3649"RTN","VWREGITT",99,0)
3650 S P5=""
3651"RTN","VWREGITT",100,0)
3652 S X=$$FTG^%ZISH(HD,FILE,$NA(AR(1)),P4,P5)
3653"RTN","VWREGITT",101,0)
3654 S N=$O(AR(" "),-1) I AR(N)="" K AR(N)  ;Empty line addition
3655"RTN","VWREGITT",102,0)
3656 K AR($O(AR(" "),-1))
3657"RTN","VWREGITT",103,0)
3658 S AR($O(AR(" "),-1)+1)=XFN
3659"RTN","VWREGITT",104,0)
3660 S AR($O(AR(" "),-1)+1)="[ID]"
3661"RTN","VWREGITT",105,0)
3662 S X=$$GTF^%ZISH($NA(AR(1)),1,HD,"regit.txt")
3663"RTN","VWREGITT",106,0)
3664 K AR
3665"RTN","VWREGITT",107,0)
3666 Q
3667"RTN","VWREGITT",108,0)
3668 ;
3669"RTN","VWREGITT",109,0)
3670CREATE ;
3671"RTN","VWREGITT",110,0)
3672 N X,Y,DIC,%DT
3673"RTN","VWREGITT",111,0)
3674 S DIC="^DIE(",DIC(0)="LZ",X=TNAME D FILE^DICN S RESULT($$INR)=Y
3675"RTN","VWREGITT",112,0)
3676 S DIE=DIC,(IEN,DA)=+Y
3677"RTN","VWREGITT",113,0)
3678 I +Y<0 S RESULT(0)="Unable to file "_TNAME_". Contact Jim Bell at jbellco65@gmail.com or your IT Dept." Q
3679"RTN","VWREGITT",114,0)
3680 S TMPNAME=$P(Y,"^",2)_"("_+Y_")"
3681"RTN","VWREGITT",115,0)
3682 S DR=2_"///^S X=""NOW""" D ^DIE
3683"RTN","VWREGITT",116,0)
3684 S VAR=2,DR=4_"///^S X=VAR" D ^DIE
3685"RTN","VWREGITT",117,0)
3686 S VAR=WHO,DR=5_"///^S X=VAR" D ^DIE
3687"RTN","VWREGITT",118,0)
3688 S ^DIE(DA,"DR",1,2)=F
3689"RTN","VWREGITT",119,0)
3690 S N=0 F  S N=$O(SUBDIC(N)) Q:'+N  D
3691"RTN","VWREGITT",120,0)
3692 . S NEXT=$O(^DIE(DA,"DR"," "),-1)+1
3693"RTN","VWREGITT",121,0)
3694 . S ^DIE(DA,"DR",NEXT,N)=SUBDIC(N)
3695"RTN","VWREGITT",122,0)
3696 D LM(TMPNAME)
3697"RTN","VWREGITT",123,0)
3698 S RESULT(0)="Filed "_TMPNAME_"."
3699"RTN","VWREGITT",124,0)
3700 Q
3701"RTN","VWREGITT",125,0)
3702 ;
3703"RTN","VWREGITT",126,0)
3704EDIT ;
3705"RTN","VWREGITT",127,0)
3706 I '$G(TNUM) S RESULT(0)="-1^Template ID not sent..." Q
3707"RTN","VWREGITT",128,0)
3708EL L +^DIE(TNUM):1 G EL:'$T
3709"RTN","VWREGITT",129,0)
3710 K ^DIE(TNUM,"DR")
3711"RTN","VWREGITT",130,0)
3712 D FIELDS
3713"RTN","VWREGITT",131,0)
3714 S DA=TNUM
3715"RTN","VWREGITT",132,0)
3716        S ^DIE(DA,"DR",1,2)=F  ;Patient file only!
3717"RTN","VWREGITT",133,0)
3718        S N=0 F  S N=$O(SUBDIC(N)) Q:'+N  D
3719"RTN","VWREGITT",134,0)
3720        . S NEXT=$O(^DIE(DA,"DR"," "),-1)+1
3721"RTN","VWREGITT",135,0)
3722        . S ^DIE(DA,"DR",NEXT,N)=SUBDIC(N)
3723"RTN","VWREGITT",136,0)
3724 L -^DIE(TNUM)
3725"RTN","VWREGITT",137,0)
3726        S RESULT(0)=$S(+DA:"Filed "_TNAME_"("_DA_")",1:"-1^Filing error")
3727"RTN","VWREGITT",138,0)
3728 Q
3729"RTN","VWREGITT",139,0)
3730 ;
3731"RTN","VWREGITT",140,0)
3732DEL ;Modifying the regit.txt file
3733"RTN","VWREGITT",141,0)
3734 K AR N IDATA,HD,FILE,N
3735"RTN","VWREGITT",142,0)
3736 I '$O(TDATA(-1)) S RESULT(0)="Template list not supplied" Q
3737"RTN","VWREGITT",143,0)
3738 S IDATA=TDATA(0)
3739"RTN","VWREGITT",144,0)
3740 S HD=$P(IDATA,"^")
3741"RTN","VWREGITT",145,0)
3742 S FILE="regit.txt"
3743"RTN","VWREGITT",146,0)
3744 ZSY "cp _"_HD_"/"_FILE_" "_HD_"/"_FILE_"/regitbu.txt"
3745"RTN","VWREGITT",147,0)
3746 S AR(1)="[TEMPLATES]"
3747"RTN","VWREGITT",148,0)
3748 S N=0 F  S N=$O(TDATA(N)) Q:'+N  S AR($O(AR(" "),-1)+1)=TDATA(N)
3749"RTN","VWREGITT",149,0)
3750 I AR($O(AR(" "),-1))'="[ID]" S AR($O(AR(" "),-1)+1)="[ID]"
3751"RTN","VWREGITT",150,0)
3752 S P4=1
3753"RTN","VWREGITT",151,0)
3754 S P5=""
3755"RTN","VWREGITT",152,0)
3756 S X=$$GTF^%ZISH($NA(AR(1)),1,HD,"regit.txt")
3757"RTN","VWREGITT",153,0)
3758 S RESULT(0)=$S(X:"Template list successfully updated",1:"Error in filing. Contact your supervisor or IT dept.")
3759"RTN","VWREGITT",154,0)
3760 Q
3761"RTN","VWREGITT",155,0)
3762 ;
3763"RTN","VWREGITT",156,0)
3764MANTL ;Manage the template list file (regit.txt)
3765"RTN","VWREGITT",157,0)
3766D W !,"Add/Editing the regit.txt file"
3767"RTN","VWREGITT",158,0)
3768 Q
3769"RTN","VWREGITT",159,0)
3770 ;
3771"RTN","VWREGITT",160,0)
3772MU(RESULT) ;Get managers and standeard reg users
3773"RTN","VWREGITT",161,0)
3774 K RESULT,AR,ARR,XK
3775"RTN","VWREGITT",162,0)
3776 N N,X,Y,MO
3777"RTN","VWREGITT",163,0)
3778 S XK($O(^DIC(19,"B","VW PATIENT REGISTRATION",0)))=0
3779"RTN","VWREGITT",164,0)
3780 S XK($O(^DIC(19,"B","VW REG IT CONTROL",0)))=1
3781"RTN","VWREGITT",165,0)
3782 S N=0 F  S N=$O(XK(N)) Q:'+N  D
3783"RTN","VWREGITT",166,0)
3784 . S DFN=0 F  S DFN=$O(^VA(200,DFN)) Q:'+DFN  D
3785"RTN","VWREGITT",167,0)
3786 .. I XK(N),$D(^VA(200,DFN,203,"B",N)) S AR(N,$P(^VA(200,DFN,0),"^"))=DFN
3787"RTN","VWREGITT",168,0)
3788 .. E  I $D(^VA(200,DFN,203,"B",N)) S ARR(N,$P(^VA(200,DFN,0),"^"))=DFN
3789"RTN","VWREGITT",169,0)
3790 S N=0 F  S N=$O(AR(N)) Q:'+N  S X=$O(AR(N," ")),N2=0 F  S N2=$O(ARR(N2)) Q:'+N2  I $D(ARR(N2,X)) K ARR(N2,X)
3791"RTN","VWREGITT",170,0)
3792 K ARX
3793"RTN","VWREGITT",171,0)
3794 S X="AR" F  S X=$Q(@X) Q:X=""  S ARX($P(^VA(200,@X,0),"^"))="*^"_$P(^(0),"^")_"("_@X_")"
3795"RTN","VWREGITT",172,0)
3796 S X="ARR" F  S X=$Q(@X) Q:X=""  S ARX($P(^VA(200,@X,0),"^"))="^"_$P(^(0),"^")_"("_@X_")"
3797"RTN","VWREGITT",173,0)
3798 S X="ARX" F  S X=$Q(@X) Q:X=""  S RESULT($$INR)=@X
3799"RTN","VWREGITT",174,0)
3800 K AR,ARR,ARX,XK
3801"RTN","VWREGITT",175,0)
3802 Q
3803"RTN","VWREGITT",176,0)
3804 ;
3805"RTN","VWREGITT",177,0)
3806UL(RESULT) ;Get a list of users in VA(200
3807"RTN","VWREGITT",178,0)
3808 K RESULT
3809"RTN","VWREGITT",179,0)
3810 N N,DFN,X
3811"RTN","VWREGITT",180,0)
3812 S N="" F  S N=$O(^VA(200,"B",N)) Q:N=""  S X=$Q(^(N)) D
3813"RTN","VWREGITT",181,0)
3814 . S DFN=+$P(X,",",$L(X,","))
3815"RTN","VWREGITT",182,0)
3816 . S RESULT($$INR)=N_"("_DFN_")"
3817"RTN","VWREGITT",183,0)
3818 Q
3819"RTN","VWREGITT",184,0)
3820 ;
3821"RTN","VWREGITT",185,0)
3822MANUL(RESULT,TDATA) ;
3823"RTN","VWREGITT",186,0)
3824 ;******************************************
3825"RTN","VWREGITT",187,0)
3826 ;* Array TDATA__Item(s) for action        *
3827"RTN","VWREGITT",188,0)
3828 ;* ACTION_______piece(item,'-'_):Del ! Add*
3829"RTN","VWREGITT",189,0)
3830 ;******************************************
3831"RTN","VWREGITT",190,0)
3832 ;
3833"RTN","VWREGITT",191,0)
3834 ;G TEST
3835"RTN","VWREGITT",192,0)
3836 K RESULT
3837"RTN","VWREGITT",193,0)
3838 N N,X,Y,NAME,IEN,ACTION,MANAGER,DIC,DA
3839"RTN","VWREGITT",194,0)
3840 S X="TDATA" F  S X=$Q(@X) Q:X=""  S @X=$$UP^XLFSTR(@X)
3841"RTN","VWREGITT",195,0)
3842 S SMO=$O(^DIC(19,"B","VW PATIENT REGISTRATION",0))_"^"_$O(^DIC(19,"B","VW REG IT CONTROL",0))
3843"RTN","VWREGITT",196,0)
3844 S N=0 F  S N=$O(TDATA(N)) Q:'+N  D
3845"RTN","VWREGITT",197,0)
3846 . S X=TDATA(N),ACTION=$P(X,"-")
3847"RTN","VWREGITT",198,0)
3848 . S NAME=$P($P(X,"-",2),"(")
3849"RTN","VWREGITT",199,0)
3850 . S IEN=+$P(X,"(",2)
3851"RTN","VWREGITT",200,0)
3852 . S MANAGER=$S($L($P(NAME,"*",2)):1,1:0)
3853"RTN","VWREGITT",201,0)
3854 . I ACTION="DEL" D  S RESULT($$INR)=NAME_": Authorization removed"
3855"RTN","VWREGITT",202,0)
3856 .. S DA(1)=IEN
3857"RTN","VWREGITT",203,0)
3858 .. S DA=$O(^VA(200,DA(1),203,"B",+SMO,0))
3859"RTN","VWREGITT",204,0)
3860 .. S DIK="^VA(200,"_IEN_",203,"
3861"RTN","VWREGITT",205,0)
3862 .. D:DA ^DIK
3863"RTN","VWREGITT",206,0)
3864 .. I MANAGER S DA=$O(^VA(200,DA(1),203,"B",$P(SMO,"^",2),0)) D:DA ^DIK
3865"RTN","VWREGITT",207,0)
3866 .. K DA,DIK
3867"RTN","VWREGITT",208,0)
3868 . I ACTION="ADD" D  S RESULT($$INR)=NAME_": Authorization added"
3869"RTN","VWREGITT",209,0)
3870 .. S DA(1)=IEN
3871"RTN","VWREGITT",210,0)
3872 .. S DA=""
3873"RTN","VWREGITT",211,0)
3874 .. S X=+SMO
3875"RTN","VWREGITT",212,0)
3876 .. S DIC="^VA(200,"_DA(1)_",203,"
3877"RTN","VWREGITT",213,0)
3878 .. S DIC(0)="LZ"
3879"RTN","VWREGITT",214,0)
3880 .. D FILE^DICN
3881"RTN","VWREGITT",215,0)
3882 .. I MANAGER S X=$P(SMO,"^",2),DA="" D FILE^DICN
3883"RTN","VWREGITT",216,0)
3884 D MU+1
3885"RTN","VWREGITT",217,0)
3886 Q
3887"RTN","VWREGITT",218,0)
3888 ;
3889"RTN","VWREGITT",219,0)
3890TFILE(RESULT) ;
3891"RTN","VWREGITT",220,0)
3892 K RESULT,AR
3893"RTN","VWREGITT",221,0)
3894 N HD,FILE,P4,P5,X
3895"RTN","VWREGITT",222,0)
3896 S HD=$$GET^XPAR("ALL","VW GUI REG TEMPLATE DIRECTORY")
3897"RTN","VWREGITT",223,0)
3898        S FILE="regit.txt"
3899"RTN","VWREGITT",224,0)
3900        S P4=1
3901"RTN","VWREGITT",225,0)
3902        S P5=""
3903"RTN","VWREGITT",226,0)
3904        S X=$$FTG^%ZISH(HD,FILE,$NA(AR(1)),P4,P5)
3905"RTN","VWREGITT",227,0)
3906 K AR(1),AR($O(AR(" "),-1))
3907"RTN","VWREGITT",228,0)
3908 S X="AR" F  S X=$Q(@X) Q:X=""  I @X'="[ID]" S RESULT($$INR)=@X
3909"RTN","VWREGITT",229,0)
3910 K AR
3911"RTN","VWREGITT",230,0)
3912 Q
3913"RTN","VWREGITT",231,0)
3914 ;
3915"RTN","VWREGITT",232,0)
3916TLIST(RESULT) ;Listing of templates from .402
3917"RTN","VWREGITT",233,0)
3918 K RESULT
3919"RTN","VWREGITT",234,0)
3920 N X,N,NAME
3921"RTN","VWREGITT",235,0)
3922 S X="^DIE(""B"")" F  S X=$Q(@X) Q:$P(X,",")'["B"  D
3923"RTN","VWREGITT",236,0)
3924 . S N=+$P(X,",",$L(X,","))
3925"RTN","VWREGITT",237,0)
3926 . S NAME=$P(^DIE(N,0),"^")
3927"RTN","VWREGITT",238,0)
3928 . Q:$P(^(0),"^",4)'=2
3929"RTN","VWREGITT",239,0)
3930 . I $L($P(^(0),"^",6)),$P(^(0),"^",6)'=DUZ(0)
3931"RTN","VWREGITT",240,0)
3932 . S RESULT($$INR)=NAME_"("_N_")"
3933"RTN","VWREGITT",241,0)
3934 Q
3935"RTN","VWREGITT",242,0)
3936 ;
3937"RTN","VWREGITT",243,0)
3938TEST ;Testing only
3939"RTN","VWREGITT",244,0)
3940 M ^DIZ("TDATA",$J)=TDATA
3941"RTN","VWREGITT",245,0)
3942 Q
3943"RTN","VWREGITT",246,0)
3944 ;
3945"RTN","VWREGITU")
39460^7^B34064749
3947"RTN","VWREGITU",1,0)
3948VWREGITU ;Portland, OR/jeb et al World Vista Registration Utilities
3949"RTN","VWREGITU",2,0)
3950 ;V.2;;**LOCAL**;; 2015;Build 4
3951"RTN","VWREGITU",3,0)
3952 ;;c2014, BellFelder Productions(BF Productions)
3953"RTN","VWREGITU",4,0)
3954 ;No Fall thru - jeb
3955"RTN","VWREGITU",5,0)
3956 Q
3957"RTN","VWREGITU",6,0)
3958 ;
3959"RTN","VWREGITU",7,0)
3960DFNID() ;Set NAME(IEN),TAB,DOB(AGE),TAB,HRN,TAB,PHONE#
3961"RTN","VWREGITU",8,0)
3962 N DFNID,NAME,X,Y,DOB,HRN,PHONE
3963"RTN","VWREGITU",9,0)
3964 I 'DFN Q ""
3965"RTN","VWREGITU",10,0)
3966 S NAME=$P(^DPT(DFN,0),"^")
3967"RTN","VWREGITU",11,0)
3968 S Y=$$OUTPUT^VWTIME(DFN) X ^DD("DD") S DOB=Y
3969"RTN","VWREGITU",12,0)
3970 S HRN=$G(^DPT(DFN,540001.1))
3971"RTN","VWREGITU",13,0)
3972 S PHONE="Phone: "_$P(^DPT(DFN,.13),"^")
3973"RTN","VWREGITU",14,0)
3974 S DFNID=NAME_$C(9)_DOB_$C(9)_$S($L(HRN):"HRN: "_HRN_$C(9),1:"")_PHONE
3975"RTN","VWREGITU",15,0)
3976 Q DFNID
3977"RTN","VWREGITU",16,0)
3978 ;
3979"RTN","VWREGITU",17,0)
3980HELP(XDIC,XFIELD) ;
3981"RTN","VWREGITU",18,0)
3982 N N
3983"RTN","VWREGITU",19,0)
3984 K FHELP
3985"RTN","VWREGITU",20,0)
3986 S FHELP=$G(^DD(XDIC,XFIELD,3))
3987"RTN","VWREGITU",21,0)
3988 G:'$L(FHELP) HELPX
3989"RTN","VWREGITU",22,0)
3990 S FHELP=FHELP_$S($E($L(FHELP))=".":" ",1:". ")
3991"RTN","VWREGITU",23,0)
3992 I XFIELD'=27.02,$D(^DD(XDIC,XFIELD,21)) S N=0 F  S N=$O(^DD(XDIC,XFIELD,21,N)) Q:'+N  S FHELP=FHELP_^(N,0)_" "
3993"RTN","VWREGITU",24,0)
3994 S FHELP=$TR(FHELP,"'","`")
3995"RTN","VWREGITU",25,0)
3996HELPX   Q FHELP
3997"RTN","VWREGITU",26,0)
3998 ;
3999"RTN","VWREGITU",27,0)
4000M(RESULT,XMF) ;
4001"RTN","VWREGITU",28,0)
4002 ; **********************************************
4003"RTN","VWREGITU",29,0)
4004 ; * XMF_____PARENT FIELD^DFN^TEMPLATE NAME(IEN)*
4005"RTN","VWREGITU",30,0)
4006 ; **********************************************
4007"RTN","VWREGITU",31,0)
4008 ;
4009"RTN","VWREGITU",32,0)
4010 ;W "  ;Intentional break
4011"RTN","VWREGITU",33,0)
4012 K RESULT,AR,TEMPLATE
4013"RTN","VWREGITU",34,0)
4014 N XMFD,SUBD,SUBD3,SUBD4,SUBD5,F2,F3,F4,F5,DFN,N,X,SUBF,XT,FHELP
4015"RTN","VWREGITU",35,0)
4016 S TNUM=+$P(XMF,"(",2)  ;Template IEN, if any
4017"RTN","VWREGITU",36,0)
4018 S DFN=+$P(XMF,"^",2)   ;Client IEN, if any
4019"RTN","VWREGITU",37,0)
4020 S XMF=+XMF  ;Parent field
4021"RTN","VWREGITU",38,0)
4022 I '+$P(^DD(2,XMF,0),"^",2) S RESULT(0)=-1  ;Not a parent, eh?!
4023"RTN","VWREGITU",39,0)
4024 S XMFD=+$P(^(0),"^",2)
4025"RTN","VWREGITU",40,0)
4026 S F=0 F  S F=$O(^DD(XMFD,F)) Q:'+F  S RESULT($$INR)=$P(^(F,0),"^")_"^"_XMFD_";"_F_"^^"_$$HELP(XMFD,F)_"^"_$P(^(0),"^",3) D:+$P(^(0),"^",2)
4027"RTN","VWREGITU",41,0)
4028 . S SUBD=+$P(^(0),"^",2)
4029"RTN","VWREGITU",42,0)
4030 . S F2=0 F  S F2=$O(^DD(SUBD,F2)) Q:'+F2  S RESULT($$INR)=$P(^(F2,0),"^")_"^"_SUBD_";"_F2_"^^"_$$HELP(SUBD,F2)_"^"_$P(^(0),"^",3) D:+$P(^DD(SUBD,F2,0),"^",2)
4031"RTN","VWREGITU",43,0)
4032 .. S SUBD3=+$P(^(0),"^",2)
4033"RTN","VWREGITU",44,0)
4034 .. S F3=0 F  S F3=$O(^DD(SUBD3,F3)) Q:'+F3  S RESULT($$INR)=$P(^(F3,0),"^")_"^"_SUBD3_";"_F3_"^^"_$$HELP(SUBD3,F3)_"^"_$P(^(0),"^",3) D:+$P(^DD(SUBD3,F3,0),"^",2)
4035"RTN","VWREGITU",45,0)
4036 ... S SUBD4=+$P(^DD(SUBD3,F3,0),"^",2)
4037"RTN","VWREGITU",46,0)
4038 ... S F4=0 F  S F4=$O(^DD(SUBD4,F4)) Q:'+F4  S RESULT($$INR)=$P(^(F4,0),"^")_"^"_SUBD4_";"_F4_"^^"_$$HELP(SUBD4,F4)_"^"_$P(^(0),"^",3) D:+$P(^DD(SUBD4,F2,0),"^",2)
4039"RTN","VWREGITU",47,0)
4040 .... S SUBD5=+$P(^(0),"^",2)
4041"RTN","VWREGITU",48,0)
4042 .... S F5=0 F  S F5=$O(^DD(SUBD5,F5)) Q:'+F5  S RESULT($$INR)=$P(^(F5,0),"^")_"^"_SUBD5_";"_F5_"^^"_$$HELP(SUBD5,F5)_"^"_$P(^(0),"^",3)
4043"RTN","VWREGITU",49,0)
4044 ;Clean up of parents IN multiple fields
4045"RTN","VWREGITU",50,0)
4046 M AR=RESULT K RESULT N DD,F
4047"RTN","VWREGITU",51,0)
4048 S N=0 F  S N=$O(AR(N)) Q:'+N  D
4049"RTN","VWREGITU",52,0)
4050 . S DD=+$P($P(AR(N),"^",2),";")  ;Is this a sub DD ?
4051"RTN","VWREGITU",53,0)
4052 . S F=+$P(AR(N),";",2)
4053"RTN","VWREGITU",54,0)
4054 . I +$P(^DD(DD,F,0),"^",2) K AR(N)
4055"RTN","VWREGITU",55,0)
4056 ;Clean up fields not in template
4057"RTN","VWREGITU",56,0)
4058 M TEMPLATE=^DIE(TNUM,"DR")
4059"RTN","VWREGITU",57,0)
4060 S X=$Q(@"TEMPLATE") K @X  ;Remove top, non-multiple subscript
4061"RTN","VWREGITU",58,0)
4062 S X="AR" F  S X=$Q(@X) Q:X=""  D
4063"RTN","VWREGITU",59,0)
4064 . S SUBD=+$P($P(@X,"^",2),";")
4065"RTN","VWREGITU",60,0)
4066 . S SUBF=+$P(@X,";",2)
4067"RTN","VWREGITU",61,0)
4068 . F I=1:1:20 I $D(TEMPLATE(I,SUBD)) D
4069"RTN","VWREGITU",62,0)
4070 .. Q:TEMPLATE(I,SUBD)[SUBF
4071"RTN","VWREGITU",63,0)
4072 .. K @X
4073"RTN","VWREGITU",64,0)
4074 S N=0 F  S N=$O(AR(N)) Q:'+N  S RESULT($$INR)=AR(N)
4075"RTN","VWREGITU",65,0)
4076 K AR,TEMPLATE
4077"RTN","VWREGITU",66,0)
4078 Q
4079"RTN","VWREGITU",67,0)
4080 ;
4081"RTN","VWREGITU",68,0)
4082DISV(RESULT,DFN) ;Set the Disv GLOBAL
4083"RTN","VWREGITU",69,0)
4084 K RESULT
4085"RTN","VWREGITU",70,0)
4086 I '$L(DFN) S RESULT=-1 Q
4087"RTN","VWREGITU",71,0)
4088 S ^DISV(DUZ,"^DPT(")=+$P(DFN,"(",2),RESULT=1
4089"RTN","VWREGITU",72,0)
4090 Q
4091"RTN","VWREGITU",73,0)
4092 ;
4093"RTN","VWREGITU",74,0)
4094SR(FNAME,FNUM,FVALUE,FHELP,FSETPNTR,FMISC) ;Set values into RESULT()
4095"RTN","VWREGITU",75,0)
4096 ;********************************************************
4097"RTN","VWREGITU",76,0)
4098 ;* FNAME________Field Name                              *
4099"RTN","VWREGITU",77,0)
4100 ;* FNUM_________Field Number                            *
4101"RTN","VWREGITU",78,0)
4102 ;* FVALUE_______Data from existing client/patient       *
4103"RTN","VWREGITU",79,0)
4104 ;* FHELP________Help text from field                    *
4105"RTN","VWREGITU",80,0)
4106 ;* FSETPNTR_____Set of codes or Pointer reference       *
4107"RTN","VWREGITU",81,0)
4108 ;* FMISC________Locally described designator (not used) *
4109"RTN","VWREGITU",82,0)
4110 ;********************************************************
4111"RTN","VWREGITU",83,0)
4112 S RESULT($$INR)=FNAME_"^"_FNUM_"^"_FVALUE_"^"_FHELP_"^"_FSETPNTR_"^"_FMISC
4113"RTN","VWREGITU",84,0)
4114 Q
4115"RTN","VWREGITU",85,0)
4116 ;     
4117"RTN","VWREGITU",86,0)
4118INR() ;Specific incrementer for RESULT array
4119"RTN","VWREGITU",87,0)
4120 Q $O(RESULT(" "),-1)+1
4121"RTN","VWREGITU",88,0)
4122 ;
4123"RTN","VWREGITU",89,0)
4124ZPC(RESULT,ZIP) ;Get zip,county/area/region,state/province,preferred city
4125"RTN","VWREGITU",90,0)
4126 K RESULT N STP,CNTP,COUNTY,XZIP
4127"RTN","VWREGITU",91,0)
4128 S XZIP=ZIP S RESULT(0)="No return" Q:'$L(XZIP)
4129"RTN","VWREGITU",92,0)
4130 D POSTAL^XIPUTIL(XZIP,.ZIPDATA)
4131"RTN","VWREGITU",93,0)
4132 I $D(ZIPDATA("ERROR")) Q  ;Can't be found
4133"RTN","VWREGITU",94,0)
4134 S COUNTY=$G(ZIPDATA("COUNTY"))
4135"RTN","VWREGITU",95,0)
4136 S STP=$G(ZIPDATA("STATE POINTER"))
4137"RTN","VWREGITU",96,0)
4138 I STP,$L(COUNTY) S CNTP=$O(^DIC(5,STP,1,"B",COUNTY,0))
4139"RTN","VWREGITU",97,0)
4140 K RESULT(0)
4141"RTN","VWREGITU",98,0)
4142 S RESULT($$INR)=ZIPDATA("STATE")_"("_STP_")"
4143"RTN","VWREGITU",99,0)
4144 S RESULT($$INR)=ZIPDATA("COUNTY")_"("_CNTP_")"
4145"RTN","VWREGITU",100,0)
4146 S RESULT($$INR)=ZIPDATA("CITY")
4147"RTN","VWREGITU",101,0)
4148 S RESULT($$INR)=ZIPDATA("FIPS CODE")
4149"RTN","VWREGITU",102,0)
4150 K ZIPDATA
4151"RTN","VWREGITU",103,0)
4152 Q
4153"RTN","VWREGITU",104,0)
4154 ;
4155"RTN","VWREGITU",105,0)
4156SPI(RESULT,DFN) ;Simple patient inquiry display
4157"RTN","VWREGITU",106,0)
4158 S LINE="----------"
4159"RTN","VWREGITU",107,0)
4160 S DIC="^DPT(",DA=DFN,DIQ(0)="E",DIQ="AR"
4161"RTN","VWREGITU",108,0)
4162 S DR=".01:.05;.111:.115;.1171:.1173;.117;.363"
4163"RTN","VWREGITU",109,0)
4164 D EN^DIQ1
4165"RTN","VWREGITU",110,0)
4166 S CITY=$G(AR(2,DFN,.114,"E"))
4167"RTN","VWREGITU",111,0)
4168 S STIEN="",STATE=$G(AR(2,DFN,.115,"E")) S:$L(STATE) STIEN=$O(^DIC(5,"B",STATE,0))
4169"RTN","VWREGITU",112,0)
4170 S XAGE=$G(AR(2,DFN,.033,"E"))
4171"RTN","VWREGITU",113,0)
4172 S XAGE=$S(+XAGE:XAGE_" y/o",1:"")
4173"RTN","VWREGITU",114,0)
4174 ;;GET HRN
4175"RTN","VWREGITU",115,0)
4176HRN S HRN="",N=$O(^AUPNPAT(DFN,41,0))
4177"RTN","VWREGITU",116,0)
4178 S HRN=$S('N:HRN,1:$P($G(^AUPNPAT(DFN,41,N,0)),"^",2))
4179"RTN","VWREGITU",117,0)
4180 S RESULT($$INR)=AR(2,DFN,.01,"E")_"  "_AR(2,DFN,.363,"E")_" HRN: "_HRN
4181"RTN","VWREGITU",118,0)
4182 S RESULT($$INR)="DOB: "_AR(2,DFN,.03,"E")_"  ("_XAGE_" "_AR(2,DFN,.02,"E")_")"
4183"RTN","VWREGITU",119,0)
4184 S RESULT($$INR)="ADDRESS"_LINE_LINE
4185"RTN","VWREGITU",120,0)
4186 S RESULT($$INR)=$G(AR(2,DFN,.111,"E"))_" "_$G(AR(2,DFN,.112,"E"))
4187"RTN","VWREGITU",121,0)
4188 S RESULT($$INR)=$G(AR(2,DFN,.114,"E"))_", "_$G(AR(2,DFN,.115,"E"))_"  "_$S($L($G(AR(2,DFN,.1172,"E"))):AR(2,DFN,.1172,"E"),1:$G(AR(2,DFN,.1112,"E")))
4189"RTN","VWREGITU",122,0)
4190 S RESULT($$INR)="Walk-ins"_LINE_LINE
4191"RTN","VWREGITU",123,0)
4192 S RESULT($$INR)="Appointments"_LINE_LINE
4193"RTN","VWREGITU",124,0)
4194 S RESULT($$INR)="Admissions"_LINE_LINE
4195"RTN","VWREGITU",125,0)
4196 Q
4197"RTN","VWREGITU",126,0)
4198 ;
4199"RTN","VWREGITU",127,0)
4200CONTROL()       ;Check for CONTROL status
4201"RTN","VWREGITU",128,0)
4202        N X S X=$O(^DIC(19,"B","VW REG IT CONTROL",0))
4203"RTN","VWREGITU",129,0)
4204        I 'X Q 0  ;Ain't no option there
4205"RTN","VWREGITU",130,0)
4206        Q $S($D(^VA(200,DUZ,203,"B",X)):1,1:0)
4207"RTN","VWREGITU",131,0)
4208        ;
4209"RTN","VWREGITU",132,0)
4210MISC(RESULT,VWDD) ;Get simple value from VWDD ID
4211"RTN","VWREGITU",133,0)
4212 ;***************************************************
4213"RTN","VWREGITU",134,0)
4214 ;* VWDD___________________(sub)-Dictionary number  *
4215"RTN","VWREGITU",135,0)
4216 ;* Multiple delimiter_____;(Semicolon)             *
4217"RTN","VWREGITU",136,0)
4218 ;***************************************************
4219"RTN","VWREGITU",137,0)
4220 ;
4221"RTN","VWREGITU",138,0)
4222 I '$L(VWDD) S RESULT(0)="No value to evaluate" Q
4223"RTN","VWREGITU",139,0)
4224 K RESULT
4225"RTN","VWREGITU",140,0)
4226 N XDD,XDDLOC,N,X
4227"RTN","VWREGITU",141,0)
4228 G MISCSD:$G(^DD(VWDD,0,"UP"))
4229"RTN","VWREGITU",142,0)
4230 S CALLER=$S($P(VWDD,"^",2)="INS":1,1:0)
4231"RTN","VWREGITU",143,0)
4232 S VWDD=$P(VWDD,"^")
4233"RTN","VWREGITU",144,0)
4234 F I=1:1:$L(VWDD,";") S XDD=+$P(VWDD,";",I) S RESULT($$INR)="["_$P(^DIC(XDD,0),"^")_"]" D MISC1
4235"RTN","VWREGITU",145,0)
4236 I CALLER S RESULT($$INR)="[GUARANTOR]" D
4237"RTN","VWREGITU",146,0)
4238 . S X=$P(^DD(2.312,16,0),"^",3)
4239"RTN","VWREGITU",147,0)
4240 . F I=1:1:$L(X,";") S Y=$P(X,";",I),RESULT($$INR)=$P(Y,":",2)_"("_$P(Y,":")_")"
4241"RTN","VWREGITU",148,0)
4242 Q
4243"RTN","VWREGITU",149,0)
4244 ;
4245"RTN","VWREGITU",150,0)
4246MISC1 S XDDLOC=$G(^DIC(XDD,0,"GL")) D:$L(XDDLOC)
4247"RTN","VWREGITU",151,0)
4248 . S N=0 F  S N=$O(@(XDDLOC_N_")")) Q:'+N  D
4249"RTN","VWREGITU",152,0)
4250 .. I XDDLOC["779.004" S XCNAME=$P(@(XDDLOC_N_",0)"),"^")_" "_$P(^(0),"^",2)_" "_+$G(^("SDS"))_"("_N_")",RESULT($$INR)=XCNAME Q
4251"RTN","VWREGITU",153,0)
4252 .. S X=$P(@(XDDLOC_N_",0)"),"^")_"("_N_")",RESULT($$INR)=X
4253"RTN","VWREGITU",154,0)
4254MX Q
4255"RTN","VWREGITU",155,0)
4256 ;
4257"RTN","VWREGITU",156,0)
4258MISCSD ;Sub-dictionary
4259"RTN","VWREGITU",157,0)
4260 W ^("UP")
4261"RTN","VWREGITU",158,0)
4262 Q
4263"RTN","VWREGITU",159,0)
4264 ;
4265"RTN","VWREGITU",160,0)
4266 
4267"RTN","VWREGITX")
42680^8^B69339357
4269"RTN","VWREGITX",1,0)
4270VWREGITX ;VWEHR/BFProd-Jim Bell, et al - World VistA GUI Pat Reg Utility
4271"RTN","VWREGITX",2,0)
4272 ;;;;;;Build 4
4273"RTN","VWREGITX",3,0)
4274 ;;1.0;WORLD VISTA;**LOCAL **;;Build 26
4275"RTN","VWREGITX",4,0)
4276 ;
4277"RTN","VWREGITX",5,0)
4278 ;This routine utility is for patient specific fields and
4279"RTN","VWREGITX",6,0)
4280 ;is used to build input templates for registration
4281"RTN","VWREGITX",7,0)
4282 ;
4283"RTN","VWREGITX",8,0)
4284 ;GNU License: See WVLIC.txt
4285"RTN","VWREGITX",9,0)
4286 ;Modified FOIA VISTA,
4287"RTN","VWREGITX",10,0)
4288 ;Copyright 2013 WorldVistA.  Licensed under the terms of the GNU
4289"RTN","VWREGITX",11,0)
4290 Q
4291"RTN","VWREGITX",12,0)
4292 ;
4293"RTN","VWREGITX",13,0)
42941 ;CallerID = HRN; value is at $P($P(CALLERID,":",2),"^")
4295"RTN","VWREGITX",14,0)
4296 S HRN=$P($P(CALLERID,":",2),"^")
4297"RTN","VWREGITX",15,0)
4298 S HRN=$$HRN(HRN)
4299"RTN","VWREGITX",16,0)
4300 I HRN="" S RESULT(0)="The Health Record Number (HRN) does not exist in this database"_$C(13,10)_"Please use NAME, DOB, or PHONE#."
4301"RTN","VWREGITX",17,0)
4302 Q
4303"RTN","VWREGITX",18,0)
4304 ;
4305"RTN","VWREGITX",19,0)
43062 ;CallerID = NAME; in ^2@+CALLERID
4307"RTN","VWREGITX",20,0)
4308 K AR,ARR
4309"RTN","VWREGITX",21,0)
4310 N HRN,PHONE,DOB,N
4311"RTN","VWREGITX",22,0)
4312 S NAME=$P(CALLERID,"^",+CALLERID)
4313"RTN","VWREGITX",23,0)
4314 S XNAME=NAME F  S XNAME=$O(^DPT("B",XNAME)) Q:XNAME'[NAME  D
4315"RTN","VWREGITX",24,0)
4316 . S N=0 F  S N=$O(^DPT("B",XNAME,N)) Q:'+N  S AR($O(AR(" "),-1)+1)=N
4317"RTN","VWREGITX",25,0)
4318 I $O(AR(" "),-1)=1 D  Q
4319"RTN","VWREGITX",26,0)
4320 . S DFN=AR(1)
4321"RTN","VWREGITX",27,0)
4322 . S HRN=$$HRN(DFN),HRN=$S($L(HRN):HRN,'$L(HRN):"ID-"_$P($G(^DPT(DFN,.36)),"^",3),1:"------------")
4323"RTN","VWREGITX",28,0)
4324 . S DOB=$P(^DPT(DFN,0),"^",3),DOB=$E(DOB,4,5)_"/"_$E(DOB,6,7)_"/"_$E(DOB,2,3)
4325"RTN","VWREGITX",29,0)
4326 . S PHONE=$P($G(^DPT(DFN,.131)),"^"),PHONE=$S($L(PHONE):PHONE,1:"<No entry>")
4327"RTN","VWREGITX",30,0)
4328 . S RESULT($$INR)=HRN_"^"_$P(^DPT(DFN,0),"^")_"("_DFN_")^"_DOB_"^"_PHONE
4329"RTN","VWREGITX",31,0)
4330 S N=0 F  S N=$O(AR(N)) Q:'+N  S ARR($P(^DPT(+AR(N),0),"^"),N)=+AR(N)
4331"RTN","VWREGITX",32,0)
4332 S X="ARR" F  S X=$Q(@X) Q:X=""  S DFN=@X D
4333"RTN","VWREGITX",33,0)
4334 . S HRN=$$HRN(DFN),HRN=$S($L(HRN):HRN,'$L(HRN):"ID-"_$P($G(^DPT(DFN,.36)),"^",3),1:"------------")
4335"RTN","VWREGITX",34,0)
4336 . S DOB=$P(^DPT(DFN,0),"^",3),DOB=$E(DOB,4,5)_"/"_$E(DOB,6,7)_"/"_$E(DOB,2,3)
4337"RTN","VWREGITX",35,0)
4338 . S PHONE=$P($G(^DPT(DFN,.131)),"^"),PHONE=$S($L(PHONE):PHONE,1:"<No entry>")
4339"RTN","VWREGITX",36,0)
4340 . S RESULT($$INR)=HRN_"^"_$P(^DPT(DFN,0),"^")_"("_DFN_")^"_DOB_"^"_PHONE
4341"RTN","VWREGITX",37,0)
4342 K AR,ARR
4343"RTN","VWREGITX",38,0)
4344 Q
4345"RTN","VWREGITX",39,0)
4346 ;
4347"RTN","VWREGITX",40,0)
43483 ;CallerID = DOB; in ^3@CALLERID
4349"RTN","VWREGITX",41,0)
4350 S X=$P(CALLERID,"^",+CALLERID)
4351"RTN","VWREGITX",42,0)
4352 K %DT,Y,AR
4353"RTN","VWREGITX",43,0)
4354 N HRN,PHONE,N
4355"RTN","VWREGITX",44,0)
4356 D ^%DT
4357"RTN","VWREGITX",45,0)
4358 S N=0 F  S N=$O(^DPT("ADOB",Y,N)) Q:'+N  S AR($O(AR(" "),-1)+1)=N_"^"_Y
4359"RTN","VWREGITX",46,0)
4360 I $O(AR(" "),-1)=1 D  Q  ;Only one find
4361"RTN","VWREGITX",47,0)
4362 . K RESULT
4363"RTN","VWREGITX",48,0)
4364 . S DFN=+AR(1)
4365"RTN","VWREGITX",49,0)
4366 . S HRN=$$HRN(DFN)
4367"RTN","VWREGITX",50,0)
4368 . I '$L(HRN) S HRN="ID-"_$P($G(^DPT(DFN,.36)),"^",3)
4369"RTN","VWREGITX",51,0)
4370 . I '$L(HRN) S HRN="------------"
4371"RTN","VWREGITX",52,0)
4372        . S PHONE=$P($G(^DPT(DFN,.131)),"^"),PHONE=$S($L(PHONE)>0:PHONE,1:"<No entry>")
4373"RTN","VWREGITX",53,0)
4374 . S RESULT($$INR)=HRN_"^"_$P(^DPT(DFN,0),"^")_"("_DFN_")"_"^"_$P(CALLERID,"^",+CALLERID)_"^"_PHONE
4375"RTN","VWREGITX",54,0)
4376 K ARR S N=0 F  S N=$O(AR(N)) Q:'+N  S ARR($P(^DPT(+AR(N),0),"^"),N)=+AR(N)
4377"RTN","VWREGITX",55,0)
4378 S X="ARR" F  S X=$Q(@X) Q:X=""  S DFN=@X D
4379"RTN","VWREGITX",56,0)
4380 . S HRN=$$HRN(DFN)
4381"RTN","VWREGITX",57,0)
4382 . I '$L(HRN) S HRN=$P($G(^DPT(DFN,.36)),"^",3)_"(ID)"
4383"RTN","VWREGITX",58,0)
4384 . I '$L(HRN)!(HRN="(ID)") S HRN="------------"
4385"RTN","VWREGITX",59,0)
4386 . S PHONE=$P($G(^DPT(DFN,.131)),"^"),PHONE=$S($L(PHONE)>0:PHONE,1:"<No entry>")
4387"RTN","VWREGITX",60,0)
4388 . S RESULT($$INR)=HRN_"^"_$P(^DPT(DFN,0),"^")_"("_DFN_")"_"^"_$P(CALLERID,"^",+CALLERID)_"^"_PHONE
4389"RTN","VWREGITX",61,0)
4390 K ARR,AR
4391"RTN","VWREGITX",62,0)
4392 Q
4393"RTN","VWREGITX",63,0)
4394 ;
4395"RTN","VWREGITX",64,0)
43964 ;CallerID = PHONE; IN ^4@+CALLERID
4397"RTN","VWREGITX",65,0)
4398 S CALLERID=$TR(CALLERID,"- ()","")
4399"RTN","VWREGITX",66,0)
4400 Q
4401"RTN","VWREGITX",67,0)
4402 ;
4403"RTN","VWREGITX",68,0)
44045 ;CallerID = space-bar; IN ^2@+CALLERID
4405"RTN","VWREGITX",69,0)
4406 S X=$P(CALLERID,"^",+CALLERID)
4407"RTN","VWREGITX",70,0)
4408 S DFN=$G(^DISV(DUZ,"^DPT("))
4409"RTN","VWREGITX",71,0)
4410 I 'DFN S RESULT(0)="Patient-Client not found" Q
4411"RTN","VWREGITX",72,0)
4412 S AR(1)=DFN G 2+6  ;Direct call
4413"RTN","VWREGITX",73,0)
4414 Q
4415"RTN","VWREGITX",74,0)
4416 ;
4417"RTN","VWREGITX",75,0)
4418DE(RESULT,DATA) ;Forced hard error
4419"RTN","VWREGITX",76,0)
4420 ;W "
4421"RTN","VWREGITX",77,0)
4422 Q
4423"RTN","VWREGITX",78,0)
4424 ;
4425"RTN","VWREGITX",79,0)
4426HRN(IEN) ;Health Record #s from IHS PATIENT
4427"RTN","VWREGITX",80,0)
4428 N N,HRNIEN,I
4429"RTN","VWREGITX",81,0)
4430 S HRNIEN=""
4431"RTN","VWREGITX",82,0)
4432 Q:'$D(^AUPNPAT(IEN)) HRNIEN
4433"RTN","VWREGITX",83,0)
4434 S N=0 F I=1:1 S N=$O(^AUPNPAT(IEN,41,N)) Q:'+N  S HRNIEN=HRNIEN_$P($G(^AUPNPAT(IEN,41,N,0)),"^",2)_"|"
4435"RTN","VWREGITX",84,0)
4436 I $E(HRNIEN,$L(HRNIEN))="|" S HRNIEN=$E(HRNIEN,1,$L(HRNIEN)-1)
4437"RTN","VWREGITX",85,0)
4438 Q HRNIEN
4439"RTN","VWREGITX",86,0)
4440 ;
4441"RTN","VWREGITX",87,0)
4442ALIST(RESULT,ALPHA,CALLERID) ;Alpha request from client
4443"RTN","VWREGITX",88,0)
4444 ;*****************************************************
4445"RTN","VWREGITX",89,0)
4446 ;* ALPHA_____Letter to look up                       *
4447"RTN","VWREGITX",90,0)
4448 ;* CALLERID__PIECE#:HRN^NAME(IEN)^DOB^PHONE look up  *
4449"RTN","VWREGITX",91,0)
4450 ;* RETURN____HRN^NAME^DOB^PHONE(Field .131 in File 2)*
4451"RTN","VWREGITX",92,0)
4452 ;*****************************************************
4453"RTN","VWREGITX",93,0)
4454 I '$L(ALPHA),'+CALLERID S RESULT(0)="No Alphabetical letter or HRN,Name,DOB,Phone selection..." Q
4455"RTN","VWREGITX",94,0)
4456 S CALLERID=$$UP^XLFSTR(CALLERID)  ;Upcase EVERYTHING
4457"RTN","VWREGITX",95,0)
4458 I +CALLERID G @+CALLERID
4459"RTN","VWREGITX",96,0)
4460 N X,I,ANAME,HRN,ADOB,APHONE,Y
4461"RTN","VWREGITX",97,0)
4462 K RESULT,AR,ARR
4463"RTN","VWREGITX",98,0)
4464 S X="^DPT(""B"""_","_""""_ALPHA_""")"
4465"RTN","VWREGITX",99,0)
4466 F I=1:1 S X=$Q(@X) Q:$S($L(ALPHA)>1:$P(X,"""",4)'[ALPHA,1:$E($P(X,"""",4))'=ALPHA)  S AR(I)=+$P(X,",",$L(X,","))
4467"RTN","VWREGITX",100,0)
4468 S ARN=0 F  S ARN=$O(AR(ARN)) Q:'+ARN  D
4469"RTN","VWREGITX",101,0)
4470 . S HRN=$$HRN(ARN)
4471"RTN","VWREGITX",102,0)
4472 . S:'$L(HRN) HRN="---            "
4473"RTN","VWREGITX",103,0)
4474 . F JJ=$L(HRN):1:15 S HRN=HRN_" "
4475"RTN","VWREGITX",104,0)
4476 . S ANAME=$P(^DPT(AR(ARN),0),"^")
4477"RTN","VWREGITX",105,0)
4478 . S Y=$P(^(0),"^",3)_$S($G(^DPT(AR(ARN),540000)):^(540000),1:"")
4479"RTN","VWREGITX",106,0)
4480 . D DD^%DT S ADOB=Y
4481"RTN","VWREGITX",107,0)
4482 . S APHONE=$P($G(^DPT(AR(ARN),.13)),"^")
4483"RTN","VWREGITX",108,0)
4484 . S ARR(ANAME,ARN)=HRN_"^"_ANAME_"("_AR(ARN)_")^"_ADOB_"^"_APHONE
4485"RTN","VWREGITX",109,0)
4486 S X="ARR" F  S X=$Q(@X) Q:X=""  S RESULT($$INR)=@X
4487"RTN","VWREGITX",110,0)
4488 Q
4489"RTN","VWREGITX",111,0)
4490 ;
4491"RTN","VWREGITX",112,0)
4492PLID(IEN) ;Primary Long ID, used with or in absence of HRN.
4493"RTN","VWREGITX",113,0)
4494 Q $P($G(^DPT(IEN,.36)),"^",3)
4495"RTN","VWREGITX",114,0)
4496 ;
4497"RTN","VWREGITX",115,0)
4498INR() Q $O(RESULT(" "),-1)+1
4499"RTN","VWREGITX",116,0)
4500 ;
4501"RTN","VWREGITX",117,0)
4502 
4503"RTN","VWREGITX",118,0)
4504FIXNAME ;
4505"RTN","VWREGITX",119,0)
4506 N N,X,Y,XIEN,NLENGTH,I
4507"RTN","VWREGITX",120,0)
4508 S NLENGTH=0,X="AR" F  S X=$Q(@X) Q:X=""  D
4509"RTN","VWREGITX",121,0)
4510 . S Y=@X,N=$P(Y,"(")_"("_+$P(Y,"(",2)_")",STR=$P(Y,")",2)
4511"RTN","VWREGITX",122,0)
4512 . S NLENGTH=$S($L(N)>NLENGTH:$L(N),1:NLENGTH)
4513"RTN","VWREGITX",123,0)
4514 . F I=NLENGTH:-1:$L(N) S N=N_" "
4515"RTN","VWREGITX",124,0)
4516 . S Y=N_" "_STR
4517"RTN","VWREGITX",125,0)
4518 . S @X=Y
4519"RTN","VWREGITX",126,0)
4520 Q
4521"RTN","VWREGITX",127,0)
4522GPL(RESULT,IDDATA) ;Partial patient lists
4523"RTN","VWREGITX",128,0)
4524 ;***********************************************
4525"RTN","VWREGITX",129,0)
4526 ;* IDDATA_____Contains Start^Stop alpha chars  *
4527"RTN","VWREGITX",130,0)
4528 ;* RESULT_____Return of results                *
4529"RTN","VWREGITX",131,0)
4530 ;***********************************************
4531"RTN","VWREGITX",132,0)
4532 K RESULT,AR
4533"RTN","VWREGITX",133,0)
4534 N N,DFN,SSN,DOB,START,STOP,NAME,XDOB ;; ,NL
4535"RTN","VWREGITX",134,0)
4536 ;;Get user's last patient ID
4537"RTN","VWREGITX",135,0)
4538 S DFN=$G(^DISV(DUZ,"^DPT(")) D:DFN
4539"RTN","VWREGITX",136,0)
4540 . S NAME=$P(^DPT(DFN,0),"^")
4541"RTN","VWREGITX",137,0)
4542 . ;S SSN=$P(^(0),"^",9)
4543"RTN","VWREGITX",138,0)
4544 . S HRN="HRN: "_$$HRN(DFN)  ;Health record number
4545"RTN","VWREGITX",139,0)
4546 . S PLID="ID: "_$$PLID(DFN)  ;Primary Long ID
4547"RTN","VWREGITX",140,0)
4548 . S DOB=$P(^(0),"^",3)
4549"RTN","VWREGITX",141,0)
4550 . S XDOB=$E(DOB,4,5)_"/"_$E(DOB,6,7)_"/"_$S($E(DOB)<3:19,1:20)_$E(DOB,2,3)
4551"RTN","VWREGITX",142,0)
4552 . S AR(0)=NAME_"("_DFN_")"_" "_XDOB_" "_$S($L($P(HRN,": ",2)):HRN,$L($P(PLID,": ",2)):PLID,1:"<NO ID ON FILE>")
4553"RTN","VWREGITX",143,0)
4554 S START=$P(IDDATA,"^")
4555"RTN","VWREGITX",144,0)
4556 S STOP=$P(IDDATA,"^",2)
4557"RTN","VWREGITX",145,0)
4558 S STOP=STOP_"z"
4559"RTN","VWREGITX",146,0)
4560 S STOP=$E($O(^DPT("B",STOP)))
4561"RTN","VWREGITX",147,0)
4562 S STOP=$S('$L(STOP):$P(IDDATA,"^",2)_"z",1:STOP)
4563"RTN","VWREGITX",148,0)
4564 S NL=0
4565"RTN","VWREGITX",149,0)
4566 S N=START F  S N=$O(^DPT("B",N)) Q:N=""!($E(N)=STOP)  D
4567"RTN","VWREGITX",150,0)
4568 . S DFN=$O(^(N,0))
4569"RTN","VWREGITX",151,0)
4570 . S NAME=$P(^DPT(DFN,0),"^")_"("_DFN_")"
4571"RTN","VWREGITX",152,0)
4572 . ;S SSN=$P(^(0),"^",9),SSN=$S('$L(SSN):"     ????",1:SSN)
4573"RTN","VWREGITX",153,0)
4574 . S HRN="HRN: "_$$HRN(DFN)
4575"RTN","VWREGITX",154,0)
4576        . S PLID="ID: "_$$PLID(DFN)  ;Primary Long ID
4577"RTN","VWREGITX",155,0)
4578 . S DOB=$P(^DPT(DFN,0),"^",3)
4579"RTN","VWREGITX",156,0)
4580 . S XDOB=$E(DOB,4,5)_"/"_$E(DOB,6,7)_"/"_$S($E(DOB)<3:19,1:20)_$E(DOB,2,3)
4581"RTN","VWREGITX",157,0)
4582 . ;W !,$J(DFN,5)," ",$J($E(NAME,1,12),12)," ",$J(SSN,10)," ",XDOB
4583"RTN","VWREGITX",158,0)
4584 . S AR(NAME,DFN)=NAME_" "_XDOB_" "_$S($L($P(HRN,": ",2)):HRN,$L($P(PLID,": ",2)):PLID,1:"<NO ID ON FILE>")
4585"RTN","VWREGITX",159,0)
4586 . S (DFN,NAME,SSN,DOB,XDOB)=""
4587"RTN","VWREGITX",160,0)
4588 D FIXNAME
4589"RTN","VWREGITX",161,0)
4590 S X="AR" F  S X=$Q(@X) Q:X=""  S RESULT($$INR)=@X
4591"RTN","VWREGITX",162,0)
4592 K AR
4593"RTN","VWREGITX",163,0)
4594 Q
4595"RTN","VWREGITX",164,0)
4596 ;
4597"RTN","VWREGITX",165,0)
4598REJECT(FIELD,IEN,SUBDIC) ;Reject Asterisked,Amis,Computed fields,VA specific fields
4599"RTN","VWREGITX",166,0)
4600 ;This subroutine left in for possible future use
4601"RTN","VWREGITX",167,0)
4602 I $L(IEN),$D(^DIZ(64850001,IEN)) Q 1  ;VA specific data field
4603"RTN","VWREGITX",168,0)
4604 I FIELD["COMPONENT" Q 1  ;Pain in the butt!
4605"RTN","VWREGITX",169,0)
4606 I FIELD["(VA)"!(FIELD["(CIVIL)") Q 1  ;VA fields
4607"RTN","VWREGITX",170,0)
4608 I FIELD["AMIS",FIELD["SEGMENT" Q 1
4609"RTN","VWREGITX",171,0)
4610 I FIELD["ELIG VERIF" Q 1
4611"RTN","VWREGITX",172,0)
4612 I FIELD["ENCOUNTER CONVERSION" Q 1
4613"RTN","VWREGITX",173,0)
4614 I FIELD["PROGRAMMERS U" Q 1
4615"RTN","VWREGITX",174,0)
4616 I FIELD["WHO " Q 1
4617"RTN","VWREGITX",175,0)
4618 I FIELD["SC AT"!(FIELD["SC%") Q 1
4619"RTN","VWREGITX",176,0)
4620 I $E(FIELD)="*" Q 1  ;field marked for deletion
4621"RTN","VWREGITX",177,0)
4622 I FIELD["10-10" Q 1
4623"RTN","VWREGITX",178,0)
4624 I $L(IEN),$E($P($G(^DD(2,IEN,0)),"^",2))="C" Q 1  ;computed field
4625"RTN","VWREGITX",179,0)
4626 I $L($G(SUBDIC)),$E($P($G(^DD(SUBDIC,IEN,0)),"^",2))="C" Q 1 ;computet in sub-dic
4627"RTN","VWREGITX",180,0)
4628 Q 0  ;Passed
4629"RTN","VWREGITX",181,0)
4630 ;
4631"RTN","VWREGITX",182,0)
4632LF(RESULT,FTYPE) ;List of assumed civilian type fields from
4633"RTN","VWREGITX",183,0)
4634 ;                Patient file(#2)
4635"RTN","VWREGITX",184,0)
4636 ;*******************************************************************
4637"RTN","VWREGITX",185,0)
4638 ;*The author (me) arbitarily selected fields from the patient file *
4639"RTN","VWREGITX",186,0)
4640 ;* that he (me) considers to be usable by civilian VistA/CPRS users*
4641"RTN","VWREGITX",187,0)
4642 ;* the field count is 284 out of the 700+ fields available in the  *
4643"RTN","VWREGITX",188,0)
4644 ;* full patient DD. File is located at ^DIZ(64850002,              *
4645"RTN","VWREGITX",189,0)
4646 ;*******************************************************************
4647"RTN","VWREGITX",190,0)
4648 ;
4649"RTN","VWREGITX",191,0)
4650 S FTYPE=$TR(FTYPE,"*&^%$#@!:;>?/., ","")  ;TMenuItem inclusions/jeb
4651"RTN","VWREGITX",192,0)
4652 ;S:$L(FTYPE) FTYPE=$P(^DIZ(64850003,+$P(FTYPE,"(",2),0),"^")
4653"RTN","VWREGITX",193,0)
4654 S FTYPE=$$UP^XLFSTR(FTYPE)
4655"RTN","VWREGITX",194,0)
4656 K RESULT
4657"RTN","VWREGITX",195,0)
4658 N N,X,FIELD,FLDNO,FGRP,M,MX,MF,MFNO,MFGP,MN
4659"RTN","VWREGITX",196,0)
4660 G FG:$L(FTYPE)
4661"RTN","VWREGITX",197,0)
4662 ; Add patient file fields
4663"RTN","VWREGITX",198,0)
4664 S N=0 F  S N=$O(^DIZ(64850002,N)) Q:'+N  D
4665"RTN","VWREGITX",199,0)
4666 . S X=^(N,0)
4667"RTN","VWREGITX",200,0)
4668 . S FIELD=$P(X,"^")
4669"RTN","VWREGITX",201,0)
4670 . S FLDNO=$P(X,"^",2)
4671"RTN","VWREGITX",202,0)
4672 . S FGRP=$P(X,"^",3)
4673"RTN","VWREGITX",203,0)
4674 . S RESULT($$INR)=FIELD_"("_FLDNO_")"_":"_FGRP
4675"RTN","VWREGITX",204,0)
4676 . I $O(^DIZ(64850002,N,"M",0)) D
4677"RTN","VWREGITX",205,0)
4678 .. S M=0 F  S M=$O(^DIZ(64850002,N,"M",M)) Q:'+M  D
4679"RTN","VWREGITX",206,0)
4680 ... S MX=^(M,0)
4681"RTN","VWREGITX",207,0)
4682 ... S MF=$P(MX,"^")
4683"RTN","VWREGITX",208,0)
4684 ... S MFNO=$P(MX,"^",2)
4685"RTN","VWREGITX",209,0)
4686 ... S MFGP=$P(MX,"^",3)
4687"RTN","VWREGITX",210,0)
4688 ... S RESULT($$INR)=" SF "_MF_"("_MFNO_")"_":"_MFGP
4689"RTN","VWREGITX",211,0)
4690 S X="RESULT" F I=1:1 S X=$Q(@X) Q:X=""
4691"RTN","VWREGITX",212,0)
4692 S RESULT(0)="Field count: "_(I-1)
4693"RTN","VWREGITX",213,0)
4694 Q
4695"RTN","VWREGITX",214,0)
4696 ;
4697"RTN","VWREGITX",215,0)
4698FG ;Fields by GROUP
4699"RTN","VWREGITX",216,0)
4700 Q:'$L(FTYPE)
4701"RTN","VWREGITX",217,0)
4702 K RESULT,AHF N LABEL,F,N,I
4703"RTN","VWREGITX",218,0)
4704 S N=$S(+$P(FTYPE,"(",2):+$P(FTYPE,"(",2),1:$O(^DIZ(64850003,"B",FTYPE,0)))
4705"RTN","VWREGITX",219,0)
4706 I 'N S RESULT($$INR)="Group not found." G FGX
4707"RTN","VWREGITX",220,0)
4708 S F=0 F I=1:1  S F=$O(^DIZ(64850003,N,"F","B",F)) Q:'+F  S RESULT($$INR)=$P(^DD(2,F,0),"^")_"("_F_")"
4709"RTN","VWREGITX",221,0)
4710FGX Q
4711"RTN","VWREGITX",222,0)
4712 ;
4713"RTN","VWREGITX",223,0)
4714RETGRP(RESULT) ;Return Group IDs
4715"RTN","VWREGITX",224,0)
4716 K RESULT
4717"RTN","VWREGITX",225,0)
4718 S N=0 F  S N=$O(^DIZ(64850003,N)) Q:'+N  S RESULT($$INR)=$P(^(N,0),"^",2)_"("_N_")"
4719"RTN","VWREGITX",226,0)
4720 Q
4721"RTN","VWREGITX",227,0)
4722 ;
4723"RTN","VWREGITX",228,0)
4724AHF(RESULT,AHF) ;Ad hoc field selection "Finished" pressed/jeb
4725"RTN","VWREGITX",229,0)
4726 ;*****************************************************
4727"RTN","VWREGITX",230,0)
4728 ;* AFH ARRAY:                                        *
4729"RTN","VWREGITX",231,0)
4730 ;*   AHF(0)____DFN                                   *
4731"RTN","VWREGITX",232,0)
4732 ;*   AHF ARRAY_FIELD(NO) OR FIELD(NO;SUB-DIC)        *
4733"RTN","VWREGITX",233,0)
4734 ;*****************************************************
4735"RTN","VWREGITX",234,0)
4736 ;W "  ;the END
4737"RTN","VWREGITX",235,0)
4738 K ^DIZ("AHF") M ^DIZ("AHF")=AHF
4739"RTN","VWREGITX",236,0)
4740 K RESULT
4741"RTN","VWREGITX",237,0)
4742 N FIELD,FNO,DFNDR
4743"RTN","VWREGITX",238,0)
4744 S DFNDR=""
4745"RTN","VWREGITX",239,0)
4746 S DFN=+AHF(0) K AHF(0)
4747"RTN","VWREGITX",240,0)
4748 S X="AHF" F  S X=$Q(@X) Q:X=""  S Y=@X D
4749"RTN","VWREGITX",241,0)
4750 . S FIELD=$P(Y,"(")
4751"RTN","VWREGITX",242,0)
4752 . S FNO=+$P(Y,"(",2)
4753"RTN","VWREGITX",243,0)
4754 . D GFA(FNO)
4755"RTN","VWREGITX",244,0)
4756 . S RESULT($$INR)=FIELD_"^"_FNO_"^^"_FHELP_"^"_FPSC_"^"_$$MF(FNO)
4757"RTN","VWREGITX",245,0)
4758 . S DFNDR=DFNDR_FNO_";"
4759"RTN","VWREGITX",246,0)
4760 I DFN D
4761"RTN","VWREGITX",247,0)
4762 . K AR N N,Y,F
4763"RTN","VWREGITX",248,0)
4764 . D GETS^DIQ(2,DFN_",",DFNDR,"E","AR","ERR")
4765"RTN","VWREGITX",249,0)
4766 . S X="AR" F  S X=$Q(@X) Q:X=""  D
4767"RTN","VWREGITX",250,0)
4768 .. S Y=@X
4769"RTN","VWREGITX",251,0)
4770 .. S F=+$P(X,",",$L(X,",")-1)
4771"RTN","VWREGITX",252,0)
4772 .. S N=0 F  S N=$O(RESULT(N)) Q:'+N  I $P(RESULT(N),"^",2)=F S $P(RESULT(N),"^",3)=Y
4773"RTN","VWREGITX",253,0)
4774 ;ToDo: write fill in for the multiple fields
4775"RTN","VWREGITX",254,0)
4776 K FHELP,FPSC
4777"RTN","VWREGITX",255,0)
4778 Q
4779"RTN","VWREGITX",256,0)
4780 ;
4781"RTN","VWREGITX",257,0)
4782GFA(FNO) ;Get field attributes at piece3 and help
4783"RTN","VWREGITX",258,0)
4784 S (FHELP,FPSC)=""
4785"RTN","VWREGITX",259,0)
4786 S FHELP=$G(^DD(2,FNO,3))
4787"RTN","VWREGITX",260,0)
4788 I FNO'=27.02 S N=0 F  S N=$O(^DD(2,FNO,21,N)) Q:'+N  S FHELP=FHELP_^(N,0)
4789"RTN","VWREGITX",261,0)
4790 S FHELP=$TR(FHELP,"'","`")
4791"RTN","VWREGITX",262,0)
4792 S FPSC=$P(^DD(2,FNO,0),"^",3)
4793"RTN","VWREGITX",263,0)
4794 Q
4795"RTN","VWREGITX",264,0)
4796 ;
4797"RTN","VWREGITX",265,0)
4798MF(X) ;Check for multiple field
4799"RTN","VWREGITX",266,0)
4800 ;*****************************************************
4801"RTN","VWREGITX",267,0)
4802 ;* Reminder: This data set is Patient file only (#2) *
4803"RTN","VWREGITX",268,0)
4804 ;* MYESNO____=1 is a parent                          *
4805"RTN","VWREGITX",269,0)
4806 ;*           =0 is a primary field                   *
4807"RTN","VWREGITX",270,0)
4808 ;*****************************************************
4809"RTN","VWREGITX",271,0)
4810 ;
4811"RTN","VWREGITX",272,0)
4812 S MYESNO=$S(+$P(^DD(2,X,0),"^",2):1,1:0)
4813"RTN","VWREGITX",273,0)
4814 Q MYESNO
4815"RTN","VWREGITX",274,0)
4816 ;
4817"RTN","VWREGITX",275,0)
4818 
4819"VER")
48208.0^22.0
4821"^DD",64850001,64850001,0)
4822FIELD^^.001^2
4823"^DD",64850001,64850001,0,"DDA")
4824N
4825"^DD",64850001,64850001,0,"DT")
48263150506
4827"^DD",64850001,64850001,0,"IX","B",64850001,.01)
4828
4829"^DD",64850001,64850001,0,"NM","PATIENT FILE FIELD EXCLUSIONS")
4830
4831"^DD",64850001,64850001,.001,0)
4832FNUMBER^NJ15,7X^^ ^K:+X'=X!(X>9999999.9999999)!(X<0)!(X?.E1"."8N.N) X S:$G(X) DINUM=X
4833"^DD",64850001,64850001,.001,3)
4834Type a number between 0 and 9999999.9999999, 7 decimal digits.
4835"^DD",64850001,64850001,.001,"DT")
48363150506
4837"^DD",64850001,64850001,.01,0)
4838FIELD^RF^^0;1^K:$L(X)>99!($L(X)<1)!'(X'?1P.E) X
4839"^DD",64850001,64850001,.01,1,0)
4840^.1
4841"^DD",64850001,64850001,.01,1,1,0)
484264850001^B
4843"^DD",64850001,64850001,.01,1,1,1)
4844S ^DIZ(64850001,"B",$E(X,1,30),DA)=""
4845"^DD",64850001,64850001,.01,1,1,2)
4846K ^DIZ(64850001,"B",$E(X,1,30),DA)
4847"^DD",64850001,64850001,.01,1,1,"DT")
48483151009
4849"^DD",64850001,64850001,.01,3)
4850Answer must be 1-99 characters in length.
4851"^DD",64850001,64850001,.01,"DT")
48523151009
4853"^DD",64850002,64850002,0)
4854FIELD^^2.5^4
4855"^DD",64850002,64850002,0,"DDA")
4856N
4857"^DD",64850002,64850002,0,"DT")
48583150602
4859"^DD",64850002,64850002,0,"IX","B",64850002,.01)
4860
4861"^DD",64850002,64850002,0,"IX","C",64850002,3)
4862
4863"^DD",64850002,64850002,0,"NM","CIVILIAN PATIENT FIELDS")
4864
4865"^DD",64850002,64850002,.01,0)
4866NAME^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X
4867"^DD",64850002,64850002,.01,1,0)
4868^.1
4869"^DD",64850002,64850002,.01,1,1,0)
487064850002^B
4871"^DD",64850002,64850002,.01,1,1,1)
4872S ^DIZ(64850002,"B",$E(X,1,30),DA)=""
4873"^DD",64850002,64850002,.01,1,1,2)
4874K ^DIZ(64850002,"B",$E(X,1,30),DA)
4875"^DD",64850002,64850002,.01,3)
4876Answer must be 3-30 characters in length.
4877"^DD",64850002,64850002,.01,4)
4878S X="SHOW ME THIS FIELD AND WHERE ITS LOCATED"
4879"^DD",64850002,64850002,.01,"DT")
48803150601
4881"^DD",64850002,64850002,2,0)
4882FIELD NO^NJ15,7^^0;2^K:+X'=X!(X>9999999.9999999)!(X<0)!(X?.E1"."8N.N) X
4883"^DD",64850002,64850002,2,3)
4884Type a number between 0 and 9999999.9999999, 7 decimal digits.
4885"^DD",64850002,64850002,2,"DT")
48863150601
4887"^DD",64850002,64850002,2.5,0)
4888Multiple of field^64850002.01A^^M;0
4889"^DD",64850002,64850002,3,0)
4890GROUP^F^^0;3^K:$L(X)>30!($L(X)<1) X
4891"^DD",64850002,64850002,3,1,0)
4892^.1
4893"^DD",64850002,64850002,3,1,1,0)
489464850002^C
4895"^DD",64850002,64850002,3,1,1,1)
4896S ^DIZ(64850002,"C",$E(X,1,30),DA)=""
4897"^DD",64850002,64850002,3,1,1,2)
4898K ^DIZ(64850002,"C",$E(X,1,30),DA)
4899"^DD",64850002,64850002,3,1,1,"DT")
49003150601
4901"^DD",64850002,64850002,3,3)
4902Answer must be 1-30 characters in length.
4903"^DD",64850002,64850002,3,"DT")
49043150601
4905"^DD",64850002,64850002.01,0)
4906Multiple of field SUB-FIELD^^3^3
4907"^DD",64850002,64850002.01,0,"DT")
49083150602
4909"^DD",64850002,64850002.01,0,"IX","B",64850002.01,.01)
4910
4911"^DD",64850002,64850002.01,0,"NM","Multiple of field")
4912
4913"^DD",64850002,64850002.01,0,"UP")
491464850002
4915"^DD",64850002,64850002.01,.01,0)
4916Multiple of field^F^^0;1^K:$L(X)>30!($L(X)<1) X
4917"^DD",64850002,64850002.01,.01,1,0)
4918^.1
4919"^DD",64850002,64850002.01,.01,1,1,0)
492064850002.01^B
4921"^DD",64850002,64850002.01,.01,1,1,1)
4922S ^DIZ(64850002,DA(1),"M","B",$E(X,1,30),DA)=""
4923"^DD",64850002,64850002.01,.01,1,1,2)
4924K ^DIZ(64850002,DA(1),"M","B",$E(X,1,30),DA)
4925"^DD",64850002,64850002.01,.01,3)
4926Answer must be 1-30 characters in length.
4927"^DD",64850002,64850002.01,.01,"DT")
49283150601
4929"^DD",64850002,64850002.01,2,0)
4930FIELD NO^NJ15,7^^0;2^K:+X'=X!(X>9999999.9999999)!(X<0)!(X?.E1"."8N.N) X
4931"^DD",64850002,64850002.01,2,3)
4932Type a number between 0 and 9999999.9999999, 7 decimal digits.
4933"^DD",64850002,64850002.01,2,"DT")
49343150601
4935"^DD",64850002,64850002.01,3,0)
4936MULT OF MULT^64850002.13A^^MM;0
4937"^DD",64850002,64850002.13,0)
4938MULT OF MULT SUB-FIELD^^2^2
4939"^DD",64850002,64850002.13,0,"DT")
49403150602
4941"^DD",64850002,64850002.13,0,"IX","B",64850002.13,.01)
4942
4943"^DD",64850002,64850002.13,0,"NM","MULT OF MULT")
4944
4945"^DD",64850002,64850002.13,0,"UP")
494664850002.01
4947"^DD",64850002,64850002.13,.01,0)
4948MULT OF MULT^F^^0;1^K:$L(X)>30!($L(X)<1) X
4949"^DD",64850002,64850002.13,.01,1,0)
4950^.1
4951"^DD",64850002,64850002.13,.01,1,1,0)
495264850002.13^B
4953"^DD",64850002,64850002.13,.01,1,1,1)
4954S ^DIZ(64850002,DA(2),"M",DA(1),"MM","B",$E(X,1,30),DA)=""
4955"^DD",64850002,64850002.13,.01,1,1,2)
4956K ^DIZ(64850002,DA(2),"M",DA(1),"MM","B",$E(X,1,30),DA)
4957"^DD",64850002,64850002.13,.01,3)
4958Answer must be 1-30 characters in length.
4959"^DD",64850002,64850002.13,.01,"DT")
49603150602
4961"^DD",64850002,64850002.13,2,0)
4962SFNOS^F^^0;2^K:$L(X)>30!($L(X)<1) X
4963"^DD",64850002,64850002.13,2,3)
4964Answer must be 1-30 characters in length.
4965"^DD",64850002,64850002.13,2,"DT")
49663150602
4967"^DD",64850003,64850003,0)
4968FIELD^^.05^3
4969"^DD",64850003,64850003,0,"DT")
49703160410
4971"^DD",64850003,64850003,0,"IX","B",64850003,.01)
4972
4973"^DD",64850003,64850003,0,"NM","FIELD GROUPS")
4974
4975"^DD",64850003,64850003,.01,0)
4976ABBREVIATION^RF^^0;1^K:$L(X)>30!($L(X)<1)!'(X'?1P.E) X
4977"^DD",64850003,64850003,.01,1,0)
4978^.1
4979"^DD",64850003,64850003,.01,1,1,0)
498064850003^B
4981"^DD",64850003,64850003,.01,1,1,1)
4982S ^DIZ(64850003,"B",$E(X,1,30),DA)=""
4983"^DD",64850003,64850003,.01,1,1,2)
4984K ^DIZ(64850003,"B",$E(X,1,30),DA)
4985"^DD",64850003,64850003,.01,3)
4986Answer must be 1-30 characters in length.
4987"^DD",64850003,64850003,.01,"DT")
49883160408
4989"^DD",64850003,64850003,.05,0)
4990FOR^F^^0;2^K:$L(X)>30!($L(X)<1) X
4991"^DD",64850003,64850003,.05,3)
4992
4993"^DD",64850003,64850003,.05,"DT")
49943160410
4995"^DD",64850003,64850003,2,0)
4996FIELD(S)^64850003.02^^F;0
4997"^DD",64850003,64850003.02,0)
4998FIELD(S) SUB-FIELD^^.01^1
4999"^DD",64850003,64850003.02,0,"DT")
50003160409
5001"^DD",64850003,64850003.02,0,"IX","B",64850003.02,.01)
5002
5003"^DD",64850003,64850003.02,0,"NM","FIELD(S)")
5004
5005"^DD",64850003,64850003.02,0,"UP")
500664850003
5007"^DD",64850003,64850003.02,.01,0)
5008FIELD(S)^MF^^0;1^K:$L(X)>30!($L(X)<1) X
5009"^DD",64850003,64850003.02,.01,1,0)
5010^.1
5011"^DD",64850003,64850003.02,.01,1,1,0)
501264850003.02^B
5013"^DD",64850003,64850003.02,.01,1,1,1)
5014S ^DIZ(64850003,DA(1),"F","B",$E(X,1,30),DA)=""
5015"^DD",64850003,64850003.02,.01,1,1,2)
5016K ^DIZ(64850003,DA(1),"F","B",$E(X,1,30),DA)
5017"^DD",64850003,64850003.02,.01,3)
5018Answer must be 1-30 characters in length.
5019"^DD",64850003,64850003.02,.01,"DT")
50203160409
5021"^DIC",64850001,64850001,0)
5022PATIENT FILE FIELD EXCLUSIONS^64850001
5023"^DIC",64850001,64850001,0,"GL")
5024^DIZ(64850001,
5025"^DIC",64850001,64850001,"%",0)
5026^1.005^^
5027"^DIC",64850001,64850001,"%D",0)
5028^^7^7^3150506^
5029"^DIC",64850001,64850001,"%D",1,0)
5030This is not quite a Fileman legal file, although it can be edited,
5031"^DIC",64850001,64850001,"%D",2,0)
5032preferrably by programmer access and direct code.
5033"^DIC",64850001,64850001,"%D",3,0)
5034The file contains patient file(#2) field numbers. These are fields that I
5035"^DIC",64850001,64850001,"%D",4,0)
5036arbitrarily consider VA specific fields and pretty much not applicable
5037"^DIC",64850001,64850001,"%D",5,0)
5038anywhere else.
5039"^DIC",64850001,64850001,"%D",6,0)
5040I know....how arrogant...
5041"^DIC",64850001,64850001,"%D",7,0)
5042jb
5043"^DIC",64850001,"B","PATIENT FILE FIELD EXCLUSIONS",64850001)
5044
5045"^DIC",64850002,64850002,0)
5046CIVILIAN PATIENT FIELDS^64850002
5047"^DIC",64850002,64850002,0,"GL")
5048^DIZ(64850002,
5049"^DIC",64850002,64850002,"%D",0)
5050^1.001^1^1^3150610^^
5051"^DIC",64850002,64850002,"%D",1,0)
5052Fields selected by the author that are considered to be non-VA mandates
5053"^DIC",64850002,"B","CIVILIAN PATIENT FIELDS",64850002)
5054
5055"^DIC",64850003,64850003,0)
5056FIELD GROUPS^64850003
5057"^DIC",64850003,64850003,0,"GL")
5058^DIZ(64850003,
5059"^DIC",64850003,"B","FIELD GROUPS",64850003)
5060
5061**END**
5062**END**
Note: See TracBrowser for help on using the repository browser.