source: VWGUIRegistration/trunk/VWREG_11192016_2-1T1_0.KID

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