source: VWGUIRegistration/trunk/VWREG_12132016_2-02T3-0.KID

Last change on this file was 1781, checked in by Jim B., 7 years ago
File size: 137.3 KB
Line 
1KIDS Distribution saved on Dec 13, 2016@10:05:14
2VW/BFP GUI Pt Reg server side
3**KIDS**:VWREG_12132016*2.02T3*0^
4
5**INSTALL NAME**
6VWREG_12132016*2.02T3*0
7"BLD",8564,0)
8VWREG_12132016*2.02T3*0^^0^3161213^n
9"BLD",8564,1,0)
10^^1^1^3161211^
11"BLD",8564,1,1,0)
12M side of VW/BFP Registration
13"BLD",8564,4,0)
14^9.64PA^64850004^4
15"BLD",8564,4,64850001,0)
1664850001
17"BLD",8564,4,64850001,222)
18y^n^f^^y^^y^m^n
19"BLD",8564,4,64850002,0)
2064850002
21"BLD",8564,4,64850002,222)
22y^n^f^^y^^y^m^y
23"BLD",8564,4,64850003,0)
2464850003
25"BLD",8564,4,64850003,222)
26y^n^f^^n^^y^m^y
27"BLD",8564,4,64850004,0)
2864850004
29"BLD",8564,4,64850004,222)
30y^n^f^^y^^y^m^y
31"BLD",8564,4,"B",64850001,64850001)
32
33"BLD",8564,4,"B",64850002,64850002)
34
35"BLD",8564,4,"B",64850003,64850003)
36
37"BLD",8564,4,"B",64850004,64850004)
38
39"BLD",8564,6.3)
404
41"BLD",8564,"INI")
42PRE^VWREGIT2
43"BLD",8564,"INIT")
44PI^VWREGIT2
45"BLD",8564,"KRN",0)
46^9.67PA^779.2^20
47"BLD",8564,"KRN",.4,0)
48.4
49"BLD",8564,"KRN",.401,0)
50.401
51"BLD",8564,"KRN",.402,0)
52.402
53"BLD",8564,"KRN",.402,"NM",0)
54^9.68A^6^6
55"BLD",8564,"KRN",.402,"NM",1,0)
56VW ADDRESS FILE #2^2^0
57"BLD",8564,"KRN",.402,"NM",2,0)
58VW EMERG. CONTACT FILE #2^2^0
59"BLD",8564,"KRN",.402,"NM",3,0)
60VW NEXT OF KIN FILE #2^2^0
61"BLD",8564,"KRN",.402,"NM",4,0)
62VW PT REGISTRATION FILE #2^2^0
63"BLD",8564,"KRN",.402,"NM",5,0)
64VW REPORTED DEATH FILE #2^2^0
65"BLD",8564,"KRN",.402,"NM",6,0)
66VW WESTVIRGINIA TEST FILE #2^2^0
67"BLD",8564,"KRN",.402,"NM","B","VW ADDRESS FILE #2",1)
68
69"BLD",8564,"KRN",.402,"NM","B","VW EMERG. CONTACT FILE #2",2)
70
71"BLD",8564,"KRN",.402,"NM","B","VW NEXT OF KIN FILE #2",3)
72
73"BLD",8564,"KRN",.402,"NM","B","VW PT REGISTRATION FILE #2",4)
74
75"BLD",8564,"KRN",.402,"NM","B","VW REPORTED DEATH FILE #2",5)
76
77"BLD",8564,"KRN",.402,"NM","B","VW WESTVIRGINIA TEST FILE #2",6)
78
79"BLD",8564,"KRN",.403,0)
80.403
81"BLD",8564,"KRN",.5,0)
82.5
83"BLD",8564,"KRN",.84,0)
84.84
85"BLD",8564,"KRN",3.6,0)
863.6
87"BLD",8564,"KRN",3.8,0)
883.8
89"BLD",8564,"KRN",3.8,"NM",0)
90^9.68A^1^1
91"BLD",8564,"KRN",3.8,"NM",1,0)
92VW REG ERROR REPORT^^0
93"BLD",8564,"KRN",3.8,"NM","B","VW REG ERROR REPORT",1)
94
95"BLD",8564,"KRN",9.2,0)
969.2
97"BLD",8564,"KRN",9.8,0)
989.8
99"BLD",8564,"KRN",9.8,"NM",0)
100^9.68A^9^8
101"BLD",8564,"KRN",9.8,"NM",1,0)
102VWREGIT^^0^B33941826
103"BLD",8564,"KRN",9.8,"NM",3,0)
104VWREGIT3^^0^B4498
105"BLD",8564,"KRN",9.8,"NM",4,0)
106VWREGITP^^0^B5382212
107"BLD",8564,"KRN",9.8,"NM",5,0)
108VWREGITS^^0^B15386714
109"BLD",8564,"KRN",9.8,"NM",6,0)
110VWREGITT^^0^B37668154
111"BLD",8564,"KRN",9.8,"NM",7,0)
112VWREGITU^^0^B34064749
113"BLD",8564,"KRN",9.8,"NM",8,0)
114VWREGITX^^0^B96032773
115"BLD",8564,"KRN",9.8,"NM",9,0)
116VWREGIT2^^0^B7008432
117"BLD",8564,"KRN",9.8,"NM","B","VWREGIT",1)
118
119"BLD",8564,"KRN",9.8,"NM","B","VWREGIT2",9)
120
121"BLD",8564,"KRN",9.8,"NM","B","VWREGIT3",3)
122
123"BLD",8564,"KRN",9.8,"NM","B","VWREGITP",4)
124
125"BLD",8564,"KRN",9.8,"NM","B","VWREGITS",5)
126
127"BLD",8564,"KRN",9.8,"NM","B","VWREGITT",6)
128
129"BLD",8564,"KRN",9.8,"NM","B","VWREGITU",7)
130
131"BLD",8564,"KRN",9.8,"NM","B","VWREGITX",8)
132
133"BLD",8564,"KRN",19,0)
13419
135"BLD",8564,"KRN",19,"NM",0)
136^9.68A^2^2
137"BLD",8564,"KRN",19,"NM",1,0)
138VW PATIENT REGISTRATION^^0
139"BLD",8564,"KRN",19,"NM",2,0)
140VW REG IT CONTROL^^0
141"BLD",8564,"KRN",19,"NM","B","VW PATIENT REGISTRATION",1)
142
143"BLD",8564,"KRN",19,"NM","B","VW REG IT CONTROL",2)
144
145"BLD",8564,"KRN",19.1,0)
14619.1
147"BLD",8564,"KRN",101,0)
148101
149"BLD",8564,"KRN",409.61,0)
150409.61
151"BLD",8564,"KRN",771,0)
152771
153"BLD",8564,"KRN",779.2,0)
154779.2
155"BLD",8564,"KRN",870,0)
156870
157"BLD",8564,"KRN",8989.51,0)
1588989.51
159"BLD",8564,"KRN",8989.51,"NM",0)
160^9.68A^3^3
161"BLD",8564,"KRN",8989.51,"NM",1,0)
162VW GUI REG TEMPLATE DIRECTORY^^0
163"BLD",8564,"KRN",8989.51,"NM",2,0)
164VW REG DEFAULT STATE^^0
165"BLD",8564,"KRN",8989.51,"NM",3,0)
166VW REG RDNPT^^0
167"BLD",8564,"KRN",8989.51,"NM","B","VW GUI REG TEMPLATE DIRECTORY",1)
168
169"BLD",8564,"KRN",8989.51,"NM","B","VW REG DEFAULT STATE",2)
170
171"BLD",8564,"KRN",8989.51,"NM","B","VW REG RDNPT",3)
172
173"BLD",8564,"KRN",8989.52,0)
1748989.52
175"BLD",8564,"KRN",8994,0)
1768994
177"BLD",8564,"KRN",8994,"NM",0)
178^9.68A^20^19
179"BLD",8564,"KRN",8994,"NM",1,0)
180VW REG AHF^^0
181"BLD",8564,"KRN",8994,"NM",2,0)
182VW REG ALIST^^0
183"BLD",8564,"KRN",8994,"NM",3,0)
184VW REG EGF^^0
185"BLD",8564,"KRN",8994,"NM",4,0)
186VW REG FGNA^^0
187"BLD",8564,"KRN",8994,"NM",5,0)
188VW REG FLD BY GRP^^0
189"BLD",8564,"KRN",8994,"NM",6,0)
190VW REG GPD^^0
191"BLD",8564,"KRN",8994,"NM",7,0)
192VW REG GPDM^^0
193"BLD",8564,"KRN",8994,"NM",8,0)
194VW REG GRP LIST^^0
195"BLD",8564,"KRN",8994,"NM",9,0)
196VW REG MAIN^^0
197"BLD",8564,"KRN",8994,"NM",10,0)
198VW REG MF^^0
199"BLD",8564,"KRN",8994,"NM",11,0)
200VW REG MISC^^0
201"BLD",8564,"KRN",8994,"NM",12,0)
202VW REG NEW PT^^0
203"BLD",8564,"KRN",8994,"NM",13,0)
204VW REG PARTIAL PT LIST^^0
205"BLD",8564,"KRN",8994,"NM",14,0)
206VW REG PF^^0
207"BLD",8564,"KRN",8994,"NM",15,0)
208VW REG RTF^^0
209"BLD",8564,"KRN",8994,"NM",16,0)
210VW REG SAVE^^0
211"BLD",8564,"KRN",8994,"NM",18,0)
212VW REG SPI^^0
213"BLD",8564,"KRN",8994,"NM",19,0)
214VW REG TEMPLATE^^0
215"BLD",8564,"KRN",8994,"NM",20,0)
216VW REG ZIP^^0
217"BLD",8564,"KRN",8994,"NM","B","VW REG AHF",1)
218
219"BLD",8564,"KRN",8994,"NM","B","VW REG ALIST",2)
220
221"BLD",8564,"KRN",8994,"NM","B","VW REG EGF",3)
222
223"BLD",8564,"KRN",8994,"NM","B","VW REG FGNA",4)
224
225"BLD",8564,"KRN",8994,"NM","B","VW REG FLD BY GRP",5)
226
227"BLD",8564,"KRN",8994,"NM","B","VW REG GPD",6)
228
229"BLD",8564,"KRN",8994,"NM","B","VW REG GPDM",7)
230
231"BLD",8564,"KRN",8994,"NM","B","VW REG GRP LIST",8)
232
233"BLD",8564,"KRN",8994,"NM","B","VW REG MAIN",9)
234
235"BLD",8564,"KRN",8994,"NM","B","VW REG MF",10)
236
237"BLD",8564,"KRN",8994,"NM","B","VW REG MISC",11)
238
239"BLD",8564,"KRN",8994,"NM","B","VW REG NEW PT",12)
240
241"BLD",8564,"KRN",8994,"NM","B","VW REG PARTIAL PT LIST",13)
242
243"BLD",8564,"KRN",8994,"NM","B","VW REG PF",14)
244
245"BLD",8564,"KRN",8994,"NM","B","VW REG RTF",15)
246
247"BLD",8564,"KRN",8994,"NM","B","VW REG SAVE",16)
248
249"BLD",8564,"KRN",8994,"NM","B","VW REG SPI",18)
250
251"BLD",8564,"KRN",8994,"NM","B","VW REG TEMPLATE",19)
252
253"BLD",8564,"KRN",8994,"NM","B","VW REG ZIP",20)
254
255"BLD",8564,"KRN","B",.4,.4)
256
257"BLD",8564,"KRN","B",.401,.401)
258
259"BLD",8564,"KRN","B",.402,.402)
260
261"BLD",8564,"KRN","B",.403,.403)
262
263"BLD",8564,"KRN","B",.5,.5)
264
265"BLD",8564,"KRN","B",.84,.84)
266
267"BLD",8564,"KRN","B",3.6,3.6)
268
269"BLD",8564,"KRN","B",3.8,3.8)
270
271"BLD",8564,"KRN","B",9.2,9.2)
272
273"BLD",8564,"KRN","B",9.8,9.8)
274
275"BLD",8564,"KRN","B",19,19)
276
277"BLD",8564,"KRN","B",19.1,19.1)
278
279"BLD",8564,"KRN","B",101,101)
280
281"BLD",8564,"KRN","B",409.61,409.61)
282
283"BLD",8564,"KRN","B",771,771)
284
285"BLD",8564,"KRN","B",779.2,779.2)
286
287"BLD",8564,"KRN","B",870,870)
288
289"BLD",8564,"KRN","B",8989.51,8989.51)
290
291"BLD",8564,"KRN","B",8989.52,8989.52)
292
293"BLD",8564,"KRN","B",8994,8994)
294
295"BLD",8564,"QDEF")
296^^^^NO^^^^NO^^NO
297"BLD",8564,"QUES",0)
298^9.62^^
299"BLD",8564,"REQB",0)
300^9.611^^
301"DATA",64850001,.081,0)
302DUPLICATE STATUS^SX^0:NO UNRESOLVED DUPLICATES;1:CHECK DUPLICATE RECORDS FILE;^0;18
303"DATA",64850001,.082,0)
304PATIENT MERGED TO^P2'^DPT(^0;19
305"DATA",64850001,.083,0)
306CHECK FOR DUPLICATE^S^1:YES;^0;20
307"DATA",64850001,.09,0)
308SOCIAL SECURITY NUMBER^FXa^^0;9
309"DATA",64850001,.0906,0)
310PSEUDO SSN REASON^S^R:REFUSED TO PROVIDE;S:SSN UNKNOWN/FOLLOW-UP REQUIRED;N:NO SSN ASSIGNED;^SSN;1
311"DATA",64850001,.0907,0)
312SSN VERIFICATION STATUS^S^4:VERIFIED;2:INVALID;^SSN;2
313"DATA",64850001,.096,0)
314WHO ENTERED PATIENT^P200'I^VA(200,^0;15
315"DATA",64850001,.097,0)
316DATE ENTERED INTO FILE^DI^^0;16
317"DATA",64850001,.098,0)
318HOW WAS PATIENT ENTERED?^S^1:10-10T REGISTRATION;^0;17
319"DATA",64850001,.1,0)
320WARD LOCATION^FX^^.1;E1,30
321"DATA",64850001,.101,0)
322ROOM-BED^F^^.101;1
323"DATA",64850001,.102,0)
324CURRENT MOVEMENT^*P405'^DGPM(^.102;1
325"DATA",64850001,.103,0)
326TREATING SPECIALTY^P45.7'^DIC(45.7,^.103;1
327"DATA",64850001,.104,0)
328PROVIDER^*P200'^VA(200,^.104;1
329"DATA",64850001,.1041,0)
330ATTENDING PHYSICIAN^*P200'^VA(200,^.1041;1
331"DATA",64850001,.105,0)
332CURRENT ADMISSION^*P405'^DGPM(^.105;1
333"DATA",64850001,.106,0)
334LAST DMMS EPISODE NUMBER^NJ5,0^^.106;1
335"DATA",64850001,.108,0)
336CURRENT ROOM^P405.4'^DG(405.4,^.108;1
337"DATA",64850001,.109,0)
338EXCLUDE FROM FACILITY DIR^S^0:NO;1:YES;^.109;1
339"DATA",64850001,.118,0)
340ADDRESS CHANGE DT/TM^D^^.11;13
341"DATA",64850001,.119,0)
342ADDRESS CHANGE SOURCE^S^HEC:HEC;VAMC:VAMC;HBSC:HBSC;NCOA:NCOA;BVA:BVA;VAINS:VAINS;USPS:USPS;LACS:LACS;VOA:VOA;^.11;14
343"DATA",64850001,.12,0)
344ADDRESS CHANGE SITE^P4'^DIC(4,^.11;15
345"DATA",64850001,.121,0)
346BAD ADDRESS INDICATOR^*S^1:UNDELIVERABLE;2:HOMELESS;3:OTHER;4:ADDRESS NOT FOUND;^.11;16
347"DATA",64850001,.12105,0)
348TEMPORARY ADDRESS ACTIVE?^RSX^Y:YES;N:NO;^.121;9
349"DATA",64850001,.122,0)
350ADDRESS CHANGE USER^P200'^VA(200,^.11;17
351"DATA",64850001,.1311,0)
352CELLULAR NUMBER CHANGE SOURCE^S^HEC:HEC;VAMC:VAMC;HBSC:HBSC;VOA:VOA;^.13;10
353"DATA",64850001,.13111,0)
354CELLULAR NUMBER CHANGE SITE^P4'^DIC(4,^.13;11
355"DATA",64850001,.132,0)
356PHONE NUMBER [WORK]^Fa^^.13;2
357"DATA",64850001,.135,0)
358PAGER NUMBER^FX^^.13;5
359"DATA",64850001,.136,0)
360EMAIL ADDRESS CHANGE DT/TM^D^^.13;6
361"DATA",64850001,.137,0)
362EMAIL ADDRESS CHANGE SOURCE^S^HEC:HEC;VAMC:VAMC;HBSC:HBSC;VOA:VOA;^.13;7
363"DATA",64850001,.138,0)
364EMAIL ADDRESS CHANGE SITE^P4'^DIC(4,^.13;8
365"DATA",64850001,.139,0)
366CELLULAR NUMBER CHANGE DT/TM^D^^.13;9
367"DATA",64850001,.14,0)
368CURRENT MEANS TEST STATUS^P408.32'I^DG(408.32,^0;14
369"DATA",64850001,.141,0)
370CONFIDENTIAL ADDRESS CATEGORY^2.141S^^.14;0
371"DATA",64850001,.14112,0)
372CONFIDENTIAL ADDR CHANGE DT/TM^DX^^.141;12
373"DATA",64850001,.14113,0)
374CONFIDENTIAL ADDR CHANGE SITE^P4'^DIC(4,^.141;13
375"DATA",64850001,.152,0)
376INELIGIBLE DATE^DX^^.15;2
377"DATA",64850001,.153,0)
378MISSING PERSON DATE^DX^^.15;3
379"DATA",64850001,.16,0)
380MISSING OR INELIGIBLE^2.16A^^.16;0
381"DATA",64850001,.1651,0)
382INELIGIBLE TWX SOURCE^RSX^1:VAMC;2:REGIONAL OFFICE;3:RPC;^INE;1
383"DATA",64850001,.1653,0)
384INELIGIBLE TWX CITY^FX^^INE;3
385"DATA",64850001,.1654,0)
386INELIGIBLE TWX STATE^P5'X^DIC(5,^INE;4
387"DATA",64850001,.1656,0)
388INELIGIBLE VARO DECISION^FX^^INE;6
389"DATA",64850001,.1657,0)
390MISSING PERSON TWX SOURCE^S^1:VAMC;2:REGIONAL OFFICE;3:RPC;^INE;7
391"DATA",64850001,.1658,0)
392MISSING PERSON TWX CITY^F^^INE;8
393"DATA",64850001,.1659,0)
394MISSING PERSON TWX STATE^P5'^DIC(5,^INE;9
395"DATA",64850001,.172,0)
396FEE HOSPITAL I.D.^S^I:ISSUED;C:CANCELLED;^.17;2
397"DATA",64850001,.181,0)
398EMERGENCY RESPONSE INDICATOR^S^K:HURRICANE KATRINA;^.18;1
399"DATA",64850001,.21012,0)
400PRIMARY NOK CHANGE DATE/TIME^DX^^.212;1
401"DATA",64850001,.211012,0)
402SECONDARY NOK CHANGE DATE/TIME^DX^^.212;2
403"DATA",64850001,.301,0)
404SERVICE CONNECTED?^SXa^Y:YES;N:NO;^.3;1
405"DATA",64850001,.3012,0)
406SC AWARD DATE^DX^^.3;12
407"DATA",64850001,.3013,0)
408P&T EFFECTIVE DATE^DX^^.3;13
409"DATA",64850001,.3014,0)
410EFF. DATE COMBINED SC% EVAL.^DX^^.3;14
411"DATA",64850001,.302,0)
412SERVICE CONNECTED PERCENTAGE^NJ3,0Xa^^.3;2
413"DATA",64850001,.3025,0)
414RECEIVING VA DISABILITY?^SX^Y:YES;N:NO;U:UNKNOWN;^.3;11
415"DATA",64850001,.303,0)
416AMOUNT OF VA DISABILITY^NJ7,0X^^.3;3
417"DATA",64850001,.304,0)
418P&T^SX^Y:YES;N:NO;^.3;4
419"DATA",64850001,.305,0)
420UNEMPLOYABLE^S^Y:YES;N:NO;^.3;5
421"DATA",64850001,.306,0)
422MONETARY BEN. VERIFY DATE^DX^^.3;6
423"DATA",64850001,.307,0)
424INELIGIBLE REASON^FX^^.3;7
425"DATA",64850001,.309,0)
426AGENCY/ALLIED COUNTRY^*P35'X^DIC(35,^.3;9
427"DATA",64850001,.31,0)
428*CATEGORY OF BENEFICIARY^P45.82'X^DIC(45.82,^.3;10
429"DATA",64850001,.31116,0)
430DATE OF RETIREMENT^DX^^.311;16
431"DATA",64850001,.313,0)
432CLAIM NUMBER^FXOa^^.31;3
433"DATA",64850001,.314,0)
434CLAIM FOLDER LOCATION^*P4'X^DIC(4,^.31;4
435"DATA",64850001,.3192,0)
436COVERED BY HEALTH INSURANCE?^RS^Y:YES;N:NO;U:UNKNOWN;^.31;11
437"DATA",64850001,.32101,0)
438VIETNAM SERVICE INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.321;1
439"DATA",64850001,.32102,0)
440AGENT ORANGE EXPOS. INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.321;2
441"DATA",64850001,.32103,0)
442RADIATION EXPOSURE INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.321;3
443"DATA",64850001,.32104,0)
444VIETNAM FROM DATE^RDX^^.321;4
445"DATA",64850001,.32105,0)
446VIETNAM TO DATE^RDX^^.321;5
447"DATA",64850001,.32107,0)
448AGENT ORANGE REGISTRATION DATE^DX^^.321;7
449"DATA",64850001,.32108,0)
450AGENT ORANGE REPORTED TO C.O.^DX^^.321;8
451"DATA",64850001,.32109,0)
452AGENT ORANGE EXAM DATE^DX^^.321;9
453"DATA",64850001,.3211,0)
454AGENT ORANGE REGISTRATION #^NJ6,0X^^.321;10
455"DATA",64850001,.32111,0)
456RADIATION REGISTRATION DATE^DX^^.321;11
457"DATA",64850001,.32115,0)
458PROJ 112/SHAD^S^1:YES;0:NO;^.321;15
459"DATA",64850001,.3212,0)
460RADIATION 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
461"DATA",64850001,.3213,0)
462AGENT ORANGE EXPOSURE LOCATION^RSX^K:KOREAN DMZ;V:VIETNAM;O:OTHER;^.321;13
463"DATA",64850001,.3214,0)
464FILIPINO 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
465"DATA",64850001,.3215,0)
466SERVICE [OEF OR OIF]^2.3215IS^^.3215;0
467"DATA",64850001,.322,0)
468SERVICE VERIFICATION DATE^DX^^.32;2
469"DATA",64850001,.32201,0)
470PERSIAN GULF SERVICE?^RSX^Y:YES;N:NO;U:UNKNOWN;^.322;10
471"DATA",64850001,.322011,0)
472PERSIAN GULF FROM DATE^RDX^^.322;11
473"DATA",64850001,.322012,0)
474PERSIAN GULF TO DATE^RDX^^.322;12
475"DATA",64850001,.322013,0)
476SOUTHWEST ASIA CONDITIONS?^RSX^Y:YES;N:NO;U:UNKNOWN;^.322;13
477"DATA",64850001,.322014,0)
478SW ASIA COND REGISTRATION DATE^DX^^.322;14
479"DATA",64850001,.322015,0)
480SW ASIA COND EXAM DATE^DX^^.322;15
481"DATA",64850001,.322016,0)
482SOMALIA SERVICE INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.322;16
483"DATA",64850001,.322017,0)
484SOMALIA FROM DATE^RDX^^.322;17
485"DATA",64850001,.322018,0)
486SOMALIA TO DATE^RDX^^.322;18
487"DATA",64850001,.322019,0)
488YUGOSLAVIA SERVICE INDICATED?^SX^Y:YES;N:NO;U:UNKNOWN;^.322;19
489"DATA",64850001,.32202,0)
490YUGOSLAVIA FROM DATE^RDX^^.322;20
491"DATA",64850001,.322021,0)
492YUGOSLAVIA TO DATE^RDX^^.322;21
493"DATA",64850001,.3221,0)
494LEBANON SERVICE INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.322;1
495"DATA",64850001,.3222,0)
496LEBANON FROM DATE^RDX^^.322;2
497"DATA",64850001,.3223,0)
498LEBANON TO DATE^RDX^^.322;3
499"DATA",64850001,.3224,0)
500GRENADA SERVICE INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.322;4
501"DATA",64850001,.3225,0)
502GRENADA FROM DATE^RDX^^.322;5
503"DATA",64850001,.3226,0)
504GRENADA TO DATE^RDX^^.322;6
505"DATA",64850001,.3227,0)
506PANAMA SERVICE INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.322;7
507"DATA",64850001,.3228,0)
508PANAMA FROM DATE^RDX^^.322;8
509"DATA",64850001,.3229,0)
510PANAMA TO DATE^RDX^^.322;9
511"DATA",64850001,.323,0)
512PERIOD OF SERVICE^*P21'Xa^DIC(21,^.32;3
513"DATA",64850001,.324,0)
514SERVICE DISCHARGE TYPE [LAST]^RP25'X^DIC(25,^.32;4
515"DATA",64850001,.325,0)
516SERVICE BRANCH [LAST]^P23'X^DIC(23,^.32;5
517"DATA",64850001,.326,0)
518SERVICE ENTRY DATE [LAST]^RDX^^.32;6
519"DATA",64850001,.327,0)
520SERVICE SEPARATION DATE [LAST]^RDX^^.32;7
521"DATA",64850001,.328,0)
522SERVICE NUMBER [LAST]^FX^^.32;8
523"DATA",64850001,.3285,0)
524SERVICE SECOND EPISODE?^RSX^Y:YES;N:NO;^.32;19
525"DATA",64850001,.329,0)
526SERVICE DISCHARGE TYPE [NTL]^RP25'X^DIC(25,^.32;9
527"DATA",64850001,.3291,0)
528SERVICE BRANCH [NTL]^P23'X^DIC(23,^.32;10
529"DATA",64850001,.32911,0)
530SERVICE COMPONENT [LAST]^*S^R:REGULAR;V:ACTIVATED RESERVE;G:ACTIVATED NG;^.3291;1
531"DATA",64850001,.32912,0)
532SERVICE COMPONENT [NTL]^*SX^R:REGULAR;V:ACTIVATED RESERVE;G:ACTIVATED NG;^.3291;2
533"DATA",64850001,.32913,0)
534SERVICE COMPONENT [NNTL]^*SX^R:REGULAR;V:ACTIVATED RESERVE;G:ACTIVATED NG;^.3291;3
535"DATA",64850001,.3292,0)
536SERVICE ENTRY DATE [NTL]^RDX^^.32;11
537"DATA",64850001,.3293,0)
538SERVICE SEPARATION DATE [NTL]^RDX^^.32;12
539"DATA",64850001,.3294,0)
540SERVICE NUMBER [NTL]^FX^^.32;13
541"DATA",64850001,.32945,0)
542SERVICE THIRD EPISODE?^RSX^Y:YES;N:NO;^.32;20
543"DATA",64850001,.3295,0)
544SERVICE DISCHARGE TYPE [NNTL]^RP25'X^DIC(25,^.32;14
545"DATA",64850001,.3296,0)
546SERVICE BRANCH [NNTL]^P23'X^DIC(23,^.32;15
547"DATA",64850001,.3297,0)
548SERVICE ENTRY DATE [NNTL]^RDX^^.32;16
549"DATA",64850001,.3298,0)
550SERVICE SEPARATION DATE [NNTL]^RDX^^.32;17
551"DATA",64850001,.3299,0)
552SERVICE NUMBER [NNTL]^FX^^.32;18
553"DATA",64850001,.3412,0)
554DESIGNEE CHANGE DATE/TIME^DX^^.332;3
555"DATA",64850001,.352,0)
556DEATH ENTERED BY^P200'^VA(200,^.35;2
557"DATA",64850001,.353,0)
558SOURCE 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
559"DATA",64850001,.355,0)
560LAST EDITED BY^P200'^VA(200,^.35;5
561"DATA",64850001,.3601,0)
562COLLATERAL SPONSOR'S NAME^R*P2'^DPT(^.36;11
563"DATA",64850001,.3602,0)
564MILITARY DISABILITY RETIREMENT^SX^1:YES;0:NO;^.36;12
565"DATA",64850001,.3603,0)
566DISCHARGE DUE TO DISABILITY^SX^1:YES;0:NO;^.36;13
567"DATA",64850001,.361,0)
568PRIMARY ELIGIBILITY CODE^*P8'Xa^DIC(8,^.36;1
569"DATA",64850001,.3611,0)
570ELIGIBILITY STATUS^SX^P:PENDING VERIFICATION;R:PENDING RE-VERIFICATION;V:VERIFIED;^.361;1
571"DATA",64850001,.3612,0)
572ELIGIBILITY STATUS DATE^DX^^.361;2
573"DATA",64850001,.3613,0)
574ELIGIBILITY VERIF. SOURCE^S^H:HEC;V:VISTA;^.361;3
575"DATA",64850001,.3614,0)
576ELIGIBILITY INTERIM RESPONSE^DX^^.361;4
577"DATA",64850001,.3615,0)
578ELIGIBILITY VERIF. METHOD^FX^^.361;5
579"DATA",64850001,.3616,0)
580ELIGIBILITY STATUS ENTERED BY^P200'^VA(200,^.361;6
581"DATA",64850001,.3617,0)
582USER ENROLLEE VALID THROUGH^DX^^.361;7
583"DATA",64850001,.3618,0)
584USER ENROLLEE SITE^P4'^DIC(4,^.361;8
585"DATA",64850001,.362,0)
586DISABILITY 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
587"DATA",64850001,.36205,0)
588RECEIVING A&A BENEFITS?^SX^Y:YES;N:NO;U:UNKNOWN;^.362;12
589"DATA",64850001,.3621,0)
590AMOUNT OF AID & ATTENDANCE^NJ10,2X^^.362;1
591"DATA",64850001,.36215,0)
592RECEIVING HOUSEBOUND BENEFITS?^SX^Y:YES;N:NO;U:UNKNOWN;^.362;13
593"DATA",64850001,.3622,0)
594AMOUNT OF HOUSEBOUND^NJ10,2X^^.362;2
595"DATA",64850001,.36225,0)
596RECEIVING SOCIAL SECURITY?^SX^Y:YES;N:NO;U:UNKNOWN;^.362;15
597"DATA",64850001,.36235,0)
598RECEIVING A VA PENSION?^SX^Y:YES;N:NO;U:UNKNOWN;^.362;14
599"DATA",64850001,.3624,0)
600AMOUNT OF VA PENSION^NJ10,2X^^.362;4
601"DATA",64850001,.3625,0)
602*AMOUNT OF MILITARY RETIREMENT^NJ10,2X^^.362;5
603"DATA",64850001,.36255,0)
604RECEIVING MILITARY RETIREMENT?^SX^Y:YES;N:NO;U:UNKNOWN;^.362;16
605"DATA",64850001,.3626,0)
606AMOUNT OF GI INSURANCE^NJ8,2X^^.362;6
607"DATA",64850001,.36265,0)
608GI INSURANCE POLICY?^SX^Y:YES;N:NO;U:UNKNOWN;^.362;17
609"DATA",64850001,.36275,0)
610RECEIVING SUP. SECURITY (SSI)?^S^Y:YES;N:NO;U:UNKNOWN;^.362;19
611"DATA",64850001,.3628,0)
612AMOUNT OF OTHER RETIREMENT^NJ8,2X^^.362;8
613"DATA",64850001,.36285,0)
614TYPE OF OTHER RETIREMENT^SX^B:BLACK LUNG;M:MILITARY;C:CIVIL;R:RAILROAD;O:OTHER;X:COMBINATIONS OF TYPES;^.362;18
615"DATA",64850001,.3629,0)
616AMOUNT OF OTHER INCOME^NJ8,2X^^.362;9
617"DATA",64850001,.36295,0)
618TOTAL ANNUAL VA CHECK AMOUNT^NJ8,2X^^.362;20
619"DATA",64850001,.364,0)
620PRIMARY SHORT ID^F^^.36;4
621"DATA",64850001,.368,0)
622SERVICE DENTAL INJURY?^S^Y:YES;N:NO;^.36;8
623"DATA",64850001,.369,0)
624SERVICE TEETH EXTRACTED?^S^Y:YES;N:NO;^.36;9
625"DATA",64850001,.37,0)
626DATE OF DENTAL TREATMENT^2.11D^^.37;0
627"DATA",64850001,.3721,0)
628RATED DISABILITIES (VA)^2.04P^^.372;0
629"DATA",64850001,.3731,0)
630SERVICE CONNECTED CONDITIONS^2.05A^^.373;0
631"DATA",64850001,.381,0)
632ELIGIBLE FOR MEDICAID?^RS^1:YES;0:NO;^.38;1
633"DATA",64850001,.382,0)
634DATE MEDICAID LAST ASKED^RD^^.38;2
635"DATA",64850001,.39,0)
636VETERAN CATASTROPHICALLY DISABLED?^S^Y:YES;N:NO;^.39;6
637"DATA",64850001,.391,0)
638DECIDED BY^F^^.39;1
639"DATA",64850001,.392,0)
640DATE OF DECISION^DX^^.39;2
641"DATA",64850001,.393,0)
642FACILITY MAKING DETERMINATION^P4'^DIC(4,^.39;3
643"DATA",64850001,.394,0)
644REVIEW DATE^D^^.39;4
645"DATA",64850001,.395,0)
646METHOD OF DETERMINATION^S^2:MEDICAL RECORD REVIEW;3:PHYSICAL EXAMINATION;^.39;5
647"DATA",64850001,.3951,0)
648DATE VETERAN REQUESTED CD EVAL^D^^.39;7
649"DATA",64850001,.3952,0)
650DATE FACILITY INITIATED REVIEW^D^^.39;8
651"DATA",64850001,.3953,0)
652DATE VETERAN WAS NOTIFIED^D^^.39;9
653"DATA",64850001,.396,0)
654CD STATUS DIAGNOSES^2.396P^^.396;0
655"DATA",64850001,.397,0)
656CD STATUS PROCEDURES^2.397P^^.397;0
657"DATA",64850001,.398,0)
658CD STATUS CONDITIONS^2.398P^^.398;0
659"DATA",64850001,.399,0)
660CD HISTORY DATE^2.399DA^^.399;0
661"DATA",64850001,.525,0)
662POW STATUS INDICATED?^RSX^Y:YES;N:NO;U:UNKNOWN;^.52;5
663"DATA",64850001,.526,0)
664POW CONFINEMENT LOCATION^RP22'X^DIC(22,^.52;6
665"DATA",64850001,.527,0)
666POW FROM DATE^RDX^^.52;7
667"DATA",64850001,.528,0)
668POW TO DATE^RDX^^.52;8
669"DATA",64850001,.529,0)
670POW STATUS VERIFIED^D^^.52;9
671"DATA",64850001,.5291,0)
672COMBAT SERVICE INDICATED?^RSX^Y:YES;N:NO;^.52;11
673"DATA",64850001,.5292,0)
674COMBAT SERVICE LOCATION^RP22'X^DIC(22,^.52;12
675"DATA",64850001,.5293,0)
676COMBAT FROM DATE^RDX^^.52;13
677"DATA",64850001,.5294,0)
678COMBAT TO DATE^RDX^^.52;14
679"DATA",64850001,.5295,0)
680COMBAT VETERAN END DATE^D^^.52;15
681"DATA",64850001,.5296,0)
682CV DATE EDITED^D^^.52;16
683"DATA",64850001,.531,0)
684CURRENT PH INDICATOR^SX^Y:YES;N:NO;^.53;1
685"DATA",64850001,.532,0)
686CURRENT PURPLE HEART STATUS^S^1:PENDING;2:IN PROCESS;3:CONFIRMED;^.53;2
687"DATA",64850001,.533,0)
688CURRENT 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
689"DATA",64850001,.535,0)
690PH DIVISION^P4'^DIC(4,^.53;4
691"DATA",64850001,.6,0)
692TEST PATIENT INDICATOR^SI^1:YES;0:NO;^0;21
693"DATA",64850001,1.01,0)
694NAME COMPONENTS
695"DATA",64850001,2.0361,0)
696PATIENT ELIGIBILITIES
697"DATA",64850001,27.01,0)
698CURRENT ENROLLMENT^P27.11'I^DGEN(27.11,^ENR;1
699"DATA",64850001,53,0)
700*REACTIONS^S^Y:YES;N:NO;^PI;1
701"DATA",64850001,57.1,0)
702*HEIGHT(cm)^NJ3,0^^57;1
703"DATA",64850001,57.2,0)
704*WEIGHT(kg)^NJ3,0^^57;2
705"DATA",64850001,57.4,0)
706SPINAL CORD INJURY^S^1:PARAPLEGIA-TRAUMATIC;2:QUADRIPLEGIA-TRAUMATIC;3:PARAPLEGIA-NONTRAUMATIC;4:QUADRIPLEGIA-NONTRAUMATIC;X:NOT APPLICABLE;^57;4
707"DATA",64850001,63,0)
708LABORATORY REFERENCE^IP63X^LR(^LR;1
709"DATA",64850001,67,0)
710LAB REFERRAL REF^P67'X^LRT(67,^LRT;1
711"DATA",64850001,148,0)
712CNH CURRENT^S^Y:YES;N:NO;^NHC;1
713"DATA",64850001,220,0)
714DENTAL CLASSIFICATION^P220.2'^DIC(220.2,^DENT;1
715"DATA",64850001,220.1,0)
716DENTAL ELIGIBILITY EXPIRATION^D^^DENT;2
717"DATA",64850001,361,0)
718PATIENT ELIGIBILITIES^2.0361IP^^E;0
719"DATA",64850001,391,0)
720TYPE^P391'a^DG(391,^TYPE;1
721"DATA",64850001,401.3,0)
722CONDITION^S^S:SERIOUSLY ILL;^DAC;1
723"DATA",64850001,401.4,0)
724DATE ENTERED ON SI LIST^RDX^^DAC;2
725"DATA",64850001,534,0)
726PH DATE/TIME UPDATED^2.0534DA^^PH;0
727"DATA",64850001,991.01,0)
728INTEGRATION CONTROL NUMBER^NJ12,0Xa^^MPI;1
729"DATA",64850001,991.02,0)
730ICN CHECKSUM^Fa^^MPI;2
731"DATA",64850001,991.03,0)
732COORDINATING MASTER OF RECORD^P4'a^DIC(4,^MPI;3
733"DATA",64850001,991.04,0)
734LOCALLY ASSIGNED ICN^Sa^1:YES;^MPI;4
735"DATA",64850001,991.05,0)
736SUBSCRIPTION CONTROL NUMBER^P774'Ia^HLS(774,^MPI;5
737"DATA",64850001,991.06,0)
738CMOR ACTIVITY SCORE^NJ7,0a^^MPI;6
739"DATA",64850001,991.07,0)
740SCORE CALCULATION DATE^Da^^MPI;7
741"DATA",64850001,992,0)
742ICN HISTORY^2.0992A^^MPIFHIS;0
743"DATA",64850001,993,0)
744CMOR HISTORY^2.0993A^^MPICMOR;0
745"DATA",64850001,1010.15,0)
746RECEIVED VA CARE PREVIOUSLY?^RS^Y:YES;N:NO;^1010.15;5
747"DATA",64850001,1010.151,0)
748MOST RECENT DATE OF CARE^DX^^1010.15;1
749"DATA",64850001,1010.1511,0)
750APPOINTMENT REQUEST DATE^D^^1010.15;11
751"DATA",64850001,1010.152,0)
752MOST RECENT LOCATION OF CARE^P4'^DIC(4,^1010.15;2
753"DATA",64850001,1010.153,0)
7542ND MOST RECENT DATE OF CARE^DX^^1010.15;3
755"DATA",64850001,1010.154,0)
7562ND MOST RECENT LOCATION^P4'^DIC(4,^1010.15;4
757"DATA",64850001,1010.156,0)
758MOST RECENT 1010EZ^P712'I^EAS(712,^1010.15;6
759"DATA",64850001,1010.157,0)
760COMBAT INDICATED ON 1010EZ^S^0:NO;1:YES;^1010.15;7
761"DATA",64850001,1010.158,0)
762DISABILITY DISCHARGE ON 1010EZ^S^0:NO;1:YES;^1010.15;8
763"DATA",64850001,1010.159,0)
764APPOINTMENT REQUEST ON 1010EZ^S^0:NO;1:YES;^1010.15;9
765"DATA",64850001,1010.161,0)
766APPOINTMENT REQUEST STATUS^S^C:CANCELLED;E:EWL;F:FILLED;I:IN PROCESS/VETERAN CONTACTED;^1010.16;1
767"DATA",64850001,1010.162,0)
768DATE STATUS LAST EDITED^D^^1010.16;2
769"DATA",64850001,1010.163,0)
770APPOINTMENT REQUEST COMMENT^F^^1010.16;3
771"DATA",64850001,1010.164,0)
772DATE COMMENT LAST EDITED^D^^1010.16;4
773"DATA",64850001,1100.02,0)
774FFF ENTERED BY^P200'^VA(200,^FFP;2
775"DATA",64850001,1100.03,0)
776FFF DATE ENTERED^D^^FFP;3
777"DATA",64850001,1100.04,0)
778FFF REMOVED BY^P200'^VA(200,^FFP;4
779"DATA",64850001,1100.05,0)
780FFF DATE REMOVED^D^^FFP;5
781"DATA",64850001,1100.09,0)
782FFF REMOVAL REMARKS^F^^FFP;9
783"DATA",64850001,1900,0)
784APPOINTMENT^2.98P^^S;0
785"DATA",64850001,1901,0)
786VETERAN (Y/N)?^SXa^Y:YES;N:NO;^VET;1
787"DATA",64850001,1903,0)
788ARCHIVED DATA^2.12SA^^ARCH;0
789"DATA",64850001,11500.01,0)
790INITIAL ODS TREATMENT RECEIVED^D^^ODS;1
791"DATA",64850001,11500.02,0)
792RECALLED TO ACTIVE DUTY^S^0:NO;1:NATIONAL GUARD;2:RESERVES;^ODS;2
793"DATA",64850001,11500.03,0)
794RANK^*P25002.1'^DIC(25002.1,^ODS;3
795"DATA",64850001,19900,0)
796ALTERNATE PHONE NUMBER^F^^19900;1
797"DATA",64850001,19902,0)
798IS PATIENT A VETERAN^S^Y:YES;N:NO;^19900;3
799"DATA",64850001,19905,0)
800YEAR ARRIVED IN COUNTRY^NJ4,0^^19900;6
801"DATA",64850001,537025,0)
802NETWORK IDENTIFIER^F^^537025;1
803"DATA",64850002,1,0)
804ALIAS^1^DEMOG
805"DATA",64850002,1,"M",0)
806^64850002.01A
807"DATA",64850002,1,"M",1,0)
808ALIAS^.01;2.01^
809"DATA",64850002,1,"M",2,0)
810ALIAS SSN^1;2.01^
811"DATA",64850002,2,0)
812AMOUNT OF SSI^.3627^MB
813"DATA",64850002,3,0)
814CITY^.114^DEMOG
815"DATA",64850002,4,0)
816CONFIDENTIAL ADDR COUNTRY^.14116^CONFIDENTIAL
817"DATA",64850002,5,0)
818CONFIDENTIAL ADDR POSTAL CODE^.14115^CONFIDENTIAL
819"DATA",64850002,6,0)
820CONFIDENTIAL ADDR PROVINCE^.14114^CONFIDENTIAL
821"DATA",64850002,7,0)
822CONFIDENTIAL ADDRESS ACTIVE?^.14105^CONFIDENTIAL
823"DATA",64850002,8,0)
824CONFIDENTIAL ADDRESS CITY^.1414^CONFIDENTIAL
825"DATA",64850002,9,0)
826CONFIDENTIAL ADDRESS COUNTY^.14111^CONFIDENTIAL
827"DATA",64850002,10,0)
828CONFIDENTIAL ADDRESS STATE^.1415^CONFIDENTIAL
829"DATA",64850002,11,0)
830CONFIDENTIAL ADDRESS ZIP CODE^.1416^CONFIDENTIAL
831"DATA",64850002,12,0)
832CONFIDENTIAL END DATE^.1418^CONFIDENTIAL
833"DATA",64850002,13,0)
834CONFIDENTIAL PHONE NUMBER^.1315^CONFIDENTIAL
835"DATA",64850002,14,0)
836CONFIDENTIAL START DATE^.1417^CONFIDENTIAL
837"DATA",64850002,15,0)
838CONFIDENTIAL STREET [LINE 1]^.1411^CONFIDENTIAL
839"DATA",64850002,16,0)
840CONFIDENTIAL STREET [LINE 2]^.1412^CONFIDENTIAL
841"DATA",64850002,17,0)
842CONFIDENTIAL STREET [LINE 3]^.1413^CONFIDENTIAL
843"DATA",64850002,18,0)
844COUNTRY^.1173^DEMOG
845"DATA",64850002,19,0)
846COUNTY^.117^DEMOG
847"DATA",64850002,20,0)
848Cell Phone^.134^DEMOG
849"DATA",64850002,21,0)
850D-CITY^.346^D1
851"DATA",64850002,22,0)
852D-DESIGNEE SAME AS NOK?^.3405^D1
853"DATA",64850002,23,0)
854D-PHONE NUMBER^.349^D1
855"DATA",64850002,24,0)
856D-RELATIONSHIP TO PATIENT^.342^D1
857"DATA",64850002,25,0)
858D-STATE^.347^D1
859"DATA",64850002,26,0)
860D-STREET ADDRESS [LINE 1]^.343^D1
861"DATA",64850002,27,0)
862D-STREET ADDRESS [LINE 2]^.344^D1
863"DATA",64850002,28,0)
864D-STREET ADDRESS [LINE 3]^.345^D1
865"DATA",64850002,29,0)
866D-WORK PHONE NUMBER^.34011^D1
867"DATA",64850002,30,0)
868D-ZIP CODE^.348^D1
869"DATA",64850002,31,0)
870D-ZIP+4^.2202^D1
871"DATA",64850002,32,0)
872DATE OF DEATH^.351^DEMOG
873"DATA",64850002,33,0)
874DATE OF DEATH LAST UPDATED^.354^DEMOG
875"DATA",64850002,34,0)
876DISPOSITION LOG-IN DATE/TIME^1000^VISIT
877"DATA",64850002,34,"M",0)
878^64850002.01A
879"DATA",64850002,34,"M",1,0)
880A-ADDRESS 1^31;2.101
881"DATA",64850002,34,"M",2,0)
882A-ADDRESS 2^32;2.101
883"DATA",64850002,34,"M",3,0)
884A-ADDRESS 3^33;2.101
885"DATA",64850002,34,"M",4,0)
886A-CITY^34;2.101
887"DATA",64850002,34,"M",5,0)
888A-PHONE^37;2.101
889"DATA",64850002,34,"M",6,0)
890A-STATE^35;2.101
891"DATA",64850002,34,"M",7,0)
892A-ZIP CODE^36;2.101
893"DATA",64850002,34,"M",8,0)
894A-ZIP+4^38;2.101
895"DATA",64850002,34,"M",9,0)
896ACTIVE^50;2.101
897"DATA",64850002,34,"M",10,0)
898ATTORNEY'S NAME^30;2.101
899"DATA",64850002,34,"M",11,0)
900DESCRIPTION OF INCIDENT^10;2.101
901"DATA",64850002,34,"M",12,0)
902DISPOSITION^6;2.101
903"DATA",64850002,34,"M",13,0)
904FACILITY APPLYING TO^3;2.101
905"DATA",64850002,34,"M",14,0)
906FILED AGAINST INJURING PARTY^26;2.101
907"DATA",64850002,34,"M",15,0)
908INJURING PARTIES INSURANCE^25;2.101
909"DATA",64850002,34,"M",16,0)
910INJURY CAUSED BY^24;2.101
911"DATA",64850002,34,"M",17,0)
912LOG IN DATE/TIME^.01;2.101
913"DATA",64850002,34,"M",18,0)
914LOG OUT DATE TIME^5;2.101
915"DATA",64850002,34,"M",19,0)
916NEED RELATED TO AN ACCIDENT^23;2.101
917"DATA",64850002,34,"M",20,0)
918NEED RELATED TO OCCUPATION^20;2.101
919"DATA",64850002,34,"M",21,0)
920OUTPATIENT ENCOUNTER^18;2.101
921"DATA",64850002,34,"M",22,0)
922REASON FOR LATE DISPOSITION^8;2.101
923"DATA",64850002,34,"M",23,0)
924REGISTRATION ELIGIBILITY CODE^13;2.101
925"DATA",64850002,34,"M",24,0)
926STATUS^1;2.101
927"DATA",64850002,34,"M",25,0)
928TYPE OF BENEFIT APPLIED FOR^2;2.101
929"DATA",64850002,34,"M",26,0)
930TYPE OF CARE APPLIED FOR^2.1;2.101
931"DATA",64850002,34,"M",27,0)
932WORKMEN'S COMP CLAIM FILED^21;2.101
933"DATA",64850002,34,"M",28,0)
934WORKMEN'S COMP CLAIM NUMBER^22;2.101
935"DATA",64850002,35,0)
936E-CITY^.336^EC1
937"DATA",64850002,36,0)
938E-CONTACT CHANGE DATE/TIME^.33012^EC1
939"DATA",64850002,37,0)
940E-EMER. CONTACT SAME AS NOK?^.3305^EC1
941"DATA",64850002,38,0)
942E-NAME^.331^EC1
943"DATA",64850002,39,0)
944E-PHONE NUMBER^.339^EC1
945"DATA",64850002,40,0)
946E-RELATIONSHIP TO PATIENT^.332^EC1
947"DATA",64850002,41,0)
948E-STATE^.337^EC1
949"DATA",64850002,42,0)
950E-STREET ADDRESS [LINE 1]^.333^EC1
951"DATA",64850002,43,0)
952E-STREET ADDRESS [LINE 2]^.334^EC1
953"DATA",64850002,44,0)
954E-STREET ADDRESS [LINE 3]^.335^EC1
955"DATA",64850002,45,0)
956E-WORK PHONE NUMBER^.33011^EC1
957"DATA",64850002,46,0)
958E-ZIP CODE^.338^EC1
959"DATA",64850002,47,0)
960E-ZIP+4^.2201^EC1
961"DATA",64850002,48,0)
962E2-CITY^.3316^EC2
963"DATA",64850002,49,0)
964E2-CONTACT CHANGE DATE/TIME^.33112^EC2
965"DATA",64850002,50,0)
966E2-NAME OF SECONDARY CONTACT^.3311^EC2
967"DATA",64850002,51,0)
968E2-PHONE NUMBER^.3319^EC2
969"DATA",64850002,52,0)
970E2-RELATIONSHIP TO PATIENT^.3312^EC2
971"DATA",64850002,53,0)
972E2-STATE^.3317^EC2
973"DATA",64850002,54,0)
974E2-STREET ADDRESS [LINE 1]^.3313^EC2
975"DATA",64850002,55,0)
976E2-STREET ADDRESS [LINE 2]^.3314^EC2
977"DATA",64850002,56,0)
978E2-STREET ADDRESS [LINE 3]^.3315^EC2
979"DATA",64850002,57,0)
980E2-WORK PHONE NUMBER^.331011^EC2
981"DATA",64850002,58,0)
982E2-ZIP CODE^.3318^EC2
983"DATA",64850002,59,0)
984E2-ZIP+4^.2204^EC2
985"DATA",64850002,60,0)
986EMAIL ADDRESS^.133^DEMOG
987"DATA",64850002,61,0)
988EMERGENCY CONTACT^.331^EC1
989"DATA",64850002,62,0)
990EMERGENCY CONTACT-2^.3311^EC2
991"DATA",64850002,63,0)
992EMPLOYER CITY^.3116^EM1
993"DATA",64850002,64,0)
994EMPLOYER NAME^.3111^EM1
995"DATA",64850002,65,0)
996EMPLOYER PHONE NUMBER^.3119^EM1
997"DATA",64850002,66,0)
998EMPLOYER STATE^.3117^EM1
999"DATA",64850002,67,0)
1000EMPLOYER STREET [LINE 1]^.3113^EM1
1001"DATA",64850002,68,0)
1002EMPLOYER STREET [LINE 2]^.3114^EM1
1003"DATA",64850002,69,0)
1004EMPLOYER STREET [LINE 3]^.3115^EM1
1005"DATA",64850002,70,0)
1006EMPLOYER ZIP CODE^.3118^EM1
1007"DATA",64850002,71,0)
1008EMPLOYER ZIP+4^.2205^EM1
1009"DATA",64850002,72,0)
1010EMPLOYMENT STATUS^.31115^EM1
1011"DATA",64850002,73,0)
1012END DATE OF TEMP ADDRESS^.1218^TAD
1013"DATA",64850002,74,0)
1014ENROLLMENT CLINIC^3^ENROLL
1015"DATA",64850002,74,"M",0)
10162.001P^^^
1017"DATA",64850002,74,"M",1,0)
1018CURRENT STATUS^2;2.001
1019"DATA",64850002,74,"M",2,0)
1020ENROLLMENT CLINIC^.01;2.001
1021"DATA",64850002,74,"M",3,0)
1022ENROLLMENT DATA^1;2.001
1023"DATA",64850002,74,"M",3,"MM",0)
10242.011DA^^^
1025"DATA",64850002,74,"M",3,"MM",1,0)
1026DATE OF ENROLLMENT^3;2.011
1027"DATA",64850002,74,"M",3,"MM",2,0)
1028OPT OR AC^1;2.011
1029"DATA",64850002,74,"M",3,"MM",3,0)
1030DATE OF DISCHARGE^3;2.011
1031"DATA",64850002,74,"M",3,"MM",4,0)
1032REASON FOR DISCHARGE^4;2.011
1033"DATA",64850002,74,"M",3,"MM",5,0)
1034REVIEW DATE^5;2.011
1035"DATA",64850002,75,0)
1036ETHNICITY INFORMATION^6^DEMOG
1037"DATA",64850002,75,"M",0)
10382.06PA^^
1039"DATA",64850002,75,"M",1,0)
1040ETHNICITY INFORMATION^.01;2.06
1041"DATA",64850002,76,0)
1042Email Address^.133^DEMOG
1043"DATA",64850002,77,0)
1044FATHER'S COUNTRY OF BIRTH^19904^DEMOG
1045"DATA",64850002,78,0)
1046FATHER'S NAME^.2401^DEMOG
1047"DATA",64850002,79,0)
1048FUGITIVE FELON FLAG^1100.01^FLAG
1049"DATA",64850002,80,0)
1050GOVERNMENT AGENCY^.3112^GOV
1051"DATA",64850002,81,0)
1052HEALTH RECORD NO.^64850001^DEMOG
1053"DATA",64850002,82,0)
1054INSURANCE TYPE^.3121^II
1055"DATA",64850002,82,"M",0)
10562.312IPA^^
1057"DATA",64850002,82,"M",1,0)
1058COMMENT - PATIENT POLICY^1.08;2.312
1059"DATA",64850002,82,"M",2,0)
1060COORDINATION OF BENEFITS^.2;2.312
1061"DATA",64850002,82,"M",3,0)
1062DATE ENTERED^1.01;2.312
1063"DATA",64850002,82,"M",4,0)
1064DATE LAST EDITED^1.05;2.312
1065"DATA",64850002,82,"M",5,0)
1066DATE LAST VERIFIED^1.03;2.312
1067"DATA",64850002,82,"M",6,0)
1068DATE OF SOURCE OF INFORMATION^1.1;2.312
1069"DATA",64850002,82,"M",7,0)
1070EFFECTIVE DATE OF POLICY^8;2.312
1071"DATA",64850002,82,"M",8,0)
1072EIV AUTO-UPDATE^4.04;2.312
1073"DATA",64850002,82,"M",9,0)
1074ELIGIBILITY/BENEFIT^60;2.312
1075"DATA",64850002,82,"M",10,0)
1076EMPLOY CLAIM ST ADDRESS LINE 2^2.03;2.312
1077"DATA",64850002,82,"M",11,0)
1078EMPLOY CLAIM ST ADDRESS LINE 3^2.04;2.312
1079"DATA",64850002,82,"M",12,0)
1080EMPLOYER CLAIMS CITY^2.05;2.312
1081"DATA",64850002,82,"M",13,0)
1082EMPLOYER CLAIMS PHONE^2.08;2.312
1083"DATA",64850002,82,"M",14,0)
1084EMPLOYER CLAIMS STATE^2.06;2.312
1085"DATA",64850002,82,"M",15,0)
1086EMPLOYER CLAIMS STREET ADDRESS^2.02;2.312
1087"DATA",64850002,82,"M",16,0)
1088EMPLOYER CLAIMS ZIP CODE^2.07;2.312
1089"DATA",64850002,82,"M",17,0)
1090EMPLOYMENT STATUS^2.11;2.312
1091"DATA",64850002,82,"M",18,0)
1092ENTERED BY^1.02;2.312
1093"DATA",64850002,82,"M",19,0)
1094ESGHP^2.1;2.312
1095"DATA",64850002,82,"M",20,0)
1096GROUP PLAN^.18;2.312
1097"DATA",64850002,82,"M",21,0)
1098INSURANCE EXPIRATION DATE^3;2.312
1099"DATA",64850002,82,"M",22,0)
1100INSURANCE NUMBER^1;2.312
1101"DATA",64850002,82,"M",23,0)
1102INSURANCE TYPE^.01;2.312
1103"DATA",64850002,82,"M",24,0)
1104INSURED'S BRANCH^3.02;2.312
1105"DATA",64850002,82,"M",25,0)
1106INSURED'S CITY^3.08;2.312
1107"DATA",64850002,82,"M",26,0)
1108INSURED'S DOB^3.01;2.312
1109"DATA",64850002,82,"M",27,0)
1110INSURED'S PHONE^3.11;2.312
1111"DATA",64850002,82,"M",28,0)
1112INSURED'S RANK^3.03;2.312
1113"DATA",64850002,82,"M",29,0)
1114INSURED'S SEX^3.12;2.312
1115"DATA",64850002,82,"M",30,0)
1116INSURED'S SSN^3.05;2.312
1117"DATA",64850002,82,"M",31,0)
1118INSURED'S STATE^3.09;2.312
1119"DATA",64850002,82,"M",32,0)
1120INSURED'S STREET 1^3.06;2.312
1121"DATA",64850002,82,"M",33,0)
1122INSURED'S STREET 2^3.07;2.312
1123"DATA",64850002,82,"M",34,0)
1124INSURED'S ZIP^3.1;2.312
1125"DATA",64850002,82,"M",35,0)
1126LAST EDITED BY^1.06;2.312
1127"DATA",64850002,82,"M",36,0)
1128NAME OF INSURED^17;2.312
1129"DATA",64850002,82,"M",37,0)
1130NEW GROUP NAME^20;2.312
1131"DATA",64850002,82,"M",38,0)
1132NEW GROUP NUMBER^21;2.312
1133"DATA",64850002,82,"M",39,0)
1134PATIENT ID^5.01;2.312
1135"DATA",64850002,82,"M",40,0)
1136PATIENT'S SEC QUALIFIER^1
1137"DATA",64850002,82,"M",41,0)
1138PATIENT'S SEC QUALIFIER^2
1139"DATA",64850002,82,"M",42,0)
1140PATIENT'S SEC QUALIFIER^3
1141"DATA",64850002,82,"M",43,0)
1142PATIENT'S SECONDARY ID^1
1143"DATA",64850002,82,"M",44,0)
1144PATIENT'S SECONDARY ID^2
1145"DATA",64850002,82,"M",45,0)
1146PATIENT'S SECONDARY ID^3
1147"DATA",64850002,82,"M",46,0)
1148POLICY NOT BILLABLE^3.04;2.312
1149"DATA",64850002,82,"M",47,0)
1150PRIMARY CARE PROVIDER^4.01;2.312
1151"DATA",64850002,82,"M",48,0)
1152PRIMARY PROVIDER PHONE^4.02;2.312
1153"DATA",64850002,82,"M",49,0)
1154PT. RELATIONSHIP - HIPAA^4.03;2.312
1155"DATA",64850002,82,"M",50,0)
1156PT. RELATIONSHIP TO INSURED^16;2.312
1157"DATA",64850002,82,"M",51,0)
1158RETIREMENT DATE^2.12;2.312
1159"DATA",64850002,82,"M",52,0)
1160SEND BILL TO EMPLOYER^2.01;2.312
1161"DATA",64850002,82,"M",53,0)
1162SOURCE OF INFORMATION^1.09;2.312
1163"DATA",64850002,82,"M",54,0)
1164SUBSCRIBER ID^1;2.312
1165"DATA",64850002,82,"M",55,0)
1166SUBSCRIBER'S EMPLOYER NAME^2.015;2.312
1167"DATA",64850002,82,"M",56,0)
1168SUBSCRIBER'S SEC ID^1
1169"DATA",64850002,82,"M",57,0)
1170SUBSCRIBER'S SEC ID^2
1171"DATA",64850002,82,"M",58,0)
1172SUBSCRIBER'S SEC ID^3
1173"DATA",64850002,82,"M",59,0)
1174SUBSCRIBER'S SEC QUALIFIER^1
1175"DATA",64850002,82,"M",60,0)
1176SUBSCRIBER'S SEC QUALIFIER^2
1177"DATA",64850002,82,"M",61,0)
1178SUBSCRIBER'S SEC QUALIFIER^3
1179"DATA",64850002,82,"M",62,0)
1180VERIFIED BY^1.04;2.312
1181"DATA",64850002,82,"M",63,0)
1182WHOSE INSURANCE^6;2.312
1183"DATA",64850002,83,0)
1184INTERPRETER LANGUAGE^19906^DEMOG
1185"DATA",64850002,83,"M",0)
11862.019906P^^
1187"DATA",64850002,83,"M",1,0)
1188INTERPRETER LANGUAGE^.01;2.019906
1189"DATA",64850002,84,0)
1190K-CITY^.216^NK1
1191"DATA",64850002,85,0)
1192K-NAME OF PRIMARY NOK^.211^NK1
1193"DATA",64850002,86,0)
1194K-PHONE NUMBER^.219^NK1
1195"DATA",64850002,87,0)
1196K-RELATIONSHIP TO PATIENT^.212^NK1
1197"DATA",64850002,88,0)
1198K-STATE^.217^NK1
1199"DATA",64850002,89,0)
1200K-STREET ADDRESS [LINE 1]^.213^NK1
1201"DATA",64850002,90,0)
1202K-STREET ADDRESS [LINE 2]^.214^NK1
1203"DATA",64850002,91,0)
1204K-STREET ADDRESS [LINE 3]^.215^NK1
1205"DATA",64850002,92,0)
1206K-WORK PHONE NUMBER^.21011^NK1
1207"DATA",64850002,93,0)
1208K-ZIP CODE^.218^NK1
1209"DATA",64850002,94,0)
1210K-ZIP+4^.2207^NK1
1211"DATA",64850002,95,0)
1212K2-ADDRESS SAME AS PATIENT'S?^.21925^NK2
1213"DATA",64850002,96,0)
1214K2-CITY^.2196^NK2
1215"DATA",64850002,97,0)
1216K2-NAME OF SECONDARY NOK^.2191^NK2
1217"DATA",64850002,98,0)
1218K2-PHONE NUMBER^.2199^NK2
1219"DATA",64850002,99,0)
1220K2-RELATIONSHIP TO PATIENT^.2192^NK2
1221"DATA",64850002,100,0)
1222K2-STATE^.2197^NK2
1223"DATA",64850002,101,0)
1224K2-STREET ADDRESS [LINE 1]^.2193^NK2
1225"DATA",64850002,102,0)
1226K2-STREET ADDRESS [LINE 2]^.2194^NK2
1227"DATA",64850002,103,0)
1228K2-STREET ADDRESS [LINE 3]^.2195^NK2
1229"DATA",64850002,104,0)
1230K2-WORK PHONE NUMBER^.211011^NK2
1231"DATA",64850002,105,0)
1232K2-ZIP CODE^.2198^NK2
1233"DATA",64850002,106,0)
1234K2-ZIP+4^.2203^NK2
1235"DATA",64850002,107,0)
1236LANGUAGE PREFERENCE^256000^DEMOG
1237"DATA",64850002,108,0)
1238LANGUAGE SKILLS^256001^DEMOG
1239"DATA",64850002,108,"M",0)
12402.0256001P^^
1241"DATA",64850002,108,"M",1,0)
1242LANGUAGE SKILLS^.01;2.0256001
1243"DATA",64850002,108,"M",2,0)
1244READING SKILL LEVEL^3;2.0256001
1245"DATA",64850002,108,"M",3,0)
1246SPEAKING SKILL LEVEL^2;2.0256001
1247"DATA",64850002,108,"M",4,0)
1248UNDERSTANDING SKILL LEVEL^1;2.0256001
1249"DATA",64850002,108,"M",5,0)
1250WRITTEN SKILL LEVEL^4;2.0256001
1251"DATA",64850002,109,0)
1252LODGER WARD LOCATION^.107^N/A
1253"DATA",64850002,110,0)
1254MARITAL STATUS^.05^DEMOG
1255"DATA",64850002,111,0)
1256MEDICAID NUMBER^.383^DEMOG
1257"DATA",64850002,112,0)
1258MOTHER'S COUNTRY OF BIRTH^19903^DEMOG
1259"DATA",64850002,113,0)
1260MOTHER'S MAIDEN NAME^.2403^DEMOG
1261"DATA",64850002,114,0)
1262MOTHER'S NAME^.2402^DEMOG
1263"DATA",64850002,115,0)
1264MULTIPLE BIRTH INDICATOR^994^DEMOG
1265"DATA",64850002,116,0)
1266NAME^.01^DEMOG
1267"DATA",64850002,117,0)
1268K-NEXT OF KIN^.211^NK1
1269"DATA",64850002,118,0)
1270K2-NEXT OF KIN^.2191^NK2
1271"DATA",64850002,119,0)
1272PAGER NUMBER CHANGE DT/TM^.1312^DEMOG
1273"DATA",64850002,120,0)
1274PAGER NUMBER CHANGE SITE^.1314^DEMOG
1275"DATA",64850002,121,0)
1276PAGER NUMBER CHANGE SOURCE^.1313^DEMOG
1277"DATA",64850002,122,0)
1278PHONE NUMBER [CELLULAR]^.134^DEMOG
1279"DATA",64850002,123,0)
1280PHONE NUMBER [RESIDENCE]^.131^DEMOG
1281"DATA",64850002,124,0)
1282PLACE OF BIRTH [CITY]^.092^DEMOG
1283"DATA",64850002,125,0)
1284PLACE OF BIRTH [STATE]^.093^DEMOG
1285"DATA",64850002,126,0)
1286POB CITY^.092^DEMOG
1287"DATA",64850002,127,0)
1288POB STATE^.093^DEMOG
1289"DATA",64850002,128,0)
1290POSTAL CODE^.1172^DEMOG
1291"DATA",64850002,129,0)
1292PREFERRED FACILITY^27.02^DEMOG
1293"DATA",64850002,130,0)
1294PRELIMINARY CAUSE OF DEATH^250043.1^DEMOG
1295"DATA",64850002,130,"M",0)
12962.250043^^^
1297"DATA",64850002,130,"M",1,0)
1298PRELIMINARY CAUSE OF DEATH^2.250043
1299"DATA",64850002,131,0)
1300D-NAME OF DESIGNEE^.341^D1
1301"DATA",64850002,132,0)
1302PROVINCE^.1171^DEMOG
1303"DATA",64850002,133,0)
1304RACE^.06^DEMOG
1305"DATA",64850002,134,0)
1306RACE INFORMATION^2^DEMOG
1307"DATA",64850002,134,"M",0)
13082.02P^^
1309"DATA",64850002,134,"M",1,0)
1310RACE INFORMATION^.01;2.02
1311"DATA",64850002,135,0)
1312RATED INCOMPETENT?^.293^DEMOG
1313"DATA",64850002,136,0)
1314RELIGION^.08^DEMOG
1315"DATA",64850002,137,0)
1316RELIGIOUS PREFERENCE^.08^DEMOG
1317"DATA",64850002,138,0)
1318REMARKS^.091^DEMOG
1319"DATA",64850002,140,0)
1320SOCIAL SECURITY AMOUNT^.3623^MB
1321"DATA",64850002,141,0)
1322SPOUSE'S EMP PHONE NUMBER^.258^SPOUSE
1323"DATA",64850002,142,0)
1324SPOUSE'S EMP STREET [LINE 1]^.252^SPOUSE
1325"DATA",64850002,143,0)
1326SPOUSE'S EMP STREET [LINE 2]^.253^SPOUSE
1327"DATA",64850002,144,0)
1328SPOUSE'S EMP STREET [LINE 3]^.254^SPOUSE
1329"DATA",64850002,145,0)
1330SPOUSE'S EMP ZIP CODE^.257^SPOUSE
1331"DATA",64850002,146,0)
1332SPOUSE'S EMP ZIP+4^.2206^SPOUSE
1333"DATA",64850002,147,0)
1334SPOUSE'S EMPLOYER NAME^.251^SPOUSE
1335"DATA",64850002,148,0)
1336SPOUSE'S EMPLOYER'S CITY^.255^SPOUSE
1337"DATA",64850002,149,0)
1338SPOUSE'S EMPLOYER'S STATE^.256^SPOUSE
1339"DATA",64850002,150,0)
1340SPOUSE'S EMPLOYMENT STATUS^.2515^SPOUSE
1341"DATA",64850002,151,0)
1342SPOUSE'S OCCUPATION^.2514^SPOUSE
1343"DATA",64850002,152,0)
1344SPOUSE'S RETIREMENT DATE^.2516^SPOUSE
1345"DATA",64850002,153,0)
1346START DATE OF TEMP ADDRESS^.1217^TAD
1347"DATA",64850002,154,0)
1348STATE^.115^DEMOG
1349"DATA",64850002,155,0)
1350STREET ADDRESS [LINE 1]^.111^DEMOG
1351"DATA",64850002,156,0)
1352STREET ADDRESS [LINE 2]^.112^DEMOG
1353"DATA",64850002,157,0)
1354STREET ADDRESS [LINE 3]^.113^DEMOG
1355"DATA",64850002,158,0)
1356TEMPORARY ADDRESS CHANGE DT/TM^.12113^TAD
1357"DATA",64850002,159,0)
1358TEMPORARY ADDRESS CHANGE SITE^.12114^TAD
1359"DATA",64850002,160,0)
1360TEMPORARY ADDRESS COUNTRY^.1223^TAD
1361"DATA",64850002,161,0)
1362TEMPORARY ADDRESS COUNTY^.12111^TAD
1363"DATA",64850002,162,0)
1364TEMPORARY ADDRESS END DATE^.1218^TAD
1365"DATA",64850002,163,0)
1366TEMPORARY ADDRESS POSTAL CODE^.1222^TAD
1367"DATA",64850002,164,0)
1368TEMPORARY ADDRESS PROVINCE^.1221^TAD
1369"DATA",64850002,165,0)
1370TEMPORARY ADDRESS START DATE^.1217^TAD
1371"DATA",64850002,166,0)
1372TEMPORARY CITY^.1214^TAD
1373"DATA",64850002,167,0)
1374TEMPORARY PHONE NUMBER^.1219^TAD
1375"DATA",64850002,168,0)
1376TEMPORARY STATE^.1215^TAD
1377"DATA",64850002,169,0)
1378TEMPORARY STREET [LINE 1]^.1211^TAD
1379"DATA",64850002,170,0)
1380TEMPORARY STREET [LINE 2]^.1212^TAD
1381"DATA",64850002,171,0)
1382TEMPORARY STREET [LINE 3]^.1213^TAD
1383"DATA",64850002,172,0)
1384TEMPORARY ZIP CODE^.1216^TAD
1385"DATA",64850002,173,0)
1386TEMPORARY ZIP+4^.12112^TAD
1387"DATA",64850002,174,0)
1388TIME OF BIRTH^540000.1^DEMOG
1389"DATA",64850002,175,0)
1390ZIP CODE^.116^DEMOG
1391"DATA",64850002,176,0)
1392ZIP+4^.1112^DEMOG
1393"DATA",64850002,177,0)
1394OCCUPATION^.07^DEMOG
1395"DATA",64850002,178,0)
1396SEX^.02^DEMOG
1397"DATA",64850003,1,0)
1398DEMOG^Demographics
1399"DATA",64850003,1,"F",0)
1400^64850003.02^21^1
1401"DATA",64850003,1,"F",1,0)
1402.01
1403"DATA",64850003,1,"F",2,0)
1404.02
1405"DATA",64850003,1,"F",3,0)
1406.03
1407"DATA",64850003,1,"F",4,0)
1408.05
1409"DATA",64850003,1,"F",5,0)
1410.06
1411"DATA",64850003,1,"F",6,0)
1412.08
1413"DATA",64850003,1,"F",7,0)
1414.09
1415"DATA",64850003,1,"F",8,0)
1416.111
1417"DATA",64850003,1,"F",9,0)
1418.1112
1419"DATA",64850003,1,"F",10,0)
1420.112
1421"DATA",64850003,1,"F",11,0)
1422.113
1423"DATA",64850003,1,"F",12,0)
1424.114
1425"DATA",64850003,1,"F",13,0)
1426.115
1427"DATA",64850003,1,"F",14,0)
1428.116
1429"DATA",64850003,1,"F",15,0)
1430.117
1431"DATA",64850003,1,"F",16,0)
1432.131
1433"DATA",64850003,1,"F",17,0)
1434.132
1435"DATA",64850003,1,"F",18,0)
1436.363
1437"DATA",64850003,1,"F",19,0)
14381
1439"DATA",64850003,1,"F",20,0)
1440256000
1441"DATA",64850003,1,"F",21,0)
1442.1172
1443"DATA",64850003,2,0)
1444D1^Designee
1445"DATA",64850003,2,"F",0)
1446^64850003.02^^0
1447"DATA",64850003,2,"F",1,0)
1448.2202
1449"DATA",64850003,2,"F",2,0)
1450.2202
1451"DATA",64850003,2,"F",3,0)
1452.3405
1453"DATA",64850003,2,"F",4,0)
1454.341
1455"DATA",64850003,2,"F",5,0)
1456.342
1457"DATA",64850003,2,"F",6,0)
1458.343
1459"DATA",64850003,2,"F",7,0)
1460.344
1461"DATA",64850003,2,"F",8,0)
1462.345
1463"DATA",64850003,2,"F",9,0)
1464.346
1465"DATA",64850003,2,"F",10,0)
1466.347
1467"DATA",64850003,2,"F",11,0)
1468.348
1469"DATA",64850003,2,"F",13,0)
1470.115
1471"DATA",64850003,2,"F",14,0)
1472.116
1473"DATA",64850003,2,"F",15,0)
1474.117
1475"DATA",64850003,2,"F",16,0)
1476.131
1477"DATA",64850003,2,"F",17,0)
1478.132
1479"DATA",64850003,2,"F",18,0)
1480.363
1481"DATA",64850003,2,"F",19,0)
14821
1483"DATA",64850003,2,"F",21,0)
1484.1172
1485"DATA",64850003,3,0)
1486EC1^Emergency contact
1487"DATA",64850003,3,"F",0)
1488^64850003.02^11^11
1489"DATA",64850003,3,"F",1,0)
1490.2201
1491"DATA",64850003,3,"F",2,0)
1492.3305
1493"DATA",64850003,3,"F",3,0)
1494.331
1495"DATA",64850003,3,"F",4,0)
1496.332
1497"DATA",64850003,3,"F",5,0)
1498.333
1499"DATA",64850003,3,"F",6,0)
1500.334
1501"DATA",64850003,3,"F",7,0)
1502.335
1503"DATA",64850003,3,"F",8,0)
1504.336
1505"DATA",64850003,3,"F",9,0)
1506.337
1507"DATA",64850003,3,"F",10,0)
1508.338
1509"DATA",64850003,3,"F",11,0)
1510.339
1511"DATA",64850003,4,0)
1512EC2^Emergency Contact
1513"DATA",64850003,4,"F",0)
1514^64850003.02^10^10
1515"DATA",64850003,4,"F",1,0)
1516.2204
1517"DATA",64850003,4,"F",2,0)
1518.3311
1519"DATA",64850003,4,"F",3,0)
1520.3312
1521"DATA",64850003,4,"F",4,0)
1522.3313
1523"DATA",64850003,4,"F",5,0)
1524.3314
1525"DATA",64850003,4,"F",6,0)
1526.3315
1527"DATA",64850003,4,"F",7,0)
1528.3316
1529"DATA",64850003,4,"F",8,0)
1530.3317
1531"DATA",64850003,4,"F",9,0)
1532.3318
1533"DATA",64850003,4,"F",10,0)
1534.3319
1535"DATA",64850003,5,0)
1536SP1^Spousal Info
1537"DATA",64850003,5,"F",0)
1538^64850003.02^.258^9
1539"DATA",64850003,5,"F",1,0)
1540.2206
1541"DATA",64850003,5,"F",2,0)
1542.251
1543"DATA",64850003,5,"F",3,0)
1544.252
1545"DATA",64850003,5,"F",4,0)
1546.253
1547"DATA",64850003,5,"F",5,0)
1548.254
1549"DATA",64850003,5,"F",6,0)
1550.255
1551"DATA",64850003,5,"F",7,0)
1552.256
1553"DATA",64850003,5,"F",8,0)
1554.257
1555"DATA",64850003,5,"F",9,0)
1556.258
1557"DATA",64850003,8,0)
1558II^Insurance
1559"DATA",64850003,8,"F",0)
1560^64850003.02^2^2
1561"DATA",64850003,8,"F",1,0)
1562.3121
1563"DATA",64850003,8,"F",2,0)
1564.3192
1565"DATA",64850003,9,0)
1566IRD^Radiation Exposure
1567"DATA",64850003,9,"F",0)
1568^64850003.02^3^3
1569"DATA",64850003,9,"F",1,0)
1570.32103
1571"DATA",64850003,9,"F",2,0)
1572.32111
1573"DATA",64850003,9,"F",3,0)
1574.3212
1575"DATA",64850003,10,0)
1576NK1^Next of kin
1577"DATA",64850003,10,"F",0)
1578^64850003.02^11^11
1579"DATA",64850003,10,"F",1,0)
1580.211
1581"DATA",64850003,10,"F",2,0)
1582.212
1583"DATA",64850003,10,"F",3,0)
1584.2125
1585"DATA",64850003,10,"F",4,0)
1586.213
1587"DATA",64850003,10,"F",5,0)
1588.214
1589"DATA",64850003,10,"F",6,0)
1590.215
1591"DATA",64850003,10,"F",7,0)
1592.216
1593"DATA",64850003,10,"F",8,0)
1594.217
1595"DATA",64850003,10,"F",9,0)
1596.218
1597"DATA",64850003,10,"F",10,0)
1598.219
1599"DATA",64850003,10,"F",11,0)
1600.2207
1601"DATA",64850003,11,0)
1602NK2^Next of kin
1603"DATA",64850003,11,"F",0)
1604^64850003.02^11^11
1605"DATA",64850003,11,"F",1,0)
1606.2191
1607"DATA",64850003,11,"F",2,0)
1608.2192
1609"DATA",64850003,11,"F",3,0)
1610.21925
1611"DATA",64850003,11,"F",4,0)
1612.2193
1613"DATA",64850003,11,"F",5,0)
1614.2194
1615"DATA",64850003,11,"F",6,0)
1616.2195
1617"DATA",64850003,11,"F",7,0)
1618.2196
1619"DATA",64850003,11,"F",8,0)
1620.2197
1621"DATA",64850003,11,"F",9,0)
1622.2198
1623"DATA",64850003,11,"F",10,0)
1624.2199
1625"DATA",64850003,11,"F",11,0)
1626.2203
1627"DATA",64850003,13,0)
1628TAD^Temp address
1629"DATA",64850003,13,"F",0)
1630^64850003.02^12^12
1631"DATA",64850003,13,"F",1,0)
1632.12105
1633"DATA",64850003,13,"F",2,0)
1634.1211
1635"DATA",64850003,13,"F",3,0)
1636.12111
1637"DATA",64850003,13,"F",4,0)
1638.12112
1639"DATA",64850003,13,"F",5,0)
1640.1212
1641"DATA",64850003,13,"F",6,0)
1642.1213
1643"DATA",64850003,13,"F",7,0)
1644.1214
1645"DATA",64850003,13,"F",8,0)
1646.1215
1647"DATA",64850003,13,"F",9,0)
1648.1216
1649"DATA",64850003,13,"F",10,0)
1650.1217
1651"DATA",64850003,13,"F",11,0)
1652.1218
1653"DATA",64850003,13,"F",12,0)
1654.1219
1655"DATA",64850004,1,0)
1656DGCOLLATERAL^418
1657"DATA",64850004,2,0)
1658DG LOAD EDIT SCREEN 7^420
1659"DATA",64850004,3,0)
1660PSO OUTPTA^867
1661"DATA",64850004,4,0)
1662DVBHINQ UPDATE^960
1663"DATA",64850004,5,0)
1664DVBA C ADD 2507 PAT^965
1665"DATA",64850004,6,0)
1666DGRPT 10-10T REGISTRATION^1476
1667"DATA",64850004,7,0)
1668A1CK VARO/DHCP^1505
1669"DATA",64850004,8,0)
1670DGEN NEACL^1724
1671"FIA",64850001)
1672PATIENT FILE FIELD EXCLUSIONS
1673"FIA",64850001,0)
1674^DIZ(64850001,
1675"FIA",64850001,0,0)
167664850001
1677"FIA",64850001,0,1)
1678y^n^f^^y^^y^m^n
1679"FIA",64850001,0,10)
1680
1681"FIA",64850001,0,11)
1682
1683"FIA",64850001,0,"RLRO")
1684
1685"FIA",64850001,64850001)
16860
1687"FIA",64850002)
1688CIVILIAN PATIENT FIELDS
1689"FIA",64850002,0)
1690^DIZ(64850002,
1691"FIA",64850002,0,0)
169264850002
1693"FIA",64850002,0,1)
1694y^n^f^^y^^y^m^y
1695"FIA",64850002,0,10)
1696
1697"FIA",64850002,0,11)
1698
1699"FIA",64850002,0,"RLRO")
1700
1701"FIA",64850002,64850002)
17020
1703"FIA",64850002,64850002.01)
17040
1705"FIA",64850002,64850002.13)
17060
1707"FIA",64850003)
1708FIELD GROUPS
1709"FIA",64850003,0)
1710^DIZ(64850003,
1711"FIA",64850003,0,0)
171264850003
1713"FIA",64850003,0,1)
1714y^n^f^^n^^y^m^y
1715"FIA",64850003,0,10)
1716
1717"FIA",64850003,0,11)
1718
1719"FIA",64850003,0,"RLRO")
1720
1721"FIA",64850003,64850003)
17220
1723"FIA",64850003,64850003.02)
17240
1725"FIA",64850004)
1726VERBOTEN TEMPLATES
1727"FIA",64850004,0)
1728^DIZ(64850004,
1729"FIA",64850004,0,0)
173064850004
1731"FIA",64850004,0,1)
1732y^n^f^^y^^y^m^y
1733"FIA",64850004,0,10)
1734
1735"FIA",64850004,0,11)
1736
1737"FIA",64850004,0,"RLRO")
1738
1739"FIA",64850004,64850004)
17400
1741"INI")
1742PRE^VWREGIT2
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)
181664265,33202
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^9
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^12
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^18
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^13
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^14
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^8
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^5
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^10
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^11
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^20
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^6
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^7
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^16
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^4
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^19
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^15
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^3
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")
24868
2487"RTN","VWREGIT")
24880^1^B33941826
2489"RTN","VWREGIT",1,0)
2490VWREGIT ;Portland,OR/Jim Bell, et al Patient Registration Utility August 2015
2491"RTN","VWREGIT",2,0)
2492 ;;2.0;B/FProductions,LLC,WORLD VISTA;**LOCAL**;;Build 4
2493"RTN","VWREGIT",3,0)
2494 ;*******************************************************************
2495"RTN","VWREGIT",4,0)
2496 ;* VW Registration is designed for patient specific fields as *
2497"RTN","VWREGIT",5,0)
2498 ;* defined in Fileman Input Templates or ad hoc field selection. *
2499"RTN","VWREGIT",6,0)
2500 ;* Copyright Martius/MMXV ad infinitum (GNU License: See GPLv3.txt)*
2501"RTN","VWREGIT",7,0)
2502 ;*******************************************************************
2503"RTN","VWREGIT",8,0)
2504 ;;NO FALL THROUGH - JEB
2505"RTN","VWREGIT",9,0)
2506 Q
2507"RTN","VWREGIT",10,0)
2508 ;
2509"RTN","VWREGIT",11,0)
2510TFM(XF) ;TemplateField Management
2511"RTN","VWREGIT",12,0)
2512 ;***********************************************
2513"RTN","VWREGIT",13,0)
2514 ;* Check primary field entries for "parentage" *
2515"RTN","VWREGIT",14,0)
2516 ;* Add an "*" to gain all sub-fields of the *
2517"RTN","VWREGIT",15,0)
2518 ;* parent *
2519"RTN","VWREGIT",16,0)
2520 ;* REMEMBER: All fields pertain to file 2 only *
2521"RTN","VWREGIT",17,0)
2522 ;***********************************************
2523"RTN","VWREGIT",18,0)
2524 N I,N,FIELD
2525"RTN","VWREGIT",19,0)
2526 K FARRAY
2527"RTN","VWREGIT",20,0)
2528 I '$L(XF),'$G(TNUM) Q ""
2529"RTN","VWREGIT",21,0)
2530 I '$L(XF),+$G(TNUM) S XF=^DIE(TNUM,"DR",1,2)
2531"RTN","VWREGIT",22,0)
2532 F I=1:1:$L(XF,";") S:$L($P(XF,";",I)) FARRAY(I)=+$P(XF,";",I)
2533"RTN","VWREGIT",23,0)
2534 S N=0 F I=1:1 S N=$O(FARRAY(N)) Q:'+N D
2535"RTN","VWREGIT",24,0)
2536 . S FIELD=FARRAY(N)
2537"RTN","VWREGIT",25,0)
2538 . I +$P(^DD(2,FIELD,0),"^",2) S FIELD=FIELD_"*",FMARRAY(FIELD)=$P(^(0),"^",4) K FARRAY(N)
2539"RTN","VWREGIT",26,0)
2540 S XF="",N=0 F S N=$O(FARRAY(N)) Q:'+N S XF=XF_FARRAY(N)_";"
2541"RTN","VWREGIT",27,0)
2542 Q XF
2543"RTN","VWREGIT",28,0)
2544 ;
2545"RTN","VWREGIT",29,0)
2546CHECK() ;
2547"RTN","VWREGIT",30,0)
2548 Q ""
2549"RTN","VWREGIT",31,0)
2550 ;
2551"RTN","VWREGIT",32,0)
2552INR() Q $O(RESULT(" "),-1)+1
2553"RTN","VWREGIT",33,0)
2554 ;
2555"RTN","VWREGIT",34,0)
2556EN(RESULT) ;Template name and ID labels
2557"RTN","VWREGIT",35,0)
2558 ;Get the input template list
2559"RTN","VWREGIT",36,0)
2560 ;housekeeping
2561"RTN","VWREGIT",37,0)
2562 S DTIME=99999
2563"RTN","VWREGIT",38,0)
2564 ZSY "chmod 777 "_$ZD_"regparam/*.txt"
2565"RTN","VWREGIT",39,0)
2566 ;end housekeeping
2567"RTN","VWREGIT",40,0)
2568 ;
2569"RTN","VWREGIT",41,0)
2570 K AR,RESULT
2571"RTN","VWREGIT",42,0)
2572 N N,HD,FILE,LOC,P4,P5,%ZISHF,%ZISHO,DEFST,XTMP,X
2573"RTN","VWREGIT",43,0)
2574 S RESULT(0)=1
2575"RTN","VWREGIT",44,0)
2576 S DEFST="";
2577"RTN","VWREGIT",45,0)
2578 ;S DEFTMP=$O(^DIE("B","FAU_EDU",0)) ;For Florida College only
2579"RTN","VWREGIT",46,0)
2580 S RESULT(0)=$$CONTROL^VWREGITU()
2581"RTN","VWREGIT",47,0)
2582 S RESULT(1)="-1^No templates found"
2583"RTN","VWREGIT",48,0)
2584 S DEFST=$$GET^XPAR("ALL","VW REG DEFAULT STATE")
2585"RTN","VWREGIT",49,0)
2586 S DEFTMP=$$GET^XPAR("ALL","VW REG RDNPT")
2587"RTN","VWREGIT",50,0)
2588 S HD=$$GET^XPAR("ALL","VW GUI REG TEMPLATE DIRECTORY")
2589"RTN","VWREGIT",51,0)
2590 I '$L(HD) K RESULT D Q
2591"RTN","VWREGIT",52,0)
2592 . S RESULT($$INR)="-1^NO HOME DIRECTORY - refer to IT support, if necessary."
2593"RTN","VWREGIT",53,0)
2594 . S RESULT($$INR)="No home directory has been supplied which indicates"
2595"RTN","VWREGIT",54,0)
2596 . S RESULT($$INR)="the VWREG installation is incomplete. See the Help manual"
2597"RTN","VWREGIT",55,0)
2598 . S RESULT($$INR)="for installation and Enter/Editing parameter values."
2599"RTN","VWREGIT",56,0)
2600 . S RESULT($$INR)="Thank you,"
2601"RTN","VWREGIT",57,0)
2602 . S RESULT($$INR)=" The Management."
2603"RTN","VWREGIT",58,0)
2604 S FILE="regit.txt"
2605"RTN","VWREGIT",59,0)
2606 S P4=1
2607"RTN","VWREGIT",60,0)
2608 S P5=""
2609"RTN","VWREGIT",61,0)
2610 S X=$$FTG^%ZISH(HD,FILE,$NA(AR(1)),P4,P5)
2611"RTN","VWREGIT",62,0)
2612 D:+RESULT(0)
2613"RTN","VWREGIT",63,0)
2614 . S $P(RESULT(0),"^",2)=$G(HD)
2615"RTN","VWREGIT",64,0)
2616 . S $P(RESULT(0),"^",3)=$S(DEFST:$P(^DIC(5,DEFST,0),"^")_"("_DEFST_")",1:"")
2617"RTN","VWREGIT",65,0)
2618 . S $P(RESULT(0),"^",4)=$S(+DEFTMP:$P(^DIE(DEFTMP,0),"^")_"("_DEFTMP_")",1:DEFTMP)
2619"RTN","VWREGIT",66,0)
2620 . S $P(RESULT(0),"^",5)=DUZ
2621"RTN","VWREGIT",67,0)
2622 I $O(AR(0)) S RESULT(1)="[TEMPLATES]"
2623"RTN","VWREGIT",68,0)
2624 S N=0 F S N=$O(AR(N)) Q:'+N D
2625"RTN","VWREGIT",69,0)
2626 . Q:$E(AR(N))="*"
2627"RTN","VWREGIT",70,0)
2628 . Q:'+$P(AR(N),"(",2)
2629"RTN","VWREGIT",71,0)
2630 . Q:$P($G(^DIE(+$P(AR(N),"(",2),0)),"^",4)'=2 ;must be pat file
2631"RTN","VWREGIT",72,0)
2632 . S RESULT($$INR)=AR(N)
2633"RTN","VWREGIT",73,0)
2634 S RESULT($$INR)="[ID]"
2635"RTN","VWREGIT",74,0)
2636 ;S N=0 F S N=$O(^DIZ(64850003,N)) Q:'+N S RESULT($$INR)=$P(^(N,0),"^",2)_"("_$P(^(0),"^")_")"
2637"RTN","VWREGIT",75,0)
2638 ;S N=0 F S N=$O(RESULT(N)) Q:'+N K:RESULT(N)="" RESULT(N)
2639"RTN","VWREGIT",76,0)
2640 I '$O(RESULT(0)) S RESULT(1)="-1^No PATIENT FILE templates found"
2641"RTN","VWREGIT",77,0)
2642 K AR
2643"RTN","VWREGIT",78,0)
2644 Q
2645"RTN","VWREGIT",79,0)
2646 ;
2647"RTN","VWREGIT",80,0)
2648NPT(RESULT,TNAME) ;
2649"RTN","VWREGIT",81,0)
2650 ; *************************************************
2651"RTN","VWREGIT",82,0)
2652 ; * Incoming: DFN^TEMPLATE NAME(IEN) *
2653"RTN","VWREGIT",83,0)
2654 ; * Process : Get template fields plus any help *
2655"RTN","VWREGIT",84,0)
2656 ; * If +TNAME (a DFN), get DFN data for *
2657"RTN","VWREGIT",85,0)
2658 ; * the template fields (Put data in *
2659"RTN","VWREGIT",86,0)
2660 ; * $P(RESULT(N),"^",3)) *
2661"RTN","VWREGIT",87,0)
2662 ; * Return : RESULT(N), etc *
2663"RTN","VWREGIT",88,0)
2664 ; *************************************************
2665"RTN","VWREGIT",89,0)
2666 ;W " ;Intentional bust for debugging
2667"RTN","VWREGIT",90,0)
2668 N N,TNUM,FIELDS,F,FNAME,FVALUE,FHELP,FPSC,FNUM
2669"RTN","VWREGIT",91,0)
2670 S TNUM=+$P(TNAME,"(",2),DFN=+TNAME
2671"RTN","VWREGIT",92,0)
2672 I 'TNUM S RESULT(0)="0^new patient Template not found" Q
2673"RTN","VWREGIT",93,0)
2674 S TNAME=$P($P(TNAME,"^",2),"(")
2675"RTN","VWREGIT",94,0)
2676 S TNAME=$TR(TNAME,"$&*","") ;Clean out TMENU chars
2677"RTN","VWREGIT",95,0)
2678 I TNAME="GENERIC INS. FRM [WorldVistA]" G GIF
2679"RTN","VWREGIT",96,0)
2680 S FIELDS=$G(^DIE(TNUM,"DR",1,2))
2681"RTN","VWREGIT",97,0)
2682 I '$L(FIELDS) Q
2683"RTN","VWREGIT",98,0)
2684 K RESULT S (FNUM,FCAP)=""
2685"RTN","VWREGIT",99,0)
2686 F I=1:1:$L(FIELDS,";")-1 D
2687"RTN","VWREGIT",100,0)
2688 . S F=$P(FIELDS,";",I)
2689"RTN","VWREGIT",101,0)
2690 . I F["~" S FNUM=+F,FNAME=$P($P(F,"~"),FNUM,2),F=FNUM K FNUM
2691"RTN","VWREGIT",102,0)
2692 . S FNAME=$S($L($G(FNAME)):FNAME,$L($G(^DD(2,F,.1))):$P(^(.1),"^"),1:$P(^DD(2,F,0),"^"))
2693"RTN","VWREGIT",103,0)
2694 . S FVALUE="" ;Patient Data
2695"RTN","VWREGIT",104,0)
2696 . S FHELP=$G(^DD(2,F,3))
2697"RTN","VWREGIT",105,0)
2698 . 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)
2699"RTN","VWREGIT",106,0)
2700 . S FHELP=$TR(FHELP,"'","`")
2701"RTN","VWREGIT",107,0)
2702 . S FPSC=$P(^DD(2,F,0),"^",3)
2703"RTN","VWREGIT",108,0)
2704 . S SUBDIC=+$P(^DD(2,F,0),"^",2)
2705"RTN","VWREGIT",109,0)
2706 . S RESULT($$INR)=FNAME_"^"_F_"^"_FVALUE_"^"_FHELP_"^"_FPSC_$S(SUBDIC:"^1",1:"^0")
2707"RTN","VWREGIT",110,0)
2708 . S (FNAME,FVALUE,FHELP,FPSC)=""
2709"RTN","VWREGIT",111,0)
2710 G NPTX:'DFN
2711"RTN","VWREGIT",112,0)
2712 I DFN D GETS^DIQ(2,DFN_",","**","EN","AR") ;,RESULT(0)=$$DFNID^VWREGITU
2713"RTN","VWREGIT",113,0)
2714 K FIELD S N=0 F S N=$O(RESULT(N)) Q:'+N S FIELD($P(RESULT(N),"^",2))=""
2715"RTN","VWREGIT",114,0)
2716 S X="AR" F S X=$Q(@X) Q:X="" D
2717"RTN","VWREGIT",115,0)
2718 . S FILE=+$P(X,"(",2)
2719"RTN","VWREGIT",116,0)
2720 . S FIELD=+$P(X,",",$L(X,",")-1)
2721"RTN","VWREGIT",117,0)
2722 . I $D(FIELD(FIELD)) S FIELD(FIELD)=@X
2723"RTN","VWREGIT",118,0)
2724 S N=0 F S N=$O(FIELD(N)) Q:'+N D
2725"RTN","VWREGIT",119,0)
2726 . S N2=0 F S N2=$O(RESULT(N2)) Q:'+N2 I $P(RESULT(N2),"^",2)=N S $P(RESULT(N2),"^",3)=FIELD(N)
2727"RTN","VWREGIT",120,0)
2728 . S RESULT(0)=$$DFNID^VWREGITU()
2729"RTN","VWREGIT",121,0)
2730NPTX K FIELD,AR,FCAP,FILE,SUBDIC,N,N2,DFN
2731"RTN","VWREGIT",122,0)
2732 Q
2733"RTN","VWREGIT",123,0)
2734 ;
2735"RTN","VWREGIT",124,0)
2736PF(RESULT,XPF) ;Pointer file - get the stuff
2737"RTN","VWREGIT",125,0)
2738 K RESULT,AR
2739"RTN","VWREGIT",126,0)
2740 N X,N
2741"RTN","VWREGIT",127,0)
2742 I '$L(XPF) S RESULT(0)="???" Q
2743"RTN","VWREGIT",128,0)
2744 S XPF="^"_XPF
2745"RTN","VWREGIT",129,0)
2746 I +$P(XPF,"(",2)=.85 G NAUTPF ;Naughty file!
2747"RTN","VWREGIT",130,0)
2748 S N=0 F S N=$O(@(XPF_N_")")) Q:'+N S X=$P(^(N,0),"^"),AR(X,N)=X_"("_N_")"
2749"RTN","VWREGIT",131,0)
2750 S X="AR" F S X=$Q(@X) Q:X="" S RESULT($$INR)=@X
2751"RTN","VWREGIT",132,0)
2752 K AR
2753"RTN","VWREGIT",133,0)
2754 Q
2755"RTN","VWREGIT",134,0)
2756 ;
2757"RTN","VWREGIT",135,0)
2758NAUTPF ;The "NAUGHTY" pointer file - has a numeric .01 - Bad file !!!
2759"RTN","VWREGIT",136,0)
2760 S N=0 F S N=$O(@(XPF_N_")")) Q:'+N S X=$P(^(N,0),"^") D
2761"RTN","VWREGIT",137,0)
2762 . S LANG=$P(^(0),"^",2)
2763"RTN","VWREGIT",138,0)
2764 . S AR(LANG,N)=LANG_"("_N_")"
2765"RTN","VWREGIT",139,0)
2766 S X="AR" F S X=$Q(@X) Q:X="" S RESULT($$INR)=@X
2767"RTN","VWREGIT",140,0)
2768 Q
2769"RTN","VWREGIT",141,0)
2770GIF ;Generic Insurance form
2771"RTN","VWREGIT",142,0)
2772 K RESULT
2773"RTN","VWREGIT",143,0)
2774 S RESULT($$INR)="Insurance Company^2.312;.01^^^DIC(36,^0"
2775"RTN","VWREGIT",144,0)
2776 S RESULT($$INR)="Group Plan^2.312;.18^^^IBA(355.3,^0"
2777"RTN","VWREGIT",145,0)
2778 S RESULT($$INR)="Policy No.^2.312;1^^^^0"
2779"RTN","VWREGIT",146,0)
2780 ;S RESULT($$INR)="Type of Plan^^^^^0"
2781"RTN","VWREGIT",147,0)
2782 S RESULT($$INR)="Coverage^355.33;40.09^^^IBE(355.1,^0"
2783"RTN","VWREGIT",148,0)
2784 S RESULT($$INR)="Effective Date^2.312;8^^^^0"
2785"RTN","VWREGIT",149,0)
2786 S RESULT($$INR)="Expiration Date^.3121;^^^^0"
2787"RTN","VWREGIT",150,0)
2788 S RESULT($$INR)="Guarantor^^^^^0"
2789"RTN","VWREGIT",151,0)
2790 S RESULT($$INR)="Signature on File^^^^0:NO;1:YES^0"
2791"RTN","VWREGIT",152,0)
2792 S RESULT($$INR)="Employer^2.312;2.015^^^^0"
2793"RTN","VWREGIT",153,0)
2794 S RESULT($$INR)="Billing Address^2.312;2.02^^^^0"
2795"RTN","VWREGIT",154,0)
2796 S RESULT($$INR)="Billing Address(cont)^2.312;2.03^^^^0"
2797"RTN","VWREGIT",155,0)
2798 S RESULT($$INR)="Postal Code^2.312;2.07^^^^0"
2799"RTN","VWREGIT",156,0)
2800 S RESULT($$INR)="City^2.312;2.05^^^^0"
2801"RTN","VWREGIT",157,0)
2802 S RESULT($$INR)="County/Region/Area^^^^^0"
2803"RTN","VWREGIT",158,0)
2804 S RESULT($$INR)="State/Province/Region^2.312;2.06^^^DIC(5,^0"
2805"RTN","VWREGIT",159,0)
2806 Q
2807"RTN","VWREGIT",160,0)
2808 ;
2809"RTN","VWREGIT",161,0)
2810
2811"RTN","VWREGIT2")
28120^9^B7008432
2813"RTN","VWREGIT2",1,0)
2814VWREGIT2 ;Portland/WorldVista/BFP,LLC/Jim Bell, et al... - Post-Install for VWREG
2815"RTN","VWREGIT2",2,0)
2816 ;;1.0;WORLD VISTA;**HOME **;;Build 4
2817"RTN","VWREGIT2",3,0)
2818 ;
2819"RTN","VWREGIT2",4,0)
2820 ;Continued from VWREGIT
2821"RTN","VWREGIT2",5,0)
2822 ;
2823"RTN","VWREGIT2",6,0)
2824 ;GNU License: See WVLIC.txt
2825"RTN","VWREGIT2",7,0)
2826 ;Modified FOIA VISTA,
2827"RTN","VWREGIT2",8,0)
2828 ;Copyright 2013 WorldVistA. Licensed under the terms of the GNU
2829"RTN","VWREGIT2",9,0)
2830 Q
2831"RTN","VWREGIT2",10,0)
2832PRE ;Did this installation happen already? Avoid a re-do?
2833"RTN","VWREGIT2",11,0)
2834 I $O(^XMB(3.8,"B","VW REG ERROR REPORT",0))&($D(^XTV(8989.51,"B","VW GUI REG TEMPLATE DIRECTORY",0))) W !?5,"Installation has already occurred"
2835"RTN","VWREGIT2",12,0)
2836 W !,"Do you want to continue? NO//" R X:60 S:'$L(X) X="NO" S X=$$UP^XLFSTR(X)
2837"RTN","VWREGIT2",13,0)
2838 I "NON"[X W !,"OK" D ^XUSCLEAN
2839"RTN","VWREGIT2",14,0)
2840 Q
2841"RTN","VWREGIT2",15,0)
2842 ;
2843"RTN","VWREGIT2",16,0)
2844PI ;Post Installation install
2845"RTN","VWREGIT2",17,0)
2846 ;Checking for a home directory & file
2847"RTN","VWREGIT2",18,0)
2848 I $O(^XMB(3.8,"B","VW REG ERROR REPORT",0)) W !?5,"Installation has already occurred" Q
2849"RTN","VWREGIT2",19,0)
2850 S AR=1,AR(1)="[TEMPLATES]"
2851"RTN","VWREGIT2",20,0)
2852 S N=0 F S N=$O(^DIE(N)) Q:'+N S X=$P(^(N,0),"^") D
2853"RTN","VWREGIT2",21,0)
2854 . I X["VW " S AR($I(AR))=X_"("_N_")"
2855"RTN","VWREGIT2",22,0)
2856 . I X["[World" S AR($I(AR))=X_"("_N_")"
2857"RTN","VWREGIT2",23,0)
2858 S AR($I(AR))="[ID]"
2859"RTN","VWREGIT2",24,0)
2860 S P4=1,P5="",HD=$ZDIRECTORY_"regparam/",FILE="regit.txt"
2861"RTN","VWREGIT2",25,0)
2862 S X=$$GTF^%ZISH($NA(AR(1)),1,HD,"regit.txt")
2863"RTN","VWREGIT2",26,0)
2864 ZSY "chmod 777 "_$ZDIRECTORY_"regparam/"_FILE ;No sensitive info here
2865"RTN","VWREGIT2",27,0)
2866 Q:$G(TEST) ;Straightening out regit.txt
2867"RTN","VWREGIT2",28,0)
2868 ;
2869"RTN","VWREGIT2",29,0)
2870 ;; NOTE: The parameter definition is installed but there is no installation for
2871"RTN","VWREGIT2",30,0)
2872 ;;the actual parameter and value. Do it here.
2873"RTN","VWREGIT2",31,0)
2874 ;parameter value attempt
2875"RTN","VWREGIT2",32,0)
2876 ;Set a home directory for editing; SYSTEM (DIC(4,) and DOMAIN (DIC(4.2,) only:"/home/vista/regparam/"
2877"RTN","VWREGIT2",33,0)
2878 S PARD=$O(^XTV(8989.51,"B","VW GUI REG TEMPLATE DIRECTORY",0))
2879"RTN","VWREGIT2",34,0)
2880 I PARD D
2881"RTN","VWREGIT2",35,0)
2882 . L +^XTV(8989.5,0):1 D L -^XTV(8989.5,0)
2883"RTN","VWREGIT2",36,0)
2884 .. S NEW=$O(^XTV(8989.5," "),-1)+1
2885"RTN","VWREGIT2",37,0)
2886 .. S $P(^XTV(8989.5,0),"^",3)=NEW
2887"RTN","VWREGIT2",38,0)
2888 .. S $P(^XTV(8989.5,0),"^",4)=$P(^(0),"^",4)+1
2889"RTN","VWREGIT2",39,0)
2890 .. S $P(^XTV(8989.5,NEW,0),"^")="1;DIC(4,"
2891"RTN","VWREGIT2",40,0)
2892 .. S $P(^XTV(8989.5,NEW,0),"^",2)=PARD
2893"RTN","VWREGIT2",41,0)
2894 .. S $P(^XTV(8989.5,NEW,0),"^",3)=1
2895"RTN","VWREGIT2",42,0)
2896 .. S ^XTV(8989.5,NEW,1)=HD
2897"RTN","VWREGIT2",43,0)
2898 .. S DA=NEW,DIK="^XTV(8989.5," D IX^DIK
2899"RTN","VWREGIT2",44,0)
2900 .. S NEW2=$O(^XTV(8989.5," "),-1)+1
2901"RTN","VWREGIT2",45,0)
2902 .. S $P(^XTV(8989.5,0),"^",3)=NEW2
2903"RTN","VWREGIT2",46,0)
2904 .. S $P(^XTV(8989.5,0),"^",4)=$P(^(0),"^",4)+1
2905"RTN","VWREGIT2",47,0)
2906 .. S $P(^XTV(8989.5,NEW2,0),"^")="9;DIC(4.2,"
2907"RTN","VWREGIT2",48,0)
2908 .. S $P(^XTV(8989.5,NEW2,0),"^",2)=PARD
2909"RTN","VWREGIT2",49,0)
2910 .. S $P(^XTV(8989.5,NEW2,0),"^",3)=1
2911"RTN","VWREGIT2",50,0)
2912 .. S ^XTV(8989.5,NEW2,1)=HD
2913"RTN","VWREGIT2",51,0)
2914 .. S DA=NEW2,DIK="^XTV(8989.5," D IX^DIK
2915"RTN","VWREGIT2",52,0)
2916 ;
2917"RTN","VWREGIT2",53,0)
2918 ;Mailgroup VW REG ERROR REPORT - add programmer's email
2919"RTN","VWREGIT2",54,0)
2920 S DA(1)=$O(^XMB(3.8,"B","VW REG ERROR REPORT",0))
2921"RTN","VWREGIT2",55,0)
2922 Q:'DA(1)
2923"RTN","VWREGIT2",56,0)
2924 S DIC="^XMB(3.8,"_DA(1)_",6,"
2925"RTN","VWREGIT2",57,0)
2926 S X="jbellco65@gmail.com"
2927"RTN","VWREGIT2",58,0)
2928 S DIC(0)="LZ"
2929"RTN","VWREGIT2",59,0)
2930 D FILE^DICN
2931"RTN","VWREGIT2",60,0)
2932 Q
2933"RTN","VWREGIT2",61,0)
2934 ;
2935"RTN","VWREGIT3")
29360^3^B4498
2937"RTN","VWREGIT3",1,0)
2938VWREGIT3 ;VWEHR/BFProd-Jim Bell, et al - World VistA GUI Pat Reg Utility
2939"RTN","VWREGIT3",2,0)
2940 ;;1.0;WORLD VISTA;** **;;Build 4
2941"RTN","VWREGIT3",3,0)
2942 ;
2943"RTN","VWREGIT3",4,0)
2944 ;This routine utility is for patient specific fields and
2945"RTN","VWREGIT3",5,0)
2946 ;is used to build input templates for registration
2947"RTN","VWREGIT3",6,0)
2948 ;
2949"RTN","VWREGIT3",7,0)
2950 ;GNU License: See WVLIC.txt
2951"RTN","VWREGIT3",8,0)
2952 ;Modified FOIA VISTA,
2953"RTN","VWREGIT3",9,0)
2954 ;Copyright 2013 WorldVistA. Licensed under the terms of the GNU
2955"RTN","VWREGIT3",10,0)
2956 Q
2957"RTN","VWREGIT3",11,0)
2958 ;
2959"RTN","VWREGITP")
29600^4^B5382212
2961"RTN","VWREGITP",1,0)
2962VWREGITP ;BFP/Portland,OR-Jim Bell,et al - Client Registration Utility
2963"RTN","VWREGITP",2,0)
2964 ;2.0;BFP for WorldVistA;**LOCAL**;;;Build 4
2965"RTN","VWREGITP",3,0)
2966 ; *******************************************
2967"RTN","VWREGITP",4,0)
2968 ; * Copyright 2015 ad infinitum et ultra *
2969"RTN","VWREGITP",5,0)
2970 ; * Gets data for existing clients/patients *
2971"RTN","VWREGITP",6,0)
2972 ; * GPL License: See License.txt *
2973"RTN","VWREGITP",7,0)
2974 ; *******************************************
2975"RTN","VWREGITP",8,0)
2976 Q ;No fall through - jeb
2977"RTN","VWREGITP",9,0)
2978 ;
2979"RTN","VWREGITP",10,0)
2980GPD(RESULT,DATA) ;Get patient data
2981"RTN","VWREGITP",11,0)
2982 ; ********************************* 8888***
2983"RTN","VWREGITP",12,0)
2984 ; * DATA_____TEMPLATE(IEN)^FIELDSET^DFN *
2985"RTN","VWREGITP",13,0)
2986 ; * TEMPLATE__The name(IEN) of a *
2987"RTN","VWREGITP",14,0)
2988 ; * stored template *
2989"RTN","VWREGITP",15,0)
2990 ; * FIELDSET_Adhoc fields in a string *
2991"RTN","VWREGITP",16,0)
2992 ; * as ".01;3;5;.131", etc *
2993"RTN","VWREGITP",17,0)
2994 ; * DFN______IEN of patient file(#2) *
2995"RTN","VWREGITP",18,0)
2996 ; * NOTE: TEMPLATE takes precedence *
2997"RTN","VWREGITP",19,0)
2998 ; * over FIELDSET *
2999"RTN","VWREGITP",20,0)
3000 ; *****************************************
3001"RTN","VWREGITP",21,0)
3002 ;
3003"RTN","VWREGITP",22,0)
3004 K RESULT,AR
3005"RTN","VWREGITP",23,0)
3006 N VAR,TNUM,FSET,F,DFN
3007"RTN","VWREGITP",24,0)
3008 I '$L(DATA) S RESULT(0)="No information relayed. Please try again" Q
3009"RTN","VWREGITP",25,0)
3010 I $P(DATA,"^",3)="" S RESULT(0)="Patient info not relayed. Please try again" Q
3011"RTN","VWREGITP",26,0)
3012 S VAR="TNUM^ADHOC^DFN" F I=1:1:3 S @$P(VAR,"^",I)=$P(DATA,"^",I)
3013"RTN","VWREGITP",27,0)
3014 S TNUM=$S(TNUM["(":+$P(TNUM,"(",2),1:TNUM)
3015"RTN","VWREGITP",28,0)
3016 S DFN=+$P($P(DATA,"^",3),"(",2)
3017"RTN","VWREGITP",29,0)
3018 S FSET=$S(TNUM:^DIE(TNUM,"DR",1,2),'TNUM&($L(ADHOC)):ADHOC,1:"")
3019"RTN","VWREGITP",30,0)
3020 D GETS^DIQ(2,DFN_",","**","N","AR")
3021"RTN","VWREGITP",31,0)
3022 F I=1:1:$L(FSET,";") D
3023"RTN","VWREGITP",32,0)
3024 . Q:'$L($P(FSET,";",I))
3025"RTN","VWREGITP",33,0)
3026 . S F=+$P(FSET,";",I)
3027"RTN","VWREGITP",34,0)
3028 . S RESULT($$INR^VWREGIT)=F_"^"_$G(AR(2,DFN_",",F))
3029"RTN","VWREGITP",35,0)
3030 Q
3031"RTN","VWREGITP",36,0)
3032GPDM(RESULT,DATA) ;
3033"RTN","VWREGITP",37,0)
3034 ; ****************************************************************
3035"RTN","VWREGITP",38,0)
3036 ; * DATA____Parent Text^Parent field #^PATIENT IEN^TEMPLATE(IEN) *
3037"RTN","VWREGITP",39,0)
3038 ; ****************************************************************
3039"RTN","VWREGITP",40,0)
3040 N F,SUBD,DFN,PIEN,X,RIND,FILE,X,Y,TNUM
3041"RTN","VWREGITP",41,0)
3042 K MX,MAR,RESULT,AR
3043"RTN","VWREGITP",42,0)
3044 S DFN=+$P(DATA,"^",3)
3045"RTN","VWREGITP",43,0)
3046 S F=+$P(DATA,"^",2)
3047"RTN","VWREGITP",44,0)
3048 S TNUM=+$P($P(DATA,"^",4),"(",2)
3049"RTN","VWREGITP",45,0)
3050 D GETS^DIQ(2,DFN_",",F_"*;","E","AR")
3051"RTN","VWREGITP",46,0)
3052 S SUBD=+$P(^DD(2,F,0),"^",2) D:+SUBD ;Multiple field values
3053"RTN","VWREGITP",47,0)
3054 . S MX="AR("_SUBD_")" F S MX=$Q(@MX) Q:MX=""!(+$P(MX,"(",2)'=SUBD) D:$P(MX,",",$L(MX,",")-1)'=.01
3055"RTN","VWREGITP",48,0)
3056 .. S FILE=SUBD,PIEN=$P(MX,",",2,$L(MX,",")-1),PIEN=$TR(PIEN,"""","")
3057"RTN","VWREGITP",49,0)
3058 .. K MAR,IMAR
3059"RTN","VWREGITP",50,0)
3060 .. D GETS^DIQ(FILE,PIEN,"**","E","MAR")
3061"RTN","VWREGITP",51,0)
3062 .. D GETS^DIQ(FILE,PIEN,"**","I","IMAR")
3063"RTN","VWREGITP",52,0)
3064 .. S X=$Q(@"MAR"),Y=$Q(@"IMAR")
3065"RTN","VWREGITP",53,0)
3066 .. I @X'=@Y S @X=@X_"("_@Y_")"
3067"RTN","VWREGITP",54,0)
3068 .. S X="MAR" ;,RIND=$$INR^VWREGIT
3069"RTN","VWREGITP",55,0)
3070 .. S RIND=$$INR^VWREGIT,RESULT(RIND)="" F S X=$Q(@X) Q:X="" S RESULT(RIND)=RESULT(RIND)_@X_"^"
3071"RTN","VWREGITP",56,0)
3072 K AR,MAR,IMAR,MX
3073"RTN","VWREGITP",57,0)
3074 Q
3075"RTN","VWREGITS")
30760^5^B15386714
3077"RTN","VWREGITS",1,0)
3078VWREGITS ;Portland,OR/jeb et al Save utility for VWREG* routines 11/2015
3079"RTN","VWREGITS",2,0)
3080 ;V.2;;**LOCAL**;;;Build 4
3081"RTN","VWREGITS",3,0)
3082 ;c2014 ad infiniti, BellFelder Productions (BF Productions) & WorldVistA
3083"RTN","VWREGITS",4,0)
3084 ;License: See License.txt that with install
3085"RTN","VWREGITS",5,0)
3086 ;No fall thru - jeb
3087"RTN","VWREGITS",6,0)
3088 Q
3089"RTN","VWREGITS",7,0)
3090 ;
3091"RTN","VWREGITS",8,0)
3092 ;* *****************************************************************
3093"RTN","VWREGITS",9,0)
3094 ;* Data coming in may be for a new case or existing case *
3095"RTN","VWREGITS",10,0)
3096 ;* Incoming: Array LDATA= *
3097"RTN","VWREGITS",11,0)
3098 ;* LDATA(1)=Field^Field number^value^[optional]DFN *
3099"RTN","VWREGITS",12,0)
3100 ;* LDATA(N...)=Field^Field number^value *
3101"RTN","VWREGITS",13,0)
3102 ;* Exception for Multiples: *
3103"RTN","VWREGITS",14,0)
3104 ;* LDATA(N)=Field(SUBDD;Field number):value(IEN)^...etc for every*
3105"RTN","VWREGITS",15,0)
3106 ;* field that is a dependent of the parent *
3107"RTN","VWREGITS",16,0)
3108 ;* Process: *
3109"RTN","VWREGITS",17,0)
3110 ;* 1. call is at Label SAVE *
3111"RTN","VWREGITS",18,0)
3112 ;* 2. Some housekeeping that this programmer needs to do proper *
3113"RTN","VWREGITS",19,0)
3114 ;* string evaluations. *
3115"RTN","VWREGITS",20,0)
3116 ;* 3. Filing of a new case with FILE^DICN. *
3117"RTN","VWREGITS",21,0)
3118 ;* 4. Remaining major fields are filed with DIE *
3119"RTN","VWREGITS",22,0)
3120 ;* 5. Multiples are filed with UPDATE^DIE *
3121"RTN","VWREGITS",23,0)
3122 ;* 6. Existing entries will contain only edited data and will *
3123"RTN","VWREGITS",24,0)
3124 ;* address those fields as in 4 & 5. *
3125"RTN","VWREGITS",25,0)
3126 ;* Bon Appettit, et al. *
3127"RTN","VWREGITS",26,0)
3128 ;*******************************************************************
3129"RTN","VWREGITS",27,0)
3130SAVE(RESULT,LDATA) ;
3131"RTN","VWREGITS",28,0)
3132 K RESULT,^DIZ("DS",$J)
3133"RTN","VWREGITS",29,0)
3134 M ^DIZ("DS",$J)=LDATA
3135"RTN","VWREGITS",30,0)
3136 Q ;Testing
3137"RTN","VWREGITS",31,0)
3138 N DFN,DIC,DA,DR,VAR,FIELD,N,N1,X,Y,DIE,DIK
3139"RTN","VWREGITS",32,0)
3140 I $D(LDATA)<10 S RESULT(0)="-1: No data sent for filing. Please contact your IT dept." Q
3141"RTN","VWREGITS",33,0)
3142 ;UPcase everyTHING
3143"RTN","VWREGITS",34,0)
3144 S XDAT="LDATA" F S XDAT=$Q(@XDAT) Q:XDAT="" S @XDAT=$$UP^XLFSTR(@XDAT)
3145"RTN","VWREGITS",35,0)
3146 ;
3147"RTN","VWREGITS",36,0)
3148 ;Incoming housekeeping
3149"RTN","VWREGITS",37,0)
3150 S X="LDATA" F I=1:1 S X=$Q(@X) Q:X="" I @X[":",@X[";" S ^DIZ("DS",$J,I)=@X K @X
3151"RTN","VWREGITS",38,0)
3152 I +$P(@$Q(LDATA),"^",4)!(+$P(@$Q(LDATA),"(",2)) G EXP ;DFN sent by client
3153"RTN","VWREGITS",39,0)
3154 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)
3155"RTN","VWREGITS",40,0)
3156 S DFN=$$FIND1^DIC(2,"","M",$P(LDATA(1),"^",3),"","","ERR")
3157"RTN","VWREGITS",41,0)
3158 G EXP:DFN ;Found patient/client
3159"RTN","VWREGITS",42,0)
3160 ;End housekeeping;
3161"RTN","VWREGITS",43,0)
3162 ;
3163"RTN","VWREGITS",44,0)
3164 S X=$P(LDATA(1),"^",3) D
3165"RTN","VWREGITS",45,0)
3166 . S DIC="^DPT(",DIC(0)="LZ" K D0 D FILE^DICN S (DA,DFN)=+Y
3167"RTN","VWREGITS",46,0)
3168 . S DIC="^AUPNPAT(",DIC(0)="LZ",X=DFN,DINUM=X,DIC(0)="L" D FILE^DICN
3169"RTN","VWREGITS",47,0)
3170 . S DIE=DIC,DR=.03_"////^S X=DT" D ^DIE
3171"RTN","VWREGITS",48,0)
3172 . S DR=.11_"////^S X=DUZ" D ^DIE
3173"RTN","VWREGITS",49,0)
3174LDPT L +^DPT(DFN):1 G LDPT:'$T
3175"RTN","VWREGITS",50,0)
3176 S N=1 F S N=$O(LDATA(N)) Q:'+N D
3177"RTN","VWREGITS",51,0)
3178 . Q:$P(LDATA(N),"^",2)[";"
3179"RTN","VWREGITS",52,0)
3180 . Q:'+$P(LDATA(N),"^",2) ;Marker of some kind
3181"RTN","VWREGITS",53,0)
3182 . S FIELD=$P(LDATA(N),"^",2)
3183"RTN","VWREGITS",54,0)
3184 . S VAR=$P(LDATA(N),"^",3)
3185"RTN","VWREGITS",55,0)
3186 . I FIELD=.03 D
3187"RTN","VWREGITS",56,0)
3188 .. S VAR=$$DC(VAR)
3189"RTN","VWREGITS",57,0)
3190 .. S VARTIME=$P(VAR,".",2),VAR=$P(VAR,".")
3191"RTN","VWREGITS",58,0)
3192 .. I $L(VARTIME) D
3193"RTN","VWREGITS",59,0)
3194 ... N FDA
3195"RTN","VWREGITS",60,0)
3196 ... S FDA(2,DFN_",",540000.1)=VARTIME
3197"RTN","VWREGITS",61,0)
3198 ... D FILE^DIE("E","FDA")
3199"RTN","VWREGITS",62,0)
3200 ... D CLEAN^DILF
3201"RTN","VWREGITS",63,0)
3202 . S:VAR["(" VAR=$S($L(VAR,"(")>2:+$P(VAR,"(",$L(VAR,"(")),1:+$P(VAR,"(",2))
3203"RTN","VWREGITS",64,0)
3204 . S DIE="^DPT(",DR=FIELD_"///"_$S(+VAR:"/",1:"")_"^S X=VAR" D ^DIE
3205"RTN","VWREGITS",65,0)
3206 L -^DPT(DFN)
3207"RTN","VWREGITS",66,0)
3208 D M ;File any multiple fields
3209"RTN","VWREGITS",67,0)
3210 S RESULT(0)="Filed..."
3211"RTN","VWREGITS",68,0)
3212 K ^DIZ("DS",$J)
3213"RTN","VWREGITS",69,0)
3214 Q
3215"RTN","VWREGITS",70,0)
3216 ;
3217"RTN","VWREGITS",71,0)
3218EXP ;Existing Patient
3219"RTN","VWREGITS",72,0)
3220 K X,FNAME,FFLD,FVALUE,AR,DIC,DA,DR,DIE,AR
3221"RTN","VWREGITS",73,0)
3222 S X="LDATA" F S X=$Q(@X) Q:X="" I @X[":" S AR($O(AR(" "),-1)+1)=@X K @X
3223"RTN","VWREGITS",74,0)
3224 S N=0 F S N=$O(LDATA(N)) Q:'+N S X=LDATA(N) D
3225"RTN","VWREGITS",75,0)
3226 . S FNAME=$P(X,"^")
3227"RTN","VWREGITS",76,0)
3228 . S FFLD=$P(X,"^",2)
3229"RTN","VWREGITS",77,0)
3230 . S FVALUE=$S($P(X,"^",3)["(":+$P(X,"(",2),1:$P(X,"^",3))
3231"RTN","VWREGITS",78,0)
3232 . S DFN=$P(X,"^",4)
3233"RTN","VWREGITS",79,0)
3234 . S DIE="^DPT(",DA=DFN,DR=FFLD_"///^S X=FVALUE" D ^DIE
3235"RTN","VWREGITS",80,0)
3236 D M
3237"RTN","VWREGITS",81,0)
3238 S RESULT($I(RESULT))="Filed..."
3239"RTN","VWREGITS",82,0)
3240 K X,FNAME,FFL,FVALUE,DFN,AR,DIE,DA,DR,DIC
3241"RTN","VWREGITS",83,0)
3242 Q
3243"RTN","VWREGITS",84,0)
3244 ;
3245"RTN","VWREGITS",85,0)
3246M ;File any multiples values; DFN should be defined above
3247"RTN","VWREGITS",86,0)
3248 Q:'$D(^DIZ("DS",$J))
3249"RTN","VWREGITS",87,0)
3250 M MULTS=^DIZ("DS",$J)
3251"RTN","VWREGITS",88,0)
3252 K MAR S N=0 F S N=$O(MULTS(N)) Q:'+N D
3253"RTN","VWREGITS",89,0)
3254 . F J=1:1:$L(MULTS(N),"^")-1 S MAR(J)=$P(MULTS(N),"^",J)
3255"RTN","VWREGITS",90,0)
3256 . S MX=$O(MAR(0))
3257"RTN","VWREGITS",91,0)
3258 . S MXFILE=+$P(MAR(MX),"(",2)
3259"RTN","VWREGITS",92,0)
3260 . S MXFLD=+$P(MAR(MX),";",2)
3261"RTN","VWREGITS",93,0)
3262 . S MXVAL=$P($P(MAR(MX),":",2),"(")
3263"RTN","VWREGITS",94,0)
3264 . I MXFLD=.01 S MXDATA(MXFILE,"?+1,"_DFN_",",MXFLD)=MXVAL K IEN D UPDATE^DIE("E","MXDATA","IEN","ERROR") Q:$G(DIERR) D
3265"RTN","VWREGITS",95,0)
3266 .. S RECORD=$G(IEN(1)),INC=$G(IEN(1,0))
3267"RTN","VWREGITS",96,0)
3268 .. S J=MX F S J=$O(MAR(J)) Q:'+J D
3269"RTN","VWREGITS",97,0)
3270 ... s MXFILE=+$P(MAR(J),"(",2)
3271"RTN","VWREGITS",98,0)
3272 ... S MXFLD=+$P(MAR(J),";",2)
3273"RTN","VWREGITS",99,0)
3274 ... S MXVAL=$P(MAR(J),":",2),MXVAL=$S(MXVAL["(":$P(MXVAL,"("),1:MXVAL)
3275"RTN","VWREGITS",100,0)
3276 ... S MXDATA(MXFILE,$S(MXFLD=.01:INC,1:"")_"1,"_RECORD_","_DFN_",",MXFLD)=MXVAL
3277"RTN","VWREGITS",101,0)
3278 ... K IEN,ERROR D UPDATE^DIE("E","MXDATA","IEN","ERROR")
3279"RTN","VWREGITS",102,0)
3280 Q
3281"RTN","VWREGITS",103,0)
3282 ;
3283"RTN","VWREGITS",104,0)
3284DC(XDATE) ;Convert DOB to internal
3285"RTN","VWREGITS",105,0)
3286 N %DT,X
3287"RTN","VWREGITS",106,0)
3288 S X=XDATE,%DT="T" D ^%DT
3289"RTN","VWREGITS",107,0)
3290 Q Y
3291"RTN","VWREGITS",108,0)
3292 ;
3293"RTN","VWREGITS",109,0)
3294INSUR ;Insurance/Billing
3295"RTN","VWREGITS",110,0)
3296 Q
3297"RTN","VWREGITS",111,0)
3298 ;
3299"RTN","VWREGITS",112,0)
3300K S DA=$P(^DPT(0),"^",3),DIK="^DPT(" D ^DIK
3301"RTN","VWREGITS",113,0)
3302 S DIK="^AUPNPAT(" D ^DIK
3303"RTN","VWREGITS",114,0)
3304 Q
3305"RTN","VWREGITS",115,0)
3306 ;
3307"RTN","VWREGITT")
33080^6^B37668154
3309"RTN","VWREGITT",1,0)
3310VWREGITT ;Portland\Jim Bell, BFP,LLC Input Template Management 2016
3311"RTN","VWREGITT",2,0)
3312 ;2.0**LOCAL** Copyright April 2016 ad infinitum;;;;;Build 4
3313"RTN","VWREGITT",3,0)
3314 ;*****************************************************************
3315"RTN","VWREGITT",4,0)
3316 ;* Licensed under GNU 2.0 or greater - see license.txt file *
3317"RTN","VWREGITT",5,0)
3318 ;* Program/application is for the management of input templates *
3319"RTN","VWREGITT",6,0)
3320 ;* owned by the user (DUZ). *
3321"RTN","VWREGITT",7,0)
3322 ;* REMINDER: All template fields pertain only to the Patient File*
3323"RTN","VWREGITT",8,0)
3324 ;* (#2)! *
3325"RTN","VWREGITT",9,0)
3326 ;*****************************************************************
3327"RTN","VWREGITT",10,0)
3328 ;
3329"RTN","VWREGITT",11,0)
3330 Q ;No fall through
3331"RTN","VWREGITT",12,0)
3332 ;
3333"RTN","VWREGITT",13,0)
3334AUTH(TUSER,TNUM) ;Can user edit or is IT CONTROL
3335"RTN","VWREGITT",14,0)
3336 N TMO
3337"RTN","VWREGITT",15,0)
3338 S TMO=$O(^DIC(19,"B","VW REG IT CONTROL",0)) I $D(^VA(200,TUSER,203,"B",TMO)) Q 1
3339"RTN","VWREGITT",16,0)
3340 S TMO=$O(^DIC(19,"B","VW PATIENT REGISTRATION",0))
3341"RTN","VWREGITT",17,0)
3342 I TMO,$P(^DIE(TNUM,0),"^",5)=TUSER Q 1
3343"RTN","VWREGITT",18,0)
3344 Q 0
3345"RTN","VWREGITT",19,0)
3346 ;
3347"RTN","VWREGITT",20,0)
3348INR() Q $O(RESULT(" "),-1)+1
3349"RTN","VWREGITT",21,0)
3350 ;
3351"RTN","VWREGITT",22,0)
3352CF(FIELD) ;If a computed field, 0, else 1
3353"RTN","VWREGITT",23,0)
3354 I $P($G(^DD(2,FIELD,0)),"^",2)["C" Q 0
3355"RTN","VWREGITT",24,0)
3356 Q 1
3357"RTN","VWREGITT",25,0)
3358 ;
3359"RTN","VWREGITT",26,0)
3360EGF(RESULT,TNAME) ;Get fields for client editing via TName
3361"RTN","VWREGITT",27,0)
3362 ;*************************
3363"RTN","VWREGITT",28,0)
3364 ;* Incoming___TNAME(IEN) *
3365"RTN","VWREGITT",29,0)
3366 ;*************************
3367"RTN","VWREGITT",30,0)
3368 K RESULT ;N TNUM,TNAME,PF,SF
3369"RTN","VWREGITT",31,0)
3370 S TNUM=+$P(TNAME,"(",2)
3371"RTN","VWREGITT",32,0)
3372 S TNAME=$P(TNAME,"(")
3373"RTN","VWREGITT",33,0)
3374 I 'TNUM!('$D(^DIE(TNUM))) S RESULT(0)="Template name or number not found in Template file" Q
3375"RTN","VWREGITT",34,0)
3376 ;Check for authorization
3377"RTN","VWREGITT",35,0)
3378 I '$$AUTH(DUZ,TNUM) S RESULT(0)="Sorry, you are not authorized to edit this template." Q
3379"RTN","VWREGITT",36,0)
3380 S RESULT(0)="Editing "_TNAME_"("_TNUM_")"
3381"RTN","VWREGITT",37,0)
3382 S PF=$G(^DIE(TNUM,"DR",1,2))
3383"RTN","VWREGITT",38,0)
3384 F I=1:1:$L(PF,";") D:$P(PF,";",I)
3385"RTN","VWREGITT",39,0)
3386 . S RESULT($$INR)=$P(^DD(2,$P(PF,";",I),0),"^")_"("_$P(PF,";",I)_")"
3387"RTN","VWREGITT",40,0)
3388 . S SDD=+$P(^DD(2,$P(PF,";",I),0),"^",2) D:SDD
3389"RTN","VWREGITT",41,0)
3390 .. S SDN=1 F S SDN=$O(^DIE(TNUM,"DR",SDN)) Q:'SDN S:$O(^(SDN,0))=SDD SF=^(SDD) D
3391"RTN","VWREGITT",42,0)
3392 ... F J=1:1:$L(SF,";") D:$P(SF,";",J)
3393"RTN","VWREGITT",43,0)
3394 .... S SFF=$P(^DIE(TNUM,"DR",SDN,SDD),";",J)
3395"RTN","VWREGITT",44,0)
3396 .... S RESULT($$INR)=" SF "_$P(^DD(SDD,SFF,0),"^")_"("_SFF_";"_SDD_")"
3397"RTN","VWREGITT",45,0)
3398 Q
3399"RTN","VWREGITT",46,0)
3400 ;
3401"RTN","VWREGITT",47,0)
3402SFLDS ;Get sub-fields and dics
3403"RTN","VWREGITT",48,0)
3404 K MULT N N,X,I,Y
3405"RTN","VWREGITT",49,0)
3406 S Y="",N=0 F S N=$O(TDATA(N)) Q:'+N D
3407"RTN","VWREGITT",50,0)
3408 . Q:TDATA(N)'[" SF" ;Still a major field
3409"RTN","VWREGITT",51,0)
3410 . F I=N:1:$O(TDATA(" "),-1) S X=TDATA(I) Q:X'[" SF" S MULT(+$P(X,";",2),+$P(X,"(",2))=""
3411"RTN","VWREGITT",52,0)
3412 Q
3413"RTN","VWREGITT",53,0)
3414 ;
3415"RTN","VWREGITT",54,0)
3416FIELDS() ;
3417"RTN","VWREGITT",55,0)
3418 N FLDLIST,N,X,FLD K MULT
3419"RTN","VWREGITT",56,0)
3420 S FLDLIST=""
3421"RTN","VWREGITT",57,0)
3422 S N=0 F S N=$O(TDATA(N)) Q:'+N D:TDATA(N)'[" SF"
3423"RTN","VWREGITT",58,0)
3424 . S FLD=+$P(TDATA(N),"(",2)
3425"RTN","VWREGITT",59,0)
3426 . Q:'$$CF(+$P(TDATA(N),"(",2)) ;Computed field
3427"RTN","VWREGITT",60,0)
3428 . S FLDLIST=FLDLIST_FLD_";"
3429"RTN","VWREGITT",61,0)
3430 ;Collate thru for multiple fields:entry looks like " SF "
3431"RTN","VWREGITT",62,0)
3432 S N=0 F S N=$O(TDATA(N)) Q:'+N D:TDATA(N)[" SF"
3433"RTN","VWREGITT",63,0)
3434 . S X=$P(TDATA(N)," ",3)
3435"RTN","VWREGITT",64,0)
3436 . S SDD=+$P(X,";",2)
3437"RTN","VWREGITT",65,0)
3438 . S SFL=+$P(X,"(",2)
3439"RTN","VWREGITT",66,0)
3440 . S MULT(SDD,SFL)=""
3441"RTN","VWREGITT",67,0)
3442 S N=0 F S N=$O(MULT(N)) Q:'+N D S SUB(N)=MF
3443"RTN","VWREGITT",68,0)
3444 . S MF="",N2=0 F S N2=$O(MULT(N,N2)) Q:'+N2 S MF=MF_N2_";"
3445"RTN","VWREGITT",69,0)
3446 K MULT
3447"RTN","VWREGITT",70,0)
3448 Q FLDLIST
3449"RTN","VWREGITT",71,0)
3450 ;
3451"RTN","VWREGITT",72,0)
3452RTF(RESULT) ;Send a refresh of regit.txt to client
3453"RTN","VWREGITT",73,0)
3454 K AR,RESULT
3455"RTN","VWREGITT",74,0)
3456 D LTF
3457"RTN","VWREGITT",75,0)
3458 M RESULT=AR
3459"RTN","VWREGITT",76,0)
3460 K AR
3461"RTN","VWREGITT",77,0)
3462 Q
3463"RTN","VWREGITT",78,0)
3464 ;
3465"RTN","VWREGITT",79,0)
3466LTF ;Load the regit.txt file into AR()
3467"RTN","VWREGITT",80,0)
3468 S HD=$$GET^XPAR("ALL","VW GUI REG TEMPLATE DIRECTORY")
3469"RTN","VWREGITT",81,0)
3470 S FILE="regit.txt"
3471"RTN","VWREGITT",82,0)
3472 S P4=1
3473"RTN","VWREGITT",83,0)
3474 S P5=""
3475"RTN","VWREGITT",84,0)
3476 S X=$$FTG^%ZISH(HD,FILE,$NA(AR(1)),P4,P5)
3477"RTN","VWREGITT",85,0)
3478 Q
3479"RTN","VWREGITT",86,0)
3480 ;
3481"RTN","VWREGITT",87,0)
3482FTF ;File the AR() to regit.txt
3483"RTN","VWREGITT",88,0)
3484 ZSY "cp "_HD_"regit.txt "_HD_"regitbu.txt"
3485"RTN","VWREGITT",89,0)
3486 S P4=1,P5="",FILE="regit.txt"
3487"RTN","VWREGITT",90,0)
3488 S X=$$GTF^%ZISH($NA(AR(1)),1,HD,FILE)
3489"RTN","VWREGITT",91,0)
3490 Q
3491"RTN","VWREGITT",92,0)
3492 ;
3493"RTN","VWREGITT",93,0)
3494ITCNTRL(USER) ;Check for control capability and user authorization
3495"RTN","VWREGITT",94,0)
3496 N ITCNTRL
3497"RTN","VWREGITT",95,0)
3498 S ITCNTRL=$O(^DIC(19,"B","VW REG IT CONTROL",0))
3499"RTN","VWREGITT",96,0)
3500 I 'ITCNTRL D Q 0
3501"RTN","VWREGITT",97,0)
3502 . S VAL=0
3503"RTN","VWREGITT",98,0)
3504 . S RESULT(0)="-1^VW REGISTRATION does not appear to be complete."
3505"RTN","VWREGITT",99,0)
3506 . S RESULT(1)="Please contact your Supervisor or IT support."
3507"RTN","VWREGITT",100,0)
3508 . S RESULT(2)="Thank you,"
3509"RTN","VWREGITT",101,0)
3510 . S RESULT(3)="The Management"
3511"RTN","VWREGITT",102,0)
3512 I '$D(^VA(200,USER,203,"B",ITCNTRL)) D Q 0
3513"RTN","VWREGITT",103,0)
3514 . S RESULT(0)="-1^User does not have authorization to modify/create"
3515"RTN","VWREGITT",104,0)
3516 . S RESULT(1)="input templates. Please contact your Supervisor or"
3517"RTN","VWREGITT",105,0)
3518 . S RESULT(2)="IT support. Or, questions can be referred to Jim"
3519"RTN","VWREGITT",106,0)
3520 . S RESULT(3)="Bell at jbellco65@gmail.com"
3521"RTN","VWREGITT",107,0)
3522 . S RESULT(4)="Thank you."
3523"RTN","VWREGITT",108,0)
3524 Q 1
3525"RTN","VWREGITT",109,0)
3526 ;
3527"RTN","VWREGITT",110,0)
3528EN(RESULT,TDATA) ;
3529"RTN","VWREGITT",111,0)
3530 ;************************************************
3531"RTN","VWREGITT",112,0)
3532 ;* Call from Client *
3533"RTN","VWREGITT",113,0)
3534 ;* TDATA Array: *
3535"RTN","VWREGITT",114,0)
3536 ;* 0____Template Name^DUZ^ACTION^WRITEACCESS *
3537"RTN","VWREGITT",115,0)
3538 ;* 1-n__Field name(number) *
3539"RTN","VWREGITT",116,0)
3540 ;************************************************
3541"RTN","VWREGITT",117,0)
3542 ; -- testing --
3543"RTN","VWREGITT",118,0)
3544 ;M ^DIZ("TDATA",$J)=TDATA
3545"RTN","VWREGITT",119,0)
3546 ;Q
3547"RTN","VWREGITT",120,0)
3548 ; -- end testing --
3549"RTN","VWREGITT",121,0)
3550 ;
3551"RTN","VWREGITT",122,0)
3552 N TNAME,TNUM,ITCNTRL,ACTION,FIELDS,CALLER
3553"RTN","VWREGITT",123,0)
3554 S CALLER=""
3555"RTN","VWREGITT",124,0)
3556 S X="TDATA" F S X=$Q(@X) Q:X="" S @X=$$UP^XLFSTR(@X) ;Upcase everyTHING
3557"RTN","VWREGITT",125,0)
3558 I '$L($G(HD)) S HD=$$GET^XPAR("ALL","VW GUI REG TEMPLATE DIRECTORY")
3559"RTN","VWREGITT",126,0)
3560 S WHO=$P(TDATA(0),"^",2)
3561"RTN","VWREGITT",127,0)
3562 S ITCNTRL=$$ITCNTRL(WHO) ;1=full action;0=create/edit own template(s)
3563"RTN","VWREGITT",128,0)
3564 S TNUM=+$P($P(TDATA(0),"^"),"(",2)
3565"RTN","VWREGITT",129,0)
3566 S TNAME=$P($P(TDATA(0),"^"),"(")
3567"RTN","VWREGITT",130,0)
3568 I TNAME["Editing" S SPEC("Editing ")="",TNAME=$$REPLACE^XLFSTR(TNAME,.SPEC)
3569"RTN","VWREGITT",131,0)
3570 S ACTION=$P(TDATA(0),"^",3)
3571"RTN","VWREGITT",132,0)
3572 S WRITEACC=$S($P(TDATA(0),"^",4)="SELF":$P(^VA(200,DUZ,0),"^",4),1:"")
3573"RTN","VWREGITT",133,0)
3574 S FIELDS=$$FIELDS
3575"RTN","VWREGITT",134,0)
3576 I '$L(ACTION) S RESULT(0)="-1^No action sent. I don't know what to do." Q
3577"RTN","VWREGITT",135,0)
3578 D @ACTION
3579"RTN","VWREGITT",136,0)
3580 Q
3581"RTN","VWREGITT",137,0)
3582 ;
3583"RTN","VWREGITT",138,0)
3584CREATE ;Create a new input template
3585"RTN","VWREGITT",139,0)
3586 ;******************************
3587"RTN","VWREGITT",140,0)
3588 ;* Check for computed fields *
3589"RTN","VWREGITT",141,0)
3590 ;******************************
3591"RTN","VWREGITT",142,0)
3592 K RESULT N %DT,X,Y
3593"RTN","VWREGITT",143,0)
3594 S %DT="TS",X="NOW" D ^%DT S FDATE=Y
3595"RTN","VWREGITT",144,0)
3596 S X=TNAME,DIC="^DIE(",DIC(0)="LZ" D FILE^DICN
3597"RTN","VWREGITT",145,0)
3598 S $P(^DIE(+Y,0),"^",2)=FDATE,$P(^(0),"^",3)="",$P(^(0),"^",4)=2,$P(^(0),"^",5)=DUZ
3599"RTN","VWREGITT",146,0)
3600 S $P(^DIE(+Y,0),"^",6)=WRITEACC
3601"RTN","VWREGITT",147,0)
3602C2 S ^DIE(+Y,"DR",1,2)=FIELDS
3603"RTN","VWREGITT",148,0)
3604 ;Do mult fields here
3605"RTN","VWREGITT",149,0)
3606 S N=0 F S N=$O(SUB(N)) Q:'+N D
3607"RTN","VWREGITT",150,0)
3608 . S UP=^DD(N,0,"UP")
3609"RTN","VWREGITT",151,0)
3610 . I UP=2 S ^DIE(+Y,"DR",$O(^DIE(+Y,"DR"," "),-1)+1,N)=SUB(N)
3611"RTN","VWREGITT",152,0)
3612 . E S ^DIE(+Y,"DR",$O(^DIE(+Y,"DR"," "),-1),N)=SUB(N)
3613"RTN","VWREGITT",153,0)
3614 I $P(^DIE(+Y,0),"^")=$P(TDATA(0),"^") S RESULT(0)=$P(Y,"^",2)_" filed"
3615"RTN","VWREGITT",154,0)
3616 Q:CALLER="EDIT"
3617"RTN","VWREGITT",155,0)
3618 S TNUM=+Y,TNAME=$P(Y,"^",2)
3619"RTN","VWREGITT",156,0)
3620 K AR
3621"RTN","VWREGITT",157,0)
3622 D LTF ;Get the regit.txt file loaded into AR()
3623"RTN","VWREGITT",158,0)
3624 S LAST=$O(AR(" "),-1)
3625"RTN","VWREGITT",159,0)
3626 S AR(LAST)=TNAME_"("_TNUM_")"
3627"RTN","VWREGITT",160,0)
3628 S AR(LAST+1)="[ID]"
3629"RTN","VWREGITT",161,0)
3630 ;M ^DIZ("TDATA","AR",$J)=AR ;Testing
3631"RTN","VWREGITT",162,0)
3632 D FTF ;File AR() to regit.txt
3633"RTN","VWREGITT",163,0)
3634 K ^DIZ("TDATA",$J)
3635"RTN","VWREGITT",164,0)
3636 Q
3637"RTN","VWREGITT",165,0)
3638 ;
3639"RTN","VWREGITT",166,0)
3640EDIT ;Edit existing. Check for allowability
3641"RTN","VWREGITT",167,0)
3642 S Y=TNUM_"^"_TNAME
3643"RTN","VWREGITT",168,0)
3644EL L -^DIE(TNUM):1 G EL:'$T
3645"RTN","VWREGITT",169,0)
3646 S S=1 F S S=$O(^DIE(TNUM,"DR",S)) Q:'+S D
3647"RTN","VWREGITT",170,0)
3648 . S SUBD=0 F S SUBD=$O(^DIE(TNUM,"DR",S,SUBD)) Q:'+SUBD K ^DIE(TNUM,"DR",S,SUBD)
3649"RTN","VWREGITT",171,0)
3650 S CALLER="EDIT"
3651"RTN","VWREGITT",172,0)
3652 D C2
3653"RTN","VWREGITT",173,0)
3654 L +^DIE(TNUM)
3655"RTN","VWREGITT",174,0)
3656 S DA=TNUM,DIK="^DIE(" D IX^DIK ;Re-index record just in case...
3657"RTN","VWREGITT",175,0)
3658 S RESULT(0)=Y_" modification filed..."
3659"RTN","VWREGITT",176,0)
3660 Q
3661"RTN","VWREGITT",177,0)
3662 ;
3663"RTN","VWREGITT",178,0)
3664DELETE ;********************************************
3665"RTN","VWREGITT",179,0)
3666 ;* 1. Get the regit.txt contents into AR() *
3667"RTN","VWREGITT",180,0)
3668 ;* 2. Remove the template from the list *
3669"RTN","VWREGITT",181,0)
3670 ;* 3. Refile regit.txt *
3671"RTN","VWREGITT",182,0)
3672 ;********************************************
3673"RTN","VWREGITT",183,0)
3674 K AR
3675"RTN","VWREGITT",184,0)
3676 M AR=RESULT
3677"RTN","VWREGITT",185,0)
3678 K AR(0) ;ID string for EN
3679"RTN","VWREGITT",186,0)
3680 D FTF
3681"RTN","VWREGITT",187,0)
3682 I X S RESULT(0)="Template menu list updated."
3683"RTN","VWREGITT",188,0)
3684 E S RESULT(0)="Template list not updated. Advise Template manager to manually update "_HD_"regit.txt"
3685"RTN","VWREGITT",189,0)
3686 Q
3687"RTN","VWREGITT",190,0)
3688
3689"RTN","VWREGITU")
36900^7^B34064749
3691"RTN","VWREGITU",1,0)
3692VWREGITU ;Portland, OR/jeb et al World Vista Registration Utilities
3693"RTN","VWREGITU",2,0)
3694 ;V.2;;**LOCAL**;; 2015;Build 4
3695"RTN","VWREGITU",3,0)
3696 ;;c2014, BellFelder Productions(BF Productions)
3697"RTN","VWREGITU",4,0)
3698 ;No Fall thru - jeb
3699"RTN","VWREGITU",5,0)
3700 Q
3701"RTN","VWREGITU",6,0)
3702 ;
3703"RTN","VWREGITU",7,0)
3704DFNID() ;Set NAME(IEN),TAB,DOB(AGE),TAB,HRN,TAB,PHONE#
3705"RTN","VWREGITU",8,0)
3706 N DFNID,NAME,X,Y,DOB,HRN,PHONE
3707"RTN","VWREGITU",9,0)
3708 I 'DFN Q ""
3709"RTN","VWREGITU",10,0)
3710 S NAME=$P(^DPT(DFN,0),"^")
3711"RTN","VWREGITU",11,0)
3712 S Y=$$OUTPUT^VWTIME(DFN) X ^DD("DD") S DOB=Y
3713"RTN","VWREGITU",12,0)
3714 S HRN=$G(^DPT(DFN,540001.1))
3715"RTN","VWREGITU",13,0)
3716 S PHONE="Phone: "_$P(^DPT(DFN,.13),"^")
3717"RTN","VWREGITU",14,0)
3718 S DFNID=NAME_$C(9)_DOB_$C(9)_$S($L(HRN):"HRN: "_HRN_$C(9),1:"")_PHONE
3719"RTN","VWREGITU",15,0)
3720 Q DFNID
3721"RTN","VWREGITU",16,0)
3722 ;
3723"RTN","VWREGITU",17,0)
3724HELP(XDIC,XFIELD) ;
3725"RTN","VWREGITU",18,0)
3726 N N
3727"RTN","VWREGITU",19,0)
3728 K FHELP
3729"RTN","VWREGITU",20,0)
3730 S FHELP=$G(^DD(XDIC,XFIELD,3))
3731"RTN","VWREGITU",21,0)
3732 G:'$L(FHELP) HELPX
3733"RTN","VWREGITU",22,0)
3734 S FHELP=FHELP_$S($E($L(FHELP))=".":" ",1:". ")
3735"RTN","VWREGITU",23,0)
3736 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)_" "
3737"RTN","VWREGITU",24,0)
3738 S FHELP=$TR(FHELP,"'","`")
3739"RTN","VWREGITU",25,0)
3740HELPX Q FHELP
3741"RTN","VWREGITU",26,0)
3742 ;
3743"RTN","VWREGITU",27,0)
3744M(RESULT,XMF) ;
3745"RTN","VWREGITU",28,0)
3746 ; **********************************************
3747"RTN","VWREGITU",29,0)
3748 ; * XMF_____PARENT FIELD^DFN^TEMPLATE NAME(IEN)*
3749"RTN","VWREGITU",30,0)
3750 ; **********************************************
3751"RTN","VWREGITU",31,0)
3752 ;
3753"RTN","VWREGITU",32,0)
3754 ;W " ;Intentional break
3755"RTN","VWREGITU",33,0)
3756 K RESULT,AR,TEMPLATE
3757"RTN","VWREGITU",34,0)
3758 N XMFD,SUBD,SUBD3,SUBD4,SUBD5,F2,F3,F4,F5,DFN,N,X,SUBF,XT,FHELP
3759"RTN","VWREGITU",35,0)
3760 S TNUM=+$P(XMF,"(",2) ;Template IEN, if any
3761"RTN","VWREGITU",36,0)
3762 S DFN=+$P(XMF,"^",2) ;Client IEN, if any
3763"RTN","VWREGITU",37,0)
3764 S XMF=+XMF ;Parent field
3765"RTN","VWREGITU",38,0)
3766 I '+$P(^DD(2,XMF,0),"^",2) S RESULT(0)=-1 ;Not a parent, eh?!
3767"RTN","VWREGITU",39,0)
3768 S XMFD=+$P(^(0),"^",2)
3769"RTN","VWREGITU",40,0)
3770 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)
3771"RTN","VWREGITU",41,0)
3772 . S SUBD=+$P(^(0),"^",2)
3773"RTN","VWREGITU",42,0)
3774 . 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)
3775"RTN","VWREGITU",43,0)
3776 .. S SUBD3=+$P(^(0),"^",2)
3777"RTN","VWREGITU",44,0)
3778 .. 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)
3779"RTN","VWREGITU",45,0)
3780 ... S SUBD4=+$P(^DD(SUBD3,F3,0),"^",2)
3781"RTN","VWREGITU",46,0)
3782 ... 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)
3783"RTN","VWREGITU",47,0)
3784 .... S SUBD5=+$P(^(0),"^",2)
3785"RTN","VWREGITU",48,0)
3786 .... 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)
3787"RTN","VWREGITU",49,0)
3788 ;Clean up of parents IN multiple fields
3789"RTN","VWREGITU",50,0)
3790 M AR=RESULT K RESULT N DD,F
3791"RTN","VWREGITU",51,0)
3792 S N=0 F S N=$O(AR(N)) Q:'+N D
3793"RTN","VWREGITU",52,0)
3794 . S DD=+$P($P(AR(N),"^",2),";") ;Is this a sub DD ?
3795"RTN","VWREGITU",53,0)
3796 . S F=+$P(AR(N),";",2)
3797"RTN","VWREGITU",54,0)
3798 . I +$P(^DD(DD,F,0),"^",2) K AR(N)
3799"RTN","VWREGITU",55,0)
3800 ;Clean up fields not in template
3801"RTN","VWREGITU",56,0)
3802 M TEMPLATE=^DIE(TNUM,"DR")
3803"RTN","VWREGITU",57,0)
3804 S X=$Q(@"TEMPLATE") K @X ;Remove top, non-multiple subscript
3805"RTN","VWREGITU",58,0)
3806 S X="AR" F S X=$Q(@X) Q:X="" D
3807"RTN","VWREGITU",59,0)
3808 . S SUBD=+$P($P(@X,"^",2),";")
3809"RTN","VWREGITU",60,0)
3810 . S SUBF=+$P(@X,";",2)
3811"RTN","VWREGITU",61,0)
3812 . F I=1:1:20 I $D(TEMPLATE(I,SUBD)) D
3813"RTN","VWREGITU",62,0)
3814 .. Q:TEMPLATE(I,SUBD)[SUBF
3815"RTN","VWREGITU",63,0)
3816 .. K @X
3817"RTN","VWREGITU",64,0)
3818 S N=0 F S N=$O(AR(N)) Q:'+N S RESULT($$INR)=AR(N)
3819"RTN","VWREGITU",65,0)
3820 K AR,TEMPLATE
3821"RTN","VWREGITU",66,0)
3822 Q
3823"RTN","VWREGITU",67,0)
3824 ;
3825"RTN","VWREGITU",68,0)
3826DISV(RESULT,DFN) ;Set the Disv GLOBAL
3827"RTN","VWREGITU",69,0)
3828 K RESULT
3829"RTN","VWREGITU",70,0)
3830 I '$L(DFN) S RESULT=-1 Q
3831"RTN","VWREGITU",71,0)
3832 S ^DISV(DUZ,"^DPT(")=+$P(DFN,"(",2),RESULT=1
3833"RTN","VWREGITU",72,0)
3834 Q
3835"RTN","VWREGITU",73,0)
3836 ;
3837"RTN","VWREGITU",74,0)
3838SR(FNAME,FNUM,FVALUE,FHELP,FSETPNTR,FMISC) ;Set values into RESULT()
3839"RTN","VWREGITU",75,0)
3840 ;********************************************************
3841"RTN","VWREGITU",76,0)
3842 ;* FNAME________Field Name *
3843"RTN","VWREGITU",77,0)
3844 ;* FNUM_________Field Number *
3845"RTN","VWREGITU",78,0)
3846 ;* FVALUE_______Data from existing client/patient *
3847"RTN","VWREGITU",79,0)
3848 ;* FHELP________Help text from field *
3849"RTN","VWREGITU",80,0)
3850 ;* FSETPNTR_____Set of codes or Pointer reference *
3851"RTN","VWREGITU",81,0)
3852 ;* FMISC________Locally described designator (not used) *
3853"RTN","VWREGITU",82,0)
3854 ;********************************************************
3855"RTN","VWREGITU",83,0)
3856 S RESULT($$INR)=FNAME_"^"_FNUM_"^"_FVALUE_"^"_FHELP_"^"_FSETPNTR_"^"_FMISC
3857"RTN","VWREGITU",84,0)
3858 Q
3859"RTN","VWREGITU",85,0)
3860 ;
3861"RTN","VWREGITU",86,0)
3862INR() ;Specific incrementer for RESULT array
3863"RTN","VWREGITU",87,0)
3864 Q $O(RESULT(" "),-1)+1
3865"RTN","VWREGITU",88,0)
3866 ;
3867"RTN","VWREGITU",89,0)
3868ZPC(RESULT,ZIP) ;Get zip,county/area/region,state/province,preferred city
3869"RTN","VWREGITU",90,0)
3870 K RESULT N STP,CNTP,COUNTY,XZIP
3871"RTN","VWREGITU",91,0)
3872 S XZIP=ZIP S RESULT(0)="No return" Q:'$L(XZIP)
3873"RTN","VWREGITU",92,0)
3874 D POSTAL^XIPUTIL(XZIP,.ZIPDATA)
3875"RTN","VWREGITU",93,0)
3876 I $D(ZIPDATA("ERROR")) Q ;Can't be found
3877"RTN","VWREGITU",94,0)
3878 S COUNTY=$G(ZIPDATA("COUNTY"))
3879"RTN","VWREGITU",95,0)
3880 S STP=$G(ZIPDATA("STATE POINTER"))
3881"RTN","VWREGITU",96,0)
3882 I STP,$L(COUNTY) S CNTP=$O(^DIC(5,STP,1,"B",COUNTY,0))
3883"RTN","VWREGITU",97,0)
3884 K RESULT(0)
3885"RTN","VWREGITU",98,0)
3886 S RESULT($$INR)=ZIPDATA("STATE")_"("_STP_")"
3887"RTN","VWREGITU",99,0)
3888 S RESULT($$INR)=ZIPDATA("COUNTY")_"("_CNTP_")"
3889"RTN","VWREGITU",100,0)
3890 S RESULT($$INR)=ZIPDATA("CITY")
3891"RTN","VWREGITU",101,0)
3892 S RESULT($$INR)=ZIPDATA("FIPS CODE")
3893"RTN","VWREGITU",102,0)
3894 K ZIPDATA
3895"RTN","VWREGITU",103,0)
3896 Q
3897"RTN","VWREGITU",104,0)
3898 ;
3899"RTN","VWREGITU",105,0)
3900SPI(RESULT,DFN) ;Simple patient inquiry display
3901"RTN","VWREGITU",106,0)
3902 S LINE="----------"
3903"RTN","VWREGITU",107,0)
3904 S DIC="^DPT(",DA=DFN,DIQ(0)="E",DIQ="AR"
3905"RTN","VWREGITU",108,0)
3906 S DR=".01:.05;.111:.115;.1171:.1173;.117;.363"
3907"RTN","VWREGITU",109,0)
3908 D EN^DIQ1
3909"RTN","VWREGITU",110,0)
3910 S CITY=$G(AR(2,DFN,.114,"E"))
3911"RTN","VWREGITU",111,0)
3912 S STIEN="",STATE=$G(AR(2,DFN,.115,"E")) S:$L(STATE) STIEN=$O(^DIC(5,"B",STATE,0))
3913"RTN","VWREGITU",112,0)
3914 S XAGE=$G(AR(2,DFN,.033,"E"))
3915"RTN","VWREGITU",113,0)
3916 S XAGE=$S(+XAGE:XAGE_" y/o",1:"")
3917"RTN","VWREGITU",114,0)
3918 ;;GET HRN
3919"RTN","VWREGITU",115,0)
3920HRN S HRN="",N=$O(^AUPNPAT(DFN,41,0))
3921"RTN","VWREGITU",116,0)
3922 S HRN=$S('N:HRN,1:$P($G(^AUPNPAT(DFN,41,N,0)),"^",2))
3923"RTN","VWREGITU",117,0)
3924 S RESULT($$INR)=AR(2,DFN,.01,"E")_" "_AR(2,DFN,.363,"E")_" HRN: "_HRN
3925"RTN","VWREGITU",118,0)
3926 S RESULT($$INR)="DOB: "_AR(2,DFN,.03,"E")_" ("_XAGE_" "_AR(2,DFN,.02,"E")_")"
3927"RTN","VWREGITU",119,0)
3928 S RESULT($$INR)="ADDRESS"_LINE_LINE
3929"RTN","VWREGITU",120,0)
3930 S RESULT($$INR)=$G(AR(2,DFN,.111,"E"))_" "_$G(AR(2,DFN,.112,"E"))
3931"RTN","VWREGITU",121,0)
3932 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")))
3933"RTN","VWREGITU",122,0)
3934 S RESULT($$INR)="Walk-ins"_LINE_LINE
3935"RTN","VWREGITU",123,0)
3936 S RESULT($$INR)="Appointments"_LINE_LINE
3937"RTN","VWREGITU",124,0)
3938 S RESULT($$INR)="Admissions"_LINE_LINE
3939"RTN","VWREGITU",125,0)
3940 Q
3941"RTN","VWREGITU",126,0)
3942 ;
3943"RTN","VWREGITU",127,0)
3944CONTROL() ;Check for CONTROL status
3945"RTN","VWREGITU",128,0)
3946 N X S X=$O(^DIC(19,"B","VW REG IT CONTROL",0))
3947"RTN","VWREGITU",129,0)
3948 I 'X Q 0 ;Ain't no option there
3949"RTN","VWREGITU",130,0)
3950 Q $S($D(^VA(200,DUZ,203,"B",X)):1,1:0)
3951"RTN","VWREGITU",131,0)
3952 ;
3953"RTN","VWREGITU",132,0)
3954MISC(RESULT,VWDD) ;Get simple value from VWDD ID
3955"RTN","VWREGITU",133,0)
3956 ;***************************************************
3957"RTN","VWREGITU",134,0)
3958 ;* VWDD___________________(sub)-Dictionary number *
3959"RTN","VWREGITU",135,0)
3960 ;* Multiple delimiter_____;(Semicolon) *
3961"RTN","VWREGITU",136,0)
3962 ;***************************************************
3963"RTN","VWREGITU",137,0)
3964 ;
3965"RTN","VWREGITU",138,0)
3966 I '$L(VWDD) S RESULT(0)="No value to evaluate" Q
3967"RTN","VWREGITU",139,0)
3968 K RESULT
3969"RTN","VWREGITU",140,0)
3970 N XDD,XDDLOC,N,X
3971"RTN","VWREGITU",141,0)
3972 G MISCSD:$G(^DD(VWDD,0,"UP"))
3973"RTN","VWREGITU",142,0)
3974 S CALLER=$S($P(VWDD,"^",2)="INS":1,1:0)
3975"RTN","VWREGITU",143,0)
3976 S VWDD=$P(VWDD,"^")
3977"RTN","VWREGITU",144,0)
3978 F I=1:1:$L(VWDD,";") S XDD=+$P(VWDD,";",I) S RESULT($$INR)="["_$P(^DIC(XDD,0),"^")_"]" D MISC1
3979"RTN","VWREGITU",145,0)
3980 I CALLER S RESULT($$INR)="[GUARANTOR]" D
3981"RTN","VWREGITU",146,0)
3982 . S X=$P(^DD(2.312,16,0),"^",3)
3983"RTN","VWREGITU",147,0)
3984 . F I=1:1:$L(X,";") S Y=$P(X,";",I),RESULT($$INR)=$P(Y,":",2)_"("_$P(Y,":")_")"
3985"RTN","VWREGITU",148,0)
3986 Q
3987"RTN","VWREGITU",149,0)
3988 ;
3989"RTN","VWREGITU",150,0)
3990MISC1 S XDDLOC=$G(^DIC(XDD,0,"GL")) D:$L(XDDLOC)
3991"RTN","VWREGITU",151,0)
3992 . S N=0 F S N=$O(@(XDDLOC_N_")")) Q:'+N D
3993"RTN","VWREGITU",152,0)
3994 .. I XDDLOC["779.004" S XCNAME=$P(@(XDDLOC_N_",0)"),"^")_" "_$P(^(0),"^",2)_" "_+$G(^("SDS"))_"("_N_")",RESULT($$INR)=XCNAME Q
3995"RTN","VWREGITU",153,0)
3996 .. S X=$P(@(XDDLOC_N_",0)"),"^")_"("_N_")",RESULT($$INR)=X
3997"RTN","VWREGITU",154,0)
3998MX Q
3999"RTN","VWREGITU",155,0)
4000 ;
4001"RTN","VWREGITU",156,0)
4002MISCSD ;Sub-dictionary
4003"RTN","VWREGITU",157,0)
4004 W ^("UP")
4005"RTN","VWREGITU",158,0)
4006 Q
4007"RTN","VWREGITU",159,0)
4008 ;
4009"RTN","VWREGITU",160,0)
4010
4011"RTN","VWREGITX")
40120^8^B96032773
4013"RTN","VWREGITX",1,0)
4014VWREGITX ;VWEHR/BFProd-Jim Bell, et al - World VistA GUI Pat Reg Utility
4015"RTN","VWREGITX",2,0)
4016 ;;;;;;Build 4
4017"RTN","VWREGITX",3,0)
4018 ;;1.0;WORLD VISTA;**LOCAL **;;Build 26
4019"RTN","VWREGITX",4,0)
4020 ;
4021"RTN","VWREGITX",5,0)
4022 ;This routine utility is for patient specific fields and
4023"RTN","VWREGITX",6,0)
4024 ;is used to build input templates for registration
4025"RTN","VWREGITX",7,0)
4026 ;
4027"RTN","VWREGITX",8,0)
4028 ;GNU License: See WVLIC.txt
4029"RTN","VWREGITX",9,0)
4030 ;Modified FOIA VISTA,
4031"RTN","VWREGITX",10,0)
4032 ;Copyright 2013 WorldVistA. Licensed under the terms of the GNU
4033"RTN","VWREGITX",11,0)
4034 Q
4035"RTN","VWREGITX",12,0)
4036 ;
4037"RTN","VWREGITX",13,0)
40381 ;CallerID = HRN; value is at $P($P(CALLERID,":",2),"^")
4039"RTN","VWREGITX",14,0)
4040 S HRN=$P($P(CALLERID,":",2),"^")
4041"RTN","VWREGITX",15,0)
4042 S HRN=$$HRN(HRN)
4043"RTN","VWREGITX",16,0)
4044 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#."
4045"RTN","VWREGITX",17,0)
4046 Q
4047"RTN","VWREGITX",18,0)
4048 ;
4049"RTN","VWREGITX",19,0)
40502 ;CallerID = NAME; in ^2@+CALLERID
4051"RTN","VWREGITX",20,0)
4052 K AR,ARR
4053"RTN","VWREGITX",21,0)
4054 N HRN,PHONE,DOB,N
4055"RTN","VWREGITX",22,0)
4056 S NAME=$P(CALLERID,"^",+CALLERID)
4057"RTN","VWREGITX",23,0)
4058 S XNAME=NAME F S XNAME=$O(^DPT("B",XNAME)) Q:XNAME'[NAME D
4059"RTN","VWREGITX",24,0)
4060 . S N=0 F S N=$O(^DPT("B",XNAME,N)) Q:'+N S AR($O(AR(" "),-1)+1)=N
4061"RTN","VWREGITX",25,0)
4062 I $O(AR(" "),-1)=1 D Q
4063"RTN","VWREGITX",26,0)
4064 . S DFN=AR(1)
4065"RTN","VWREGITX",27,0)
4066 . S HRN=$$HRN(DFN),HRN=$S($L(HRN):HRN,'$L(HRN):"ID-"_$P($G(^DPT(DFN,.36)),"^",3),1:"------------")
4067"RTN","VWREGITX",28,0)
4068 . S DOB=$P(^DPT(DFN,0),"^",3),DOB=$E(DOB,4,5)_"/"_$E(DOB,6,7)_"/"_$E(DOB,2,3)
4069"RTN","VWREGITX",29,0)
4070 . S PHONE=$P($G(^DPT(DFN,.131)),"^"),PHONE=$S($L(PHONE):PHONE,1:"<No entry>")
4071"RTN","VWREGITX",30,0)
4072 . S RESULT($$INR)=HRN_"^"_$P(^DPT(DFN,0),"^")_"("_DFN_")^"_DOB_"^"_PHONE
4073"RTN","VWREGITX",31,0)
4074 S N=0 F S N=$O(AR(N)) Q:'+N S ARR($P(^DPT(+AR(N),0),"^"),N)=+AR(N)
4075"RTN","VWREGITX",32,0)
4076 S X="ARR" F S X=$Q(@X) Q:X="" S DFN=@X D
4077"RTN","VWREGITX",33,0)
4078 . S HRN=$$HRN(DFN),HRN=$S($L(HRN):HRN,'$L(HRN):"ID-"_$P($G(^DPT(DFN,.36)),"^",3),1:"------------")
4079"RTN","VWREGITX",34,0)
4080 . S DOB=$P(^DPT(DFN,0),"^",3),DOB=$E(DOB,4,5)_"/"_$E(DOB,6,7)_"/"_$E(DOB,2,3)
4081"RTN","VWREGITX",35,0)
4082 . S PHONE=$P($G(^DPT(DFN,.131)),"^"),PHONE=$S($L(PHONE):PHONE,1:"<No entry>")
4083"RTN","VWREGITX",36,0)
4084 . S RESULT($$INR)=HRN_"^"_$P(^DPT(DFN,0),"^")_"("_DFN_")^"_DOB_"^"_PHONE
4085"RTN","VWREGITX",37,0)
4086 K AR,ARR
4087"RTN","VWREGITX",38,0)
4088 Q
4089"RTN","VWREGITX",39,0)
4090 ;
4091"RTN","VWREGITX",40,0)
40923 ;CallerID = DOB; in ^3@CALLERID
4093"RTN","VWREGITX",41,0)
4094 S X=$P(CALLERID,"^",+CALLERID)
4095"RTN","VWREGITX",42,0)
4096 K %DT,Y,AR
4097"RTN","VWREGITX",43,0)
4098 N HRN,PHONE,N
4099"RTN","VWREGITX",44,0)
4100 D ^%DT
4101"RTN","VWREGITX",45,0)
4102 S N=0 F S N=$O(^DPT("ADOB",Y,N)) Q:'+N S AR($O(AR(" "),-1)+1)=N_"^"_Y
4103"RTN","VWREGITX",46,0)
4104 I $O(AR(" "),-1)=1 D Q ;Only one find
4105"RTN","VWREGITX",47,0)
4106 . K RESULT
4107"RTN","VWREGITX",48,0)
4108 . S DFN=+AR(1)
4109"RTN","VWREGITX",49,0)
4110 . S HRN=$$HRN(DFN)
4111"RTN","VWREGITX",50,0)
4112 . I '$L(HRN) S HRN="ID-"_$P($G(^DPT(DFN,.36)),"^",3)
4113"RTN","VWREGITX",51,0)
4114 . I '$L(HRN) S HRN="------------"
4115"RTN","VWREGITX",52,0)
4116 . S PHONE=$P($G(^DPT(DFN,.131)),"^"),PHONE=$S($L(PHONE)>0:PHONE,1:"<No entry>")
4117"RTN","VWREGITX",53,0)
4118 . S RESULT($$INR)=HRN_"^"_$P(^DPT(DFN,0),"^")_"("_DFN_")"_"^"_$P(CALLERID,"^",+CALLERID)_"^"_PHONE
4119"RTN","VWREGITX",54,0)
4120 K ARR S N=0 F S N=$O(AR(N)) Q:'+N S ARR($P(^DPT(+AR(N),0),"^"),N)=+AR(N)
4121"RTN","VWREGITX",55,0)
4122 S X="ARR" F S X=$Q(@X) Q:X="" S DFN=@X D
4123"RTN","VWREGITX",56,0)
4124 . S HRN=$$HRN(DFN)
4125"RTN","VWREGITX",57,0)
4126 . I '$L(HRN) S HRN=$P($G(^DPT(DFN,.36)),"^",3)_"(ID)"
4127"RTN","VWREGITX",58,0)
4128 . I '$L(HRN)!(HRN="(ID)") S HRN="------------"
4129"RTN","VWREGITX",59,0)
4130 . S PHONE=$P($G(^DPT(DFN,.131)),"^"),PHONE=$S($L(PHONE)>0:PHONE,1:"<No entry>")
4131"RTN","VWREGITX",60,0)
4132 . S RESULT($$INR)=HRN_"^"_$P(^DPT(DFN,0),"^")_"("_DFN_")"_"^"_$P(CALLERID,"^",+CALLERID)_"^"_PHONE
4133"RTN","VWREGITX",61,0)
4134 K ARR,AR
4135"RTN","VWREGITX",62,0)
4136 Q
4137"RTN","VWREGITX",63,0)
4138 ;
4139"RTN","VWREGITX",64,0)
41404 ;CallerID = PHONE; IN ^4@+CALLERID
4141"RTN","VWREGITX",65,0)
4142 S CALLERID=$TR(CALLERID,"- ()","")
4143"RTN","VWREGITX",66,0)
4144 Q
4145"RTN","VWREGITX",67,0)
4146 ;
4147"RTN","VWREGITX",68,0)
41485 ;CallerID = space-bar; IN ^2@+CALLERID
4149"RTN","VWREGITX",69,0)
4150 S X=$P(CALLERID,"^",+CALLERID)
4151"RTN","VWREGITX",70,0)
4152 S DFN=$G(^DISV(DUZ,"^DPT("))
4153"RTN","VWREGITX",71,0)
4154 I 'DFN S RESULT(0)="Patient-Client not found" Q
4155"RTN","VWREGITX",72,0)
4156 S AR(1)=DFN G 2+6 ;Direct call
4157"RTN","VWREGITX",73,0)
4158 Q
4159"RTN","VWREGITX",74,0)
4160 ;
4161"RTN","VWREGITX",75,0)
4162DE(RESULT,DATA) ;Forced hard error
4163"RTN","VWREGITX",76,0)
4164 ;W "
4165"RTN","VWREGITX",77,0)
4166 Q
4167"RTN","VWREGITX",78,0)
4168 ;
4169"RTN","VWREGITX",79,0)
4170HRN(IEN) ;Health Record #s from IHS PATIENT
4171"RTN","VWREGITX",80,0)
4172 N N,HRNIEN,I
4173"RTN","VWREGITX",81,0)
4174 S HRNIEN=""
4175"RTN","VWREGITX",82,0)
4176 Q:'$D(^AUPNPAT(IEN)) HRNIEN
4177"RTN","VWREGITX",83,0)
4178 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)_"|"
4179"RTN","VWREGITX",84,0)
4180 I $E(HRNIEN,$L(HRNIEN))="|" S HRNIEN=$E(HRNIEN,1,$L(HRNIEN)-1)
4181"RTN","VWREGITX",85,0)
4182 Q HRNIEN
4183"RTN","VWREGITX",86,0)
4184 ;
4185"RTN","VWREGITX",87,0)
4186ALIST(RESULT,ALPHA,CALLERID) ;Alpha request from client
4187"RTN","VWREGITX",88,0)
4188 ;*****************************************************
4189"RTN","VWREGITX",89,0)
4190 ;* ALPHA_____Letter to look up *
4191"RTN","VWREGITX",90,0)
4192 ;* CALLERID__PIECE#:HRN^NAME(IEN)^DOB^PHONE look up *
4193"RTN","VWREGITX",91,0)
4194 ;* RETURN____HRN^NAME^DOB^PHONE(Field .131 in File 2)*
4195"RTN","VWREGITX",92,0)
4196 ;*****************************************************
4197"RTN","VWREGITX",93,0)
4198 I '$L(ALPHA),'+CALLERID S RESULT(0)="No Alphabetical letter or HRN,Name,DOB,Phone selection..." Q
4199"RTN","VWREGITX",94,0)
4200 S CALLERID=$$UP^XLFSTR(CALLERID) ;Upcase EVERYTHING
4201"RTN","VWREGITX",95,0)
4202 I +CALLERID G @+CALLERID
4203"RTN","VWREGITX",96,0)
4204 N X,I,ANAME,HRN,ADOB,APHONE,Y
4205"RTN","VWREGITX",97,0)
4206 K RESULT,AR,ARR
4207"RTN","VWREGITX",98,0)
4208 S X="^DPT(""B"""_","_""""_ALPHA_""")"
4209"RTN","VWREGITX",99,0)
4210 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,","))
4211"RTN","VWREGITX",100,0)
4212 S ARN=0 F S ARN=$O(AR(ARN)) Q:'+ARN D
4213"RTN","VWREGITX",101,0)
4214 . S HRN=$$HRN(ARN)
4215"RTN","VWREGITX",102,0)
4216 . S:'$L(HRN) HRN="--- "
4217"RTN","VWREGITX",103,0)
4218 . F JJ=$L(HRN):1:15 S HRN=HRN_" "
4219"RTN","VWREGITX",104,0)
4220 . S ANAME=$P(^DPT(AR(ARN),0),"^")
4221"RTN","VWREGITX",105,0)
4222 . S Y=$P(^(0),"^",3)_$S($G(^DPT(AR(ARN),540000)):^(540000),1:"")
4223"RTN","VWREGITX",106,0)
4224 . D DD^%DT S ADOB=Y
4225"RTN","VWREGITX",107,0)
4226 . S APHONE=$P($G(^DPT(AR(ARN),.13)),"^")
4227"RTN","VWREGITX",108,0)
4228 . S ARR(ANAME,ARN)=HRN_"^"_ANAME_"("_AR(ARN)_")^"_ADOB_"^"_APHONE
4229"RTN","VWREGITX",109,0)
4230 S X="ARR" F S X=$Q(@X) Q:X="" S RESULT($$INR)=@X
4231"RTN","VWREGITX",110,0)
4232 Q
4233"RTN","VWREGITX",111,0)
4234 ;
4235"RTN","VWREGITX",112,0)
4236PLID(IEN) ;Primary Long ID, used with or in absence of HRN.
4237"RTN","VWREGITX",113,0)
4238 Q $P($G(^DPT(IEN,.36)),"^",3)
4239"RTN","VWREGITX",114,0)
4240 ;
4241"RTN","VWREGITX",115,0)
4242INR() Q $O(RESULT(" "),-1)+1
4243"RTN","VWREGITX",116,0)
4244 ;
4245"RTN","VWREGITX",117,0)
4246
4247"RTN","VWREGITX",118,0)
4248FIXNAME ;
4249"RTN","VWREGITX",119,0)
4250 N N,X,Y,XIEN,NLENGTH,I
4251"RTN","VWREGITX",120,0)
4252 S NLENGTH=0,X="AR" F S X=$Q(@X) Q:X="" D
4253"RTN","VWREGITX",121,0)
4254 . S Y=@X,N=$P(Y,"(")_"("_+$P(Y,"(",2)_")",STR=$P(Y,")",2)
4255"RTN","VWREGITX",122,0)
4256 . S NLENGTH=$S($L(N)>NLENGTH:$L(N),1:NLENGTH)
4257"RTN","VWREGITX",123,0)
4258 . F I=NLENGTH:-1:$L(N) S N=N_" "
4259"RTN","VWREGITX",124,0)
4260 . S Y=N_" "_STR
4261"RTN","VWREGITX",125,0)
4262 . S @X=Y
4263"RTN","VWREGITX",126,0)
4264 Q
4265"RTN","VWREGITX",127,0)
4266GPL(RESULT,IDDATA) ;Partial patient lists
4267"RTN","VWREGITX",128,0)
4268 ;***********************************************
4269"RTN","VWREGITX",129,0)
4270 ;* IDDATA_____Contains Start^Stop alpha chars *
4271"RTN","VWREGITX",130,0)
4272 ;* RESULT_____Return of results *
4273"RTN","VWREGITX",131,0)
4274 ;***********************************************
4275"RTN","VWREGITX",132,0)
4276 K RESULT,AR
4277"RTN","VWREGITX",133,0)
4278 N N,DFN,SSN,DOB,START,STOP,NAME,XDOB ;; ,NL
4279"RTN","VWREGITX",134,0)
4280 ;;Get user's last patient ID
4281"RTN","VWREGITX",135,0)
4282 S DFN=$G(^DISV(DUZ,"^DPT(")) D:DFN
4283"RTN","VWREGITX",136,0)
4284 . S NAME=$P(^DPT(DFN,0),"^")
4285"RTN","VWREGITX",137,0)
4286 . ;S SSN=$P(^(0),"^",9)
4287"RTN","VWREGITX",138,0)
4288 . S HRN="HRN: "_$$HRN(DFN) ;Health record number
4289"RTN","VWREGITX",139,0)
4290 . S PLID="ID: "_$$PLID(DFN) ;Primary Long ID
4291"RTN","VWREGITX",140,0)
4292 . S DOB=$P(^(0),"^",3)
4293"RTN","VWREGITX",141,0)
4294 . S XDOB=$E(DOB,4,5)_"/"_$E(DOB,6,7)_"/"_$S($E(DOB)<3:19,1:20)_$E(DOB,2,3)
4295"RTN","VWREGITX",142,0)
4296 . S AR(0)=NAME_"("_DFN_")"_" "_XDOB_" "_$S($L($P(HRN,": ",2)):HRN,$L($P(PLID,": ",2)):PLID,1:"<NO ID ON FILE>")
4297"RTN","VWREGITX",143,0)
4298 S START=$P(IDDATA,"^")
4299"RTN","VWREGITX",144,0)
4300 S STOP=$P(IDDATA,"^",2)
4301"RTN","VWREGITX",145,0)
4302 S STOP=STOP_"z"
4303"RTN","VWREGITX",146,0)
4304 S STOP=$E($O(^DPT("B",STOP)))
4305"RTN","VWREGITX",147,0)
4306 S STOP=$S('$L(STOP):$P(IDDATA,"^",2)_"z",1:STOP)
4307"RTN","VWREGITX",148,0)
4308 S NL=0
4309"RTN","VWREGITX",149,0)
4310 S N=START F S N=$O(^DPT("B",N)) Q:N=""!($E(N)=STOP) D
4311"RTN","VWREGITX",150,0)
4312 . S DFN=$O(^(N,0))
4313"RTN","VWREGITX",151,0)
4314 . S NAME=$P(^DPT(DFN,0),"^")_"("_DFN_")"
4315"RTN","VWREGITX",152,0)
4316 . ;S SSN=$P(^(0),"^",9),SSN=$S('$L(SSN):" ????",1:SSN)
4317"RTN","VWREGITX",153,0)
4318 . S HRN="HRN: "_$$HRN(DFN)
4319"RTN","VWREGITX",154,0)
4320 . S PLID="ID: "_$$PLID(DFN) ;Primary Long ID
4321"RTN","VWREGITX",155,0)
4322 . S DOB=$P(^DPT(DFN,0),"^",3)
4323"RTN","VWREGITX",156,0)
4324 . S XDOB=$E(DOB,4,5)_"/"_$E(DOB,6,7)_"/"_$S($E(DOB)<3:19,1:20)_$E(DOB,2,3)
4325"RTN","VWREGITX",157,0)
4326 . ;W !,$J(DFN,5)," ",$J($E(NAME,1,12),12)," ",$J(SSN,10)," ",XDOB
4327"RTN","VWREGITX",158,0)
4328 . S AR(NAME,DFN)=NAME_" "_XDOB_" "_$S($L($P(HRN,": ",2)):HRN,$L($P(PLID,": ",2)):PLID,1:"<NO ID ON FILE>")
4329"RTN","VWREGITX",159,0)
4330 . S (DFN,NAME,SSN,DOB,XDOB)=""
4331"RTN","VWREGITX",160,0)
4332 D FIXNAME
4333"RTN","VWREGITX",161,0)
4334 S X="AR" F S X=$Q(@X) Q:X="" S RESULT($$INR)=@X
4335"RTN","VWREGITX",162,0)
4336 K AR
4337"RTN","VWREGITX",163,0)
4338 Q
4339"RTN","VWREGITX",164,0)
4340 ;
4341"RTN","VWREGITX",165,0)
4342REJECT(FIELD,IEN,SUBDIC) ;Reject Asterisked,Amis,Computed fields,VA specific fields
4343"RTN","VWREGITX",166,0)
4344 ;This subroutine left in for possible future use
4345"RTN","VWREGITX",167,0)
4346 I $L(IEN),$D(^DIZ(64850001,IEN)) Q 1 ;VA specific data field
4347"RTN","VWREGITX",168,0)
4348 I FIELD["COMPONENT" Q 1 ;Pain in the butt!
4349"RTN","VWREGITX",169,0)
4350 I FIELD["(VA)"!(FIELD["(CIVIL)") Q 1 ;VA fields
4351"RTN","VWREGITX",170,0)
4352 I FIELD["AMIS",FIELD["SEGMENT" Q 1
4353"RTN","VWREGITX",171,0)
4354 I FIELD["ELIG VERIF" Q 1
4355"RTN","VWREGITX",172,0)
4356 I FIELD["ENCOUNTER CONVERSION" Q 1
4357"RTN","VWREGITX",173,0)
4358 I FIELD["PROGRAMMERS U" Q 1
4359"RTN","VWREGITX",174,0)
4360 I FIELD["WHO " Q 1
4361"RTN","VWREGITX",175,0)
4362 I FIELD["SC AT"!(FIELD["SC%") Q 1
4363"RTN","VWREGITX",176,0)
4364 I $E(FIELD)="*" Q 1 ;field marked for deletion
4365"RTN","VWREGITX",177,0)
4366 I FIELD["10-10" Q 1
4367"RTN","VWREGITX",178,0)
4368 I $L(IEN),$E($P($G(^DD(2,IEN,0)),"^",2))="C" Q 1 ;computed field
4369"RTN","VWREGITX",179,0)
4370 I $L($G(SUBDIC)),$E($P($G(^DD(SUBDIC,IEN,0)),"^",2))="C" Q 1 ;computet in sub-dic
4371"RTN","VWREGITX",180,0)
4372 Q 0 ;Passed
4373"RTN","VWREGITX",181,0)
4374 ;
4375"RTN","VWREGITX",182,0)
4376LF(RESULT,FTYPE) ;List of assumed civilian type fields from
4377"RTN","VWREGITX",183,0)
4378 ; Patient file(#2)
4379"RTN","VWREGITX",184,0)
4380 ;*******************************************************************
4381"RTN","VWREGITX",185,0)
4382 ;*The author (me) arbitarily selected fields from the patient file *
4383"RTN","VWREGITX",186,0)
4384 ;* that he (me) considers to be usable by civilian VistA/CPRS users*
4385"RTN","VWREGITX",187,0)
4386 ;* the field count is 284 out of the 700+ fields available in the *
4387"RTN","VWREGITX",188,0)
4388 ;* full patient DD. File is located at ^DIZ(64850002, *
4389"RTN","VWREGITX",189,0)
4390 ;*******************************************************************
4391"RTN","VWREGITX",190,0)
4392 ;
4393"RTN","VWREGITX",191,0)
4394 S FTYPE=$TR(FTYPE,"*&^%$#@!:;>?/., ","") ;TMenuItem inclusions/jeb
4395"RTN","VWREGITX",192,0)
4396 ;S:$L(FTYPE) FTYPE=$P(^DIZ(64850003,+$P(FTYPE,"(",2),0),"^")
4397"RTN","VWREGITX",193,0)
4398 S FTYPE=$$UP^XLFSTR(FTYPE)
4399"RTN","VWREGITX",194,0)
4400 K RESULT
4401"RTN","VWREGITX",195,0)
4402 N N,X,FIELD,FLDNO,FGRP,M,MX,MF,MFNO,MFGP,MN
4403"RTN","VWREGITX",196,0)
4404 G FG:$L(FTYPE)
4405"RTN","VWREGITX",197,0)
4406 ; Add patient file fields
4407"RTN","VWREGITX",198,0)
4408 S N=0 F S N=$O(^DIZ(64850002,N)) Q:'+N D
4409"RTN","VWREGITX",199,0)
4410 . S X=^(N,0)
4411"RTN","VWREGITX",200,0)
4412 . S FIELD=$P(X,"^")
4413"RTN","VWREGITX",201,0)
4414 . S FLDNO=$P(X,"^",2)
4415"RTN","VWREGITX",202,0)
4416 . S FGRP=$P(X,"^",3)
4417"RTN","VWREGITX",203,0)
4418 . S RESULT($$INR)=FIELD_"("_FLDNO_")"_":"_FGRP
4419"RTN","VWREGITX",204,0)
4420 . I $O(^DIZ(64850002,N,"M",0)) D
4421"RTN","VWREGITX",205,0)
4422 .. S M=0 F S M=$O(^DIZ(64850002,N,"M",M)) Q:'+M D
4423"RTN","VWREGITX",206,0)
4424 ... S MX=^(M,0)
4425"RTN","VWREGITX",207,0)
4426 ... S MF=$P(MX,"^")
4427"RTN","VWREGITX",208,0)
4428 ... S MFNO=$P(MX,"^",2)
4429"RTN","VWREGITX",209,0)
4430 ... S MFGP=$P(MX,"^",3)
4431"RTN","VWREGITX",210,0)
4432 ... S RESULT($$INR)=" SF "_MF_"("_MFNO_")"_":"_MFGP
4433"RTN","VWREGITX",211,0)
4434 S X="RESULT" F I=1:1 S X=$Q(@X) Q:X=""
4435"RTN","VWREGITX",212,0)
4436 S RESULT(0)="Field count: "_(I-1)
4437"RTN","VWREGITX",213,0)
4438 Q
4439"RTN","VWREGITX",214,0)
4440 ;
4441"RTN","VWREGITX",215,0)
4442FG ;Fields by GROUP
4443"RTN","VWREGITX",216,0)
4444 Q:'$L(FTYPE)
4445"RTN","VWREGITX",217,0)
4446 K RESULT,AHF N LABEL,F,N,I
4447"RTN","VWREGITX",218,0)
4448 S N=$S(+$P(FTYPE,"(",2):+$P(FTYPE,"(",2),1:$O(^DIZ(64850003,"B",FTYPE,0)))
4449"RTN","VWREGITX",219,0)
4450 I 'N S RESULT($$INR)="Group not found." G FGX
4451"RTN","VWREGITX",220,0)
4452 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_")"
4453"RTN","VWREGITX",221,0)
4454FGX Q
4455"RTN","VWREGITX",222,0)
4456 ;
4457"RTN","VWREGITX",223,0)
4458FGNA(RESULT,KIND) ;Fields by sort designator
4459"RTN","VWREGITX",224,0)
4460 ;**********************************
4461"RTN","VWREGITX",225,0)
4462 ;* KIND *
4463"RTN","VWREGITX",226,0)
4464 ;* G____Group,Field *
4465"RTN","VWREGITX",227,0)
4466 ;* N____Field# *
4467"RTN","VWREGITX",228,0)
4468 ;* A____Alphabetical (Default) *
4469"RTN","VWREGITX",229,0)
4470 ;* RESULT__Returned array *
4471"RTN","VWREGITX",230,0)
4472 ;**********************************
4473"RTN","VWREGITX",231,0)
4474 K RESULT
4475"RTN","VWREGITX",232,0)
4476 I KIND="G" D G FGNAX
4477"RTN","VWREGITX",233,0)
4478 . K AR
4479"RTN","VWREGITX",234,0)
4480 . S N=0 F S N=$O(^DIZ(64850002,N)) Q:'+N S X=^(N,0) D
4481"RTN","VWREGITX",235,0)
4482 .. S GRP=$P(X,"^",3)
4483"RTN","VWREGITX",236,0)
4484 .. S FN=$P(X,"^",2)
4485"RTN","VWREGITX",237,0)
4486 .. S FIELD=$P(X,"^")
4487"RTN","VWREGITX",238,0)
4488 .. S AR(GRP,FN)=FIELD_"("_FN_")"
4489"RTN","VWREGITX",239,0)
4490 .. I $O(^DIZ(64850002,N,"M",0)) D
4491"RTN","VWREGITX",240,0)
4492 ... S MN=0 F S MN=$O(^DIZ(64850002,N,"M",MN)) Q:'+MN D
4493"RTN","VWREGITX",241,0)
4494 .... S MX=^(MN,0)
4495"RTN","VWREGITX",242,0)
4496 .... S MFN=+$P(MX,"^",2)
4497"RTN","VWREGITX",243,0)
4498 .... S MFLD=$P(MX,"^")
4499"RTN","VWREGITX",244,0)
4500 .... S AR(GRP,FN,MFN)=" SF "_$P(MX,"^")_"("_$P(MX,"^",2)_")"
4501"RTN","VWREGITX",245,0)
4502 . S G="" F S G=$O(AR(G)) Q:G="" S RESULT($$INR)="--- "_G_" ---" D
4503"RTN","VWREGITX",246,0)
4504 .. 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)
4505"RTN","VWREGITX",247,0)
4506 I KIND="N" D G FGNAX
4507"RTN","VWREGITX",248,0)
4508 . K AR,RESULT
4509"RTN","VWREGITX",249,0)
4510 . S N=0 F S N=$O(^DIZ(64850002,N)) Q:'+N S X=^(N,0) D
4511"RTN","VWREGITX",250,0)
4512 .. S GRP=$P(X,"^",3)
4513"RTN","VWREGITX",251,0)
4514 .. S FN=$P(X,"^",2)
4515"RTN","VWREGITX",252,0)
4516 .. S FIELD=$P(X,"^")
4517"RTN","VWREGITX",253,0)
4518 .. S AR(FN)=FIELD_"("_FN_")"
4519"RTN","VWREGITX",254,0)
4520 .. I $O(^DIZ(64850002,N,"M",0)) D
4521"RTN","VWREGITX",255,0)
4522 ... S MN=0 F S MN=$O(^DIZ(64850002,N,"M",MN)) Q:'+MN D
4523"RTN","VWREGITX",256,0)
4524 .... S MX=^(MN,0)
4525"RTN","VWREGITX",257,0)
4526 .... S MFN=+$P(MX,"^",2)
4527"RTN","VWREGITX",258,0)
4528 .... S MFLD=$P(MX,"^")
4529"RTN","VWREGITX",259,0)
4530 .... S AR(FN,MFN)=" SF "_$P(MX,"^")_"("_$P(MX,"^",2)_")"
4531"RTN","VWREGITX",260,0)
4532 . S X="AR" F S X=$Q(@X) Q:X="" S RESULT($$INR)=@X
4533"RTN","VWREGITX",261,0)
4534 ;Kind = alphabetical
4535"RTN","VWREGITX",262,0)
4536 S N=0 F S N=$O(^DIZ(64850002,N)) Q:'+N S X=^(N,0) D
4537"RTN","VWREGITX",263,0)
4538 . S AR($P(X,"^"))=$P(X,"^")_"("_$P(X,"^",2)_")"
4539"RTN","VWREGITX",264,0)
4540 . I $O(^DIZ(64850002,N,"M",0)) D
4541"RTN","VWREGITX",265,0)
4542 .. S MN=0 F S MN=$O(^DIZ(64850002,N,"M",MN)) Q:'+MN D
4543"RTN","VWREGITX",266,0)
4544 ... S MX=^(MN,0)
4545"RTN","VWREGITX",267,0)
4546 ... S MFN=+$P(MX,"^",2)
4547"RTN","VWREGITX",268,0)
4548 ... S MFLD=$P(MX,"^")
4549"RTN","VWREGITX",269,0)
4550 ... S AR($P(X,"^"),MFLD)=" SF "_$P(MX,"^")_"("_$P(MX,"^",2)_")"
4551"RTN","VWREGITX",270,0)
4552 S X="AR" F S X=$Q(@X) Q:X="" S RESULT($$INR)=@X
4553"RTN","VWREGITX",271,0)
4554FGNAX ;K AR
4555"RTN","VWREGITX",272,0)
4556 Q
4557"RTN","VWREGITX",273,0)
4558 ;
4559"RTN","VWREGITX",274,0)
4560RETGRP(RESULT) ;Return Group IDs
4561"RTN","VWREGITX",275,0)
4562 K RESULT
4563"RTN","VWREGITX",276,0)
4564 S N=0 F S N=$O(^DIZ(64850003,N)) Q:'+N S RESULT($$INR)=$P(^(N,0),"^",2)_"("_N_")"
4565"RTN","VWREGITX",277,0)
4566 Q
4567"RTN","VWREGITX",278,0)
4568 ;
4569"RTN","VWREGITX",279,0)
4570AHF(RESULT,AHF) ;Ad hoc field selection "Finished" pressed/jeb
4571"RTN","VWREGITX",280,0)
4572 ;*****************************************************
4573"RTN","VWREGITX",281,0)
4574 ;* AFH ARRAY: *
4575"RTN","VWREGITX",282,0)
4576 ;* AHF(0)____DFN *
4577"RTN","VWREGITX",283,0)
4578 ;* AHF ARRAY_FIELD(NO) OR FIELD(NO;SUB-DIC) *
4579"RTN","VWREGITX",284,0)
4580 ;*****************************************************
4581"RTN","VWREGITX",285,0)
4582 ;W " ;the END
4583"RTN","VWREGITX",286,0)
4584 K ^DIZ("AHF") M ^DIZ("AHF")=AHF
4585"RTN","VWREGITX",287,0)
4586 K RESULT
4587"RTN","VWREGITX",288,0)
4588 N FIELD,FNO,DFNDR
4589"RTN","VWREGITX",289,0)
4590 S DFNDR=""
4591"RTN","VWREGITX",290,0)
4592 S DFN=+AHF(0) K AHF(0)
4593"RTN","VWREGITX",291,0)
4594 S X="AHF" F S X=$Q(@X) Q:X="" S Y=@X D
4595"RTN","VWREGITX",292,0)
4596 . S FIELD=$P(Y,"(")
4597"RTN","VWREGITX",293,0)
4598 . S FNO=+$P(Y,"(",2)
4599"RTN","VWREGITX",294,0)
4600 . D GFA(FNO)
4601"RTN","VWREGITX",295,0)
4602 . S RESULT($$INR)=FIELD_"^"_FNO_"^^"_FHELP_"^"_FPSC_"^"_$$MF(FNO)
4603"RTN","VWREGITX",296,0)
4604 . S DFNDR=DFNDR_FNO_";"
4605"RTN","VWREGITX",297,0)
4606 I DFN D
4607"RTN","VWREGITX",298,0)
4608 . K AR N N,Y,F
4609"RTN","VWREGITX",299,0)
4610 . D GETS^DIQ(2,DFN_",",DFNDR,"E","AR","ERR")
4611"RTN","VWREGITX",300,0)
4612 . S X="AR" F S X=$Q(@X) Q:X="" D
4613"RTN","VWREGITX",301,0)
4614 .. S Y=@X
4615"RTN","VWREGITX",302,0)
4616 .. S F=+$P(X,",",$L(X,",")-1)
4617"RTN","VWREGITX",303,0)
4618 .. S N=0 F S N=$O(RESULT(N)) Q:'+N I $P(RESULT(N),"^",2)=F S $P(RESULT(N),"^",3)=Y
4619"RTN","VWREGITX",304,0)
4620 ;ToDo: write fill in for the multiple fields
4621"RTN","VWREGITX",305,0)
4622 K FHELP,FPSC
4623"RTN","VWREGITX",306,0)
4624 Q
4625"RTN","VWREGITX",307,0)
4626 ;
4627"RTN","VWREGITX",308,0)
4628GFA(FNO) ;Get field attributes at piece3 and help
4629"RTN","VWREGITX",309,0)
4630 S (FHELP,FPSC)=""
4631"RTN","VWREGITX",310,0)
4632 S FHELP=$G(^DD(2,FNO,3))
4633"RTN","VWREGITX",311,0)
4634 I FNO'=27.02 S N=0 F S N=$O(^DD(2,FNO,21,N)) Q:'+N S FHELP=FHELP_^(N,0)
4635"RTN","VWREGITX",312,0)
4636 S FHELP=$TR(FHELP,"'","`")
4637"RTN","VWREGITX",313,0)
4638 S FPSC=$P(^DD(2,FNO,0),"^",3)
4639"RTN","VWREGITX",314,0)
4640 Q
4641"RTN","VWREGITX",315,0)
4642 ;
4643"RTN","VWREGITX",316,0)
4644MF(X) ;Check for multiple field
4645"RTN","VWREGITX",317,0)
4646 ;*****************************************************
4647"RTN","VWREGITX",318,0)
4648 ;* Reminder: This data set is Patient file only (#2) *
4649"RTN","VWREGITX",319,0)
4650 ;* MYESNO____=1 is a parent *
4651"RTN","VWREGITX",320,0)
4652 ;* =0 is a primary field *
4653"RTN","VWREGITX",321,0)
4654 ;*****************************************************
4655"RTN","VWREGITX",322,0)
4656 ;
4657"RTN","VWREGITX",323,0)
4658 S MYESNO=$S(+$P(^DD(2,X,0),"^",2):1,1:0)
4659"RTN","VWREGITX",324,0)
4660 Q MYESNO
4661"RTN","VWREGITX",325,0)
4662 ;
4663"RTN","VWREGITX",326,0)
4664
4665"VER")
46668.0^22.2
4667"^DD",64850001,64850001,0)
4668FIELD^^.001^2
4669"^DD",64850001,64850001,0,"DDA")
4670N
4671"^DD",64850001,64850001,0,"DT")
46723150506
4673"^DD",64850001,64850001,0,"IX","B",64850001,.01)
4674
4675"^DD",64850001,64850001,0,"NM","PATIENT FILE FIELD EXCLUSIONS")
4676
4677"^DD",64850001,64850001,.001,0)
4678FNUMBER^NJ15,7X^^ ^K:+X'=X!(X>9999999.9999999)!(X<0)!(X?.E1"."8N.N) X S:$G(X) DINUM=X
4679"^DD",64850001,64850001,.001,3)
4680Type a number between 0 and 9999999.9999999, 7 decimal digits.
4681"^DD",64850001,64850001,.001,"DT")
46823150506
4683"^DD",64850001,64850001,.01,0)
4684FIELD^RF^^0;1^K:$L(X)>99!($L(X)<1)!'(X'?1P.E) X
4685"^DD",64850001,64850001,.01,1,0)
4686^.1
4687"^DD",64850001,64850001,.01,1,1,0)
468864850001^B
4689"^DD",64850001,64850001,.01,1,1,1)
4690S ^DIZ(64850001,"B",$E(X,1,30),DA)=""
4691"^DD",64850001,64850001,.01,1,1,2)
4692K ^DIZ(64850001,"B",$E(X,1,30),DA)
4693"^DD",64850001,64850001,.01,1,1,"DT")
46943151009
4695"^DD",64850001,64850001,.01,3)
4696Answer must be 1-99 characters in length.
4697"^DD",64850001,64850001,.01,"DT")
46983151009
4699"^DD",64850002,64850002,0)
4700FIELD^^2.5^4
4701"^DD",64850002,64850002,0,"DDA")
4702N
4703"^DD",64850002,64850002,0,"DT")
47043150602
4705"^DD",64850002,64850002,0,"IX","B",64850002,.01)
4706
4707"^DD",64850002,64850002,0,"IX","C",64850002,3)
4708
4709"^DD",64850002,64850002,0,"NM","CIVILIAN PATIENT FIELDS")
4710
4711"^DD",64850002,64850002,.01,0)
4712NAME^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X
4713"^DD",64850002,64850002,.01,1,0)
4714^.1
4715"^DD",64850002,64850002,.01,1,1,0)
471664850002^B
4717"^DD",64850002,64850002,.01,1,1,1)
4718S ^DIZ(64850002,"B",$E(X,1,30),DA)=""
4719"^DD",64850002,64850002,.01,1,1,2)
4720K ^DIZ(64850002,"B",$E(X,1,30),DA)
4721"^DD",64850002,64850002,.01,3)
4722Answer must be 3-30 characters in length.
4723"^DD",64850002,64850002,.01,4)
4724S X="SHOW ME THIS FIELD AND WHERE ITS LOCATED"
4725"^DD",64850002,64850002,.01,"DT")
47263150601
4727"^DD",64850002,64850002,2,0)
4728FIELD NO^NJ15,7^^0;2^K:+X'=X!(X>9999999.9999999)!(X<0)!(X?.E1"."8N.N) X
4729"^DD",64850002,64850002,2,3)
4730Type a number between 0 and 9999999.9999999, 7 decimal digits.
4731"^DD",64850002,64850002,2,"DT")
47323150601
4733"^DD",64850002,64850002,2.5,0)
4734Multiple of field^64850002.01A^^M;0
4735"^DD",64850002,64850002,3,0)
4736GROUP^F^^0;3^K:$L(X)>30!($L(X)<1) X
4737"^DD",64850002,64850002,3,1,0)
4738^.1
4739"^DD",64850002,64850002,3,1,1,0)
474064850002^C
4741"^DD",64850002,64850002,3,1,1,1)
4742S ^DIZ(64850002,"C",$E(X,1,30),DA)=""
4743"^DD",64850002,64850002,3,1,1,2)
4744K ^DIZ(64850002,"C",$E(X,1,30),DA)
4745"^DD",64850002,64850002,3,1,1,"DT")
47463150601
4747"^DD",64850002,64850002,3,3)
4748Answer must be 1-30 characters in length.
4749"^DD",64850002,64850002,3,"DT")
47503150601
4751"^DD",64850002,64850002.01,0)
4752Multiple of field SUB-FIELD^^3^3
4753"^DD",64850002,64850002.01,0,"DT")
47543150602
4755"^DD",64850002,64850002.01,0,"IX","B",64850002.01,.01)
4756
4757"^DD",64850002,64850002.01,0,"NM","Multiple of field")
4758
4759"^DD",64850002,64850002.01,0,"UP")
476064850002
4761"^DD",64850002,64850002.01,.01,0)
4762Multiple of field^F^^0;1^K:$L(X)>30!($L(X)<1) X
4763"^DD",64850002,64850002.01,.01,1,0)
4764^.1
4765"^DD",64850002,64850002.01,.01,1,1,0)
476664850002.01^B
4767"^DD",64850002,64850002.01,.01,1,1,1)
4768S ^DIZ(64850002,DA(1),"M","B",$E(X,1,30),DA)=""
4769"^DD",64850002,64850002.01,.01,1,1,2)
4770K ^DIZ(64850002,DA(1),"M","B",$E(X,1,30),DA)
4771"^DD",64850002,64850002.01,.01,3)
4772Answer must be 1-30 characters in length.
4773"^DD",64850002,64850002.01,.01,"DT")
47743150601
4775"^DD",64850002,64850002.01,2,0)
4776FIELD NO^NJ15,7^^0;2^K:+X'=X!(X>9999999.9999999)!(X<0)!(X?.E1"."8N.N) X
4777"^DD",64850002,64850002.01,2,3)
4778Type a number between 0 and 9999999.9999999, 7 decimal digits.
4779"^DD",64850002,64850002.01,2,"DT")
47803150601
4781"^DD",64850002,64850002.01,3,0)
4782MULT OF MULT^64850002.13A^^MM;0
4783"^DD",64850002,64850002.13,0)
4784MULT OF MULT SUB-FIELD^^2^2
4785"^DD",64850002,64850002.13,0,"DT")
47863150602
4787"^DD",64850002,64850002.13,0,"IX","B",64850002.13,.01)
4788
4789"^DD",64850002,64850002.13,0,"NM","MULT OF MULT")
4790
4791"^DD",64850002,64850002.13,0,"UP")
479264850002.01
4793"^DD",64850002,64850002.13,.01,0)
4794MULT OF MULT^F^^0;1^K:$L(X)>30!($L(X)<1) X
4795"^DD",64850002,64850002.13,.01,1,0)
4796^.1
4797"^DD",64850002,64850002.13,.01,1,1,0)
479864850002.13^B
4799"^DD",64850002,64850002.13,.01,1,1,1)
4800S ^DIZ(64850002,DA(2),"M",DA(1),"MM","B",$E(X,1,30),DA)=""
4801"^DD",64850002,64850002.13,.01,1,1,2)
4802K ^DIZ(64850002,DA(2),"M",DA(1),"MM","B",$E(X,1,30),DA)
4803"^DD",64850002,64850002.13,.01,3)
4804Answer must be 1-30 characters in length.
4805"^DD",64850002,64850002.13,.01,"DT")
48063150602
4807"^DD",64850002,64850002.13,2,0)
4808SFNOS^F^^0;2^K:$L(X)>30!($L(X)<1) X
4809"^DD",64850002,64850002.13,2,3)
4810Answer must be 1-30 characters in length.
4811"^DD",64850002,64850002.13,2,"DT")
48123150602
4813"^DD",64850003,64850003,0)
4814FIELD^^.05^3
4815"^DD",64850003,64850003,0,"DT")
48163160410
4817"^DD",64850003,64850003,0,"IX","B",64850003,.01)
4818
4819"^DD",64850003,64850003,0,"NM","FIELD GROUPS")
4820
4821"^DD",64850003,64850003,.01,0)
4822ABBREVIATION^RF^^0;1^K:$L(X)>30!($L(X)<1)!'(X'?1P.E) X
4823"^DD",64850003,64850003,.01,1,0)
4824^.1
4825"^DD",64850003,64850003,.01,1,1,0)
482664850003^B
4827"^DD",64850003,64850003,.01,1,1,1)
4828S ^DIZ(64850003,"B",$E(X,1,30),DA)=""
4829"^DD",64850003,64850003,.01,1,1,2)
4830K ^DIZ(64850003,"B",$E(X,1,30),DA)
4831"^DD",64850003,64850003,.01,3)
4832Answer must be 1-30 characters in length.
4833"^DD",64850003,64850003,.01,"DT")
48343160408
4835"^DD",64850003,64850003,.05,0)
4836FOR^F^^0;2^K:$L(X)>30!($L(X)<1) X
4837"^DD",64850003,64850003,.05,3)
4838
4839"^DD",64850003,64850003,.05,"DT")
48403160410
4841"^DD",64850003,64850003,2,0)
4842FIELD(S)^64850003.02^^F;0
4843"^DD",64850003,64850003.02,0)
4844FIELD(S) SUB-FIELD^^.01^1
4845"^DD",64850003,64850003.02,0,"DT")
48463160409
4847"^DD",64850003,64850003.02,0,"IX","B",64850003.02,.01)
4848
4849"^DD",64850003,64850003.02,0,"NM","FIELD(S)")
4850
4851"^DD",64850003,64850003.02,0,"UP")
485264850003
4853"^DD",64850003,64850003.02,.01,0)
4854FIELD(S)^MF^^0;1^K:$L(X)>30!($L(X)<1) X
4855"^DD",64850003,64850003.02,.01,1,0)
4856^.1
4857"^DD",64850003,64850003.02,.01,1,1,0)
485864850003.02^B
4859"^DD",64850003,64850003.02,.01,1,1,1)
4860S ^DIZ(64850003,DA(1),"F","B",$E(X,1,30),DA)=""
4861"^DD",64850003,64850003.02,.01,1,1,2)
4862K ^DIZ(64850003,DA(1),"F","B",$E(X,1,30),DA)
4863"^DD",64850003,64850003.02,.01,3)
4864Answer must be 1-30 characters in length.
4865"^DD",64850003,64850003.02,.01,"DT")
48663160409
4867"^DD",64850004,64850004,0)
4868FIELD^^.02^3
4869"^DD",64850004,64850004,0,"DDA")
4870N
4871"^DD",64850004,64850004,0,"DT")
48723160503
4873"^DD",64850004,64850004,0,"IX","B",64850004,.01)
4874
4875"^DD",64850004,64850004,0,"IX","C",64850004,.02)
4876
4877"^DD",64850004,64850004,0,"NM","VERBOTEN TEMPLATES")
4878
4879"^DD",64850004,64850004,.001,0)
4880NUMBER^NJ9,0^^ ^K:+X'=X!(X>999999999)!(X<0)!(X?.E1"."1N.N) X
4881"^DD",64850004,64850004,.001,3)
4882Type a number between 0 and 999999999, 0 decimal digits.
4883"^DD",64850004,64850004,.001,"DT")
48843160503
4885"^DD",64850004,64850004,.01,0)
4886TEMPLATE NAME^RF^^0;1^K:$L(X)>30!($L(X)<1)!'(X'?1P.E) X
4887"^DD",64850004,64850004,.01,1,0)
4888^.1
4889"^DD",64850004,64850004,.01,1,1,0)
489064850004^B
4891"^DD",64850004,64850004,.01,1,1,1)
4892S ^DIZ(64850004,"B",$E(X,1,30),DA)=""
4893"^DD",64850004,64850004,.01,1,1,2)
4894K ^DIZ(64850004,"B",$E(X,1,30),DA)
4895"^DD",64850004,64850004,.01,3)
4896Answer must be 1-30 characters in length.
4897"^DD",64850004,64850004,.01,10)
4898.402
4899"^DD",64850004,64850004,.01,20,0)
4900^.3LA^1^1
4901"^DD",64850004,64850004,.01,20,1,0)
4902TEMPLATE
4903"^DD",64850004,64850004,.01,21,0)
4904^^2^2^3160503^
4905"^DD",64850004,64850004,.01,21,1,0)
4906These are templates that are screen driven on the roll 'n scroll
4907"^DD",64850004,64850004,.01,21,2,0)
4908Fileman environ. The GUI by BFP for WorldVistA does not special navigation.
4909"^DD",64850004,64850004,.01,"DT")
49103160503
4911"^DD",64850004,64850004,.02,0)
4912IEN^NJ9,0^^0;2^K:+X'=X!(X>999999999)!(X<0)!(X?.E1"."1N.N) X
4913"^DD",64850004,64850004,.02,1,0)
4914^.1
4915"^DD",64850004,64850004,.02,1,1,0)
491664850004^C
4917"^DD",64850004,64850004,.02,1,1,1)
4918S ^DIZ(64850004,"C",$E(X,1,30),DA)=""
4919"^DD",64850004,64850004,.02,1,1,2)
4920K ^DIZ(64850004,"C",$E(X,1,30),DA)
4921"^DD",64850004,64850004,.02,1,1,"DT")
49223160503
4923"^DD",64850004,64850004,.02,3)
4924Type a number between 0 and 999999999, 0 decimal digits.
4925"^DD",64850004,64850004,.02,"DT")
49263160503
4927"^DIC",64850001,64850001,0)
4928PATIENT FILE FIELD EXCLUSIONS^64850001
4929"^DIC",64850001,64850001,0,"GL")
4930^DIZ(64850001,
4931"^DIC",64850001,64850001,"%",0)
4932^1.005^^0
4933"^DIC",64850001,64850001,"%D",0)
4934^^7^7^3150506^
4935"^DIC",64850001,64850001,"%D",1,0)
4936This is not quite a Fileman legal file, although it can be edited,
4937"^DIC",64850001,64850001,"%D",2,0)
4938preferrably by programmer access and direct code.
4939"^DIC",64850001,64850001,"%D",3,0)
4940The file contains patient file(#2) field numbers. These are fields that I
4941"^DIC",64850001,64850001,"%D",4,0)
4942arbitrarily consider VA specific fields and pretty much not applicable
4943"^DIC",64850001,64850001,"%D",5,0)
4944anywhere else.
4945"^DIC",64850001,64850001,"%D",6,0)
4946I know....how arrogant...
4947"^DIC",64850001,64850001,"%D",7,0)
4948jb
4949"^DIC",64850001,"B","PATIENT FILE FIELD EXCLUSIONS",64850001)
4950
4951"^DIC",64850002,64850002,0)
4952CIVILIAN PATIENT FIELDS^64850002
4953"^DIC",64850002,64850002,0,"GL")
4954^DIZ(64850002,
4955"^DIC",64850002,64850002,"%D",0)
4956^1.001^1^1^3150610^^
4957"^DIC",64850002,64850002,"%D",1,0)
4958Fields selected by the author that are considered to be non-VA mandates
4959"^DIC",64850002,"B","CIVILIAN PATIENT FIELDS",64850002)
4960
4961"^DIC",64850003,64850003,0)
4962FIELD GROUPS^64850003
4963"^DIC",64850003,64850003,0,"GL")
4964^DIZ(64850003,
4965"^DIC",64850003,"B","FIELD GROUPS",64850003)
4966
4967"^DIC",64850004,64850004,0)
4968VERBOTEN TEMPLATES^64850004
4969"^DIC",64850004,64850004,0,"GL")
4970^DIZ(64850004,
4971"^DIC",64850004,64850004,"%D",0)
4972^^3^3^3160503^
4973"^DIC",64850004,64850004,"%D",1,0)
4974These are templates that have navigation for the roll 'n scroll
4975"^DIC",64850004,64850004,"%D",2,0)
4976Fileman environ. The GUI Registation utility by BFP for World-
4977"^DIC",64850004,64850004,"%D",3,0)
4978vistA does not require navigation.
4979"^DIC",64850004,"B","VERBOTEN TEMPLATES",64850004)
4980
4981**END**
4982**END**
Note: See TracBrowser for help on using the repository browser.