source: ccr/trunk/kids/NHIN1_0.KID@ 1800

Last change on this file since 1800 was 1293, checked in by George Lilly, 13 years ago

added so people can find them.. the ccr package depends on these from the VA
File size: 89.5 KB
RevLine 
[1293]1KIDS Distribution saved on Oct 15, 2010@10:42:58
2NHIN 1.0
3**KIDS**:NHIN 1.0^
4
5**INSTALL NAME**
6NHIN 1.0
7"BLD",7491,0)
8NHIN 1.0^NATIONAL HEALTH INFO NETWORK^0^3101015^y
9"BLD",7491,4,0)
10^9.64PA^^
11"BLD",7491,6.3)
1214
13"BLD",7491,"ABPKG")
14n
15"BLD",7491,"INIT")
16POST^NHINPI
17"BLD",7491,"KRN",0)
18^9.67PA^779.2^20
19"BLD",7491,"KRN",.4,0)
20.4
21"BLD",7491,"KRN",.401,0)
22.401
23"BLD",7491,"KRN",.402,0)
24.402
25"BLD",7491,"KRN",.403,0)
26.403
27"BLD",7491,"KRN",.5,0)
28.5
29"BLD",7491,"KRN",.84,0)
30.84
31"BLD",7491,"KRN",3.6,0)
323.6
33"BLD",7491,"KRN",3.8,0)
343.8
35"BLD",7491,"KRN",9.2,0)
369.2
37"BLD",7491,"KRN",9.8,0)
389.8
39"BLD",7491,"KRN",9.8,"NM",0)
40^9.68A^12^11
41"BLD",7491,"KRN",9.8,"NM",1,0)
42NHINPI^^0^B313819
43"BLD",7491,"KRN",9.8,"NM",3,0)
44NHINV^^0^B13990789
45"BLD",7491,"KRN",9.8,"NM",4,0)
46NHINVART^^0^B28029452
47"BLD",7491,"KRN",9.8,"NM",5,0)
48NHINVIMM^^0^B8275429
49"BLD",7491,"KRN",9.8,"NM",6,0)
50NHINVIT^^0^B30108507
51"BLD",7491,"KRN",9.8,"NM",7,0)
52NHINVLR^^0^B23999856
53"BLD",7491,"KRN",9.8,"NM",8,0)
54NHINVPL^^0^B19630772
55"BLD",7491,"KRN",9.8,"NM",9,0)
56NHINVPS^^0^B13986678
57"BLD",7491,"KRN",9.8,"NM",10,0)
58NHINVPSI^^0^B32869468
59"BLD",7491,"KRN",9.8,"NM",11,0)
60NHINVPSO^^0^B66033397
61"BLD",7491,"KRN",9.8,"NM",12,0)
62NHINVPT^^0^B58401800
63"BLD",7491,"KRN",9.8,"NM","B","NHINPI",1)
64
65"BLD",7491,"KRN",9.8,"NM","B","NHINV",3)
66
67"BLD",7491,"KRN",9.8,"NM","B","NHINVART",4)
68
69"BLD",7491,"KRN",9.8,"NM","B","NHINVIMM",5)
70
71"BLD",7491,"KRN",9.8,"NM","B","NHINVIT",6)
72
73"BLD",7491,"KRN",9.8,"NM","B","NHINVLR",7)
74
75"BLD",7491,"KRN",9.8,"NM","B","NHINVPL",8)
76
77"BLD",7491,"KRN",9.8,"NM","B","NHINVPS",9)
78
79"BLD",7491,"KRN",9.8,"NM","B","NHINVPSI",10)
80
81"BLD",7491,"KRN",9.8,"NM","B","NHINVPSO",11)
82
83"BLD",7491,"KRN",9.8,"NM","B","NHINVPT",12)
84
85"BLD",7491,"KRN",19,0)
8619
87"BLD",7491,"KRN",19,"NM",0)
88^9.68A^1^1
89"BLD",7491,"KRN",19,"NM",1,0)
90NHIN APPLICATION PROXY^^0
91"BLD",7491,"KRN",19,"NM","B","NHIN APPLICATION PROXY",1)
92
93"BLD",7491,"KRN",19.1,0)
9419.1
95"BLD",7491,"KRN",19.1,"NM",0)
96^9.68A^^
97"BLD",7491,"KRN",101,0)
98101
99"BLD",7491,"KRN",409.61,0)
100409.61
101"BLD",7491,"KRN",771,0)
102771
103"BLD",7491,"KRN",779.2,0)
104779.2
105"BLD",7491,"KRN",870,0)
106870
107"BLD",7491,"KRN",8989.51,0)
1088989.51
109"BLD",7491,"KRN",8989.52,0)
1108989.52
111"BLD",7491,"KRN",8994,0)
1128994
113"BLD",7491,"KRN",8994,"NM",0)
114^9.68A^2^1
115"BLD",7491,"KRN",8994,"NM",2,0)
116NHIN GET VISTA DATA^^0
117"BLD",7491,"KRN",8994,"NM","B","NHIN GET VISTA DATA",2)
118
119"BLD",7491,"KRN","B",.4,.4)
120
121"BLD",7491,"KRN","B",.401,.401)
122
123"BLD",7491,"KRN","B",.402,.402)
124
125"BLD",7491,"KRN","B",.403,.403)
126
127"BLD",7491,"KRN","B",.5,.5)
128
129"BLD",7491,"KRN","B",.84,.84)
130
131"BLD",7491,"KRN","B",3.6,3.6)
132
133"BLD",7491,"KRN","B",3.8,3.8)
134
135"BLD",7491,"KRN","B",9.2,9.2)
136
137"BLD",7491,"KRN","B",9.8,9.8)
138
139"BLD",7491,"KRN","B",19,19)
140
141"BLD",7491,"KRN","B",19.1,19.1)
142
143"BLD",7491,"KRN","B",101,101)
144
145"BLD",7491,"KRN","B",409.61,409.61)
146
147"BLD",7491,"KRN","B",771,771)
148
149"BLD",7491,"KRN","B",779.2,779.2)
150
151"BLD",7491,"KRN","B",870,870)
152
153"BLD",7491,"KRN","B",8989.51,8989.51)
154
155"BLD",7491,"KRN","B",8989.52,8989.52)
156
157"BLD",7491,"KRN","B",8994,8994)
158
159"BLD",7491,"QUES",0)
160^9.62^^
161"BLD",7491,"REQB",0)
162^9.611^^
163"INIT")
164POST^NHINPI
165"KRN",19,10580,-1)
1660^1
167"KRN",19,10580,0)
168NHIN APPLICATION PROXY^Nhin Application Proxy^^B^^^^^^^^
169"KRN",19,10580,1,0)
170^19.06^3^3^3091201^^^
171"KRN",19,10580,1,1,0)
172This option allows the NHIN connector proxy access to the VistA system.
173"KRN",19,10580,1,2,0)
174
175"KRN",19,10580,1,3,0)
176
177"KRN",19,10580,"RPC",0)
178^19.05P^2^1
179"KRN",19,10580,"RPC",2,0)
180NHIN GET VISTA DATA
181"KRN",19,10580,"U")
182NHIN APPLICATION PROXY
183"KRN",8994,3140,-1)
1840^2
185"KRN",8994,3140,0)
186NHIN GET VISTA DATA^GET^NHINV^4^S^^^1^^^1
187"KRN",8994,3140,1,0)
188^8994.01^2^2^3100329^^^
189"KRN",8994,3140,1,1,0)
190This RPC retrieves the requested data from VistA, and returns it in
191"KRN",8994,3140,1,2,0)
192^TMP($J,"NHINV",n) as XML.
193"KRN",8994,3140,2,0)
194^8994.02A^6^6
195"KRN",8994,3140,2,1,0)
196DFN^1^20^1^1
197"KRN",8994,3140,2,1,1,0)
198^8994.021^2^2^3100203^^
199"KRN",8994,3140,2,1,1,1,0)
200Internal entry number from Patient file #2
201"KRN",8994,3140,2,1,1,2,0)
202[optionally DFN;ICN for remote calls]
203"KRN",8994,3140,2,2,0)
204TYPE^1^100^0^2
205"KRN",8994,3140,2,2,1,0)
206^8994.021^3^3^3100203^^
207"KRN",8994,3140,2,2,1,1,0)
208The kind(s) of data to return, which may include:
209"KRN",8994,3140,2,2,1,2,0)
210 patient;allergy;problem;vital;lab;med;xray;
211"KRN",8994,3140,2,2,1,3,0)
212 consult;procedure;surgery;document;encounter
213"KRN",8994,3140,2,3,0)
214START^1^20^0^3
215"KRN",8994,3140,2,3,1,0)
216^8994.021^1^1^3100203^^
217"KRN",8994,3140,2,3,1,1,0)
218The date/time from which to begin searching for data [optional].
219"KRN",8994,3140,2,4,0)
220STOP^1^20^0^4
221"KRN",8994,3140,2,4,1,0)
222^8994.021^1^1^3100203^^
223"KRN",8994,3140,2,4,1,1,0)
224The date/time at which to end searching for data [optional].
225"KRN",8994,3140,2,5,0)
226MAX^1^7^0^5
227"KRN",8994,3140,2,5,1,0)
228^8994.021^1^1^3100203^^
229"KRN",8994,3140,2,5,1,1,0)
230The maximum number of items to return per data type [optional].
231"KRN",8994,3140,2,6,0)
232ITEM^1^30^0^6
233"KRN",8994,3140,2,6,1,0)
234^8994.021^2^2^3100329^^^
235"KRN",8994,3140,2,6,1,1,0)
236The identifier of a single item to return [optional, but TYPE must
237"KRN",8994,3140,2,6,1,2,0)
238also be defined when used].
239"KRN",8994,3140,2,"B","DFN",1)
240
241"KRN",8994,3140,2,"B","ITEM",6)
242
243"KRN",8994,3140,2,"B","MAX",5)
244
245"KRN",8994,3140,2,"B","START",3)
246
247"KRN",8994,3140,2,"B","STOP",4)
248
249"KRN",8994,3140,2,"B","TYPE",2)
250
251"KRN",8994,3140,2,"PARAMSEQ",1,1)
252
253"KRN",8994,3140,2,"PARAMSEQ",2,2)
254
255"KRN",8994,3140,2,"PARAMSEQ",3,3)
256
257"KRN",8994,3140,2,"PARAMSEQ",4,4)
258
259"KRN",8994,3140,2,"PARAMSEQ",5,5)
260
261"KRN",8994,3140,2,"PARAMSEQ",6,6)
262
263"KRN",8994,3140,3,0)
264^8994.03^1^1^3100329^^^^
265"KRN",8994,3140,3,1,0)
266Text array formatted as XML
267"MBREQ")
2680
269"ORD",16,8994)
2708994;16;1;;;;;;;RPCDEL^XPDIA1
271"ORD",16,8994,0)
272REMOTE PROCEDURE
273"ORD",18,19)
27419;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA
275"ORD",18,19,0)
276OPTION
277"PKG",407,-1)
2781^1
279"PKG",407,0)
280NATIONAL HEALTH INFO NETWORK^NHIN^NATIONAL HEALTH INFORMATION NETWORK ADAPTER
281"PKG",407,1,0)
282^^22^22^3091217^
283"PKG",407,1,1,0)
284VA's NHIN product supports the VA's business initiatives for
285"PKG",407,1,2,0)
286the increased exchange of health information between VA and
287"PKG",407,1,3,0)
288non-VA providers (other government and private sector health
289"PKG",407,1,4,0)
290organizations) that are providing care to veterans because
291"PKG",407,1,5,0)
292it is estimated that 3 out of 4 veterans receive care from
293"PKG",407,1,6,0)
294non-VA providers.
295"PKG",407,1,7,0)
296
297"PKG",407,1,8,0)
298The VA NHIN system provides VistaWeb with access to the
299"PKG",407,1,9,0)
300available patient medical information provided by the NHIN.
301"PKG",407,1,10,0)
302The VA NHIN system will access the VA MPI to retrieve
303"PKG",407,1,11,0)
304patient demographics and the VA Vista(s) to retrieve patient
305"PKG",407,1,12,0)
306medical information. Version 1.0 of the NHIN supports these
307"PKG",407,1,13,0)
308medical domains: Patient Problem List Patient Allergies
309"PKG",407,1,14,0)
310Patient Medications (Pharmacy All Out-Patient Pharmacy).
311"PKG",407,1,15,0)
312
313"PKG",407,1,16,0)
314The VA NHIN system accesses this information in the form of
315"PKG",407,1,17,0)
316a HITSP CCD or (C32) Continuity of Care Document.
317"PKG",407,1,18,0)
318
319"PKG",407,1,19,0)
320The VA NHIN also provides the VA ROI office with support for
321"PKG",407,1,20,0)
322the patient authorizations process with a web page for the
323"PKG",407,1,21,0)
324Consumer Preferences and Policy Management System.
325"PKG",407,1,22,0)
326
327"PKG",407,5)
328SLC
329"PKG",407,7)
330^^I
331"PKG",407,20,0)
332^9.402P^^
333"PKG",407,22,0)
334^9.49I^1^1
335"PKG",407,22,1,0)
3361.0^3101015
337"PKG",407,"DEV")
338PULEO/SLC
339"PKG",407,"VERSION")
3401.0
341"QUES","XPF1",0)
342Y
343"QUES","XPF1","??")
344^D REP^XPDH
345"QUES","XPF1","A")
346Shall I write over your |FLAG| File
347"QUES","XPF1","B")
348YES
349"QUES","XPF1","M")
350D XPF1^XPDIQ
351"QUES","XPF2",0)
352Y
353"QUES","XPF2","??")
354^D DTA^XPDH
355"QUES","XPF2","A")
356Want my data |FLAG| yours
357"QUES","XPF2","B")
358YES
359"QUES","XPF2","M")
360D XPF2^XPDIQ
361"QUES","XPI1",0)
362YO
363"QUES","XPI1","??")
364^D INHIBIT^XPDH
365"QUES","XPI1","A")
366Want KIDS to INHIBIT LOGONs during the install
367"QUES","XPI1","B")
368NO
369"QUES","XPI1","M")
370D XPI1^XPDIQ
371"QUES","XPM1",0)
372PO^VA(200,:EM
373"QUES","XPM1","??")
374^D MG^XPDH
375"QUES","XPM1","A")
376Enter the Coordinator for Mail Group '|FLAG|'
377"QUES","XPM1","B")
378
379"QUES","XPM1","M")
380D XPM1^XPDIQ
381"QUES","XPO1",0)
382Y
383"QUES","XPO1","??")
384^D MENU^XPDH
385"QUES","XPO1","A")
386Want KIDS to Rebuild Menu Trees Upon Completion of Install
387"QUES","XPO1","B")
388NO
389"QUES","XPO1","M")
390D XPO1^XPDIQ
391"QUES","XPZ1",0)
392Y
393"QUES","XPZ1","??")
394^D OPT^XPDH
395"QUES","XPZ1","A")
396Want to DISABLE Scheduled Options, Menu Options, and Protocols
397"QUES","XPZ1","B")
398NO
399"QUES","XPZ1","M")
400D XPZ1^XPDIQ
401"QUES","XPZ2",0)
402Y
403"QUES","XPZ2","??")
404^D RTN^XPDH
405"QUES","XPZ2","A")
406Want to MOVE routines to other CPUs
407"QUES","XPZ2","B")
408NO
409"QUES","XPZ2","M")
410D XPZ2^XPDIQ
411"RTN")
41211
413"RTN","NHINPI")
4140^1^B313819
415"RTN","NHINPI",1,0)
416NHINPI ; SLC/AGP - NHIN package post install ; 12/01/2009
417"RTN","NHINPI",2,0)
418 ;;1.0;NHIN;;Oct 25, 2010;Build 14
419"RTN","NHINPI",3,0)
420 ;
421"RTN","NHINPI",4,0)
422POST ;
423"RTN","NHINPI",5,0)
424 ; Create proxy user
425"RTN","NHINPI",6,0)
426 Q:$O(^VA(200,"B","NHIN,APPLICATION PROXY",0))
427"RTN","NHINPI",7,0)
428 N X
429"RTN","NHINPI",8,0)
430 S X=$$CREATE^XUSAP("NHIN,APPLICATION PROXY","","NHIN APPLICATION PROXY")
431"RTN","NHINPI",9,0)
432 Q
433"RTN","NHINPI",10,0)
434 ;
435"RTN","NHINV")
4360^3^B13990789
437"RTN","NHINV",1,0)
438NHINV ;SLC/MKB - Serve VistA data as XML via RPC
439"RTN","NHINV",2,0)
440 ;;1.0;NHIN;;Oct 25, 2010;Build 14
441"RTN","NHINV",3,0)
442 ;
443"RTN","NHINV",4,0)
444 ; External References DBIA#
445"RTN","NHINV",5,0)
446 ; ------------------- -----
447"RTN","NHINV",6,0)
448 ; ^DPT 10035
449"RTN","NHINV",7,0)
450 ; ^SC 10040
451"RTN","NHINV",8,0)
452 ; DIQ 2056
453"RTN","NHINV",9,0)
454 ; MPIF001 2701
455"RTN","NHINV",10,0)
456 ; VASITE 10112
457"RTN","NHINV",11,0)
458 ; XLFDT 10103
459"RTN","NHINV",12,0)
460 ; XLFSTR 10104
461"RTN","NHINV",13,0)
462 ; XUAF4 2171
463"RTN","NHINV",14,0)
464 ;
465"RTN","NHINV",15,0)
466GET(NHIN,DFN,TYPE,START,STOP,MAX,ID) ; -- Return search results as XML in @NHIN@(n)
467"RTN","NHINV",16,0)
468 ; RPC = NHIN GET VISTA DATA
469"RTN","NHINV",17,0)
470 N ICN,NHINI
471"RTN","NHINV",18,0)
472 S NHIN=$NA(^TMP($J,"NHINV")) K @NHIN
473"RTN","NHINV",19,0)
474 ;
475"RTN","NHINV",20,0)
476 ; parse & validate input parameters
477"RTN","NHINV",21,0)
478 S ICN=+$P(DFN,";",2),DFN=+$G(DFN)
479"RTN","NHINV",22,0)
480 I 'DFN S DFN=+$$GETDFN^MPIF001(ICN)
481"RTN","NHINV",23,0)
482 I DFN<1!'$D(^DPT(DFN)) D ERR(1,DFN) G GTQ
483"RTN","NHINV",24,0)
484 S TYPE=$G(TYPE) I TYPE="" S TYPE=$$ALL
485"RTN","NHINV",25,0)
486 S START=$G(START),STOP=$G(STOP),MAX=$G(MAX),ID=$G(ID)
487"RTN","NHINV",26,0)
488 S:'START START=1410101 S:'STOP STOP=9999998 S:'MAX MAX=999999
489"RTN","NHINV",27,0)
490 I START,STOP,STOP<START N X S X=START,START=STOP,STOP=X ;switch
491"RTN","NHINV",28,0)
492 I STOP,$L(STOP,".")<2 S STOP=STOP_".24"
493"RTN","NHINV",29,0)
494 ;
495"RTN","NHINV",30,0)
496 ; extract data
497"RTN","NHINV",31,0)
498 N NHINTYPE,NHINP,RTN
499"RTN","NHINV",32,0)
500 S NHINTYPE=TYPE D ADD("<results>")
501"RTN","NHINV",33,0)
502 F NHINP=1:1:$L(NHINTYPE,";") S TYPE=$P(NHINTYPE,";",NHINP) I $L(TYPE) D
503"RTN","NHINV",34,0)
504 . S RTN="EN^"_$$RTN(TYPE) Q:'$L($T(@RTN)) ;D ERR(2) Q
505"RTN","NHINV",35,0)
506 . D @(RTN_"(DFN,START,STOP,MAX,ID)")
507"RTN","NHINV",36,0)
508 D ADD("</results>")
509"RTN","NHINV",37,0)
510 ;
511"RTN","NHINV",38,0)
512GTQ ; end
513"RTN","NHINV",39,0)
514 Q
515"RTN","NHINV",40,0)
516 ;
517"RTN","NHINV",41,0)
518UPD(DFN,TYPE,ID) ; -- send message that TYPE/ID has been updated
519"RTN","NHINV",42,0)
520 Q
521"RTN","NHINV",43,0)
522 ;
523"RTN","NHINV",44,0)
524RTN(X) ; -- Return name of NHINVxxx routine for clinical type X
525"RTN","NHINV",45,0)
526 S X=$$UP^XLFSTR(X),Y=""
527"RTN","NHINV",46,0)
528 I X="ALLERGY" S Y="NHINVART"
529"RTN","NHINV",47,0)
530 I X="CONSULT" S Y="NHINVCON"
531"RTN","NHINV",48,0)
532 I X="DOCUMENT" S Y="NHINVTIU"
533"RTN","NHINV",49,0)
534 I X="IMMUNIZATION" S Y="NHINVIMM"
535"RTN","NHINV",50,0)
536 I X="LAB" S Y="NHINVLR"
537"RTN","NHINV",51,0)
538 I X="MED" S Y="NHINVPS"
539"RTN","NHINV",52,0)
540 I X="RX" S Y="NHINVPSO"
541"RTN","NHINV",53,0)
542 I X="ORDER" S Y="NHINVOR"
543"RTN","NHINV",54,0)
544 I X="PATIENT" S Y="NHINVPT"
545"RTN","NHINV",55,0)
546 I X="PROBLEM" S Y="NHINVPL"
547"RTN","NHINV",56,0)
548 I X="PROCEDURE" S Y="NHINVMC"
549"RTN","NHINV",57,0)
550 I X="SURGERY" S Y="NHINVSR"
551"RTN","NHINV",58,0)
552 I X="VISIT" S Y="NHINVSIT"
553"RTN","NHINV",59,0)
554 ; X="VISITDATA" S Y="NHINVPCE"
555"RTN","NHINV",60,0)
556 I X="VITAL" S Y="NHINVIT"
557"RTN","NHINV",61,0)
558 I X="XRAY" S Y="NHINVRA"
559"RTN","NHINV",62,0)
560 Q Y
561"RTN","NHINV",63,0)
562 ;
563"RTN","NHINV",64,0)
564ALL() ; -- return string for all types of data
565"RTN","NHINV",65,0)
566 Q "patient;allergy;problem;vital;lab;med;immunization;visit;document"
567"RTN","NHINV",66,0)
568 ;
569"RTN","NHINV",67,0)
570ERR(X,VAL) ; -- return error message
571"RTN","NHINV",68,0)
572 N MSG
573"RTN","NHINV",69,0)
574 I X=1 S MSG="Patient with dfn '"_$G(VAL)_"' not found"
575"RTN","NHINV",70,0)
576 I X=2 S MSG="Requested data type '"_$G(VAL)_"' not found"
577"RTN","NHINV",71,0)
578 I X=99 S MSG="Unknown request"
579"RTN","NHINV",72,0)
580 ;
581"RTN","NHINV",73,0)
582 D ADD("<error>")
583"RTN","NHINV",74,0)
584 D ADD("<message>"_MSG_"</message>")
585"RTN","NHINV",75,0)
586 D ADD("</error>")
587"RTN","NHINV",76,0)
588 Q
589"RTN","NHINV",77,0)
590 ;
591"RTN","NHINV",78,0)
592ESC(X) ; -- escape outgoing XML
593"RTN","NHINV",79,0)
594 ; Q $ZCONVERT(X,"O","HTML") ; uncomment for fastest performance on Cache
595"RTN","NHINV",80,0)
596 ;
597"RTN","NHINV",81,0)
598 N I,Y,QOT S QOT=""""
599"RTN","NHINV",82,0)
600 S Y=$P(X,"&") F I=2:1:$L(X,"&") S Y=Y_"&amp;"_$P(X,"&",I)
601"RTN","NHINV",83,0)
602 S X=Y,Y=$P(X,"<") F I=2:1:$L(X,"<") S Y=Y_"&lt;"_$P(X,"<",I)
603"RTN","NHINV",84,0)
604 S X=Y,Y=$P(X,">") F I=2:1:$L(X,">") S Y=Y_"&gt;"_$P(X,">",I)
605"RTN","NHINV",85,0)
606 S X=Y,Y=$P(X,"'") F I=2:1:$L(X,"'") S Y=Y_"&apos;"_$P(X,"'",I)
607"RTN","NHINV",86,0)
608 S X=Y,Y=$P(X,QOT) F I=2:1:$L(X,QOT) S Y=Y_"&quot;"_$P(X,QOT,I)
609"RTN","NHINV",87,0)
610 Q Y
611"RTN","NHINV",88,0)
612 ;
613"RTN","NHINV",89,0)
614ADD(X) ; Add a line @NHIN@(n)=X
615"RTN","NHINV",90,0)
616 S NHINI=$G(NHINI)+1
617"RTN","NHINV",91,0)
618 S @NHIN@(NHINI)=X
619"RTN","NHINV",92,0)
620 Q
621"RTN","NHINV",93,0)
622 ;
623"RTN","NHINV",94,0)
624STRING(ARRAY) ; -- Return text in ARRAY(n) or ARRAY(n,0) as a string
625"RTN","NHINV",95,0)
626 N I,X,Y S Y=""
627"RTN","NHINV",96,0)
628 S I=+$O(ARRAY("")) I I=0 S I=+$O(ARRAY(0))
629"RTN","NHINV",97,0)
630 S Y=$S($D(ARRAY(I,0)):ARRAY(I,0),1:$G(ARRAY(I)))
631"RTN","NHINV",98,0)
632 F S I=$O(ARRAY(I)) Q:I<1 D
633"RTN","NHINV",99,0)
634 . S X=$S($D(ARRAY(I,0)):ARRAY(I,0),1:ARRAY(I))
635"RTN","NHINV",100,0)
636 . S Y=Y_$C(13,10)_X
637"RTN","NHINV",101,0)
638 Q Y
639"RTN","NHINV",102,0)
640 ;
641"RTN","NHINV",103,0)
642FAC(X) ; -- return Institution file station# for location X
643"RTN","NHINV",104,0)
644 N HLOC,FAC,Y0,Y S Y=""
645"RTN","NHINV",105,0)
646 S HLOC=$G(^SC(+$G(X),0)),FAC=$P(HLOC,U,4) ;Institution ien
647"RTN","NHINV",106,0)
648 ; Get P4 via Med Ctr Div, if not directly linked
649"RTN","NHINV",107,0)
650 I 'FAC,$P(HLOC,U,15) S FAC=$$GET1^DIQ(40.8,+$P(HLOC,U,15)_",",.07,"I")
651"RTN","NHINV",108,0)
652 S Y0=$S(FAC:$$NS^XUAF4(FAC),1:$P($$SITE^VASITE,U,2,3)) ;name^stn#
653"RTN","NHINV",109,0)
654 S:$L(Y0) Y=$P(Y0,U,2)_U_$P(Y0,U) ;switch to stn#^name
655"RTN","NHINV",110,0)
656 I $L(Y),'Y S $P(Y,U)=FAC
657"RTN","NHINV",111,0)
658 Q Y
659"RTN","NHINV",112,0)
660 ;
661"RTN","NHINV",113,0)
662VUID(IEN,FILE) ; -- Return VUID for item
663"RTN","NHINV",114,0)
664 Q $$GET1^DIQ(FILE,IEN_",",99.99)
665"RTN","NHINVART")
6660^4^B28029452
667"RTN","NHINVART",1,0)
668NHINVART ;SLC/MKB -- Allergy/Reaction extract
669"RTN","NHINVART",2,0)
670 ;;1.0;NHIN;;Oct 25, 2010;Build 14
671"RTN","NHINVART",3,0)
672 ;
673"RTN","NHINVART",4,0)
674 ; External References DBIA#
675"RTN","NHINVART",5,0)
676 ; ------------------- -----
677"RTN","NHINVART",6,0)
678 ; %DT 10003
679"RTN","NHINVART",7,0)
680 ; GMRADPT 10099
681"RTN","NHINVART",8,0)
682 ; EN1^GMRAOR2 2422
683"RTN","NHINVART",9,0)
684 ; PSN50P41 4531
685"RTN","NHINVART",10,0)
686 ; PSN50P65 4543
687"RTN","NHINVART",11,0)
688 ;
689"RTN","NHINVART",12,0)
690 ; ------------ Get reactions from VistA ------------
691"RTN","NHINVART",13,0)
692 ;
693"RTN","NHINVART",14,0)
694EN(DFN,BEG,END,MAX,IFN) ; -- find patient's allergies/reactions
695"RTN","NHINVART",15,0)
696 N GMRA,GMRAL,NHI,NHITM,NHICNT
697"RTN","NHINVART",16,0)
698 S DFN=+$G(DFN) Q:DFN<1
699"RTN","NHINVART",17,0)
700 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999),NHICNT=0
701"RTN","NHINVART",18,0)
702 D EN1^GMRADPT
703"RTN","NHINVART",19,0)
704 ;
705"RTN","NHINVART",20,0)
706 ; get one reaction
707"RTN","NHINVART",21,0)
708 I $G(IFN) D EN1(IFN,.NHITM),XML(.NHITM) Q
709"RTN","NHINVART",22,0)
710 ;
711"RTN","NHINVART",23,0)
712 ; get all reactions
713"RTN","NHINVART",24,0)
714 I 'GMRAL S NHITM("assessment")=$S(GMRAL=0:"nka",1:"not done") D XML(.NHITM) Q
715"RTN","NHINVART",25,0)
716 S NHI=0 F S NHI=+$O(GMRAL(NHI)) Q:NHI<1 D Q:NHICNT'<MAX
717"RTN","NHINVART",26,0)
718 . K NHITM D EN1(NHI,.NHITM) Q:'$D(NHITM)
719"RTN","NHINVART",27,0)
720 . D XML(.NHITM) S NHICNT=NHICNT+1
721"RTN","NHINVART",28,0)
722 Q
723"RTN","NHINVART",29,0)
724 ;
725"RTN","NHINVART",30,0)
726EN1(ID,REAC) ; -- return a reaction in REAC("attribute")=value
727"RTN","NHINVART",31,0)
728 ; from EN: expects GMRAL(ID)
729"RTN","NHINVART",32,0)
730 N NHY,GMRA,I,J,X,Y,SEV,TXT,SYMP,NM,SEV K REAC
731"RTN","NHINVART",33,0)
732 S GMRA=$G(GMRAL(ID)) D EN1^GMRAOR2(ID,"NHY")
733"RTN","NHINVART",34,0)
734 S X=$P(NHY,U,10) I $L(X) S X=$$DATE(X) Q:X<BEG Q:X>END S REAC("entered")=X
735"RTN","NHINVART",35,0)
736 S REAC("facility")=$$FAC^NHINV ;local stn#^name
737"RTN","NHINVART",36,0)
738 S REAC("id")=ID,REAC("name")=$P(GMRA,U,2) D
739"RTN","NHINVART",37,0)
740 . S X=$P(GMRA,U,9),Y=+$P(X,"(",2) I 'Y,X["PSDRUG" S Y=50
741"RTN","NHINVART",38,0)
742 . S REAC("localCode")=X,REAC("vuid")=$$VUID^NHINV(+X,Y)
743"RTN","NHINVART",39,0)
744 ;S X=$P(GMRA,U,8) S:$L(X) REAC("mechanism")=$P(X,";")
745"RTN","NHINVART",40,0)
746 S X=$P(NHY,U,5),REAC("source")=$E(X)
747"RTN","NHINVART",41,0)
748 S REAC("adverseEventType")=$P(GMRA,U,7)
749"RTN","NHINVART",42,0)
750 I $P(GMRA,U,4),$P(NHY,U,9) S REAC("verified")=$P(NHY,U,9)
751"RTN","NHINVART",43,0)
752 S I=0,SEV="" F S I=$O(NHY("O",I)) Q:I<1 S X=$P(NHY("O",I),U,2) S:X]SEV SEV=X ;find highest severity
753"RTN","NHINVART",44,0)
754 S:$L(SEV) REAC("severity")=SEV
755"RTN","NHINVART",45,0)
756 ; reactions [index first]
757"RTN","NHINVART",46,0)
758 S I=0 F S I=$O(GMRAL(ID,"S",I)) Q:I<1 S X=$G(GMRAL(ID,"S",I)),Y=+$P(X,";",2),SYMP($P(X,";"))=Y
759"RTN","NHINVART",47,0)
760 S I=0 F S I=$O(NHY("S",I)) Q:I<1 D
761"RTN","NHINVART",48,0)
762 . S X=NHY("S",I),NM=$P(X," ("),Y=+$G(SYMP(NM))
763"RTN","NHINVART",49,0)
764 . S REAC("reaction",I)=NM_U_$$VUID^NHINV(Y,120.83)
765"RTN","NHINVART",50,0)
766 ; comments
767"RTN","NHINVART",51,0)
768 S I=0 F S I=$O(NHY("C",I)) Q:I<1 D
769"RTN","NHINVART",52,0)
770 . S X=$G(NHY("C",I)) K TXT
771"RTN","NHINVART",53,0)
772 . S Y=$$VA200($P(X,U,3))_U_$P(X,U)
773"RTN","NHINVART",54,0)
774 . S Y=Y_U_$S($L($P(X,U,2)):$E($P(X,U,2)),1:"E")
775"RTN","NHINVART",55,0)
776 . S J=0 F S J=$O(NHY("C",I,J)) Q:J<1 S X=$G(NHY("C",I,J,0)),TXT(J)=X
777"RTN","NHINVART",56,0)
778 . K X S X=$$STRING^NHINV(.TXT)
779"RTN","NHINVART",57,0)
780 . S REAC("comment",I)=Y_U_X ;ien^name^date^type^text
781"RTN","NHINVART",58,0)
782 ; drug info
783"RTN","NHINVART",59,0)
784 I $D(NHY("I")) D
785"RTN","NHINVART",60,0)
786 . N ROOT S ROOT=$$B^PSN50P41
787"RTN","NHINVART",61,0)
788 . S I=0 F S I=$O(NHY("I",I)) Q:I<1 S X=$G(NHY("I",I)) D
789"RTN","NHINVART",62,0)
790 .. N IEN S IEN=$O(@ROOT@(X,0))
791"RTN","NHINVART",63,0)
792 .. S REAC("drugIngredient",I)=X_U_$$VUID^NHINV(IEN,50.416)
793"RTN","NHINVART",64,0)
794 I $D(NHY("V")) D
795"RTN","NHINVART",65,0)
796 . S I=0 F S I=$O(NHY("V",I)) Q:I<1 S X=$G(NHY("V",I)) D
797"RTN","NHINVART",66,0)
798 .. D C^PSN50P65("",$P(X,U,2),"PSN")
799"RTN","NHINVART",67,0)
800 .. N IEN S IEN=+$O(^TMP($J,"PSN","C",$P(X,U),0))
801"RTN","NHINVART",68,0)
802 .. S REAC("drugClass",I)=$P(X,U,2)_U_$$VUID^NHINV(IEN,50.605)
803"RTN","NHINVART",69,0)
804 Q
805"RTN","NHINVART",70,0)
806 ;
807"RTN","NHINVART",71,0)
808VA200(NAME) ; -- Return ien^name from #200
809"RTN","NHINVART",72,0)
810 N Y S NAME=$G(NAME),Y="^"
811"RTN","NHINVART",73,0)
812 I $L(NAME) S Y=+$O(^VA(200,"B",NAME,0))_U_NAME
813"RTN","NHINVART",74,0)
814 Q Y
815"RTN","NHINVART",75,0)
816 ;
817"RTN","NHINVART",76,0)
818DATE(X) ; -- Return internal form of date X
819"RTN","NHINVART",77,0)
820 N %DT,Y
821"RTN","NHINVART",78,0)
822 S %DT="TX" D ^%DT
823"RTN","NHINVART",79,0)
824 Q Y
825"RTN","NHINVART",80,0)
826 ;
827"RTN","NHINVART",81,0)
828 ; ------------ Return data to middle tier ------------
829"RTN","NHINVART",82,0)
830 ;
831"RTN","NHINVART",83,0)
832XML(REAC) ; -- Return patient reaction as XML
833"RTN","NHINVART",84,0)
834 ; as <element code='123' displayName='ABC' />
835"RTN","NHINVART",85,0)
836 N ATT,X,Y,I,P,NM,TAG
837"RTN","NHINVART",86,0)
838 D ADD("<allergy>")
839"RTN","NHINVART",87,0)
840 S ATT="" F S ATT=$O(REAC(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
841"RTN","NHINVART",88,0)
842 . I ATT="comment" D S Y="" Q
843"RTN","NHINVART",89,0)
844 .. S I=0,Y="<comments>" D ADD(Y)
845"RTN","NHINVART",90,0)
846 .. F S I=$O(REAC(ATT,I)) Q:I<1 S X=$G(REAC(ATT,I)) D
847"RTN","NHINVART",91,0)
848 ... S Y="<comment id='"_I
849"RTN","NHINVART",92,0)
850 ... S:$L($P(X,U,3)) Y=Y_"' entered='"_$P(X,U,3)
851"RTN","NHINVART",93,0)
852 ... S:$L($P(X,U,2)) Y=Y_"' enteredBy='"_$$ESC^NHINV($P(X,U,2))
853"RTN","NHINVART",94,0)
854 ... S:$L($P(X,U,4)) Y=Y_"' commentType='"_$P(X,U,4)
855"RTN","NHINVART",95,0)
856 ... S:$L($P(X,U,5)) Y=Y_"' commentText='"_$$ESC^NHINV($P(X,U,5))
857"RTN","NHINVART",96,0)
858 ... S Y=Y_"' />" D ADD(Y)
859"RTN","NHINVART",97,0)
860 .. D ADD("</comments>")
861"RTN","NHINVART",98,0)
862 . I $O(REAC(ATT,0)) D S Y="" Q
863"RTN","NHINVART",99,0)
864 .. S NM=ATT_$S($E(ATT,$L(ATT))="s":"es",1:"s") D ADD("<"_NM_">")
865"RTN","NHINVART",100,0)
866 .. S I=0 F S I=$O(REAC(ATT,I)) Q:I<1 D
867"RTN","NHINVART",101,0)
868 ... S X=$G(REAC(ATT,I)),Y="<"_ATT_" "
869"RTN","NHINVART",102,0)
870 ... F P=1:1 S TAG=$P("name^vuid^severity^Z",U,P) Q:TAG="Z" I $L($P(X,U,P)) S Y=Y_TAG_"='"_$$ESC^NHINV($P(X,U,P))_"' "
871"RTN","NHINVART",103,0)
872 ... S Y=Y_"/>" D ADD(Y)
873"RTN","NHINVART",104,0)
874 .. D ADD("</"_NM_">")
875"RTN","NHINVART",105,0)
876 . S X=$G(REAC(ATT)),Y="" Q:'$L(X)
877"RTN","NHINVART",106,0)
878 . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
879"RTN","NHINVART",107,0)
880 . I $L(X)>1 D S Y=""
881"RTN","NHINVART",108,0)
882 .. S Y="<"_ATT_" "
883"RTN","NHINVART",109,0)
884 .. F P=1:1 S TAG=$P("code^name^Z",U,P) Q:TAG="Z" I $L($P(X,U,P)) S Y=Y_TAG_"='"_$$ESC^NHINV($P(X,U,P))_"' "
885"RTN","NHINVART",110,0)
886 .. S Y=Y_"/>" D ADD(Y)
887"RTN","NHINVART",111,0)
888 D ADD("</allergy>")
889"RTN","NHINVART",112,0)
890 Q
891"RTN","NHINVART",113,0)
892 ;
893"RTN","NHINVART",114,0)
894ADD(X) ; Add a line @NHIN@(n)=X
895"RTN","NHINVART",115,0)
896 S NHINI=$G(NHINI)+1
897"RTN","NHINVART",116,0)
898 S @NHIN@(NHINI)=X
899"RTN","NHINVART",117,0)
900 Q
901"RTN","NHINVART",118,0)
902 ;
903"RTN","NHINVART",119,0)
904C32(REAC) ; -- convert iens to C32 codes
905"RTN","NHINVART",120,0)
906 N X,Y,I
907"RTN","NHINVART",121,0)
908 S X=$G(REAC("product")) I X S $P(REAC("product"),U)=$$VUID^NHINV(+X,120.82)
909"RTN","NHINVART",122,0)
910 S X=$P($G(REAC("type")),U),Y=$P($G(REAC("mechanism")),U)
911"RTN","NHINVART",123,0)
912 I $L(X) D S $P(REAC("type"),U)=I
913"RTN","NHINVART",124,0)
914 . I Y="A" S I=$S(X["D":416098002,X["F":414285001,1:419199007) Q
915"RTN","NHINVART",125,0)
916 . I Y="P" S I=$S(X["D":59037007,X["F":235719002,1:420134006) Q
917"RTN","NHINVART",126,0)
918 . S I=$S(X["D":419511003,X["F":418471000,1:418038007)
919"RTN","NHINVART",127,0)
920 S X=+$G(REAC("severity")) I X D
921"RTN","NHINVART",128,0)
922 . S X=$S(X=1:255604002,X=2:6736007,X=3:24484000,1:X)
923"RTN","NHINVART",129,0)
924 . S $P(REAC("severity"),U)=X
925"RTN","NHINVART",130,0)
926 S I=0 F S I=$O(REAC("reaction",I)) Q:I<1 D
927"RTN","NHINVART",131,0)
928 . S X=$G(REAC("reaction",I)) Q:'X
929"RTN","NHINVART",132,0)
930 . S $P(REAC("reaction",I),U)=$$VUID^NHINV(+X,120.83)
931"RTN","NHINVART",133,0)
932 S I=0 F S I=$O(REAC("drugClass",I)) Q:I<1 D
933"RTN","NHINVART",134,0)
934 . S X=$G(REAC("drugClass",I)) Q:'X
935"RTN","NHINVART",135,0)
936 . S $P(REAC("drugClass",I),U)=$$VUID^NHINV(+X,50.605)
937"RTN","NHINVART",136,0)
938 S I=0 F S I=$O(REAC("drugIngredient",I)) Q:I<1 D
939"RTN","NHINVART",137,0)
940 . S X=$G(REAC("drugIngredient",I)) Q:'X
941"RTN","NHINVART",138,0)
942 . S $P(REAC("drugIngredient",I),U)=$$VUID^NHINV(+X,50.416)
943"RTN","NHINVART",139,0)
944 Q
945"RTN","NHINVIMM")
9460^5^B8275429
947"RTN","NHINVIMM",1,0)
948NHINVIMM ;SLC/MKB -- Immunizations extract
949"RTN","NHINVIMM",2,0)
950 ;;1.0;NHIN;;Oct 25, 2010;Build 14
951"RTN","NHINVIMM",3,0)
952 ;
953"RTN","NHINVIMM",4,0)
954 ; External References DBIA#
955"RTN","NHINVIMM",5,0)
956 ; ------------------- -----
957"RTN","NHINVIMM",6,0)
958 ; ^DIC(4 10090
959"RTN","NHINVIMM",7,0)
960 ; ^VA(200 10060
961"RTN","NHINVIMM",8,0)
962 ; DIC 2051
963"RTN","NHINVIMM",9,0)
964 ; DIQ 2056
965"RTN","NHINVIMM",10,0)
966 ; PXRHS03,^TMP("PXI",$J) 1239
967"RTN","NHINVIMM",11,0)
968 ; XUAF4 2171
969"RTN","NHINVIMM",12,0)
970 ;
971"RTN","NHINVIMM",13,0)
972 ; ------------ Get immunizations from VistA ------------
973"RTN","NHINVIMM",14,0)
974 ;
975"RTN","NHINVIMM",15,0)
976EN(DFN,BEG,END,MAX,IFN) ; -- find patient's immunizations
977"RTN","NHINVIMM",16,0)
978 N NHITM,NHICNT,NM,IDT
979"RTN","NHINVIMM",17,0)
980 S DFN=+$G(DFN) Q:DFN<1 ;invalid patient
981"RTN","NHINVIMM",18,0)
982 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999),NHICNT=0
983"RTN","NHINVIMM",19,0)
984 K ^TMP("PXI",$J) D IMMUN^PXRHS03(DFN)
985"RTN","NHINVIMM",20,0)
986 ;
987"RTN","NHINVIMM",21,0)
988 ; get one immunization
989"RTN","NHINVIMM",22,0)
990 I $G(IFN) D Q
991"RTN","NHINVIMM",23,0)
992 . N DONE S DONE=0
993"RTN","NHINVIMM",24,0)
994 . S NM="" F S NM=$O(^TMP("PXI",$J,NM)) Q:NM="" D Q:DONE
995"RTN","NHINVIMM",25,0)
996 .. S IDT=0 F S IDT=$O(^TMP("PXI",$J,NM,IDT)) Q:IDT<1 I $D(^(IDT,IFN)) D Q
997"RTN","NHINVIMM",26,0)
998 ... D EN1(.NHITM),XML(.NHITM)
999"RTN","NHINVIMM",27,0)
1000 ... S DONE=1
1001"RTN","NHINVIMM",28,0)
1002 . K ^TMP("PXI",$J)
1003"RTN","NHINVIMM",29,0)
1004 ;
1005"RTN","NHINVIMM",30,0)
1006 ; get all immunizations
1007"RTN","NHINVIMM",31,0)
1008 S NM="" F S NM=$O(^TMP("PXI",$J,NM)) Q:NM="" D
1009"RTN","NHINVIMM",32,0)
1010 . S IDT=0 F S IDT=$O(^TMP("PXI",$J,NM,IDT)) Q:IDT<1 D
1011"RTN","NHINVIMM",33,0)
1012 .. S IFN=0 F S IFN=$O(^TMP("PXI",$J,NM,IDT,IFN)) Q:IFN<1 D Q:NHICNT'<MAX
1013"RTN","NHINVIMM",34,0)
1014 ... K NHITM D EN1(.NHITM),XML(.NHITM)
1015"RTN","NHINVIMM",35,0)
1016 ... S NHICNT=NHICNT+1
1017"RTN","NHINVIMM",36,0)
1018 K ^TMP("PXI",$J)
1019"RTN","NHINVIMM",37,0)
1020 Q
1021"RTN","NHINVIMM",38,0)
1022 ;
1023"RTN","NHINVIMM",39,0)
1024EN1(IMM) ; -- return an immunization in IMM("attribute")=value
1025"RTN","NHINVIMM",40,0)
1026 ; Expects ^TMP("PXI",$J,NM,IDT,IFN) from IMMUN^PXRHS03
1027"RTN","NHINVIMM",41,0)
1028 N X0,X1,CPT,DA,X,Y K IMM
1029"RTN","NHINVIMM",42,0)
1030 S X0=$G(^TMP("PXI",$J,NM,IDT,IFN,0)),X1=$G(^(1)),X=$G(^("COM"))
1031"RTN","NHINVIMM",43,0)
1032 S:$L(X) IMM("comment")=X
1033"RTN","NHINVIMM",44,0)
1034 S IMM("id")=IFN,IMM("name")=$P(X0,U)
1035"RTN","NHINVIMM",45,0)
1036 S IMM("administered")=+$P(X0,U,3)
1037"RTN","NHINVIMM",46,0)
1038 S IMM("series")=$P(X0,U,5)
1039"RTN","NHINVIMM",47,0)
1040 S IMM("reaction")=$P(X0,U,6)
1041"RTN","NHINVIMM",48,0)
1042 S IMM("contraindicated")=+$P(X0,U,7)
1043"RTN","NHINVIMM",49,0)
1044 S IMM("location")=$P(X1,U)
1045"RTN","NHINVIMM",50,0)
1046 S X=$P(X1,U,3) I $L(X) D
1047"RTN","NHINVIMM",51,0)
1048 . S Y=$$LKUP^XUAF4(X) ;ien
1049"RTN","NHINVIMM",52,0)
1050 . I Y<1 S Y=+$O(^DIC(4,"B",X,0)) ;dupl -> get 1st
1051"RTN","NHINVIMM",53,0)
1052 . S IMM("facility")=$$STA^XUAF4(Y)_U_X
1053"RTN","NHINVIMM",54,0)
1054 S X=$P(X0,U,9) S:'$L(X) X=$P(X0,U,8)
1055"RTN","NHINVIMM",55,0)
1056 I $L(X) S IMM("provider")=+$O(^VA(200,"B",X,0))_U_X
1057"RTN","NHINVIMM",56,0)
1058 ;
1059"RTN","NHINVIMM",57,0)
1060 S DA=+$$GET1^DIQ(9000010.11,IFN_",",.01,"I") Q:'DA
1061"RTN","NHINVIMM",58,0)
1062 S X=+$$FIND1^DIC(811.1,,"QX",DA_";AUTTIMM(","B") I X>0 D
1063"RTN","NHINVIMM",59,0)
1064 . S Y=$$GET1^DIQ(811.1,X_",",.02,"I") Q:Y<1
1065"RTN","NHINVIMM",60,0)
1066 . S CPT=$G(@(U_$P(Y,";",2)_+Y_",0)"))
1067"RTN","NHINVIMM",61,0)
1068 . S IMM("cpt")=$P(CPT,U,1,2)
1069"RTN","NHINVIMM",62,0)
1070 Q
1071"RTN","NHINVIMM",63,0)
1072 ;
1073"RTN","NHINVIMM",64,0)
1074 ; ------------ Return data to middle tier ------------
1075"RTN","NHINVIMM",65,0)
1076 ;
1077"RTN","NHINVIMM",66,0)
1078XML(IMM) ; -- Return immunizations as XML
1079"RTN","NHINVIMM",67,0)
1080 N ATT,X,Y,I,P,NAMES,TAG
1081"RTN","NHINVIMM",68,0)
1082 D ADD("<immunization>")
1083"RTN","NHINVIMM",69,0)
1084 S ATT="" F S ATT=$O(IMM(ATT)) Q:ATT="" D
1085"RTN","NHINVIMM",70,0)
1086 . S X=$G(IMM(ATT)),Y="" Q:'$L(X)
1087"RTN","NHINVIMM",71,0)
1088 . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" D ADD(Y) Q
1089"RTN","NHINVIMM",72,0)
1090 . I $L(X)>1 D
1091"RTN","NHINVIMM",73,0)
1092 .. S Y="<"_ATT_" "
1093"RTN","NHINVIMM",74,0)
1094 .. F P=1:1 S TAG=$P("code^name^Z",U,P) Q:TAG="Z" I $L($P(X,U,P)) S Y=Y_TAG_"='"_$$ESC^NHINV($P(X,U,P))_"' "
1095"RTN","NHINVIMM",75,0)
1096 .. S Y=Y_"/>" D ADD(Y)
1097"RTN","NHINVIMM",76,0)
1098 D ADD("</immunization>")
1099"RTN","NHINVIMM",77,0)
1100 Q
1101"RTN","NHINVIMM",78,0)
1102 ;
1103"RTN","NHINVIMM",79,0)
1104ADD(X) ; -- Add a line @NHIN@(n)=X
1105"RTN","NHINVIMM",80,0)
1106 S NHINI=$G(NHINI)+1
1107"RTN","NHINVIMM",81,0)
1108 S @NHIN@(NHINI)=X
1109"RTN","NHINVIMM",82,0)
1110 Q
1111"RTN","NHINVIT")
11120^6^B30108507
1113"RTN","NHINVIT",1,0)
1114NHINVIT ;SLC/MKB -- Vitals extract
1115"RTN","NHINVIT",2,0)
1116 ;;1.0;NHIN;;Oct 25, 2010;Build 14
1117"RTN","NHINVIT",3,0)
1118 ;
1119"RTN","NHINVIT",4,0)
1120 ; External References DBIA#
1121"RTN","NHINVIT",5,0)
1122 ; ------------------- -----
1123"RTN","NHINVIT",6,0)
1124 ; ^SC 10040
1125"RTN","NHINVIT",7,0)
1126 ; ^VA(200 10060
1127"RTN","NHINVIT",8,0)
1128 ; DIC 2051
1129"RTN","NHINVIT",9,0)
1130 ; DIQ 2056
1131"RTN","NHINVIT",10,0)
1132 ; GMRVUT0,^UTILITY($J,"GMRVD") 1446
1133"RTN","NHINVIT",11,0)
1134 ; GMVPXRM 3647
1135"RTN","NHINVIT",12,0)
1136 ;
1137"RTN","NHINVIT",13,0)
1138 ; ------------ Get vitals from VistA ------------
1139"RTN","NHINVIT",14,0)
1140 ;
1141"RTN","NHINVIT",15,0)
1142EN(DFN,BEG,END,MAX,IFN) ; -- find patient's vitals
1143"RTN","NHINVIT",16,0)
1144 N NHITM,NHIPRM,GMRVSTR,IDT,TYPE,VIT,CNT,X0,X,Y,I,N
1145"RTN","NHINVIT",17,0)
1146 S DFN=+$G(DFN) Q:DFN<1
1147"RTN","NHINVIT",18,0)
1148 ;
1149"RTN","NHINVIT",19,0)
1150 ; get one measurement
1151"RTN","NHINVIT",20,0)
1152 I $G(IFN) D EN1(IFN,.NHITM),XML(.NHITM) Q
1153"RTN","NHINVIT",21,0)
1154 ;
1155"RTN","NHINVIT",22,0)
1156 ; get all measurements
1157"RTN","NHINVIT",23,0)
1158 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
1159"RTN","NHINVIT",24,0)
1160 S GMRVSTR="BP;T;R;P;HT;WT;CVP;CG;PO2;PN",GMRVSTR(0)=BEG_U_END_U_MAX_"^1"
1161"RTN","NHINVIT",25,0)
1162 K ^UTILITY($J,"GMRVD") D EN1^GMRVUT0
1163"RTN","NHINVIT",26,0)
1164 S (IDT,CNT)=0 F S IDT=$O(^UTILITY($J,"GMRVD",IDT)) Q:IDT<1 D Q:CNT'<MAX
1165"RTN","NHINVIT",27,0)
1166 . K VIT S VIT("taken")=9999999-IDT,CNT=CNT+1,N=0
1167"RTN","NHINVIT",28,0)
1168 . S TYPE="" F S TYPE=$O(^UTILITY($J,"GMRVD",IDT,TYPE)) Q:TYPE="" D
1169"RTN","NHINVIT",29,0)
1170 .. N NAME,VUID,RESULT,UNIT,MRES,MUNT,HIGH,LOW,QUAL
1171"RTN","NHINVIT",30,0)
1172 .. S IFN=+$O(^UTILITY($J,"GMRVD",IDT,TYPE,0)),X0=$G(^(IFN))
1173"RTN","NHINVIT",31,0)
1174 .. S X=+$P(X0,U,3),NAME=$$GET1^DIQ(120.5,IFN_",",.03)
1175"RTN","NHINVIT",32,0)
1176 .. S VUID=$$VUID^NHINV(X,120.51),RESULT=$P(X0,U,8)
1177"RTN","NHINVIT",33,0)
1178 .. S UNIT=$S(TYPE="T":"F",TYPE="HT":"in",TYPE="WT":"lb",TYPE="CVP":"cmH2O",TYPE="CG":"in",1:"")
1179"RTN","NHINVIT",34,0)
1180 .. S (MRES,MUNT)="" I $L($P(X0,U,13)) D
1181"RTN","NHINVIT",35,0)
1182 ... S X=$S(TYPE="T":"C",TYPE="HT":"cm",TYPE="WT":"kg",TYPE="CG":"cm",1:"")
1183"RTN","NHINVIT",36,0)
1184 ... S MRES=$P(X0,U,13) S:$L(X) MUNT=X
1185"RTN","NHINVIT",37,0)
1186 .. S X=$$RANGE(TYPE),(HIGH,LOW)="" I $L(X) S HIGH=$P(X,U),LOW=$P(X,U,2)
1187"RTN","NHINVIT",38,0)
1188 .. S N=N+1,VIT("measurement",N)=IFN_U_VUID_U_NAME_U_RESULT_U_UNIT_U_MRES_U_MUNT_U_HIGH_U_LOW
1189"RTN","NHINVIT",39,0)
1190 .. S QUAL=$P(X0,U,17) I $L(QUAL) F I=1:1:$L(QUAL,";") D
1191"RTN","NHINVIT",40,0)
1192 ... S X=$P(QUAL,";",I),Y=$$FIND1^DIC(120.52,,"QX",X)
1193"RTN","NHINVIT",41,0)
1194 ... I Y S VIT("measurement",N,"qualifier",I)=X_U_$$VUID^NHINV(Y,120.52)
1195"RTN","NHINVIT",42,0)
1196 . S VIT("entered")=$P($G(X0),U,4) ;use last one
1197"RTN","NHINVIT",43,0)
1198 . S VIT("facility")=$$FAC^NHINV($P($G(X0),U,5))
1199"RTN","NHINVIT",44,0)
1200 . D XML(.VIT)
1201"RTN","NHINVIT",45,0)
1202 K ^UTILITY($J,"GMRVD")
1203"RTN","NHINVIT",46,0)
1204 Q
1205"RTN","NHINVIT",47,0)
1206 ;
1207"RTN","NHINVIT",48,0)
1208EN1(ID,VIT) ; -- return a vital/measurement in VIT("attribute")
1209"RTN","NHINVIT",49,0)
1210 K VIT S ID=+$G(ID) Q:ID<1 ;invalid ien
1211"RTN","NHINVIT",50,0)
1212 N NHY,DFN,TYPE,X,Y,NAME,VUID,RESULT,UNIT,MRES,MUNT,HIGH,LOW,I
1213"RTN","NHINVIT",51,0)
1214 D EN^GMVPXRM(.NHY,ID,"B")
1215"RTN","NHINVIT",52,0)
1216 S DFN=+$G(NHY(2)) Q:DFN<1
1217"RTN","NHINVIT",53,0)
1218 S TYPE=$$GET1^DIQ(120.51,+NHY(3)_",",1)
1219"RTN","NHINVIT",54,0)
1220 S VIT("facility")=$$FAC^NHINV(+NHY(5)),VIT("taken")=+NHY(1)
1221"RTN","NHINVIT",55,0)
1222 S NAME=$P(NHY(3),U,2),VUID=$$VUID^NHINV(+NHY(3),120.51)
1223"RTN","NHINVIT",56,0)
1224 S X=$P(NHY(7),U,2),RESULT=X,(UNIT,MRES,MUNT)=""
1225"RTN","NHINVIT",57,0)
1226 I TYPE="T" S UNIT="F",MUNT="C" S MRES=$J(X-32*5/9,0,1) ; EN1^GMRVUTL
1227"RTN","NHINVIT",58,0)
1228 I TYPE="HT" S UNIT="in",MUNT="cm" S MRES=$J(2.54*X,0,2) ; EN2^GMRVUTL
1229"RTN","NHINVIT",59,0)
1230 I TYPE="WT" S UNIT="lb",MUNT="kg" S MRES=$J(X/2.2,0,2) ; EN3^GMRVUTL
1231"RTN","NHINVIT",60,0)
1232 I TYPE="CG" S UNIT="in",MUNT="cm" S MRES=$J(2.54*X,0,2)
1233"RTN","NHINVIT",61,0)
1234 I TYPE="CVP" S UNIT="cmH2O"
1235"RTN","NHINVIT",62,0)
1236 S VIT("entered")=+NHY(4),(HIGH,LOW)=""
1237"RTN","NHINVIT",63,0)
1238 S X=$$RANGE(TYPE) I $L(X) S HIGH=$P(X,U),LOW=$P(X,U,2)
1239"RTN","NHINVIT",64,0)
1240 S VIT("measurement",1)=ID_U_VUID_U_NAME_U_RESULT_U_UNIT_U_MRES_U_MUNT_U_HIGH_U_LOW
1241"RTN","NHINVIT",65,0)
1242 S I=0 F S I=$O(NHY(12,I)) Q:I<1 S X=$G(NHY(12,I)),VIT("measurement",1,"qualifier",I)=$P(X,U,2)_U_$$VUID^NHINV(+X,120.52)
1243"RTN","NHINVIT",66,0)
1244 Q
1245"RTN","NHINVIT",67,0)
1246 ;
1247"RTN","NHINVIT",68,0)
1248USER(X) ; -- Return ien^name for person# X
1249"RTN","NHINVIT",69,0)
1250 N Y S X=+$G(X)
1251"RTN","NHINVIT",70,0)
1252 S Y=$S(X:X_U_$P($G(^VA(200,X,0)),U),1:"^")
1253"RTN","NHINVIT",71,0)
1254 Q Y
1255"RTN","NHINVIT",72,0)
1256 ;
1257"RTN","NHINVIT",73,0)
1258LOC(X) ; -- Return ien^name for hospital location X
1259"RTN","NHINVIT",74,0)
1260 N Y S X=+$G(X)
1261"RTN","NHINVIT",75,0)
1262 S Y=$S(X:X_U_$P($G(^SC(X,0)),U),1:"^")
1263"RTN","NHINVIT",76,0)
1264 Q Y
1265"RTN","NHINVIT",77,0)
1266 ;
1267"RTN","NHINVIT",78,0)
1268RANGE(TYPE) ; -- return high^low range of values for TYPE
1269"RTN","NHINVIT",79,0)
1270 N Y S Y="" I '$D(NHIPRM) D ;get parameter values
1271"RTN","NHINVIT",80,0)
1272 . N VAL D GETS^DIQ(120.57,"1,","5:7","","VAL")
1273"RTN","NHINVIT",81,0)
1274 . M NHIPRM=VAL(120.57,"1,")
1275"RTN","NHINVIT",82,0)
1276 I TYPE="T" S Y=$G(NHIPRM(5.1))_U_$G(NHIPRM(5.2))
1277"RTN","NHINVIT",83,0)
1278 I TYPE="P" S Y=$G(NHIPRM(5.3))_U_$G(NHIPRM(5.4))
1279"RTN","NHINVIT",84,0)
1280 I TYPE="R" S Y=$G(NHIPRM(5.5))_U_$G(NHIPRM(5.6))
1281"RTN","NHINVIT",85,0)
1282 I TYPE="CVP" S Y=$G(NHIPRM(6.1))_U_$G(NHIPRM(6.2))
1283"RTN","NHINVIT",86,0)
1284 I TYPE="PO2" S Y="100^"_$G(NHIPRM(6.3))
1285"RTN","NHINVIT",87,0)
1286 I TYPE="BP" D
1287"RTN","NHINVIT",88,0)
1288 . S Y=$G(NHIPRM(5.7))_"/"_$G(NHIPRM(5.71))_U
1289"RTN","NHINVIT",89,0)
1290 . S Y=Y_$G(NHIPRM(5.8))_"/"_$G(NHIPRM(5.81))
1291"RTN","NHINVIT",90,0)
1292 Q Y
1293"RTN","NHINVIT",91,0)
1294 ;
1295"RTN","NHINVIT",92,0)
1296 ; ------------ Return data to middle tier ------------
1297"RTN","NHINVIT",93,0)
1298 ;
1299"RTN","NHINVIT",94,0)
1300NAME(X) ; -- Return name of measurement type X for XML element
1301"RTN","NHINVIT",95,0)
1302 N Y S X=$G(X),Y=""
1303"RTN","NHINVIT",96,0)
1304 S Y=$S(X="BP":"bloodPressure",X="T":"temperature",X="R":"respiration",X="P":"pulse",X="HT":"height",X="WT":"weight",X="CVP":"centralVenousPressure",X="CG":"circumferenceGirth",X="PO2":"pulseOximetry",X="PN":"pain",1:"")
1305"RTN","NHINVIT",97,0)
1306 Q Y
1307"RTN","NHINVIT",98,0)
1308 ;
1309"RTN","NHINVIT",99,0)
1310XML(VIT) ; -- Return vital measurement as XML in @NHIN@(#)
1311"RTN","NHINVIT",100,0)
1312 N ATT,X,Y,I,J,P,NAMES,TAG
1313"RTN","NHINVIT",101,0)
1314 D ADD("<vital>")
1315"RTN","NHINVIT",102,0)
1316 S ATT="" F S ATT=$O(VIT(ATT)) Q:ATT="" D
1317"RTN","NHINVIT",103,0)
1318 . I ATT="measurement" D Q
1319"RTN","NHINVIT",104,0)
1320 .. D ADD("<measurements>")
1321"RTN","NHINVIT",105,0)
1322 .. S NAMES="id^vuid^name^value^units^metricValue^metricUnits^high^low^Z"
1323"RTN","NHINVIT",106,0)
1324 .. S I=0 F S I=$O(VIT(ATT,I)) Q:I<1 D
1325"RTN","NHINVIT",107,0)
1326 ... S X=$G(VIT(ATT,I)),Y="<"_ATT_" "
1327"RTN","NHINVIT",108,0)
1328 ... F P=1:1 S TAG=$P(NAMES,U,P) Q:TAG="Z" I $L($P(X,U,P)) S Y=Y_TAG_"='"_$$ESC^NHINV($P(X,U,P))_"' "
1329"RTN","NHINVIT",109,0)
1330 ... I '$D(VIT(ATT,I,"qualifier")) S Y=Y_"/>" D ADD(Y) Q
1331"RTN","NHINVIT",110,0)
1332 ... S Y=Y_">" D ADD(Y),ADD("<qualifiers>")
1333"RTN","NHINVIT",111,0)
1334 ... S J=0 F S J=$O(VIT(ATT,I,"qualifier",J)) Q:J<1 D
1335"RTN","NHINVIT",112,0)
1336 .... S Y="<qualifier ",X=$G(VIT(ATT,I,"qualifier",J))
1337"RTN","NHINVIT",113,0)
1338 .... F P=1:1 S TAG=$P("name^vuid^Z",U,P) Q:TAG="Z" I $L($P(X,U,P)) S Y=Y_TAG_"='"_$$ESC^NHINV($P(X,U,P))_"' "
1339"RTN","NHINVIT",114,0)
1340 .... S Y=Y_"/>" D ADD(Y)
1341"RTN","NHINVIT",115,0)
1342 ... D ADD("</qualifiers>"),ADD("</measurement>")
1343"RTN","NHINVIT",116,0)
1344 .. D ADD("</measurements>")
1345"RTN","NHINVIT",117,0)
1346 . S X=$G(VIT(ATT)),Y="" Q:'$L(X)
1347"RTN","NHINVIT",118,0)
1348 . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" D ADD(Y) Q
1349"RTN","NHINVIT",119,0)
1350 . I $L(X)>1 D
1351"RTN","NHINVIT",120,0)
1352 .. S Y="<"_ATT_" "
1353"RTN","NHINVIT",121,0)
1354 .. F P=1:1 S TAG=$P("code^name^Z",U,P) Q:TAG="Z" I $L($P(X,U,P)) S Y=Y_TAG_"='"_$$ESC^NHINV($P(X,U,P))_"' "
1355"RTN","NHINVIT",122,0)
1356 .. S Y=Y_"/>" D ADD(Y)
1357"RTN","NHINVIT",123,0)
1358 D ADD("</vital>")
1359"RTN","NHINVIT",124,0)
1360 Q
1361"RTN","NHINVIT",125,0)
1362 ;
1363"RTN","NHINVIT",126,0)
1364ADD(X) ; Add a line @NHIN@(n)=X
1365"RTN","NHINVIT",127,0)
1366 S NHINI=$G(NHINI)+1
1367"RTN","NHINVIT",128,0)
1368 S @NHIN@(NHINI)=X
1369"RTN","NHINVIT",129,0)
1370 Q
1371"RTN","NHINVLR")
13720^7^B23999856
1373"RTN","NHINVLR",1,0)
1374NHINVLR ;SLC/MKB -- Laboratory extract
1375"RTN","NHINVLR",2,0)
1376 ;;1.0;NHIN;;Oct 25, 2010;Build 14
1377"RTN","NHINVLR",3,0)
1378 ;
1379"RTN","NHINVLR",4,0)
1380 ; External References DBIA#
1381"RTN","NHINVLR",5,0)
1382 ; ------------------- -----
1383"RTN","NHINVLR",6,0)
1384 ; ^DPT 10035
1385"RTN","NHINVLR",7,0)
1386 ; ^LAB(60 10054
1387"RTN","NHINVLR",8,0)
1388 ; ^LRO(69 2407
1389"RTN","NHINVLR",9,0)
1390 ; ^LR 525
1391"RTN","NHINVLR",10,0)
1392 ; DIC 2051
1393"RTN","NHINVLR",11,0)
1394 ; DIQ 2056
1395"RTN","NHINVLR",12,0)
1396 ; LR7OR1,^TMP("LRRR",$J) 2503
1397"RTN","NHINVLR",13,0)
1398 ;
1399"RTN","NHINVLR",14,0)
1400 ; ------------ Get results from VistA ------------
1401"RTN","NHINVLR",15,0)
1402 ;
1403"RTN","NHINVLR",16,0)
1404EN(DFN,BEG,END,MAX,ID) ; -- find patient's lab results
1405"RTN","NHINVLR",17,0)
1406 N NHSUB,NHIDT,NHI,NHITM,LRDFN,SUB
1407"RTN","NHINVLR",18,0)
1408 S DFN=+$G(DFN) Q:$G(DFN)<1
1409"RTN","NHINVLR",19,0)
1410 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
1411"RTN","NHINVLR",20,0)
1412 K ^TMP("LRRR",$J,DFN) S LRDFN=$G(^DPT(DFN,"LR")),NHSUB="CH"
1413"RTN","NHINVLR",21,0)
1414 ;
1415"RTN","NHINVLR",22,0)
1416 ; get result(s)
1417"RTN","NHINVLR",23,0)
1418 I $L($G(ID)) D Q:NHI ;done
1419"RTN","NHINVLR",24,0)
1420 . S NHSUB=$P(ID,";"),NHIDT=+$P(ID,";",2),(BEG,END)=9999999-NHIDT
1421"RTN","NHINVLR",25,0)
1422 . S NHI=$P(ID,";",3) I NHI D ;skip loop - single result
1423"RTN","NHINVLR",26,0)
1424 .. D RR^LR7OR1(DFN,,BEG,END,NHSUB)
1425"RTN","NHINVLR",27,0)
1426 .. S SUB=$S("CH^MI"[NHSUB:NHSUB,1:"AP")_"(.NHITM)"
1427"RTN","NHINVLR",28,0)
1428 .. D @SUB,XML(.NHITM)
1429"RTN","NHINVLR",29,0)
1430 .. K ^TMP("LRRR",$J,DFN)
1431"RTN","NHINVLR",30,0)
1432 D RR^LR7OR1(DFN,,BEG,END,NHSUB,,,MAX)
1433"RTN","NHINVLR",31,0)
1434 ;
1435"RTN","NHINVLR",32,0)
1436 S NHSUB="" F S NHSUB=$O(^TMP("LRRR",$J,DFN,NHSUB)) Q:NHSUB="" D
1437"RTN","NHINVLR",33,0)
1438 . S NHIDT=0 F S NHIDT=$O(^TMP("LRRR",$J,DFN,NHSUB,NHIDT)) Q:NHIDT<1 D
1439"RTN","NHINVLR",34,0)
1440 .. S NHI=0 F S NHI=$O(^TMP("LRRR",$J,DFN,NHSUB,NHIDT,NHI)) Q:NHI<1 D
1441"RTN","NHINVLR",35,0)
1442 ... K NHITM S SUB=$S("CH^MI"[NHSUB:NHSUB,1:"AP")_"(.NHITM)"
1443"RTN","NHINVLR",36,0)
1444 ... D @SUB,XML(.NHITM)
1445"RTN","NHINVLR",37,0)
1446 K ^TMP("LRRR",$J,DFN)
1447"RTN","NHINVLR",38,0)
1448 Q
1449"RTN","NHINVLR",39,0)
1450 ;
1451"RTN","NHINVLR",40,0)
1452CH(LAB) ; -- return a Chemistry result in LAB("attribute")=value
1453"RTN","NHINVLR",41,0)
1454 ; Expects ^TMP("LRRR",$J,DFN,"CH",NHIDT,NHI),LRDFN
1455"RTN","NHINVLR",42,0)
1456 N ID,CDT,X0,X,NUM,ORD,CMMT,LR0,LOINC K LAB
1457"RTN","NHINVLR",43,0)
1458 S ID="CH;"_NHIDT_";"_NHI,LAB("id")=ID
1459"RTN","NHINVLR",44,0)
1460 S CDT=9999999-NHIDT,LAB("collected")=CDT,LAB("status")="completed"
1461"RTN","NHINVLR",45,0)
1462 S LR0=$G(^LR(LRDFN,"CH",NHIDT,0)),LAB("resulted")=$P(LR0,U,3)
1463"RTN","NHINVLR",46,0)
1464 S X0=$G(^TMP("LRRR",$J,DFN,"CH",NHIDT,NHI))
1465"RTN","NHINVLR",47,0)
1466 S LAB("test")=$P($G(^LAB(60,+X0,0)),U) ;$P(X0,U,10)?
1467"RTN","NHINVLR",48,0)
1468 S:$L($P(X0,U,2)) LAB("result")=$P(X0,U,2)
1469"RTN","NHINVLR",49,0)
1470 S:$L($P(X0,U,4)) LAB("units")=$P(X0,U,4)
1471"RTN","NHINVLR",50,0)
1472 S:$L($P(X0,U,3)) LAB("interpretation")=$P(X0,U,3)
1473"RTN","NHINVLR",51,0)
1474 S X=$P(X0,U,5) I $L(X),X["-" S LAB("low")=$P(X,"-"),LAB("high")=$P(X,"-",2)
1475"RTN","NHINVLR",52,0)
1476 S LAB("localName")=$S($L($P(X0,U,15)):$P(X0,U,15),1:LAB("test"))
1477"RTN","NHINVLR",53,0)
1478 S NUM=$P(X0,U,16),LAB("groupID")=NUM
1479"RTN","NHINVLR",54,0)
1480 S X=$P(NUM," "),LAB("type")=$$TYPE(X)
1481"RTN","NHINVLR",55,0)
1482 S X=$P($P(LR0,U,3),"!",3) S:X LOINC=$$GET1^DIQ(95.3,X_",",.01)
1483"RTN","NHINVLR",56,0)
1484 S X=+$P(X0,U,19) I X D ;specimen
1485"RTN","NHINVLR",57,0)
1486 . N VUID S VUID=""
1487"RTN","NHINVLR",58,0)
1488 . S LAB("specimen")=$$GET1^DIQ(61,X_",",2) ;SNOMED
1489"RTN","NHINVLR",59,0)
1490 . S LAB("sample")=$$GET1^DIQ(61,X_",",4.1)
1491"RTN","NHINVLR",60,0)
1492 . ; LOINC=+$G(^LAB(60,+X0,1,X,95.3))
1493"RTN","NHINVLR",61,0)
1494 . S:'$G(LOINC) LOINC=$$GET1^DIQ(60.01,X_","_+X0_",",95.3)
1495"RTN","NHINVLR",62,0)
1496 . I LOINC S LAB("loinc")=LOINC,VUID=$$VUID^NHINV(+LOINC,95.3)
1497"RTN","NHINVLR",63,0)
1498 . S:VUID LAB("vuid")=VUID
1499"RTN","NHINVLR",64,0)
1500 S ORD=+$P(X0,U,17) S:ORD LAB("labOrderID")=ORD
1501"RTN","NHINVLR",65,0)
1502 S X=$$ORDER(ORD,+X0) S:X LAB("orderID")=X
1503"RTN","NHINVLR",66,0)
1504 S X=$P(LR0,U,14)
1505"RTN","NHINVLR",67,0)
1506 S:X LAB("facility")=$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U)
1507"RTN","NHINVLR",68,0)
1508 I 'X S LAB("facility")=$$FAC^NHINV ;local stn#^name
1509"RTN","NHINVLR",69,0)
1510 I $D(^TMP("LRRR",$J,DFN,"CH",NHIDT,"N")) M CMMT=^("N") S LAB("comment")=$$STRING^NHINV(.CMMT)
1511"RTN","NHINVLR",70,0)
1512 Q
1513"RTN","NHINVLR",71,0)
1514 ;
1515"RTN","NHINVLR",72,0)
1516ORDER(LABORD,TEST) ; -- return #100 order for Lab order# & Test
1517"RTN","NHINVLR",73,0)
1518 N Y,D,S,T S Y=""
1519"RTN","NHINVLR",74,0)
1520 S D=$O(^LRO(69,"C",LABORD,0)) I D D
1521"RTN","NHINVLR",75,0)
1522 . S S=0 F S S=$O(^LRO(69,"C",LABORD,D,S)) Q:S<1 D
1523"RTN","NHINVLR",76,0)
1524 .. S T=0 F S T=$O(^LRO(69,D,1,S,2,T)) Q:T<1 I +$G(^(T,0))=TEST S Y=+$P(^(0),U,7)
1525"RTN","NHINVLR",77,0)
1526 Q Y
1527"RTN","NHINVLR",78,0)
1528 ;
1529"RTN","NHINVLR",79,0)
1530MI(LAB) ; -- return a Microbiology result in LAB("attribute")=value
1531"RTN","NHINVLR",80,0)
1532 ; Expects ^TMP("LRRR",$J,DFN,"MI",NHIDT,NHI),LRDFN
1533"RTN","NHINVLR",81,0)
1534 N ID,CDT,X0,X,CMMT,LR0 K LAB
1535"RTN","NHINVLR",82,0)
1536 S X0=$G(^TMP("LRRR",$J,DFN,"MI",NHIDT,NHI)) Q:$L($P(X0,U))'>1
1537"RTN","NHINVLR",83,0)
1538 S ID="MI;"_NHIDT_"#"_NHI,LAB("id")=ID,LAB("status")="completed"
1539"RTN","NHINVLR",84,0)
1540 S LAB("type")="MICROBIOLOGY",CDT=9999999-NHIDT,LAB("collected")=CDT
1541"RTN","NHINVLR",85,0)
1542 S LR0=$G(^LR(LRDFN,"MI",NHIDT,0)),LAB("resulted")=$P(LR0,U,3)
1543"RTN","NHINVLR",86,0)
1544 S:$L($P(X0,U,2)) LAB("result")=$P(X0,U,2)
1545"RTN","NHINVLR",87,0)
1546 S:$L($P(X0,U,4)) LAB("units")=$P(X0,U,4)
1547"RTN","NHINVLR",88,0)
1548 S:$L($P(X0,U,3)) LAB("interpretation")=$P(X0,U,3)
1549"RTN","NHINVLR",89,0)
1550 S (LAB("test"),LAB("localName"))=$P(X0,U,15)
1551"RTN","NHINVLR",90,0)
1552 S X=+$P(X0,U,19) I X D ;specimen
1553"RTN","NHINVLR",91,0)
1554 . S LAB("specimen")=$$GET1^DIQ(61,X_",",2) ;SNOMED
1555"RTN","NHINVLR",92,0)
1556 . S LAB("sample")=$$GET1^DIQ(61,X_",",4.1) ;name
1557"RTN","NHINVLR",93,0)
1558 S X=$P(LR0,U,14)
1559"RTN","NHINVLR",94,0)
1560 S:X LAB("facility")=$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U)
1561"RTN","NHINVLR",95,0)
1562 I 'X S LAB("facility")=$$FAC^NHINV ;local stn#^name
1563"RTN","NHINVLR",96,0)
1564 I $D(^TMP("LRRR",$J,DFN,"MI",NHIDT,"N")) M CMMT=^("N") S LAB("comment")=$$STRING^NHINV(.CMMT)
1565"RTN","NHINVLR",97,0)
1566 Q
1567"RTN","NHINVLR",98,0)
1568 ;
1569"RTN","NHINVLR",99,0)
1570AP(LAB) ; -- return a Pathology result in LAB("attribute")=value
1571"RTN","NHINVLR",100,0)
1572 K LAB ;not implemented yet
1573"RTN","NHINVLR",101,0)
1574 Q
1575"RTN","NHINVLR",102,0)
1576 ;
1577"RTN","NHINVLR",103,0)
1578TYPE(X) ; -- Return name of lab section
1579"RTN","NHINVLR",104,0)
1580 N NHIY,Y S Y=X
1581"RTN","NHINVLR",105,0)
1582 D FIND^DIC(68,,.01,"PQX",X,,"B",,,"NHIY")
1583"RTN","NHINVLR",106,0)
1584 S:$G(NHIY("DILIST",1,0)) Y=$P(NHIY("DILIST",1,0),U,2) ;name
1585"RTN","NHINVLR",107,0)
1586 Q Y
1587"RTN","NHINVLR",108,0)
1588 ;
1589"RTN","NHINVLR",109,0)
1590 ; ------------ Return data to middle tier ------------
1591"RTN","NHINVLR",110,0)
1592 ;
1593"RTN","NHINVLR",111,0)
1594XML(LAB) ; -- Return result as XML in @NHIN@(#)
1595"RTN","NHINVLR",112,0)
1596 N ATT,X,Y,P,NAMES,TAG
1597"RTN","NHINVLR",113,0)
1598 D ADD("<lab>")
1599"RTN","NHINVLR",114,0)
1600 S ATT="" F S ATT=$O(LAB(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
1601"RTN","NHINVLR",115,0)
1602 . S X=$G(LAB(ATT)),Y="" Q:'$L(X)
1603"RTN","NHINVLR",116,0)
1604 . I ATT="comment" S Y="<"_ATT_" xml:space='preserve'>"_$$ESC^NHINV(X)_"</"_ATT_">" Q
1605"RTN","NHINVLR",117,0)
1606 . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
1607"RTN","NHINVLR",118,0)
1608 . I $L(X)>1 D S Y=""
1609"RTN","NHINVLR",119,0)
1610 .. S Y="<"_ATT_" ",NAMES="code^name^Z"
1611"RTN","NHINVLR",120,0)
1612 .. F P=1:1 S TAG=$P(NAMES,U,P) Q:TAG="Z" I $L($P(X,U,P)) S Y=Y_TAG_"='"_$$ESC^NHINV($P(X,U,P))_"' "
1613"RTN","NHINVLR",121,0)
1614 .. S Y=Y_"/>" D ADD(Y)
1615"RTN","NHINVLR",122,0)
1616 D ADD("</lab>")
1617"RTN","NHINVLR",123,0)
1618 Q
1619"RTN","NHINVLR",124,0)
1620 ;
1621"RTN","NHINVLR",125,0)
1622ADD(X) ; -- Add a line @NHIN@(n)=X
1623"RTN","NHINVLR",126,0)
1624 S NHINI=$G(NHINI)+1
1625"RTN","NHINVLR",127,0)
1626 S @NHIN@(NHINI)=X
1627"RTN","NHINVLR",128,0)
1628 Q
1629"RTN","NHINVPL")
16300^8^B19630772
1631"RTN","NHINVPL",1,0)
1632NHINVPL ;SLC/MKB -- Problem extract
1633"RTN","NHINVPL",2,0)
1634 ;;1.0;NHIN;;Oct 25, 2010;Build 14
1635"RTN","NHINVPL",3,0)
1636 ;
1637"RTN","NHINVPL",4,0)
1638 ; External References DBIA#
1639"RTN","NHINVPL",5,0)
1640 ; ------------------- -----
1641"RTN","NHINVPL",6,0)
1642 ; ^VA(200 10060
1643"RTN","NHINVPL",7,0)
1644 ; %DT 10003
1645"RTN","NHINVPL",8,0)
1646 ; DIQ 2056
1647"RTN","NHINVPL",9,0)
1648 ; GMPLUTL2 2741
1649"RTN","NHINVPL",10,0)
1650 ; XUAF4 2171
1651"RTN","NHINVPL",11,0)
1652 ;
1653"RTN","NHINVPL",12,0)
1654 ; ------------ Get problems from VistA ------------
1655"RTN","NHINVPL",13,0)
1656 ;
1657"RTN","NHINVPL",14,0)
1658EN(DFN,BEG,END,MAX,IFN) ; -- find patient's problems
1659"RTN","NHINVPL",15,0)
1660 N NHIPROB,NHI,NHITM,NHICNT,X
1661"RTN","NHINVPL",16,0)
1662 ;
1663"RTN","NHINVPL",17,0)
1664 ; get one problem
1665"RTN","NHINVPL",18,0)
1666 I $G(IFN) D EN1(IFN,.NHITM),XML(.NHITM) Q
1667"RTN","NHINVPL",19,0)
1668 ;
1669"RTN","NHINVPL",20,0)
1670 ; get all patient problems
1671"RTN","NHINVPL",21,0)
1672 S DFN=+$G(DFN) Q:DFN<1
1673"RTN","NHINVPL",22,0)
1674 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999),NHICNT=0
1675"RTN","NHINVPL",23,0)
1676 D LIST^GMPLUTL2(.NHIPROB,DFN,"") ;all problems
1677"RTN","NHINVPL",24,0)
1678 S NHI=0 F S NHI=$O(NHIPROB(NHI)) Q:(NHI<1)!(NHICNT'<MAX) D
1679"RTN","NHINVPL",25,0)
1680 . S X=$P(NHIPROB(NHI),U,5) I X,(X<BEG)!(X>END) Q ;onset
1681"RTN","NHINVPL",26,0)
1682 . S X=+NHIPROB(NHI) K NHITM ;ien
1683"RTN","NHINVPL",27,0)
1684 . D EN1(X,.NHITM),XML(.NHITM)
1685"RTN","NHINVPL",28,0)
1686 . S NHICNT=NHICNT+1
1687"RTN","NHINVPL",29,0)
1688 Q
1689"RTN","NHINVPL",30,0)
1690 ;
1691"RTN","NHINVPL",31,0)
1692EN1(ID,PROB) ; -- return a problem in PROB("attribute")=value
1693"RTN","NHINVPL",32,0)
1694 N NHPL,X,I,J K PROB
1695"RTN","NHINVPL",33,0)
1696 S ID=+$G(ID) Q:ID<1 ;invalid ien
1697"RTN","NHINVPL",34,0)
1698 D DETAIL^GMPLUTL2(ID,.NHPL) Q:'$D(NHPL) ;doesn't exist
1699"RTN","NHINVPL",35,0)
1700 S PROB("id")=ID ;,PROB("lexiconID")=+X1 ;SNOMED?
1701"RTN","NHINVPL",36,0)
1702 S PROB("name")=$G(NHPL("NARRATIVE"))
1703"RTN","NHINVPL",37,0)
1704 S X=$G(NHPL("MODIFIED")) S:$L(X) PROB("updated")=$$DATE(X)
1705"RTN","NHINVPL",38,0)
1706 S PROB("icd")=$G(NHPL("DIAGNOSIS"))
1707"RTN","NHINVPL",39,0)
1708 S X=$G(NHPL("STATUS")) S:$L(X) PROB("status")=$E(X)
1709"RTN","NHINVPL",40,0)
1710 S X=$G(NHPL("HISTORY")) S:$L(X) PROB("history")=$E(X)
1711"RTN","NHINVPL",41,0)
1712 S X=$G(NHPL("PRIORITY")) S:$L(X) PROB("acuity")=$E(X)
1713"RTN","NHINVPL",42,0)
1714 S X=$G(NHPL("ONSET")) S:$L(X) PROB("onset")=$$DATE(X)
1715"RTN","NHINVPL",43,0)
1716 S X=$$GET1^DIQ(9000011,ID_",",1.07,"I") S:X PROB("resolved")=X
1717"RTN","NHINVPL",44,0)
1718 S X=$P($G(NHPL("ENTERED")),U) S:$L(X) PROB("entered")=$$DATE(X)
1719"RTN","NHINVPL",45,0)
1720 S X=$$GET1^DIQ(9000011,ID_",",1.02,"I")
1721"RTN","NHINVPL",46,0)
1722 S:X="P" PROB("unverified")=0,PROB("removed")=0
1723"RTN","NHINVPL",47,0)
1724 S:X="T" PROB("unverified")=1,PROB("removed")=0
1725"RTN","NHINVPL",48,0)
1726 S:X="H" PROB("unverified")=0,PROB("removed")=1
1727"RTN","NHINVPL",49,0)
1728 S X=$G(NHPL("SC")),X=$S(X="YES":1,X="NO":0,1:"")
1729"RTN","NHINVPL",50,0)
1730 S:$L(X) PROB("sc")=X I $G(NHPL("EXPOSURE")) D ;ao^rad^pgulf^hnc^mst^cv
1731"RTN","NHINVPL",51,0)
1732 . S I=0 F S I=$O(NHPL("EXPOSURE",I)) Q:I<1 D
1733"RTN","NHINVPL",52,0)
1734 .. S X=$G(NHPL("EXPOSURE",I))
1735"RTN","NHINVPL",53,0)
1736 .. S PROB("exposure",I)=$$EXP(X)
1737"RTN","NHINVPL",54,0)
1738 S X=$G(NHPL("PROVIDER")) S:$L(X) PROB("provider")=$$VA200(X)_U_X
1739"RTN","NHINVPL",55,0)
1740 S X=$$GET1^DIQ(9000011,ID_",",1.06) S:$L(X) PROB("service")=X
1741"RTN","NHINVPL",56,0)
1742 S X=$G(NHPL("CLINIC")) S:$L(X) PROB("location")=X
1743"RTN","NHINVPL",57,0)
1744 S X=+$$GET1^DIQ(9000011,ID_",",.06,"I")
1745"RTN","NHINVPL",58,0)
1746 S:X PROB("facility")=$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U)
1747"RTN","NHINVPL",59,0)
1748 I 'X S PROB("facility")=$$FAC^NHINV ;local stn#^name
1749"RTN","NHINVPL",60,0)
1750CMT ; comments
1751"RTN","NHINVPL",61,0)
1752 Q:'$G(NHPL("COMMENT"))
1753"RTN","NHINVPL",62,0)
1754 S I=0 F S I=$O(NHPL("COMMENT",I)) Q:I<1 D
1755"RTN","NHINVPL",63,0)
1756 . S X=$G(NHPL("COMMENT",I))
1757"RTN","NHINVPL",64,0)
1758 . S PROB("comment",I)=$$DATE($P(X,U))_U_$P(X,U,2,3)
1759"RTN","NHINVPL",65,0)
1760 . ; = date ^ name of author ^ text
1761"RTN","NHINVPL",66,0)
1762 Q
1763"RTN","NHINVPL",67,0)
1764 ;
1765"RTN","NHINVPL",68,0)
1766DATE(X) ; -- Return internal form of date X
1767"RTN","NHINVPL",69,0)
1768 N %DT,Y
1769"RTN","NHINVPL",70,0)
1770 S %DT="" D ^%DT S:Y<1 Y=X
1771"RTN","NHINVPL",71,0)
1772 Q Y
1773"RTN","NHINVPL",72,0)
1774 ;
1775"RTN","NHINVPL",73,0)
1776VA200(X) ; -- Return ien of New Person X
1777"RTN","NHINVPL",74,0)
1778 N Y S Y=$S($L($G(X)):+$O(^VA(200,"B",X,0)),1:"")
1779"RTN","NHINVPL",75,0)
1780 Q Y
1781"RTN","NHINVPL",76,0)
1782 ;
1783"RTN","NHINVPL",77,0)
1784EXP(X) ; -- Return code for exposure name X
1785"RTN","NHINVPL",78,0)
1786 N Y S Y="",X=$E($G(X))
1787"RTN","NHINVPL",79,0)
1788 I X="A" S Y="AO" ;agent orange
1789"RTN","NHINVPL",80,0)
1790 I X="R" S Y="IR" ;ionizing radiation
1791"RTN","NHINVPL",81,0)
1792 I X="E" S Y="PG" ;persian gulf
1793"RTN","NHINVPL",82,0)
1794 I X="H" S Y="HNC" ;head/neck cancer
1795"RTN","NHINVPL",83,0)
1796 I X="M" S Y="MST" ;military sexual trauma
1797"RTN","NHINVPL",84,0)
1798 I X="C" S Y="CV" ;combat vet
1799"RTN","NHINVPL",85,0)
1800 I X="S" S Y="SHAD"
1801"RTN","NHINVPL",86,0)
1802 Q Y
1803"RTN","NHINVPL",87,0)
1804 ;
1805"RTN","NHINVPL",88,0)
1806 ; ------------ Return data to middle tier ------------
1807"RTN","NHINVPL",89,0)
1808 ;
1809"RTN","NHINVPL",90,0)
1810XML(PROB) ; -- Return patient problem as XML in @NHIN@(I)
1811"RTN","NHINVPL",91,0)
1812 N ATT,I,X,Y,P,TAG
1813"RTN","NHINVPL",92,0)
1814 D ADD("<problem>")
1815"RTN","NHINVPL",93,0)
1816 S ATT="" F S ATT=$O(PROB(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
1817"RTN","NHINVPL",94,0)
1818 . I ATT="exposure" D S Y="" Q
1819"RTN","NHINVPL",95,0)
1820 .. S Y="<exposures>" D ADD(Y)
1821"RTN","NHINVPL",96,0)
1822 .. S I=0 F S I=$O(PROB(ATT,I)) Q:I<1 S X=$G(PROB(ATT,I)) S:$L(X) Y="<exposure value='"_X_"' />" D ADD(Y)
1823"RTN","NHINVPL",97,0)
1824 .. D ADD("</exposures>")
1825"RTN","NHINVPL",98,0)
1826 . I ATT="comment" D S Y="" Q
1827"RTN","NHINVPL",99,0)
1828 .. D ADD("<comments>")
1829"RTN","NHINVPL",100,0)
1830 .. S I=0 F S I=$O(PROB(ATT,I)) Q:I<1 S X=$G(PROB(ATT,I)) D
1831"RTN","NHINVPL",101,0)
1832 ... S Y="<comment id='"_I
1833"RTN","NHINVPL",102,0)
1834 ... S:$L($P(X,U,1)) Y=Y_"' entered='"_$P(X,U)
1835"RTN","NHINVPL",103,0)
1836 ... S:$L($P(X,U,2)) Y=Y_"' enteredBy='"_$$ESC^NHINV($P(X,U,2))
1837"RTN","NHINVPL",104,0)
1838 ... S:$L($P(X,U,3)) Y=Y_"' commentText='"_$$ESC^NHINV($P(X,U,3))
1839"RTN","NHINVPL",105,0)
1840 ... S Y=Y_"' />" D ADD(Y)
1841"RTN","NHINVPL",106,0)
1842 .. D ADD("</comments>")
1843"RTN","NHINVPL",107,0)
1844 . S X=$G(PROB(ATT)),Y="" Q:'$L(X)
1845"RTN","NHINVPL",108,0)
1846 . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
1847"RTN","NHINVPL",109,0)
1848 . I $L(X)>1 D S Y=""
1849"RTN","NHINVPL",110,0)
1850 .. S Y="<"_ATT_" "
1851"RTN","NHINVPL",111,0)
1852 .. F P=1:1 S TAG=$P("code^name^Z",U,P) Q:TAG="Z" I $L($P(X,U,P)) S Y=Y_TAG_"='"_$$ESC^NHINV($P(X,U,P))_"' "
1853"RTN","NHINVPL",112,0)
1854 .. S Y=Y_"/>" D ADD(Y)
1855"RTN","NHINVPL",113,0)
1856 D ADD("</problem>")
1857"RTN","NHINVPL",114,0)
1858 Q
1859"RTN","NHINVPL",115,0)
1860 ;
1861"RTN","NHINVPL",116,0)
1862ADD(X) ; Add a line @NHIN@(n)=X
1863"RTN","NHINVPL",117,0)
1864 S NHINI=$G(NHINI)+1
1865"RTN","NHINVPL",118,0)
1866 S @NHIN@(NHINI)=X
1867"RTN","NHINVPL",119,0)
1868 Q
1869"RTN","NHINVPS")
18700^9^B13986678
1871"RTN","NHINVPS",1,0)
1872NHINVPS ;SLC/MKB -- Pharmacy extract
1873"RTN","NHINVPS",2,0)
1874 ;;1.0;NHIN;;Oct 25, 2010;Build 14
1875"RTN","NHINVPS",3,0)
1876 ;
1877"RTN","NHINVPS",4,0)
1878 ; External References DBIA#
1879"RTN","NHINVPS",5,0)
1880 ; ------------------- -----
1881"RTN","NHINVPS",6,0)
1882 ; DIQ 2056
1883"RTN","NHINVPS",7,0)
1884 ; PSOORRL,^TMP("PS",$J) 2400
1885"RTN","NHINVPS",8,0)
1886 ; PSS50,^TMP($J 4483
1887"RTN","NHINVPS",9,0)
1888 ;
1889"RTN","NHINVPS",10,0)
1890 ; ------------ Get medications from VistA ------------
1891"RTN","NHINVPS",11,0)
1892 ;
1893"RTN","NHINVPS",12,0)
1894EN(DFN,BEG,END,MAX,ID) ; -- find patient's meds
1895"RTN","NHINVPS",13,0)
1896 N PS0,NHI,NHITM,IV K ^TMP("PS",$J)
1897"RTN","NHINVPS",14,0)
1898 S DFN=+$G(DFN) Q:DFN<1
1899"RTN","NHINVPS",15,0)
1900 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
1901"RTN","NHINVPS",16,0)
1902 ;
1903"RTN","NHINVPS",17,0)
1904 ; get one med
1905"RTN","NHINVPS",18,0)
1906 I $G(ID) D D:$D(NHITM)>9 XML(.NHITM) K ^TMP("PS",$J) Q
1907"RTN","NHINVPS",19,0)
1908 . I ID["N" D NVA^NHINVPSO(ID,.NHITM) Q
1909"RTN","NHINVPS",20,0)
1910 . I ID["O",(ID'["P")&(ID'["S") D RX^NHINVPSO(ID,.NHITM) Q
1911"RTN","NHINVPS",21,0)
1912 . D OEL^PSOORRL(DFN,ID)
1913"RTN","NHINVPS",22,0)
1914 . I ID["O",(ID["P")!(ID["S") D PEN1^NHINVPSO(ID,.NHITM) Q
1915"RTN","NHINVPS",23,0)
1916 . S IV=$S(ID["V":1,$G(^TMP("PS",$J,"B",0)):1,1:0)
1917"RTN","NHINVPS",24,0)
1918 . D @($S(IV:"IV1",1:"IN1")_"^NHINVPSI(ID,.NHITM)")
1919"RTN","NHINVPS",25,0)
1920 ;
1921"RTN","NHINVPS",26,0)
1922 ; get all meds
1923"RTN","NHINVPS",27,0)
1924 D OCL^PSOORRL(DFN,BEG,END)
1925"RTN","NHINVPS",28,0)
1926 S NHI=0 F S NHI=$O(^TMP("PS",$J,NHI)) Q:NHI<1!(NHI>MAX) S PS0=$G(^(NHI,0)) D I $D(NHITM)>9 D XML(.NHITM)
1927"RTN","NHINVPS",29,0)
1928 . S ID=$P(PS0,U) K NHITM
1929"RTN","NHINVPS",30,0)
1930 . I ID["N" D NVA^NHINVPSO(ID,.NHITM) Q
1931"RTN","NHINVPS",31,0)
1932 . I ID["O" D RX^NHINVPSO(ID,.NHITM) Q
1933"RTN","NHINVPS",32,0)
1934 . S IV=$S(ID["V":1,$G(^TMP("PS",$J,NHI,"B",0)):1,1:0)
1935"RTN","NHINVPS",33,0)
1936 . D @($S(IV:"IV",1:"IN")_"^NHINVPSI(ID,.NHITM)")
1937"RTN","NHINVPS",34,0)
1938 K ^TMP("PS",$J)
1939"RTN","NHINVPS",35,0)
1940 Q
1941"RTN","NHINVPS",36,0)
1942 ;
1943"RTN","NHINVPS",37,0)
1944NDF(DRUG,I) ; -- Set NDF data for dispense DRUG ien
1945"RTN","NHINVPS",38,0)
1946 N VUID,X
1947"RTN","NHINVPS",39,0)
1948 S DRUG=+$G(DRUG) Q:'DRUG
1949"RTN","NHINVPS",40,0)
1950 D NDF^PSS50(DRUG,,,,,"NDF") S I=+$G(I)+1
1951"RTN","NHINVPS",41,0)
1952 S MED("product",I)=DRUG_U_$G(^TMP($J,"NDF",DRUG,.01))_"^^D" ;Drug
1953"RTN","NHINVPS",42,0)
1954 S X=$G(^TMP($J,"NDF",DRUG,20)),VUID=$$GET1^DIQ(50.6,+X_",",99.99)
1955"RTN","NHINVPS",43,0)
1956 S MED("product",I,"G")=X_U_VUID ;VA Generic
1957"RTN","NHINVPS",44,0)
1958 S X=$G(^TMP($J,"NDF",DRUG,22)),VUID=$$GET1^DIQ(50.68,+X_",",99.99)
1959"RTN","NHINVPS",45,0)
1960 S MED("product",I,"P")=X_U_VUID ;VA Product
1961"RTN","NHINVPS",46,0)
1962 S MED("product",I,"C")=$P($G(^TMP($J,"NDF",+DRUG,25)),U,3) ;display name
1963"RTN","NHINVPS",47,0)
1964 K ^TMP($J,"NDF",DRUG)
1965"RTN","NHINVPS",48,0)
1966 Q
1967"RTN","NHINVPS",49,0)
1968 ;
1969"RTN","NHINVPS",50,0)
1970 ; ------------ Return data to middle tier ------------
1971"RTN","NHINVPS",51,0)
1972 ;
1973"RTN","NHINVPS",52,0)
1974XML(MED) ; -- Return patient meds as XML
1975"RTN","NHINVPS",53,0)
1976 N ATT,X,Y,I,NAMES
1977"RTN","NHINVPS",54,0)
1978 D ADD("<med>")
1979"RTN","NHINVPS",55,0)
1980 S ATT="" F S ATT=$O(MED(ATT)) Q:ATT="" D I $L(Y) D ADD(Y)
1981"RTN","NHINVPS",56,0)
1982 . I $O(MED(ATT,0)) D S Y="" Q ;multiples
1983"RTN","NHINVPS",57,0)
1984 .. D ADD("<"_ATT_"s>")
1985"RTN","NHINVPS",58,0)
1986 .. S I=0 F S I=$O(MED(ATT,I)) Q:I<1 D
1987"RTN","NHINVPS",59,0)
1988 ... S X=$G(MED(ATT,I)),NAMES=""
1989"RTN","NHINVPS",60,0)
1990 ... I ATT="dose" S NAMES="dose^units^unitsPerDose^noun^route^schedule^duration^conjunction^doseStart^doseStop^Z"
1991"RTN","NHINVPS",61,0)
1992 ... I ATT="fill" S NAMES="fillDate^fillRouting^releaseDate^fillQuantity^fillDaysSupply^partial^Z"
1993"RTN","NHINVPS",62,0)
1994 ... I ATT="product" S NAMES="code^name^vuid^role^concentration^Z"
1995"RTN","NHINVPS",63,0)
1996 ... S Y="<"_ATT_" "_$$LOOP_$S(ATT'="product":"/>",1:">") D ADD(Y)
1997"RTN","NHINVPS",64,0)
1998 ... Q:ATT'="product"
1999"RTN","NHINVPS",65,0)
2000 ... S X=$G(MED(ATT,I,"C")) I $L(X) S Y="<class "_$$LOOP_"/>" D ADD(Y)
2001"RTN","NHINVPS",66,0)
2002 ... S X=$G(MED(ATT,I,"G")) I $L(X) S Y="<vaGeneric "_$$LOOP_"/>" D ADD(Y)
2003"RTN","NHINVPS",67,0)
2004 ... S X=$G(MED(ATT,I,"P")) I $L(X) S Y="<vaProduct "_$$LOOP_"/>" D ADD(Y)
2005"RTN","NHINVPS",68,0)
2006 ... D ADD("</product>")
2007"RTN","NHINVPS",69,0)
2008 .. D ADD("</"_ATT_"s>")
2009"RTN","NHINVPS",70,0)
2010 . S X=$G(MED(ATT)),Y="" Q:'$L(X)
2011"RTN","NHINVPS",71,0)
2012 . I ATT="sig"!(ATT?1"ptIn"1.A) S Y="<"_ATT_" xml:space='preserve'>"_$$ESC^NHINV(X)_"</"_ATT_">" Q
2013"RTN","NHINVPS",72,0)
2014 . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
2015"RTN","NHINVPS",73,0)
2016 . I $L(X)>1 S NAMES="code^name^Z",Y="<"_ATT_" "_$$LOOP_"/>"
2017"RTN","NHINVPS",74,0)
2018 D ADD("</med>")
2019"RTN","NHINVPS",75,0)
2020 Q
2021"RTN","NHINVPS",76,0)
2022 ;
2023"RTN","NHINVPS",77,0)
2024LOOP() ; -- build sub-items string from NAMES and X
2025"RTN","NHINVPS",78,0)
2026 N STR,P,TAG S STR=""
2027"RTN","NHINVPS",79,0)
2028 F P=1:1 S TAG=$P(NAMES,U,P) Q:TAG="Z" I $L($P(X,U,P)) S STR=STR_TAG_"='"_$$ESC^NHINV($P(X,U,P))_"' "
2029"RTN","NHINVPS",80,0)
2030 Q STR
2031"RTN","NHINVPS",81,0)
2032 ;
2033"RTN","NHINVPS",82,0)
2034ADD(X) ; Add a line @NHIN@(n)=X
2035"RTN","NHINVPS",83,0)
2036 S NHINI=$G(NHINI)+1
2037"RTN","NHINVPS",84,0)
2038 S @NHIN@(NHINI)=X
2039"RTN","NHINVPS",85,0)
2040 Q
2041"RTN","NHINVPSI")
20420^10^B32869468
2043"RTN","NHINVPSI",1,0)
2044NHINVPSI ;SLC/MKB -- Inpatient Pharmacy extract
2045"RTN","NHINVPSI",2,0)
2046 ;;1.0;NHIN;;Oct 25, 2010;Build 14
2047"RTN","NHINVPSI",3,0)
2048 ;
2049"RTN","NHINVPSI",4,0)
2050 ; External References DBIA#
2051"RTN","NHINVPSI",5,0)
2052 ; ------------------- -----
2053"RTN","NHINVPSI",6,0)
2054 ; ^SC 10040
2055"RTN","NHINVPSI",7,0)
2056 ; DIQ 2056
2057"RTN","NHINVPSI",8,0)
2058 ; ORX8 2467
2059"RTN","NHINVPSI",9,0)
2060 ; PSOORRL,^TMP("PS",$J) 2400
2061"RTN","NHINVPSI",10,0)
2062 ; PSS50P7 4662
2063"RTN","NHINVPSI",11,0)
2064 ; XLFSTR 10104
2065"RTN","NHINVPSI",12,0)
2066 ;
2067"RTN","NHINVPSI",13,0)
2068 ; ------------ Get medications from VistA ------------
2069"RTN","NHINVPSI",14,0)
2070 ;
2071"RTN","NHINVPSI",15,0)
2072EN(DFN,BEG,END,MAX,ID) ; -- find patient's UD/IV meds
2073"RTN","NHINVPSI",16,0)
2074 N PS0,NHI,NHITM,IV K ^TMP("PS",$J)
2075"RTN","NHINVPSI",17,0)
2076 S DFN=+$G(DFN) Q:DFN<1
2077"RTN","NHINVPSI",18,0)
2078 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
2079"RTN","NHINVPSI",19,0)
2080 ;
2081"RTN","NHINVPSI",20,0)
2082 ; get one med
2083"RTN","NHINVPSI",21,0)
2084 I $G(ID) D Q
2085"RTN","NHINVPSI",22,0)
2086 . Q:ID["N" Q:ID["O" ;inpatient only
2087"RTN","NHINVPSI",23,0)
2088 . D OEL^PSOORRL(DFN,ID)
2089"RTN","NHINVPSI",24,0)
2090 . S IV=$S(ID["V":1,$G(^TMP("PS",$J,"B",0)):1,1:0)
2091"RTN","NHINVPSI",25,0)
2092 . D @($S(IV:"IV1",1:"IN1")_"(ID,.NHITM)")
2093"RTN","NHINVPSI",26,0)
2094 . I $D(NHITM)>9 D XML^NHINVPS(.NHITM)
2095"RTN","NHINVPSI",27,0)
2096 . K ^TMP("PS",$J)
2097"RTN","NHINVPSI",28,0)
2098 ;
2099"RTN","NHINVPSI",29,0)
2100 ; get all meds
2101"RTN","NHINVPSI",30,0)
2102 D OCL^PSOORRL(DFN,BEG,END)
2103"RTN","NHINVPSI",31,0)
2104 S NHI=0 F S NHI=$O(^TMP("PS",$J,NHI)) Q:NHI<1!(NHI>MAX) S PS0=$G(^(NHI,0)) D
2105"RTN","NHINVPSI",32,0)
2106 . S ID=$P(PS0,U) K NHITM
2107"RTN","NHINVPSI",33,0)
2108 . Q:ID["N" Q:ID["O" ;inpatient only
2109"RTN","NHINVPSI",34,0)
2110 . S IV=$S(ID["V":1,$G(^TMP("PS",$J,NHI,"B",0)):1,1:0)
2111"RTN","NHINVPSI",35,0)
2112 . D @($S(IV:"IV",1:"IN")_"(ID,.NHITM)")
2113"RTN","NHINVPSI",36,0)
2114 . I $D(NHITM)>9 D XML^NHINVPS(.NHITM)
2115"RTN","NHINVPSI",37,0)
2116 K ^TMP("PS",$J)
2117"RTN","NHINVPSI",38,0)
2118 Q
2119"RTN","NHINVPSI",39,0)
2120 ;
2121"RTN","NHINVPSI",40,0)
2122IN(ID,MED) ; -- return a medication in MED("attribute")=value
2123"RTN","NHINVPSI",41,0)
2124 ; [expects PS0,OCL^PSOORRL data]
2125"RTN","NHINVPSI",42,0)
2126 N X,PS,ORDER,DOSE,UNTS,RTE,SCH,OI,PSOI,LOC K MED
2127"RTN","NHINVPSI",43,0)
2128 M PS=^TMP("PS",$J,NHI)
2129"RTN","NHINVPSI",44,0)
2130 S MED("id")=ID,MED("vaType")="I"
2131"RTN","NHINVPSI",45,0)
2132 S X=$P(PS0,U,15) S:X MED("start")=X
2133"RTN","NHINVPSI",46,0)
2134 S X=$P(PS0,U,4) S:X MED("stop")=X
2135"RTN","NHINVPSI",47,0)
2136 S MED("name")=$P(PS0,U,2),X=$P(PS0,U,9),MED("vaStatus")=X,X=$E(X,1,3)
2137"RTN","NHINVPSI",48,0)
2138 S MED("status")=$S(X="DIS"!(X="PEN"):"not active",X="EXP"!(X="REN"):"historical",X="REI":"active",1:$$LOW^XLFSTR($P(PS0,U,9)))
2139"RTN","NHINVPSI",49,0)
2140 S DOSE=$P(PS0,U,6) S:DOSE="" DOSE=$G(PS("SIG",1,0))
2141"RTN","NHINVPSI",50,0)
2142 S RTE=$G(PS("MDR",1,0)),SCH=$P($G(PS("SCH",1,0)),U)
2143"RTN","NHINVPSI",51,0)
2144 S MED("dose",1)=DOSE_"^^^^"_RTE_U_SCH
2145"RTN","NHINVPSI",52,0)
2146 S MED("sig")="Give: "_DOSE_" "_RTE_" "_SCH I $G(PS("SIO",0)) D
2147"RTN","NHINVPSI",53,0)
2148 . N SIO M SIO=PS("SIO")
2149"RTN","NHINVPSI",54,0)
2150 . S MED("sig")=MED("sig")_$C(13,10)_$$STRING^NHINV(.SIO)
2151"RTN","NHINVPSI",55,0)
2152 I $D(PS("P",0)) S MED("orderingProvider")=PS("P",0)
2153"RTN","NHINVPSI",56,0)
2154 S MED("facility")=$$FAC^NHINV ;local stn#^name
2155"RTN","NHINVPSI",57,0)
2156 S ORDER=+$P(PS0,U,8) D:ORDER ORD
2157"RTN","NHINVPSI",58,0)
2158 Q
2159"RTN","NHINVPSI",59,0)
2160 ;
2161"RTN","NHINVPSI",60,0)
2162IN1(ID,MED) ; -- return a medication in MED("attribute")=value
2163"RTN","NHINVPSI",61,0)
2164 ; [expects OEL^PSOORRL data]
2165"RTN","NHINVPSI",62,0)
2166 N X,PS,PS0,ORDER,DOSE,UNTS,RTE,SCH,OI,PSOI,LOC K MED
2167"RTN","NHINVPSI",63,0)
2168 M PS=^TMP("PS",$J) S PS0=PS(0)
2169"RTN","NHINVPSI",64,0)
2170 S MED("id")=ID,MED("vaType")="I"
2171"RTN","NHINVPSI",65,0)
2172 S X=$P(PS0,U,5) S:X MED("start")=X
2173"RTN","NHINVPSI",66,0)
2174 S X=$P(PS0,U,3) S:X MED("stop")=X
2175"RTN","NHINVPSI",67,0)
2176 S MED("name")=$P(PS0,U),X=$P(PS0,U,6),MED("vaStatus")=X,X=$E(X,1,3)
2177"RTN","NHINVPSI",68,0)
2178 S MED("status")=$S(X="DIS"!(X="PEN"):"not active",X="EXP"!(X="REN"):"historical",X="REI":"active",1:$$LOW^XLFSTR($P(PS0,U,9)))
2179"RTN","NHINVPSI",69,0)
2180 S DOSE=$P(PS0,U,9) S:DOSE="" DOSE=$G(PS("SIG",1,0))
2181"RTN","NHINVPSI",70,0)
2182 S RTE=$G(PS("MDR",1,0)),SCH=$P($G(PS("SCH",1,0)),U)
2183"RTN","NHINVPSI",71,0)
2184 S MED("dose",1)=DOSE_"^^^^"_RTE_U_SCH
2185"RTN","NHINVPSI",72,0)
2186 S MED("sig")="Give: "_DOSE_" "_RTE_" "_SCH I $G(PS("SIO",0)) D
2187"RTN","NHINVPSI",73,0)
2188 . N SIO M SIO=PS("SIO")
2189"RTN","NHINVPSI",74,0)
2190 . S MED("sig")=MED("sig")_$C(13,10)_$$STRING^NHINV(.SIO)
2191"RTN","NHINVPSI",75,0)
2192 I $D(PS("P",0)) S MED("orderingProvider")=PS("P",0)
2193"RTN","NHINVPSI",76,0)
2194 S MED("facility")=$$FAC^NHINV ;local stn#^name
2195"RTN","NHINVPSI",77,0)
2196 S ORDER=+$P(PS0,U,11) D:ORDER ORD
2197"RTN","NHINVPSI",78,0)
2198 Q
2199"RTN","NHINVPSI",79,0)
2200 ;
2201"RTN","NHINVPSI",80,0)
2202ORD ; get rest of inpatient data from ORDER
2203"RTN","NHINVPSI",81,0)
2204 S MED("orderID")=ORDER
2205"RTN","NHINVPSI",82,0)
2206 S OI=$$OI^ORX8(ORDER),PSOI=+$P(OI,U,3)
2207"RTN","NHINVPSI",83,0)
2208 S MED("name")=$P(OI,U,2) I PSOI D
2209"RTN","NHINVPSI",84,0)
2210 . D ZERO^PSS50P7(PSOI,,,"OI")
2211"RTN","NHINVPSI",85,0)
2212 . S MED("form")=$P($G(^TMP($J,"OI",PSOI,.02)),U,2)
2213"RTN","NHINVPSI",86,0)
2214 S X=$$VALUE^ORX8(ORDER,"DOSE"),DOSE=DOSE_"^^^"
2215"RTN","NHINVPSI",87,0)
2216 S DRUG="" I X'="",X["&" D
2217"RTN","NHINVPSI",88,0)
2218 . S DRUG=+$P(X,"&",6)
2219"RTN","NHINVPSI",89,0)
2220 . S DOSE=$TR($P(X,"&",1,4),"&","^")
2221"RTN","NHINVPSI",90,0)
2222 . S $P(MED("dose",1),U,1,4)=DOSE
2223"RTN","NHINVPSI",91,0)
2224 S:'DRUG DRUG=+$$VALUE^ORX8(ORDER,"DRUG")
2225"RTN","NHINVPSI",92,0)
2226 D:DRUG NDF^NHINVPS(DRUG)
2227"RTN","NHINVPSI",93,0)
2228 S LOC=+$$GET1^DIQ(100,ORDER_",",6,"I") I LOC D
2229"RTN","NHINVPSI",94,0)
2230 . S MED("location")=$P($G(^SC(LOC,0)),U)
2231"RTN","NHINVPSI",95,0)
2232 . S MED("facility")=$$FAC^NHINV(LOC)
2233"RTN","NHINVPSI",96,0)
2234 K ^TMP($J,"OI")
2235"RTN","NHINVPSI",97,0)
2236 Q
2237"RTN","NHINVPSI",98,0)
2238 ;
2239"RTN","NHINVPSI",99,0)
2240IV(ID,MED) ; -- return an infusion in MED("attribute")=value
2241"RTN","NHINVPSI",100,0)
2242 ; [expects PS0,OCL^PSOORRL data]
2243"RTN","NHINVPSI",101,0)
2244 N PS,X K MED
2245"RTN","NHINVPSI",102,0)
2246 M PS=^TMP("PS",$J,NHI)
2247"RTN","NHINVPSI",103,0)
2248 S MED("id")=ID,MED("vaType")="V",MED("name")=$P(PS0,U,2)
2249"RTN","NHINVPSI",104,0)
2250 S X=$P(PS0,U,15) S:X MED("start")=X
2251"RTN","NHINVPSI",105,0)
2252 S X=$P(PS0,U,4) S:X MED("stop")=X
2253"RTN","NHINVPSI",106,0)
2254 S MED("vaStatus")=$P(PS0,U,9),X=$E($P(PS0,U,9),1,3)
2255"RTN","NHINVPSI",107,0)
2256 S MED("status")=$S(X="DIS"!(X="PEN"):"not active",X="EXP"!(X="PUR"):"historical",X="HOL":"hold",1:"active")
2257"RTN","NHINVPSI",108,0)
2258 S MED("dose",1)=$P(PS0,U,3)_"^^^^"_$G(PS("MDR",1,0))_U_$P($G(PS("SCH",1,0)),U)
2259"RTN","NHINVPSI",109,0)
2260 S MED("facility")=$$FAC^NHINV ;local stn#^name
2261"RTN","NHINVPSI",110,0)
2262 I $G(PS("P",0)) S MED("orderingProvider")=PS("P",0)
2263"RTN","NHINVPSI",111,0)
2264 D IVP
2265"RTN","NHINVPSI",112,0)
2266 Q
2267"RTN","NHINVPSI",113,0)
2268 ;
2269"RTN","NHINVPSI",114,0)
2270IV1(ID,MED) ; -- return an infusion in MED("attribute")=value
2271"RTN","NHINVPSI",115,0)
2272 ; [expects OEL^PSOORRL data]
2273"RTN","NHINVPSI",116,0)
2274 N PS,PS0,X K MED
2275"RTN","NHINVPSI",117,0)
2276 M PS=^TMP("PS",$J) S PS0=PS(0)
2277"RTN","NHINVPSI",118,0)
2278 S MED("id")=ID,MED("vaType")="V",MED("name")=$P(PS0,U)
2279"RTN","NHINVPSI",119,0)
2280 S X=$P(PS0,U,5) S:X MED("start")=X
2281"RTN","NHINVPSI",120,0)
2282 S X=$P(PS0,U,3) S:X MED("stop")=X
2283"RTN","NHINVPSI",121,0)
2284 S MED("vaStatus")=$P(PS0,U,6),X=$E($P(PS0,U,6),1,3)
2285"RTN","NHINVPSI",122,0)
2286 S MED("status")=$S(X="DIS"!(X="PEN"):"not active",X="EXP"!(X="PUR"):"historical",X="HOL":"hold",1:"active")
2287"RTN","NHINVPSI",123,0)
2288 S MED("dose",1)=$P(PS0,U,2)_"^^^^"_$G(PS("MDR",1,0))_U_$P($G(PS("SCH",1,0)),U)
2289"RTN","NHINVPSI",124,0)
2290 S MED("facility")=$$FAC^NHINV ;local stn#^name
2291"RTN","NHINVPSI",125,0)
2292 I $G(PS("P",0)) S MED("orderingProvider")=PS("P",0)
2293"RTN","NHINVPSI",126,0)
2294 D IVP
2295"RTN","NHINVPSI",127,0)
2296 Q
2297"RTN","NHINVPSI",128,0)
2298 ;
2299"RTN","NHINVPSI",129,0)
2300IVP ; -- add IV products for ID,DFN
2301"RTN","NHINVPSI",130,0)
2302 N I,N,FILE,IENS,NHIN,LIST,IEN,DRUG,STR
2303"RTN","NHINVPSI",131,0)
2304 S FILE=$S(ID["P":53.157,1:55.02),N=0
2305"RTN","NHINVPSI",132,0)
2306 S IENS=","_+ID_","_$S(ID["P":"",1:DFN_",")
2307"RTN","NHINVPSI",133,0)
2308 F I=1:1 K NHIN D GETS^DIQ(FILE,I_IENS,"*","IE","NHIN") Q:'$D(NHIN) D
2309"RTN","NHINVPSI",134,0)
2310 . K LIST M LIST=NHIN(FILE,I_IENS)
2311"RTN","NHINVPSI",135,0)
2312 . S IEN=LIST(.01,"I"),DRUG=$$GET1^DIQ(52.6,IEN_",",1,"I")
2313"RTN","NHINVPSI",136,0)
2314 . D:DRUG NDF^NHINVPS(DRUG,.N) S:'DRUG N=N+1
2315"RTN","NHINVPSI",137,0)
2316 . S STR=$S(FILE=53.157:LIST(1,"E"),1:LIST(.02,"E"))
2317"RTN","NHINVPSI",138,0)
2318 . S MED("product",N)=IEN_U_LIST(.01,"E")_"^^A^"_STR
2319"RTN","NHINVPSI",139,0)
2320 S FILE=$S(ID["P":53.158,1:55.11)
2321"RTN","NHINVPSI",140,0)
2322 F I=1:1 K NHIN D GETS^DIQ(FILE,I_IENS,"*","IE","NHIN") Q:'$D(NHIN) D
2323"RTN","NHINVPSI",141,0)
2324 . K LIST M LIST=NHIN(FILE,I_IENS)
2325"RTN","NHINVPSI",142,0)
2326 . S IEN=LIST(.01,"I"),DRUG=$$GET1^DIQ(52.7,IEN_",",1,"I")
2327"RTN","NHINVPSI",143,0)
2328 . D:DRUG NDF^NHINVPS(DRUG,.N) S:'DRUG N=N+1
2329"RTN","NHINVPSI",144,0)
2330 . S MED("product",N)=IEN_U_LIST(.01,"E")_"^^B^"_LIST(1,"E")
2331"RTN","NHINVPSI",145,0)
2332 Q
2333"RTN","NHINVPSO")
23340^11^B66033397
2335"RTN","NHINVPSO",1,0)
2336NHINVPSO ;SLC/MKB -- Outpatient Pharmacy extract
2337"RTN","NHINVPSO",2,0)
2338 ;;1.0;NHIN;;Oct 25, 2010;Build 14
2339"RTN","NHINVPSO",3,0)
2340 ;
2341"RTN","NHINVPSO",4,0)
2342 ; External References DBIA#
2343"RTN","NHINVPSO",5,0)
2344 ; ------------------- -----
2345"RTN","NHINVPSO",6,0)
2346 ; ^SC 10040
2347"RTN","NHINVPSO",7,0)
2348 ; ^VA(200) 10060
2349"RTN","NHINVPSO",8,0)
2350 ; DIQ 2056
2351"RTN","NHINVPSO",9,0)
2352 ; ORX8 2467
2353"RTN","NHINVPSO",10,0)
2354 ; PSO5241 4821
2355"RTN","NHINVPSO",11,0)
2356 ; PSOORDER,^TMP("PSOR",$J) 1878
2357"RTN","NHINVPSO",12,0)
2358 ; PSOORRL,^TMP("PS",$J) 2400
2359"RTN","NHINVPSO",13,0)
2360 ; PSS50P7 4662
2361"RTN","NHINVPSO",14,0)
2362 ; PSS51P2 4548
2363"RTN","NHINVPSO",15,0)
2364 ; XLFDT 10103
2365"RTN","NHINVPSO",16,0)
2366 ;
2367"RTN","NHINVPSO",17,0)
2368 ; ------------ Get medications from VistA ------------
2369"RTN","NHINVPSO",18,0)
2370 ;
2371"RTN","NHINVPSO",19,0)
2372EN(DFN,BEG,END,MAX,ID) ; -- find patient's meds
2373"RTN","NHINVPSO",20,0)
2374 N PS0,NHI,NHITM K ^TMP("PS",$J)
2375"RTN","NHINVPSO",21,0)
2376 S DFN=+$G(DFN) Q:DFN<1
2377"RTN","NHINVPSO",22,0)
2378 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
2379"RTN","NHINVPSO",23,0)
2380 ;
2381"RTN","NHINVPSO",24,0)
2382 ; get one med
2383"RTN","NHINVPSO",25,0)
2384 I $G(ID) D D:$D(NHITM)>9 XML^NHINVPS(.NHITM) Q
2385"RTN","NHINVPSO",26,0)
2386 . Q:ID["I"
2387"RTN","NHINVPSO",27,0)
2388 . I ID["N" D NVA(ID,.NHITM) Q
2389"RTN","NHINVPSO",28,0)
2390 . I ID'["P",ID'["S" D RX(ID,.NHITM) Q
2391"RTN","NHINVPSO",29,0)
2392 . D OEL^PSOORRL(DFN,ID),PEN1(ID,.NHITM)
2393"RTN","NHINVPSO",30,0)
2394 . K ^TMP("PS",$J)
2395"RTN","NHINVPSO",31,0)
2396 ;
2397"RTN","NHINVPSO",32,0)
2398 ; get all meds
2399"RTN","NHINVPSO",33,0)
2400 D OCL^PSOORRL(DFN,BEG,END)
2401"RTN","NHINVPSO",34,0)
2402 S NHI=0 F S NHI=$O(^TMP("PS",$J,NHI)) Q:NHI<1!(NHI>MAX) S PS0=$G(^(NHI,0)) D I $D(NHITM)>9 D XML^NHINVPS(.NHITM)
2403"RTN","NHINVPSO",35,0)
2404 . S ID=$P(PS0,U) K NHITM Q:ID["I"
2405"RTN","NHINVPSO",36,0)
2406 . I ID["N" D NVA(ID,.NHITM) Q
2407"RTN","NHINVPSO",37,0)
2408 . I ID["O" D RX(ID,.NHITM) Q
2409"RTN","NHINVPSO",38,0)
2410 K ^TMP("PS",$J)
2411"RTN","NHINVPSO",39,0)
2412 Q
2413"RTN","NHINVPSO",40,0)
2414 ;
2415"RTN","NHINVPSO",41,0)
2416RX(ID,MED) ; -- return a prescription in MED("attribute")=value
2417"RTN","NHINVPSO",42,0)
2418 I ID["P"!(ID["S") G PEND ;pending order
2419"RTN","NHINVPSO",43,0)
2420 N RX0,RX1,DRUG,PSOI,X,I,START,STOP,ORIFN,FILL,RFD,PRV K MED
2421"RTN","NHINVPSO",44,0)
2422 K ^TMP("PSOR",$J) D EN^PSOORDER(DFN,+ID)
2423"RTN","NHINVPSO",45,0)
2424 S RX0=$G(^TMP("PSOR",$J,+ID,0)),RX1=$G(^(1)),DRUG=$G(^("DRUG",0))
2425"RTN","NHINVPSO",46,0)
2426 S MED("id")=ID,MED("vaType")="O",MED("type")="Prescription"
2427"RTN","NHINVPSO",47,0)
2428 S ORIFN=+$P(RX1,U,8) S:ORIFN MED("orderID")=ORIFN
2429"RTN","NHINVPSO",48,0)
2430 S PSOI=$G(^TMP("PSOR",$J,+ID,"DRUGOI",0)) I PSOI D
2431"RTN","NHINVPSO",49,0)
2432 . S MED("name")=$P(PSOI,";",2)
2433"RTN","NHINVPSO",50,0)
2434 . D ZERO^PSS50P7(+PSOI,,,"OI")
2435"RTN","NHINVPSO",51,0)
2436 . S MED("form")=$P($G(^TMP($J,"OI",+PSOI,.02)),U,2)
2437"RTN","NHINVPSO",52,0)
2438 D:DRUG NDF^NHINVPS(+DRUG) ;add NDF data
2439"RTN","NHINVPSO",53,0)
2440 S START=$P(RX0,U) S:START MED("start")=START
2441"RTN","NHINVPSO",54,0)
2442 S STOP=$P(RX0,U,12) S:STOP MED("stop")=STOP ;_".2359"?
2443"RTN","NHINVPSO",55,0)
2444 S X=$$GET1^DIQ(52,+ID_",",26,"I") S:X MED("expires")=X
2445"RTN","NHINVPSO",56,0)
2446 S X=$P(RX0,U,17) S:X MED("ordered")=X
2447"RTN","NHINVPSO",57,0)
2448 S MED("vaStatus")=$P($P(RX0,U,4),";",2)
2449"RTN","NHINVPSO",58,0)
2450 S X=$$GET1^DIQ(52,+ID_",",100,"I"),MED("status")=$S(X=3!(X=16):"hold",X>9:"not active",1:"active")
2451"RTN","NHINVPSO",59,0)
2452 S MED("quantity")=$P(RX0,U,6),MED("daysSupply")=$P(RX0,U,7)
2453"RTN","NHINVPSO",60,0)
2454 S MED("fillsAllowed")=$P(RX0,U,8),MED("fillsRemaining")=$P(RX0,U,9)
2455"RTN","NHINVPSO",61,0)
2456 S MED("routing")=$P($P(RX1,U,6),";"),MED("prescription")=$P(RX0,U,5)
2457"RTN","NHINVPSO",62,0)
2458 S MED("lastFilled")=$P(RX0,U,3) K FILL
2459"RTN","NHINVPSO",63,0)
2460 S I=0 F S I=$O(^TMP("PSOR",$J,+ID,"REF",I)) Q:I<1 S X=$G(^(I,0)),FILL(+X)=X
2461"RTN","NHINVPSO",64,0)
2462 S I=0 F S I=$O(^TMP("PSOR",$J,+ID,"RPAR",I)) Q:I<1 S X=$G(^(I,0)),$P(X,U,14)=1,FILL(+X)=X
2463"RTN","NHINVPSO",65,0)
2464 S (I,RFD,PRV)=0 F S RFD=$O(FILL(RFD)) Q:RFD<1 S X=$G(FILL(RFD)) D ;sort 1st
2465"RTN","NHINVPSO",66,0)
2466 . N MW,REL S I=I+1
2467"RTN","NHINVPSO",67,0)
2468 . S RFD=$P(RFD,"."),MW=$P($P(X,U,10),";"),REL=$P($P(X,U,8),".")
2469"RTN","NHINVPSO",68,0)
2470 . S MED("fill",I)=RFD_U_MW_U_REL_U_$P(X,U,4,5)_$S($P(X,U,14):"^1",1:"")
2471"RTN","NHINVPSO",69,0)
2472 . S:$P(X,U,2) PRV=$P(X,U,2) ;save last provider
2473"RTN","NHINVPSO",70,0)
2474 . ; fill comments?
2475"RTN","NHINVPSO",71,0)
2476 S X=$S($P(RX0,U,11):$P(RX0,U,11),$P(RX0,U,10):$P(RX0,U,10),1:0)
2477"RTN","NHINVPSO",72,0)
2478 S:X MED("fillCost")=X
2479"RTN","NHINVPSO",73,0)
2480 S X=$G(^TMP("PSOR",$J,+ID,"SIG",1,0)),I=1
2481"RTN","NHINVPSO",74,0)
2482 F S I=$O(^TMP("PSOR",$J,+ID,"SIG",I)) Q:I<1 S X=X_$G(^(I,0))
2483"RTN","NHINVPSO",75,0)
2484 S MED("sig")=X
2485"RTN","NHINVPSO",76,0)
2486 S X=$G(^TMP("PSOR",$J,+ID,"PI",1,0)),I=1
2487"RTN","NHINVPSO",77,0)
2488 F S I=$O(^TMP("PSOR",$J,+ID,"PI",I)) Q:I<1 S X=X_$G(^(I,0))
2489"RTN","NHINVPSO",78,0)
2490 S:$L(X) MED("ptInstructions")=X
2491"RTN","NHINVPSO",79,0)
2492 S I=0 F S I=$O(^TMP("PSOR",$J,+ID,"MI",I)) Q:I<1 S X=$G(^(I,0)) D
2493"RTN","NHINVPSO",80,0)
2494 . N UD,NOUN,DOSE,UNIT,RTE,SCH,DUR,CONJ,END
2495"RTN","NHINVPSO",81,0)
2496 . S UD=$P(X,U,2),NOUN=$P(X,U,4)
2497"RTN","NHINVPSO",82,0)
2498 . S DOSE=$P(X,U),UNIT=$P($P(X,U,3),";",2)
2499"RTN","NHINVPSO",83,0)
2500 . S RTE=+$P(X,U,7) D ALL^PSS51P2(RTE,,,,"MR")
2501"RTN","NHINVPSO",84,0)
2502 . S RTE=$G(^TMP($J,"MR",RTE,1))
2503"RTN","NHINVPSO",85,0)
2504 . S DUR=$P(X,U,5),CONJ=$P(X,U,6),SCH=$P(X,U,8)
2505"RTN","NHINVPSO",86,0)
2506 . S END=$S(DUR:$$STOP(START,DUR),1:STOP)
2507"RTN","NHINVPSO",87,0)
2508 . S MED("dose",I)=DOSE_U_UNIT_U_UD_U_NOUN_U_RTE_U_SCH_U_DUR_U_CONJ_U_START_U_STOP
2509"RTN","NHINVPSO",88,0)
2510 . I $E(CONJ)="T",DUR S START=END
2511"RTN","NHINVPSO",89,0)
2512 S:RX1 X=$TR($P(RX1,U),";","^"),MED("orderingProvider")=X,MED("currentProvider")=X
2513"RTN","NHINVPSO",90,0)
2514 S:$G(PRV) MED("currentProvider")=$TR(PRV,";","^")
2515"RTN","NHINVPSO",91,0)
2516 S:$P(RX1,U,9) MED("pharmacist")=$TR($P(RX1,U,9),";","^")
2517"RTN","NHINVPSO",92,0)
2518 S:$P(RX1,U,4) MED("location")=$TR($P(RX1,U,4),";","^")
2519"RTN","NHINVPSO",93,0)
2520 S MED("facility")=$$FAC^NHINV(+$P(RX1,U,4))
2521"RTN","NHINVPSO",94,0)
2522 K ^TMP("PSOR",$J),^TMP($J,"MR"),^TMP($J,"NDF"),^TMP($J,"OI")
2523"RTN","NHINVPSO",95,0)
2524 Q
2525"RTN","NHINVPSO",96,0)
2526 ;
2527"RTN","NHINVPSO",97,0)
2528PEND ; -- pending prescription
2529"RTN","NHINVPSO",98,0)
2530 ; [expects PS0,OCL^PSOORRL data]
2531"RTN","NHINVPSO",99,0)
2532 N I,X,NHIN K MED
2533"RTN","NHINVPSO",100,0)
2534 S MED("id")=ID,MED("vaType")="O",MED("type")="Prescription"
2535"RTN","NHINVPSO",101,0)
2536 S MED("vaStatus")=$P(PS0,U,9),MED("status")="not active" ;??
2537"RTN","NHINVPSO",102,0)
2538 S X=+$P(PS0,U,8) S:X MED("orderID")=X
2539"RTN","NHINVPSO",103,0)
2540 S X=+$P(PS0,U,12) S:X MED("quantity")=X
2541"RTN","NHINVPSO",104,0)
2542 D GETS^DIQ(52.41,+ID_",","101;13;19;15;5;1.1","I","NHIN")
2543"RTN","NHINVPSO",105,0)
2544 S X=NHIN(52.41,+ID_",",101,"I") S:X MED("daysSupply")=X
2545"RTN","NHINVPSO",106,0)
2546 S X=NHIN(52.41,+ID_",",13,"I") S:X MED("fillsAllowed")=X
2547"RTN","NHINVPSO",107,0)
2548 S X=NHIN(52.41,+ID_",",19,"I") S:$L(X) MED("routing")=X
2549"RTN","NHINVPSO",108,0)
2550 S X=NHIN(52.41,+ID_",",15,"I") S:X MED("ordered")=X
2551"RTN","NHINVPSO",109,0)
2552 S X=NHIN(52.41,+ID_",",5,"I") S:X MED("orderingProvider")=X_U_$P($G(^VA(200,X,0)),U)
2553"RTN","NHINVPSO",110,0)
2554 S X=NHIN(52.41,+ID_",",1.1,"I") S:X MED("location")=X_U_$P($G(^SC(X,0)),U)
2555"RTN","NHINVPSO",111,0)
2556 S MED("facility")=$$FAC^NHINV(X)
2557"RTN","NHINVPSO",112,0)
2558 S X=$G(^TMP("PS",$J,NHI,"SIG",1,0)),I=1
2559"RTN","NHINVPSO",113,0)
2560 F S I=$O(^TMP("PS",$J,NHI,"SIG",I)) Q:I<1 S X=X_$C(13,10)_$G(^(I,0))
2561"RTN","NHINVPSO",114,0)
2562 S MED("sig")=X
2563"RTN","NHINVPSO",115,0)
2564 D PEN^PSO5241(DFN,"NHIN",+ID)
2565"RTN","NHINVPSO",116,0)
2566 S X=$G(^TMP($J,"NHIN",DFN,+ID,8)) I X D ;Pharmacy OI
2567"RTN","NHINVPSO",117,0)
2568 . S MED("name")=$P(X,U,2)_" "_$P(X,U,4),MED("form")=$P(X,U,4)
2569"RTN","NHINVPSO",118,0)
2570 S X=$G(^TMP($J,"NHIN",DFN,+ID,11)) D:X NDF^NHINVPS(+X) ;Dispense Drug
2571"RTN","NHINVPSO",119,0)
2572 D PDOSE K ^TMP($J,"NHIN")
2573"RTN","NHINVPSO",120,0)
2574 Q
2575"RTN","NHINVPSO",121,0)
2576 ;
2577"RTN","NHINVPSO",122,0)
2578PEN1(ID,MED) ; -- return a pending Rx in MED("attribute")=value
2579"RTN","NHINVPSO",123,0)
2580 ; [expects OEL^PSOORRL data]
2581"RTN","NHINVPSO",124,0)
2582 N PS,PS0,I,X,NHIN K MED
2583"RTN","NHINVPSO",125,0)
2584 M PS=^TMP("PS",$J) S PS0=PS(0)
2585"RTN","NHINVPSO",126,0)
2586 S MED("id")=ID,MED("vaType")="O",MED("type")="Prescription"
2587"RTN","NHINVPSO",127,0)
2588 S MED("vaStatus")=$P(PS0,U,6),MED("status")="not active" ;??
2589"RTN","NHINVPSO",128,0)
2590 S X=+$P(PS0,U,11) S:X MED("orderID")=X
2591"RTN","NHINVPSO",129,0)
2592 S X=+$P(PS0,U,8) S:X MED("quantity")=X
2593"RTN","NHINVPSO",130,0)
2594 S X=+$P(PS0,U,4) S:X MED("fillsAllowed")=X
2595"RTN","NHINVPSO",131,0)
2596 S X=+$P(PS0,U,5) S:X MED("ordered")=X
2597"RTN","NHINVPSO",132,0)
2598 S X=$G(PS("DD",1,0)) D:X NDF^NHINVPS(+X) ;Dispense Drug
2599"RTN","NHINVPSO",133,0)
2600 D GETS^DIQ(52.41,+ID_",","101;19;5;1.1","I","NHIN")
2601"RTN","NHINVPSO",134,0)
2602 S X=NHIN(52.41,+ID_",",101,"I") S:X MED("daysSupply")=X
2603"RTN","NHINVPSO",135,0)
2604 S X=NHIN(52.41,+ID_",",19,"I") S:$L(X) MED("routing")=X
2605"RTN","NHINVPSO",136,0)
2606 S X=NHIN(52.41,+ID_",",5,"I") S:X MED("orderingProvider")=X_U_$P($G(^VA(200,X,0)),U)
2607"RTN","NHINVPSO",137,0)
2608 S X=NHIN(52.41,+ID_",",1.1,"I") S:X MED("location")=X_U_$P($G(^SC(X,0)),U)
2609"RTN","NHINVPSO",138,0)
2610 S MED("facility")=$$FAC^NHINV(X)
2611"RTN","NHINVPSO",139,0)
2612 S X=$G(PS("SIG",1,0)),I=1
2613"RTN","NHINVPSO",140,0)
2614 F S I=$O(PS("SIG",I)) Q:I<1 S X=X_$C(13,10)_$G(PS("SIG",I,0))
2615"RTN","NHINVPSO",141,0)
2616 S MED("sig")=X
2617"RTN","NHINVPSO",142,0)
2618 D PEN^PSO5241(DFN,"NHIN",+ID)
2619"RTN","NHINVPSO",143,0)
2620 S X=$G(^TMP($J,"NHIN",DFN,+ID,8)) I X D ;Pharmacy OI
2621"RTN","NHINVPSO",144,0)
2622 . S MED("name")=$P(X,U,2)_" "_$P(X,U,4),MED("form")=$P(X,U,4)
2623"RTN","NHINVPSO",145,0)
2624 D PDOSE K ^TMP($J,"NHIN")
2625"RTN","NHINVPSO",146,0)
2626 Q
2627"RTN","NHINVPSO",147,0)
2628 ;
2629"RTN","NHINVPSO",148,0)
2630PDOSE ; Pending file doses
2631"RTN","NHINVPSO",149,0)
2632 N QT,UNIT,UD,NOUN,DOSE,RTE,SCH,DUR,CONJ,BEG,END
2633"RTN","NHINVPSO",150,0)
2634 F I=1:1 K NHIN D GETS^DIQ(52.413,I_","_+ID_",","*",,"NHIN") Q:'$D(NHIN) D
2635"RTN","NHINVPSO",151,0)
2636 . K QT M QT=NHIN(52.413,I_","_+ID_",")
2637"RTN","NHINVPSO",152,0)
2638 . S (UNIT,UD,NOUN)="",(DOSE,X)=QT(.01) I X["&" D
2639"RTN","NHINVPSO",153,0)
2640 .. S DOSE=$P(X,"&"),UNIT=$P(X,"&",2)
2641"RTN","NHINVPSO",154,0)
2642 .. S UD=$P(X,"&",3),NOUN=$P(X,"&",4)
2643"RTN","NHINVPSO",155,0)
2644 . S SCH=QT(1),DUR=QT(2),CONJ=QT(6),BEG=QT(3),END=QT(4)
2645"RTN","NHINVPSO",156,0)
2646 . S RTE=$$GET1^DIQ(52.413,I_","_+ID_",","10:1")
2647"RTN","NHINVPSO",157,0)
2648 . S MED("dose",I)=DOSE_U_UNIT_U_UD_U_NOUN_U_RTE_U_SCH_U_DUR_U_CONJ_U_BEG_U_END
2649"RTN","NHINVPSO",158,0)
2650 Q
2651"RTN","NHINVPSO",159,0)
2652 ;
2653"RTN","NHINVPSO",160,0)
2654STOP(BEG,X) ; -- Return date after adding X to BEG
2655"RTN","NHINVPSO",161,0)
2656 N D,H,M,S,UNT,Y
2657"RTN","NHINVPSO",162,0)
2658 S Y=BEG,(D,H,M,S)=0,UNT=$P(X," ",2),X=+X
2659"RTN","NHINVPSO",163,0)
2660 S:UNT?1"MON".E D=30*X
2661"RTN","NHINVPSO",164,0)
2662 S:UNT?1"WEE".E D=7*X
2663"RTN","NHINVPSO",165,0)
2664 S:UNT?1"DAY".E D=X
2665"RTN","NHINVPSO",166,0)
2666 S:UNT?1"HOU".E H=X
2667"RTN","NHINVPSO",167,0)
2668 S:UNT?1"MIN".E M=X
2669"RTN","NHINVPSO",168,0)
2670 S:UNT?1"SEC".E S=X
2671"RTN","NHINVPSO",169,0)
2672 S Y=$$FMADD^XLFDT(BEG,D,H,M,S)
2673"RTN","NHINVPSO",170,0)
2674 Q Y
2675"RTN","NHINVPSO",171,0)
2676 ;
2677"RTN","NHINVPSO",172,0)
2678NVA(ID,MED) ; -- return a non-VA med in MED("attribute")=value
2679"RTN","NHINVPSO",173,0)
2680 N NVA,NHZ,ORIFN,DOSE,X K MED
2681"RTN","NHINVPSO",174,0)
2682 D GETS^DIQ(55.05,+ID_","_DFN_",",".01:8;11:13","IE","NHZ")
2683"RTN","NHINVPSO",175,0)
2684 M NVA=NHZ(55.05,+ID_","_DFN_",") K NHZ
2685"RTN","NHINVPSO",176,0)
2686 S MED("id")=ID,MED("type")="OTC",MED("vaType")="N"
2687"RTN","NHINVPSO",177,0)
2688 S ORIFN=+NVA(7,"I") S:ORIFN MED("orderID")=ORIFN
2689"RTN","NHINVPSO",178,0)
2690 I NVA(.01,"I") D ;orderable item
2691"RTN","NHINVPSO",179,0)
2692 . N FORM
2693"RTN","NHINVPSO",180,0)
2694 . S X=NVA(.01,"I") D ZERO^PSS50P7(+X,,,"PSOI")
2695"RTN","NHINVPSO",181,0)
2696 . S FORM=$P($G(^TMP($J,"PSOI",+X,.02)),U,2),MED("form")=FORM
2697"RTN","NHINVPSO",182,0)
2698 . S MED("name")=NVA(.01,"E")_" "_FORM
2699"RTN","NHINVPSO",183,0)
2700 S X=NVA(1,"I") D:X NDF^NHINVPS(+X) ;dispense drug
2701"RTN","NHINVPSO",184,0)
2702 S MED("sig")=NVA(2,"E")_" BY "_NVA(3,"E")_" "_NVA(4,"E")
2703"RTN","NHINVPSO",185,0)
2704 S X=NVA(2,"I"),NVA(2,"I")=+X_U_$P(X,+X,2) ;amt^unit
2705"RTN","NHINVPSO",186,0)
2706 S DOSE=NVA(2,"I")_"^^" I ORIFN D ;reformat from order
2707"RTN","NHINVPSO",187,0)
2708 . S X=$$VALUE^ORX8(ORIFN,"ROUTE") S:X NVA(3,"E")=$$GET1^DIQ(51.2,+X_",",1)
2709"RTN","NHINVPSO",188,0)
2710 . S X=$$VALUE^ORX8(ORIFN,"SCHEDULE") S:$L(X) NVA(4,"E")=X
2711"RTN","NHINVPSO",189,0)
2712 . S X=$$VALUE^ORX8(ORIFN,"DOSE"),DOSE=$TR($P(X,"&",1,4),"&","^")
2713"RTN","NHINVPSO",190,0)
2714 S MED("dose",1)=DOSE_U_NVA(3,"E")_U_NVA(4,"E")
2715"RTN","NHINVPSO",191,0)
2716 S:NVA(8,"I") MED("start")=NVA(8,"I")
2717"RTN","NHINVPSO",192,0)
2718 S:NVA(6,"I") MED("stop")=NVA(6,"I")
2719"RTN","NHINVPSO",193,0)
2720 S:NVA(11,"I") MED("ordered")=NVA(11,"I")
2721"RTN","NHINVPSO",194,0)
2722 S MED("status")=$S($G(NVA(5,"E")):"not active",1:"active")
2723"RTN","NHINVPSO",195,0)
2724 S:NVA(12,"I") MED("orderingProvider")=NVA(12,"I")_U_NVA(12,"E")
2725"RTN","NHINVPSO",196,0)
2726 S:NVA(13,"I") MED("location")=NVA(13,"I")_U_NVA(13,"E")
2727"RTN","NHINVPSO",197,0)
2728 S MED("facility")=$$FAC^NHINV(NVA(13,"I"))
2729"RTN","NHINVPSO",198,0)
2730 K ^TMP($J,"PSOI"),^TMP($J,"NDF")
2731"RTN","NHINVPSO",199,0)
2732 Q
2733"RTN","NHINVPSO",200,0)
2734 ;
2735"RTN","NHINVPSO",201,0)
2736ACTIVE(X) ; -- return 1 or 0, if X is an active status
2737"RTN","NHINVPSO",202,0)
2738 N Y S Y=1
2739"RTN","NHINVPSO",203,0)
2740 I X="PURGE" S Y=0
2741"RTN","NHINVPSO",204,0)
2742 I X="DELETED" S Y=0
2743"RTN","NHINVPSO",205,0)
2744 I X="EXPIRED" S Y=0 ;keep, to renew?
2745"RTN","NHINVPSO",206,0)
2746 I $P(X," ")="DISCONTINUED" S Y=0
2747"RTN","NHINVPSO",207,0)
2748 Q Y
2749"RTN","NHINVPT")
27500^12^B58401800
2751"RTN","NHINVPT",1,0)
2752NHINVPT ;SLC/MKB -- Patient demographics extract
2753"RTN","NHINVPT",2,0)
2754 ;;1.0;NHIN;;Oct 25, 2010;Build 14
2755"RTN","NHINVPT",3,0)
2756 ;
2757"RTN","NHINVPT",4,0)
2758 ; External References DBIA#
2759"RTN","NHINVPT",5,0)
2760 ; ------------------- -----
2761"RTN","NHINVPT",6,0)
2762 ; ^DIC(42 10039
2763"RTN","NHINVPT",7,0)
2764 ; ^DPT 10035
2765"RTN","NHINVPT",8,0)
2766 ; DGCV 4156
2767"RTN","NHINVPT",9,0)
2768 ; DGMSTAPI 2716
2769"RTN","NHINVPT",10,0)
2770 ; DGNTAPI 3457
2771"RTN","NHINVPT",11,0)
2772 ; DGPFAPI 3860
2773"RTN","NHINVPT",12,0)
2774 ; DILFD 2055
2775"RTN","NHINVPT",13,0)
2776 ; DIQ 2056
2777"RTN","NHINVPT",14,0)
2778 ; MPIF001 2701
2779"RTN","NHINVPT",15,0)
2780 ; SDUTL3 1252
2781"RTN","NHINVPT",16,0)
2782 ; VADPT 10061
2783"RTN","NHINVPT",17,0)
2784 ; VAFCTFU1 2990
2785"RTN","NHINVPT",18,0)
2786 ; VASITE 10112
2787"RTN","NHINVPT",19,0)
2788 ; XUAF4 2171
2789"RTN","NHINVPT",20,0)
2790 ;
2791"RTN","NHINVPT",21,0)
2792 ; ------------ Get data from VistA ------------
2793"RTN","NHINVPT",22,0)
2794 ;
2795"RTN","NHINVPT",23,0)
2796EN(DFN,BEG,END,MAX,ID) ; -- find current patient demographics
2797"RTN","NHINVPT",24,0)
2798 ; [BEG,END,MAX,ID not currently used]
2799"RTN","NHINVPT",25,0)
2800 S DFN=+$G(DFN) Q:DFN<1 ;invalid patient
2801"RTN","NHINVPT",26,0)
2802 N PAT,SYS S SYS=$$SITE^VASITE
2803"RTN","NHINVPT",27,0)
2804 D DEM,SVC,PRF,ATC,SUPP,ALIAS,FAC
2805"RTN","NHINVPT",28,0)
2806 I $D(PAT)>9 D XML(.PAT)
2807"RTN","NHINVPT",29,0)
2808 Q
2809"RTN","NHINVPT",30,0)
2810 ;
2811"RTN","NHINVPT",31,0)
2812DEM ;-demographic data
2813"RTN","NHINVPT",32,0)
2814 N VADM,VA,VAERR,X
2815"RTN","NHINVPT",33,0)
2816 S PAT("id")=DFN,PAT("icn")=+$$GETICN^MPIF001(DFN)
2817"RTN","NHINVPT",34,0)
2818 D DEM^VADPT S X=VADM(1),PAT("fullName")=X
2819"RTN","NHINVPT",35,0)
2820 S PAT("familyName")=$P(X,","),PAT("givenNames")=$P(X,",",2,99)
2821"RTN","NHINVPT",36,0)
2822 S PAT("ssn")=$P(VADM(2),U)
2823"RTN","NHINVPT",37,0)
2824 S:$D(VA("BID")) PAT("bid")=$E(X)_VA("BID")
2825"RTN","NHINVPT",38,0)
2826 S PAT("dob")=+$P($P(VADM(3),U),".")
2827"RTN","NHINVPT",39,0)
2828 S PAT("gender")=$P(VADM(5),U)
2829"RTN","NHINVPT",40,0)
2830 S PAT("lrdfn")=+$G(^DPT(DFN,"LR"))
2831"RTN","NHINVPT",41,0)
2832 S X=+$P($P(VADM(6),U),".") S:X PAT("died")=X
2833"RTN","NHINVPT",42,0)
2834 S X=$$GET1^DIQ(38.1,DFN_",",2,"I") S:$L(X) PAT("sensitive")=X
2835"RTN","NHINVPT",43,0)
2836 S X=+VADM(9) S:X PAT("religion")=X
2837"RTN","NHINVPT",44,0)
2838 S X=$P(VADM(10),U,2) S:$L(X) PAT("maritalStatus")=$E(X)
2839"RTN","NHINVPT",45,0)
2840 I VADM(11) D
2841"RTN","NHINVPT",46,0)
2842 . N I S I=0
2843"RTN","NHINVPT",47,0)
2844 . F S I=$O(VADM(11,I)) Q:I<1 S X=+VADM(11,I),PAT("ethnicity",X)=$$GET1^DIQ(10.2,X_",",4)
2845"RTN","NHINVPT",48,0)
2846 I VADM(12) D
2847"RTN","NHINVPT",49,0)
2848 . N I S I=0
2849"RTN","NHINVPT",50,0)
2850 . F S I=$O(VADM(12,I)) Q:I<1 S X=+VADM(12,I),PAT("race",X)=$$GET1^DIQ(10,X_",",4)
2851"RTN","NHINVPT",51,0)
2852 Q
2853"RTN","NHINVPT",52,0)
2854SVC ;-service data
2855"RTN","NHINVPT",53,0)
2856 N VAEL,VASV,VAERR,X,Y,I,AO,IR,PGF,HNC,MST,CV
2857"RTN","NHINVPT",54,0)
2858 D 7^VADPT
2859"RTN","NHINVPT",55,0)
2860 S PAT("veteran")=VAEL(4)
2861"RTN","NHINVPT",56,0)
2862 S PAT("sc")=+VAEL(3) S:VAEL(3) PAT("scPercent")=+$P(VAEL(3),U,2)
2863"RTN","NHINVPT",57,0)
2864 ;
2865"RTN","NHINVPT",58,0)
2866 ; exposures
2867"RTN","NHINVPT",59,0)
2868 S AO=VASV(2),IR=VASV(3)
2869"RTN","NHINVPT",60,0)
2870 S X=$P($G(^DPT(DFN,.322)),U,10),PGF=$S(X="Y":1,X="N":0,1:"")
2871"RTN","NHINVPT",61,0)
2872 S X=$$GETCUR^DGNTAPI(DFN,"HNC"),X=+($G(HNC("STAT")))
2873"RTN","NHINVPT",62,0)
2874 S HNC=$S(X=4:1,X=5:1,X=1:0,X=6:0,1:"")
2875"RTN","NHINVPT",63,0)
2876 S X=$P($$GETSTAT^DGMSTAPI(DFN),U,2),MST=$S(X="Y":1,X="N":0,1:"")
2877"RTN","NHINVPT",64,0)
2878 S X=$$CVEDT^DGCV(DFN),CV=$S(+X<0:"",+X=0:0,$P(X,U,3):1,1:0)
2879"RTN","NHINVPT",65,0)
2880 S PAT("exposures")=AO_U_IR_U_PGF_U_HNC_U_MST_U_CV
2881"RTN","NHINVPT",66,0)
2882 ;
2883"RTN","NHINVPT",67,0)
2884 ; rated disabilities [see DGRPDB]
2885"RTN","NHINVPT",68,0)
2886 S I=0 F S I=$O(^DPT(DFN,.372,I)) Q:I<1 D
2887"RTN","NHINVPT",69,0)
2888 . N DIS S DIS=$G(^DPT(DFN,.372,I,0))
2889"RTN","NHINVPT",70,0)
2890 . S Y=$$GET1^DIQ(31,+DIS_",",.01)
2891"RTN","NHINVPT",71,0)
2892 . S PAT("disability",+DIS)=Y_U_$P(DIS,U,2,3) ;name^%^sc
2893"RTN","NHINVPT",72,0)
2894 Q
2895"RTN","NHINVPT",73,0)
2896PRF ;-patient record flags
2897"RTN","NHINVPT",74,0)
2898 N NHINPF,I,NAME,TEXT
2899"RTN","NHINVPT",75,0)
2900 Q:'$$GETACT^DGPFAPI(DFN,"NHINPF")
2901"RTN","NHINVPT",76,0)
2902 S I=0 F S I=$O(NHINPF(I)) Q:I<1 D
2903"RTN","NHINVPT",77,0)
2904 . S NAME=$P(NHINPF(I,"FLAG"),U,2)
2905"RTN","NHINVPT",78,0)
2906 . M TEXT=NHINPF(I,"NARR")
2907"RTN","NHINVPT",79,0)
2908 . S PAT("flag",I)=NAME_U_$$STRING^NHINV(.TEXT)
2909"RTN","NHINVPT",80,0)
2910 Q
2911"RTN","NHINVPT",81,0)
2912ATC ;-address & telecom
2913"RTN","NHINVPT",82,0)
2914 N VAPA,I,X
2915"RTN","NHINVPT",83,0)
2916 S VAPA("P")="" D ADD^VADPT ;permanent address
2917"RTN","NHINVPT",84,0)
2918 S X="" F I=1:1:4 S X=X_VAPA(I)_U
2919"RTN","NHINVPT",85,0)
2920 S X=X_$P(VAPA(5),U,2)_U_$P(VAPA(11),U,2)
2921"RTN","NHINVPT",86,0)
2922 S PAT("address")=X ;street1^st2^st3^city^state^zip
2923"RTN","NHINVPT",87,0)
2924 S X=VAPA(8)_U_$$GET1^DIQ(2,DFN_",",.134)_U_$$GET1^DIQ(2,DFN_",",.132)
2925"RTN","NHINVPT",88,0)
2926 S PAT("telecom")=X ;home^cell^work phones
2927"RTN","NHINVPT",89,0)
2928 Q
2929"RTN","NHINVPT",90,0)
2930SUPP ;-support contacts
2931"RTN","NHINVPT",91,0)
2932 N VAOA,A,I,X,TYPE
2933"RTN","NHINVPT",92,0)
2934 F A="",1 K VAOA D
2935"RTN","NHINVPT",93,0)
2936 . S:A VAOA("A")=A D OAD^VADPT Q:'$L($G(VAOA(9)))
2937"RTN","NHINVPT",94,0)
2938 . S TYPE=$S(A=1:"ECON",1:"NOK")
2939"RTN","NHINVPT",95,0)
2940 . S PAT("support",TYPE)=VAOA(9)_U_VAOA(10) ;name^relationship
2941"RTN","NHINVPT",96,0)
2942 . S X="" F I=1:1:4 S X=X_VAOA(I)_U
2943"RTN","NHINVPT",97,0)
2944 . S X=X_$P(VAOA(5),U,2)_U_$P(VAOA(11),U,2)
2945"RTN","NHINVPT",98,0)
2946 . S PAT("support",TYPE,"address")=X ;street1^st2^st3^city^state^zip
2947"RTN","NHINVPT",99,0)
2948 . S I=$S(A=1:.33011,1:.21011),X=VAOA(8)_U_U_$$GET1^DIQ(2,DFN_",",I)
2949"RTN","NHINVPT",100,0)
2950 . S PAT("support",TYPE,"telecom")=X ;home^cell^work phones
2951"RTN","NHINVPT",101,0)
2952 Q
2953"RTN","NHINVPT",102,0)
2954ALIAS ;-other names used
2955"RTN","NHINVPT",103,0)
2956 N I,X
2957"RTN","NHINVPT",104,0)
2958 S I=0 F S I=$O(^DPT(DFN,.01,I)) Q:I<1 S X=$G(^(I,0)) D
2959"RTN","NHINVPT",105,0)
2960 . S PAT("alias",I)=$P(X,U)
2961"RTN","NHINVPT",106,0)
2962 Q
2963"RTN","NHINVPT",107,0)
2964FAC ;-treating facilities [see FACLIST^ORWCIRN]
2965"RTN","NHINVPT",108,0)
2966 N IFN S DFN=+$G(DFN) Q:DFN<1
2967"RTN","NHINVPT",109,0)
2968 N NHINY,HOME,I,X,IEN
2969"RTN","NHINVPT",110,0)
2970 I $L($T(TFL^VAFCTFU1)) D TFL^VAFCTFU1(.NHINY,DFN)
2971"RTN","NHINVPT",111,0)
2972 Q:$P($G(NHINY(1)),U)<0 ;not setup
2973"RTN","NHINVPT",112,0)
2974 S HOME=+$P($G(^DPT(DFN,"MPI")),U,3) ;home facility
2975"RTN","NHINVPT",113,0)
2976 S I=0 F S I=$O(NHINY(I)) Q:I<1 D
2977"RTN","NHINVPT",114,0)
2978 . S X=NHINY(I) Q:$P(X,U)="" ;unknown
2979"RTN","NHINVPT",115,0)
2980 . S IEN=+$$IEN^XUAF4($P(X,U))
2981"RTN","NHINVPT",116,0)
2982 . I +X=776!(+X=200) S $P(X,U,2)="DEPT. OF DEFENSE"
2983"RTN","NHINVPT",117,0)
2984 . S PAT("facility",IEN)=$P(X,U,1,3) ;stn# ^ name ^ last date
2985"RTN","NHINVPT",118,0)
2986 . I IEN=HOME S $P(PAT("facility",IEN),U,4)=1
2987"RTN","NHINVPT",119,0)
2988 Q
2989"RTN","NHINVPT",120,0)
2990 ;
2991"RTN","NHINVPT",121,0)
2992INPT ;-current inpt status data
2993"RTN","NHINVPT",122,0)
2994 N ADM,X
2995"RTN","NHINVPT",123,0)
2996 S ADM=+$G(^DPT(DFN,.105)) I ADM D
2997"RTN","NHINVPT",124,0)
2998 . N VAIN,VAERR,HLOC,SVC
2999"RTN","NHINVPT",125,0)
3000 . D INP^VADPT S PAT("admitted")=ADM_U_+VAIN(7)
3001"RTN","NHINVPT",126,0)
3002 . S PAT("ward")=VAIN(4),PAT("roomBed")=VAIN(5)
3003"RTN","NHINVPT",127,0)
3004 . S HLOC=+$G(^DIC(42,+VAIN(4),44)),SVC=$P($G(^(0)),U,3)
3005"RTN","NHINVPT",128,0)
3006 . S PAT("location")=HLOC_U_$P(VAIN(4),U,2)
3007"RTN","NHINVPT",129,0)
3008 . S:$L(SVC) PAT("locSvc")=SVC_U_$$EXTERNAL^DILFD(42,.03,,SVC)
3009"RTN","NHINVPT",130,0)
3010 . S PAT("specialty")=VAIN(3)
3011"RTN","NHINVPT",131,0)
3012 . S PAT("attending")=VAIN(11)
3013"RTN","NHINVPT",132,0)
3014 . S X=$$FAC^NHINV(HLOC),PAT("site")=X
3015"RTN","NHINVPT",133,0)
3016 S PAT("inpatient")=$S(ADM:"true",1:"false")
3017"RTN","NHINVPT",134,0)
3018 S X=$$OUTPTPR^SDUTL3(DFN) S:X PAT("pcProvider")=X
3019"RTN","NHINVPT",135,0)
3020 S X=$$OUTPTTM^SDUTL3(DFN) S:X PAT("pcTeam")=X
3021"RTN","NHINVPT",136,0)
3022 Q
3023"RTN","NHINVPT",137,0)
3024 ;
3025"RTN","NHINVPT",138,0)
3026 ; ------------ Return data to middle tier ------------
3027"RTN","NHINVPT",139,0)
3028 ;
3029"RTN","NHINVPT",140,0)
3030XML(ITEM) ; -- Return patient data as XML in @NHIN@(n)
3031"RTN","NHINVPT",141,0)
3032 ; as <element code='123' displayName='ABC' />
3033"RTN","NHINVPT",142,0)
3034 N ATT,X,Y,I,ID
3035"RTN","NHINVPT",143,0)
3036 D ADD("<patient>")
3037"RTN","NHINVPT",144,0)
3038 S ATT="" F S ATT=$O(ITEM(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
3039"RTN","NHINVPT",145,0)
3040 . I ATT="exposures" D:X["1" S Y="" Q
3041"RTN","NHINVPT",146,0)
3042 .. S I=0,Y="<exposures>" D ADD(Y)
3043"RTN","NHINVPT",147,0)
3044 .. F ID="AO","IR","PG","HNC","MST","CV" S I=I+1 I $P(X,U,I) S Y="<exposure value='"_ID_"' />" D ADD(Y)
3045"RTN","NHINVPT",148,0)
3046 .. D ADD("</exposures>")
3047"RTN","NHINVPT",149,0)
3048 . I $L($O(ITEM(ATT,""))) D Q ;multiples
3049"RTN","NHINVPT",150,0)
3050 .. S ID=$S($E(ATT,$L(ATT))="s":ATT_"es",$E(ATT,$L(ATT))="y":$E(ATT,1,$L(ATT)-1)_"ies",1:ATT_"s")
3051"RTN","NHINVPT",151,0)
3052 .. D ADD("<"_ID_">")
3053"RTN","NHINVPT",152,0)
3054 .. S I="" F S I=$O(ITEM(ATT,I)) Q:I="" D D:$L(Y) ADD(Y)
3055"RTN","NHINVPT",153,0)
3056 ... S X=ITEM(ATT,I),Y="<"_ATT_" "
3057"RTN","NHINVPT",154,0)
3058 ... I ATT="support" D S Y="" Q
3059"RTN","NHINVPT",155,0)
3060 .... S Y=Y_"contactType='"_I_"' name='"_$$ESC^NHINV($P(X,U))_$S($L($P(X,U,2)):"' relationship='"_$$ESC^NHINV($P(X,U,2)),1:"")_"' >" D ADD(Y)
3061"RTN","NHINVPT",156,0)
3062 .... S X=$G(ITEM(ATT,I,"address")) I $L(X) D ADDR(X)
3063"RTN","NHINVPT",157,0)
3064 .... S X=$G(ITEM(ATT,I,"telecom")) I $L(X) D PHONE(X)
3065"RTN","NHINVPT",158,0)
3066 .... D ADD("</support>")
3067"RTN","NHINVPT",159,0)
3068 ... I ATT="alias" S Y=Y_"fullName='"_$$ESC^NHINV(X)_$S(X[",":"' familyName='"_$$ESC^NHINV($P(X,","))_"' givenNames='"_$$ESC^NHINV($P(X,",",2,99)),1:"")_"' />" Q
3069"RTN","NHINVPT",160,0)
3070 ... I ATT="flag" S Y=Y_"name='"_$$ESC^NHINV($P(X,U))_"' text='"_$$ESC^NHINV($P(X,U,2))_"' />" Q
3071"RTN","NHINVPT",161,0)
3072 ... I ATT="facility" S Y=Y_"code='"_$P(X,U)_"' name='"_$$ESC^NHINV($P(X,U,2))_$S($P(X,U,3):"' latestDate='"_$P($P(X,U,3),"."),1:"")_$S($P(X,U,4):"' homeSite='1",1:"")_"' />" Q
3073"RTN","NHINVPT",162,0)
3074 ... I ATT="disability" S Y=Y_"vaCode='"_I_"' printName='"_$$ESC^NHINV($P(X,U))_$S($P(X,U,2):"' sc='"_$P(X,U,2)_"' scPercent='"_$P(X,U,3),1:"")_"' />" Q
3075"RTN","NHINVPT",163,0)
3076 ... S Y=Y_"value='"_$$ESC^NHINV(ITEM(ATT,I))_"' />"
3077"RTN","NHINVPT",164,0)
3078 .. D ADD("</"_ID_">") S Y=""
3079"RTN","NHINVPT",165,0)
3080 . S X=$G(ITEM(ATT)),Y="" Q:'$L(X)
3081"RTN","NHINVPT",166,0)
3082 . I ATT="address" D ADDR(X) S Y="" Q
3083"RTN","NHINVPT",167,0)
3084 . I ATT="telecom" D PHONE(X) S Y="" Q
3085"RTN","NHINVPT",168,0)
3086 . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
3087"RTN","NHINVPT",169,0)
3088 . S Y="<"_ATT_" code='"_$P(X,U)_"' name='"_$$ESC^NHINV($P(X,U,2))_"' />"
3089"RTN","NHINVPT",170,0)
3090 D ADD("</patient>")
3091"RTN","NHINVPT",171,0)
3092 Q
3093"RTN","NHINVPT",172,0)
3094 ;
3095"RTN","NHINVPT",173,0)
3096ADDR(X) ; -- XML address node from X=street1^st2^st3^city^state^zip
3097"RTN","NHINVPT",174,0)
3098 N I,Y Q:$L(X)'>5 ;no data
3099"RTN","NHINVPT",175,0)
3100 S Y="<address"
3101"RTN","NHINVPT",176,0)
3102 F I=1,2,3 I $L($P(X,U,I)) S Y=Y_" streetLine"_I_"='"_$$ESC^NHINV($P(X,U,I))_"'"
3103"RTN","NHINVPT",177,0)
3104 I $L($P(X,U,4)) S Y=Y_" city='"_$$ESC^NHINV($P(X,U,4))_"'"
3105"RTN","NHINVPT",178,0)
3106 I $L($P(X,U,5)) S Y=Y_" stateProvince='"_$P(X,U,5)_"'"
3107"RTN","NHINVPT",179,0)
3108 I $L($P(X,U,6)) S Y=Y_" postalCode='"_$P(X,U,6)_"'"
3109"RTN","NHINVPT",180,0)
3110 S Y=Y_" />" D ADD(Y)
3111"RTN","NHINVPT",181,0)
3112 Q
3113"RTN","NHINVPT",182,0)
3114 ;
3115"RTN","NHINVPT",183,0)
3116PHONE(X) ; -- XML telecom node from X=home^cell^work numbers
3117"RTN","NHINVPT",184,0)
3118 N I,Y Q:$L(X)'>2 ;no data
3119"RTN","NHINVPT",185,0)
3120 D ADD("<telecomList>")
3121"RTN","NHINVPT",186,0)
3122 I $L($P(X,U,1)) S Y="<telecom usageType='H' value='"_$P(X,U,1)_"' />" D ADD(Y)
3123"RTN","NHINVPT",187,0)
3124 I $L($P(X,U,2)) S Y="<telecom usageType='MC' value='"_$P(X,U,2)_"' />" D ADD(Y)
3125"RTN","NHINVPT",188,0)
3126 I $L($P(X,U,3)) S Y="<telecom usageType='WP' value='"_$P(X,U,3)_"' />" D ADD(Y)
3127"RTN","NHINVPT",189,0)
3128 D ADD("</telecomList>")
3129"RTN","NHINVPT",190,0)
3130 Q
3131"RTN","NHINVPT",191,0)
3132 ;
3133"RTN","NHINVPT",192,0)
3134ADD(X) ; Add a line @NHIN@(n)=X
3135"RTN","NHINVPT",193,0)
3136 S NHINI=$G(NHINI)+1
3137"RTN","NHINVPT",194,0)
3138 S @NHIN@(NHINI)=X
3139"RTN","NHINVPT",195,0)
3140 Q
3141"VER")
31428.0^22.0
3143**END**
3144**END**
Note: See TracBrowser for help on using the repository browser.