source: ccr/trunk/kids/NHIN-1_SEQ-1_PAT-1.KID@ 1553

Last change on this file since 1553 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: 153.1 KB
RevLine 
[1293]1Released NHIN*1*1 SEQ #1
2Extracted from mail message
3**KIDS**:NHIN*1.0*1^
4
5**INSTALL NAME**
6NHIN*1.0*1
7"BLD",7816,0)
8NHIN*1.0*1^NATIONAL HEALTH INFO NETWORK^0^3110215^y
9"BLD",7816,4,0)
10^9.64PA^^
11"BLD",7816,6.3)
1211
13"BLD",7816,"ABPKG")
14n
15"BLD",7816,"KRN",0)
16^9.67PA^8989.52^19
17"BLD",7816,"KRN",.4,0)
18.4
19"BLD",7816,"KRN",.401,0)
20.401
21"BLD",7816,"KRN",.402,0)
22.402
23"BLD",7816,"KRN",.403,0)
24.403
25"BLD",7816,"KRN",.5,0)
26.5
27"BLD",7816,"KRN",.84,0)
28.84
29"BLD",7816,"KRN",3.6,0)
303.6
31"BLD",7816,"KRN",3.8,0)
323.8
33"BLD",7816,"KRN",9.2,0)
349.2
35"BLD",7816,"KRN",9.8,0)
369.8
37"BLD",7816,"KRN",9.8,"NM",0)
38^9.68A^28^18
39"BLD",7816,"KRN",9.8,"NM",1,0)
40NHINV^^0^B15789004
41"BLD",7816,"KRN",9.8,"NM",2,0)
42NHINVART^^0^B30332823
43"BLD",7816,"KRN",9.8,"NM",4,0)
44NHINVIT^^0^B33591565
45"BLD",7816,"KRN",9.8,"NM",5,0)
46NHINVLR^^0^B25540846
47"BLD",7816,"KRN",9.8,"NM",11,0)
48NHINVRA^^0^B18363736
49"BLD",7816,"KRN",9.8,"NM",12,0)
50NHINVSR^^0^B25931760
51"BLD",7816,"KRN",9.8,"NM",13,0)
52NHINVTIU^^0^B18326219
53"BLD",7816,"KRN",9.8,"NM",14,0)
54NHINVIMM^^0^B9313203
55"BLD",7816,"KRN",9.8,"NM",15,0)
56NHINVSIT^^0^B60599762
57"BLD",7816,"KRN",9.8,"NM",16,0)
58NHINVPRC^^0^B6896734
59"BLD",7816,"KRN",9.8,"NM",17,0)
60NHINVAPT^^0^B9234836
61"BLD",7816,"KRN",9.8,"NM",21,0)
62NHINVLRA^^0^B45252098
63"BLD",7816,"KRN",9.8,"NM",22,0)
64NHINVLRO^^0^B32647424
65"BLD",7816,"KRN",9.8,"NM",24,0)
66NHINVPSI^^0^B41411886
67"BLD",7816,"KRN",9.8,"NM",25,0)
68NHINVPT^^0^B59592091
69"BLD",7816,"KRN",9.8,"NM",26,0)
70NHINVPL^^0^B19846807
71"BLD",7816,"KRN",9.8,"NM",27,0)
72NHINVPS^^0^B14129801
73"BLD",7816,"KRN",9.8,"NM",28,0)
74NHINVPSO^^0^B65991145
75"BLD",7816,"KRN",9.8,"NM","B","NHINV",1)
76
77"BLD",7816,"KRN",9.8,"NM","B","NHINVAPT",17)
78
79"BLD",7816,"KRN",9.8,"NM","B","NHINVART",2)
80
81"BLD",7816,"KRN",9.8,"NM","B","NHINVIMM",14)
82
83"BLD",7816,"KRN",9.8,"NM","B","NHINVIT",4)
84
85"BLD",7816,"KRN",9.8,"NM","B","NHINVLR",5)
86
87"BLD",7816,"KRN",9.8,"NM","B","NHINVLRA",21)
88
89"BLD",7816,"KRN",9.8,"NM","B","NHINVLRO",22)
90
91"BLD",7816,"KRN",9.8,"NM","B","NHINVPL",26)
92
93"BLD",7816,"KRN",9.8,"NM","B","NHINVPRC",16)
94
95"BLD",7816,"KRN",9.8,"NM","B","NHINVPS",27)
96
97"BLD",7816,"KRN",9.8,"NM","B","NHINVPSI",24)
98
99"BLD",7816,"KRN",9.8,"NM","B","NHINVPSO",28)
100
101"BLD",7816,"KRN",9.8,"NM","B","NHINVPT",25)
102
103"BLD",7816,"KRN",9.8,"NM","B","NHINVRA",11)
104
105"BLD",7816,"KRN",9.8,"NM","B","NHINVSIT",15)
106
107"BLD",7816,"KRN",9.8,"NM","B","NHINVSR",12)
108
109"BLD",7816,"KRN",9.8,"NM","B","NHINVTIU",13)
110
111"BLD",7816,"KRN",19,0)
11219
113"BLD",7816,"KRN",19.1,0)
11419.1
115"BLD",7816,"KRN",101,0)
116101
117"BLD",7816,"KRN",409.61,0)
118409.61
119"BLD",7816,"KRN",771,0)
120771
121"BLD",7816,"KRN",870,0)
122870
123"BLD",7816,"KRN",8989.51,0)
1248989.51
125"BLD",7816,"KRN",8989.52,0)
1268989.52
127"BLD",7816,"KRN",8994,0)
1288994
129"BLD",7816,"KRN",8994,"NM",0)
130^9.68A^^0
131"BLD",7816,"KRN","B",.4,.4)
132
133"BLD",7816,"KRN","B",.401,.401)
134
135"BLD",7816,"KRN","B",.402,.402)
136
137"BLD",7816,"KRN","B",.403,.403)
138
139"BLD",7816,"KRN","B",.5,.5)
140
141"BLD",7816,"KRN","B",.84,.84)
142
143"BLD",7816,"KRN","B",3.6,3.6)
144
145"BLD",7816,"KRN","B",3.8,3.8)
146
147"BLD",7816,"KRN","B",9.2,9.2)
148
149"BLD",7816,"KRN","B",9.8,9.8)
150
151"BLD",7816,"KRN","B",19,19)
152
153"BLD",7816,"KRN","B",19.1,19.1)
154
155"BLD",7816,"KRN","B",101,101)
156
157"BLD",7816,"KRN","B",409.61,409.61)
158
159"BLD",7816,"KRN","B",771,771)
160
161"BLD",7816,"KRN","B",870,870)
162
163"BLD",7816,"KRN","B",8989.51,8989.51)
164
165"BLD",7816,"KRN","B",8989.52,8989.52)
166
167"BLD",7816,"KRN","B",8994,8994)
168
169"BLD",7816,"QUES",0)
170^9.62^^
171"BLD",7816,"REQB",0)
172^9.611^1^1
173"BLD",7816,"REQB",1,0)
174NHIN 1.0^2
175"BLD",7816,"REQB","B","NHIN 1.0",1)
176
177"MBREQ")
1780
179"PKG",568,-1)
1801^1
181"PKG",568,0)
182NATIONAL HEALTH INFO NETWORK^NHIN^NATIONAL HEALTH INFORMATION NETWORK ADAPTER
183"PKG",568,20,0)
184^9.402P^^
185"PKG",568,22,0)
186^9.49I^1^1
187"PKG",568,22,1,0)
1881.0^3100914^3101007^10000000219
189"PKG",568,22,1,"PAH",1,0)
1901^3110215^10000000219
191"QUES","XPF1",0)
192Y
193"QUES","XPF1","??")
194^D REP^XPDH
195"QUES","XPF1","A")
196Shall I write over your |FLAG| File
197"QUES","XPF1","B")
198YES
199"QUES","XPF1","M")
200D XPF1^XPDIQ
201"QUES","XPF2",0)
202Y
203"QUES","XPF2","??")
204^D DTA^XPDH
205"QUES","XPF2","A")
206Want my data |FLAG| yours
207"QUES","XPF2","B")
208YES
209"QUES","XPF2","M")
210D XPF2^XPDIQ
211"QUES","XPI1",0)
212YO
213"QUES","XPI1","??")
214^D INHIBIT^XPDH
215"QUES","XPI1","A")
216Want KIDS to INHIBIT LOGONs during the install
217"QUES","XPI1","B")
218NO
219"QUES","XPI1","M")
220D XPI1^XPDIQ
221"QUES","XPM1",0)
222PO^VA(200,:EM
223"QUES","XPM1","??")
224^D MG^XPDH
225"QUES","XPM1","A")
226Enter the Coordinator for Mail Group '|FLAG|'
227"QUES","XPM1","B")
228
229"QUES","XPM1","M")
230D XPM1^XPDIQ
231"QUES","XPO1",0)
232Y
233"QUES","XPO1","??")
234^D MENU^XPDH
235"QUES","XPO1","A")
236Want KIDS to Rebuild Menu Trees Upon Completion of Install
237"QUES","XPO1","B")
238NO
239"QUES","XPO1","M")
240D XPO1^XPDIQ
241"QUES","XPZ1",0)
242Y
243"QUES","XPZ1","??")
244^D OPT^XPDH
245"QUES","XPZ1","A")
246Want to DISABLE Scheduled Options, Menu Options, and Protocols
247"QUES","XPZ1","B")
248NO
249"QUES","XPZ1","M")
250D XPZ1^XPDIQ
251"QUES","XPZ2",0)
252Y
253"QUES","XPZ2","??")
254^D RTN^XPDH
255"QUES","XPZ2","A")
256Want to MOVE routines to other CPUs
257"QUES","XPZ2","B")
258NO
259"QUES","XPZ2","M")
260D XPZ2^XPDIQ
261"RTN")
26218
263"RTN","NHINV")
2640^1^B15789004^n/a
265"RTN","NHINV",1,0)
266NHINV ;SLC/MKB - Serve VistA data as XML via RPC
267"RTN","NHINV",2,0)
268 ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
269"RTN","NHINV",3,0)
270 ;
271"RTN","NHINV",4,0)
272 ; External References DBIA#
273"RTN","NHINV",5,0)
274 ; ------------------- -----
275"RTN","NHINV",6,0)
276 ; ^DPT 10035
277"RTN","NHINV",7,0)
278 ; ^SC 10040
279"RTN","NHINV",8,0)
280 ; DIQ 2056
281"RTN","NHINV",9,0)
282 ; MPIF001 2701
283"RTN","NHINV",10,0)
284 ; VASITE 10112
285"RTN","NHINV",11,0)
286 ; XLFDT 10103
287"RTN","NHINV",12,0)
288 ; XLFSTR 10104
289"RTN","NHINV",13,0)
290 ; XUAF4 2171
291"RTN","NHINV",14,0)
292 ;
293"RTN","NHINV",15,0)
294GET(NHIN,DFN,TYPE,START,STOP,MAX,ID) ; -- Return search results as XML in @NHIN@(n)
295"RTN","NHINV",16,0)
296 ; RPC = NHIN GET VISTA DATA
297"RTN","NHINV",17,0)
298 N ICN,NHINI,NHINTOTL
299"RTN","NHINV",18,0)
300 S NHIN=$NA(^TMP("NHINV",$J)) K @NHIN
301"RTN","NHINV",19,0)
302 ;
303"RTN","NHINV",20,0)
304 ; parse & validate input parameters
305"RTN","NHINV",21,0)
306 S ICN=+$P(DFN,";",2),DFN=+$G(DFN)
307"RTN","NHINV",22,0)
308 I 'DFN S DFN=+$$GETDFN^MPIF001(ICN)
309"RTN","NHINV",23,0)
310 I DFN<1!'$D(^DPT(DFN)) D ERR(1,DFN) G GTQ
311"RTN","NHINV",24,0)
312 S TYPE=$G(TYPE) I TYPE="" S TYPE=$$ALL
313"RTN","NHINV",25,0)
314 S:'$G(START) START=1410101 S:'$G(STOP) STOP=9999998 S:'$G(MAX) MAX=9999
315"RTN","NHINV",26,0)
316 I START,STOP,STOP<START N X S X=START,START=STOP,STOP=X ;switch
317"RTN","NHINV",27,0)
318 I STOP,$L(STOP,".")<2 S STOP=STOP_".24"
319"RTN","NHINV",28,0)
320 S ID=$G(ID)
321"RTN","NHINV",29,0)
322 ;
323"RTN","NHINV",30,0)
324 ; extract data
325"RTN","NHINV",31,0)
326 N NHINTYPE,NHINP,RTN
327"RTN","NHINV",32,0)
328 S NHINTYPE=TYPE D ADD("<results>")
329"RTN","NHINV",33,0)
330 F NHINP=1:1:$L(NHINTYPE,";") S TYPE=$P(NHINTYPE,";",NHINP) I $L(TYPE) D
331"RTN","NHINV",34,0)
332 . S RTN="EN^"_$$RTN(TYPE) Q:'$L($T(@RTN)) ;D ERR(2) Q
333"RTN","NHINV",35,0)
334 . D @(RTN_"(DFN,START,STOP,MAX,ID)")
335"RTN","NHINV",36,0)
336 D ADD("</results>")
337"RTN","NHINV",37,0)
338 ;
339"RTN","NHINV",38,0)
340 I $G(NHINTOTL),$G(@NHIN@(1))="<results>" S @NHIN@(1)="<results total='"_NHINTOTL_"' >"
341"RTN","NHINV",39,0)
342 ;
343"RTN","NHINV",40,0)
344GTQ ; end
345"RTN","NHINV",41,0)
346 Q
347"RTN","NHINV",42,0)
348 ;
349"RTN","NHINV",43,0)
350RTN(X) ; -- Return name of NHINVxxx routine for clinical domain X
351"RTN","NHINV",44,0)
352 S X=$$UP^XLFSTR(X),Y="NHINV"
353"RTN","NHINV",45,0)
354 I X="ACCESSION" S Y="NHINVLRA"
355"RTN","NHINV",46,0)
356 I X="ALLERGY" S Y="NHINVART"
357"RTN","NHINV",47,0)
358 I X="APPOINTMENT" S Y="NHINVAPT"
359"RTN","NHINV",48,0)
360 ; X="CONSULT" S Y="NHINVCON"
361"RTN","NHINV",49,0)
362 I X="DOCUMENT" S Y="NHINVTIU"
363"RTN","NHINV",50,0)
364 I X="IMMUNIZATION" S Y="NHINVIMM"
365"RTN","NHINV",51,0)
366 I X="LAB" S Y="NHINVLR"
367"RTN","NHINV",52,0)
368 I X="PANEL" S Y="NHINVLRO"
369"RTN","NHINV",53,0)
370 I X="MED" S Y="NHINVPS"
371"RTN","NHINV",54,0)
372 I X="RX" S Y="NHINVPSO"
373"RTN","NHINV",55,0)
374 ; X="ORDER" S Y="NHINVOR"
375"RTN","NHINV",56,0)
376 I X="PATIENT" S Y="NHINVPT"
377"RTN","NHINV",57,0)
378 I X="PROBLEM" S Y="NHINVPL"
379"RTN","NHINV",58,0)
380 I X="PROCEDURE" S Y="NHINVPRC"
381"RTN","NHINV",59,0)
382 I X="SURGERY" S Y="NHINVSR"
383"RTN","NHINV",60,0)
384 I X="VISIT" S Y="NHINVSIT"
385"RTN","NHINV",61,0)
386 I X="VITAL" S Y="NHINVIT"
387"RTN","NHINV",62,0)
388 I X="RADIOLOGY" S Y="NHINVRA"
389"RTN","NHINV",63,0)
390 I X="NEW" S Y="NHINVPR"
391"RTN","NHINV",64,0)
392 Q Y
393"RTN","NHINV",65,0)
394 ;
395"RTN","NHINV",66,0)
396ALL() ; -- return string for all types of data
397"RTN","NHINV",67,0)
398 Q "patient;allergy;problem;vital;lab;med;immunization;visit;appointment;document;procedure"
399"RTN","NHINV",68,0)
400 ;
401"RTN","NHINV",69,0)
402ERR(X,VAL) ; -- return error message
403"RTN","NHINV",70,0)
404 N MSG S MSG="Error"
405"RTN","NHINV",71,0)
406 I X=1 S MSG="Patient with dfn '"_$G(VAL)_"' not found"
407"RTN","NHINV",72,0)
408 I X=2 S MSG="Requested domain type '"_$G(VAL)_"' not recognized"
409"RTN","NHINV",73,0)
410 I X=99 S MSG="Unknown request"
411"RTN","NHINV",74,0)
412 ;
413"RTN","NHINV",75,0)
414 D ADD("<error>")
415"RTN","NHINV",76,0)
416 D ADD("<message>"_MSG_"</message>")
417"RTN","NHINV",77,0)
418 D ADD("</error>")
419"RTN","NHINV",78,0)
420 Q
421"RTN","NHINV",79,0)
422 ;
423"RTN","NHINV",80,0)
424ESC(X) ; -- escape outgoing XML
425"RTN","NHINV",81,0)
426 ; Q $ZCONVERT(X,"O","HTML") ; uncomment for fastest performance on Cache
427"RTN","NHINV",82,0)
428 ;
429"RTN","NHINV",83,0)
430 N I,Y,QOT S QOT=""""
431"RTN","NHINV",84,0)
432 S Y=$P(X,"&") F I=2:1:$L(X,"&") S Y=Y_"&amp;"_$P(X,"&",I)
433"RTN","NHINV",85,0)
434 S X=Y,Y=$P(X,"<") F I=2:1:$L(X,"<") S Y=Y_"&lt;"_$P(X,"<",I)
435"RTN","NHINV",86,0)
436 S X=Y,Y=$P(X,">") F I=2:1:$L(X,">") S Y=Y_"&gt;"_$P(X,">",I)
437"RTN","NHINV",87,0)
438 S X=Y,Y=$P(X,"'") F I=2:1:$L(X,"'") S Y=Y_"&apos;"_$P(X,"'",I)
439"RTN","NHINV",88,0)
440 S X=Y,Y=$P(X,QOT) F I=2:1:$L(X,QOT) S Y=Y_"&quot;"_$P(X,QOT,I)
441"RTN","NHINV",89,0)
442 Q Y
443"RTN","NHINV",90,0)
444 ;
445"RTN","NHINV",91,0)
446ADD(X) ; Add a line @NHIN@(n)=X
447"RTN","NHINV",92,0)
448 S NHINI=$G(NHINI)+1
449"RTN","NHINV",93,0)
450 S @NHIN@(NHINI)=X
451"RTN","NHINV",94,0)
452 Q
453"RTN","NHINV",95,0)
454 ;
455"RTN","NHINV",96,0)
456STRING(ARRAY) ; -- Return text in ARRAY(n) or ARRAY(n,0) as a string
457"RTN","NHINV",97,0)
458 N I,X,Y S Y=""
459"RTN","NHINV",98,0)
460 S I=+$O(ARRAY("")) I I=0 S I=+$O(ARRAY(0))
461"RTN","NHINV",99,0)
462 S Y=$S($D(ARRAY(I,0)):ARRAY(I,0),1:$G(ARRAY(I)))
463"RTN","NHINV",100,0)
464 F S I=$O(ARRAY(I)) Q:I<1 D
465"RTN","NHINV",101,0)
466 . S X=$S($D(ARRAY(I,0)):ARRAY(I,0),1:ARRAY(I))
467"RTN","NHINV",102,0)
468 . I $E(X)=" " S Y=Y_$C(13,10)_X Q
469"RTN","NHINV",103,0)
470 . S Y=Y_$S($E(Y,$L(Y))=" ":"",1:" ")_X
471"RTN","NHINV",104,0)
472 Q Y
473"RTN","NHINV",105,0)
474 ;
475"RTN","NHINV",106,0)
476FAC(X) ; -- return Institution file station# for location X
477"RTN","NHINV",107,0)
478 N HLOC,FAC,Y0,Y S Y=""
479"RTN","NHINV",108,0)
480 S HLOC=$G(^SC(+$G(X),0)),FAC=$P(HLOC,U,4) ;Institution ien
481"RTN","NHINV",109,0)
482 ; Get P:4 via Med Ctr Div, if not directly linked
483"RTN","NHINV",110,0)
484 I 'FAC,$P(HLOC,U,15) S FAC=$$GET1^DIQ(40.8,+$P(HLOC,U,15)_",",.07,"I")
485"RTN","NHINV",111,0)
486 S Y0=$S(FAC:$$NS^XUAF4(FAC),1:$P($$SITE^VASITE,U,2,3)) ;name^stn#
487"RTN","NHINV",112,0)
488 S:$L(Y0) Y=$P(Y0,U,2)_U_$P(Y0,U) ;switch to stn#^name
489"RTN","NHINV",113,0)
490 I $L(Y),'Y S $P(Y,U)=FAC
491"RTN","NHINV",114,0)
492 Q Y
493"RTN","NHINV",115,0)
494 ;
495"RTN","NHINV",116,0)
496VUID(IEN,FILE) ; -- Return VUID for item
497"RTN","NHINV",117,0)
498 Q $$GET1^DIQ(FILE,IEN_",",99.99)
499"RTN","NHINVAPT")
5000^17^B9234836^n/a
501"RTN","NHINVAPT",1,0)
502NHINVAPT ;SLC/MKB -- Appointment extract
503"RTN","NHINVAPT",2,0)
504 ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
505"RTN","NHINVAPT",3,0)
506 ;
507"RTN","NHINVAPT",4,0)
508 ; External References DBIA#
509"RTN","NHINVAPT",5,0)
510 ; ------------------- -----
511"RTN","NHINVAPT",6,0)
512 ; DIQ 2056
513"RTN","NHINVAPT",7,0)
514 ; SDAMA201 3859
515"RTN","NHINVAPT",8,0)
516 ; VADPT 10061
517"RTN","NHINVAPT",9,0)
518 ;
519"RTN","NHINVAPT",10,0)
520 ; ------------ Get appointment(s) from VistA ------------
521"RTN","NHINVAPT",11,0)
522 ;
523"RTN","NHINVAPT",12,0)
524EN(DFN,BEG,END,MAX,ID) ; -- find patient's appointments
525"RTN","NHINVAPT",13,0)
526 N NHICNT,NHITOT,NHI,X1,X2,X3,X12,NHITM
527"RTN","NHINVAPT",14,0)
528 S DFN=+$G(DFN) Q:DFN<1
529"RTN","NHINVAPT",15,0)
530 S BEG=$G(BEG,DT),END=$G(END,9999998),MAX=$G(MAX,999999)
531"RTN","NHINVAPT",16,0)
532 ;
533"RTN","NHINVAPT",17,0)
534 ; get one appt
535"RTN","NHINVAPT",18,0)
536 I $L($G(ID)) D Q
537"RTN","NHINVAPT",19,0)
538 . S (BEG,END)=$P(ID,";",2)
539"RTN","NHINVAPT",20,0)
540 . D GETAPPT^SDAMA201(DFN,"1;2;3;12","",BEG,END,.NHITOT)
541"RTN","NHINVAPT",21,0)
542 . I NHITOT>0 F NHI=1:1:NHITOT D
543"RTN","NHINVAPT",22,0)
544 .. S X1=+$G(^TMP($J,"SDAMA201","GETAPPT",NHI,1)),X2=$G(^(2)),X3=$G(^(3)),X12=$G(^(12))
545"RTN","NHINVAPT",23,0)
546 .. Q:+X2'=$P(ID,";",3) ;not same location
547"RTN","NHINVAPT",24,0)
548 .. D EN1(X1,X2,X3,X12,.NHITM),XML(.NHITM)
549"RTN","NHINVAPT",25,0)
550 . K ^TMP($J,"SDAMA201","GETAPPT")
551"RTN","NHINVAPT",26,0)
552 ;
553"RTN","NHINVAPT",27,0)
554 ; get all [future] appointments
555"RTN","NHINVAPT",28,0)
556 D GETAPPT^SDAMA201(DFN,"1;2;3;12","",BEG,END,.NHITOT)
557"RTN","NHINVAPT",29,0)
558 I NHITOT>0 S NHICNT=0 F NHI=1:1:NHITOT D Q:NHICNT'<MAX
559"RTN","NHINVAPT",30,0)
560 . S X1=+$G(^TMP($J,"SDAMA201","GETAPPT",NHI,1)),X2=+$G(^(2)),X3=$G(^(3))
561"RTN","NHINVAPT",31,0)
562 . ;no cancelled, or prior kept appointments [ORWCV]
563"RTN","NHINVAPT",32,0)
564 . Q:X3="C" I X1<DT,(X3="R"!(X3="NT")) Q
565"RTN","NHINVAPT",33,0)
566 . K NHITM D EN1(X1,X2,X3,X12,.NHITM) Q:'$D(NHITM)
567"RTN","NHINVAPT",34,0)
568 . D XML(.NHITM) S NHICNT=NHICNT+1
569"RTN","NHINVAPT",35,0)
570 K ^TMP($J,"SDAMA201","GETAPPT")
571"RTN","NHINVAPT",36,0)
572 Q
573"RTN","NHINVAPT",37,0)
574 ;
575"RTN","NHINVAPT",38,0)
576EN1(DATE,HLOC,STS,CLS,APPT) ; -- return an appointment in APPT("attribute")=value
577"RTN","NHINVAPT",39,0)
578 N X,VIEN K APPT
579"RTN","NHINVAPT",40,0)
580 S DATE=+$G(DATE),HLOC=$G(HLOC),STS=$G(STS),CLS=$G(CLS)
581"RTN","NHINVAPT",41,0)
582 S APPT("id")="A;"_DATE_";"_+HLOC,APPT("dateTime")=DATE I HLOC D
583"RTN","NHINVAPT",42,0)
584 . S APPT("location")=$P(HLOC,U,2)
585"RTN","NHINVAPT",43,0)
586 . S APPT("type")=U_$P(HLOC,U,2)_" APPOINTMENT"
587"RTN","NHINVAPT",44,0)
588 . S X=$$GET1^DIQ(44,+HLOC_",",9.5,"I")
589"RTN","NHINVAPT",45,0)
590 . I X S APPT("service")=$$SERV(X)
591"RTN","NHINVAPT",46,0)
592 S APPT("facility")=$$FAC^NHINV(+HLOC)
593"RTN","NHINVAPT",47,0)
594 S APPT("patientClass")=$S(CLS="I":"IMP",1:"AMB")
595"RTN","NHINVAPT",48,0)
596 S APPT("serviceCategory")=$S(CLS="I":"I^INPATIENT VISIT",1:"A^AMBULATORY")
597"RTN","NHINVAPT",49,0)
598 S X=$S(STS="N":"NO-SHOW",STS="C":"CANCELLED",STS="R":"SCHEDULED/KEPT",STS="NT":"NO ACTION TAKEN",1:"")
599"RTN","NHINVAPT",50,0)
600 S:$L(X) APPT("apptStatus")=X
601"RTN","NHINVAPT",51,0)
602 S APPT("visitString")=+HLOC_";"_DATE_";A"
603"RTN","NHINVAPT",52,0)
604 Q
605"RTN","NHINVAPT",53,0)
606 ;
607"RTN","NHINVAPT",54,0)
608SERV(FTS) ; -- Return #42.4 Service for a Facility Treating Specialty
609"RTN","NHINVAPT",55,0)
610 N Y S Y="",FTS=+$G(FTS)
611"RTN","NHINVAPT",56,0)
612 S Y=$$GET1^DIQ(45.7,FTS_",","1:3","E")
613"RTN","NHINVAPT",57,0)
614 Q Y
615"RTN","NHINVAPT",58,0)
616 ;
617"RTN","NHINVAPT",59,0)
618 ; ------------ Return data to middle tier ------------
619"RTN","NHINVAPT",60,0)
620 ;
621"RTN","NHINVAPT",61,0)
622XML(APPT) ; -- Return appointment as XML
623"RTN","NHINVAPT",62,0)
624 N ATT,X,Y,NAMES
625"RTN","NHINVAPT",63,0)
626 D ADD("<appointment>") S NHINTOTL=$G(NHINTOTL)+1
627"RTN","NHINVAPT",64,0)
628 S ATT="" F S ATT=$O(APPT(ATT)) Q:ATT="" D
629"RTN","NHINVAPT",65,0)
630 . S X=$G(APPT(ATT)),Y="" Q:'$L(X)
631"RTN","NHINVAPT",66,0)
632 . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />"
633"RTN","NHINVAPT",67,0)
634 . I $L(X)>1 S NAMES="code^name^Z",Y="<"_ATT_" "_$$LOOP_"/>"
635"RTN","NHINVAPT",68,0)
636 . D:$L(Y) ADD(Y)
637"RTN","NHINVAPT",69,0)
638 D ADD("</appointment>")
639"RTN","NHINVAPT",70,0)
640 Q
641"RTN","NHINVAPT",71,0)
642 ;
643"RTN","NHINVAPT",72,0)
644LOOP() ; -- build sub-items string from NAMES and X
645"RTN","NHINVAPT",73,0)
646 N STR,P,TAG S STR=""
647"RTN","NHINVAPT",74,0)
648 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))_"' "
649"RTN","NHINVAPT",75,0)
650 Q STR
651"RTN","NHINVAPT",76,0)
652 ;
653"RTN","NHINVAPT",77,0)
654ADD(X) ; -- Add a line @NHIN@(n)=X
655"RTN","NHINVAPT",78,0)
656 S NHINI=$G(NHINI)+1
657"RTN","NHINVAPT",79,0)
658 S @NHIN@(NHINI)=X
659"RTN","NHINVAPT",80,0)
660 Q
661"RTN","NHINVART")
6620^2^B30332823^n/a
663"RTN","NHINVART",1,0)
664NHINVART ;SLC/MKB -- Allergy/Reaction extract
665"RTN","NHINVART",2,0)
666 ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
667"RTN","NHINVART",3,0)
668 ;
669"RTN","NHINVART",4,0)
670 ; External References DBIA#
671"RTN","NHINVART",5,0)
672 ; ------------------- -----
673"RTN","NHINVART",6,0)
674 ; %DT 10003
675"RTN","NHINVART",7,0)
676 ; GMRADPT 10099
677"RTN","NHINVART",8,0)
678 ; EN1^GMRAOR2 2422
679"RTN","NHINVART",9,0)
680 ; PSN50P41 4531
681"RTN","NHINVART",10,0)
682 ; PSN50P65 4543
683"RTN","NHINVART",11,0)
684 ;
685"RTN","NHINVART",12,0)
686 ; ------------ Get reactions from VistA ------------
687"RTN","NHINVART",13,0)
688 ;
689"RTN","NHINVART",14,0)
690EN(DFN,BEG,END,MAX,IFN) ; -- find patient's allergies/reactions
691"RTN","NHINVART",15,0)
692 N GMRA,GMRAL,NHI,NHITM,NHICNT
693"RTN","NHINVART",16,0)
694 S DFN=+$G(DFN) Q:DFN<1
695"RTN","NHINVART",17,0)
696 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999),NHICNT=0
697"RTN","NHINVART",18,0)
698 D EN1^GMRADPT
699"RTN","NHINVART",19,0)
700 ;
701"RTN","NHINVART",20,0)
702 ; get one reaction
703"RTN","NHINVART",21,0)
704 I $G(IFN) D EN1(IFN,.NHITM),XML(.NHITM) Q
705"RTN","NHINVART",22,0)
706 ;
707"RTN","NHINVART",23,0)
708 ; get all reactions
709"RTN","NHINVART",24,0)
710 I 'GMRAL S NHITM("assessment")=$S(GMRAL=0:"nka",1:"not done") D XML(.NHITM) Q
711"RTN","NHINVART",25,0)
712 S NHI=0 F S NHI=+$O(GMRAL(NHI)) Q:NHI<1 D Q:NHICNT'<MAX
713"RTN","NHINVART",26,0)
714 . K NHITM D EN1(NHI,.NHITM) Q:'$D(NHITM)
715"RTN","NHINVART",27,0)
716 . D XML(.NHITM) S NHICNT=NHICNT+1
717"RTN","NHINVART",28,0)
718 Q
719"RTN","NHINVART",29,0)
720 ;
721"RTN","NHINVART",30,0)
722EN1(ID,REAC) ; -- return a reaction in REAC("attribute")=value
723"RTN","NHINVART",31,0)
724 ; from EN: expects GMRAL(ID)
725"RTN","NHINVART",32,0)
726 N NHY,GMRA,I,J,X,Y,SEV,TXT,NM,SEV K REAC
727"RTN","NHINVART",33,0)
728 S GMRA=$G(GMRAL(ID)) D EN1^GMRAOR2(ID,"NHY")
729"RTN","NHINVART",34,0)
730 S X=$P(NHY,U,10) I $L(X) S X=$$DATE(X) Q:X<BEG Q:X>END S REAC("entered")=X
731"RTN","NHINVART",35,0)
732 S REAC("facility")=$$FAC^NHINV ;local stn#^name
733"RTN","NHINVART",36,0)
734 S REAC("id")=ID,REAC("name")=$P(NHY,U) I $P(GMRA,U,9) D
735"RTN","NHINVART",37,0)
736 . S X=$P(GMRA,U,9),Y=+$P(X,"(",2) I 'Y,X["PSDRUG" S Y=50
737"RTN","NHINVART",38,0)
738 . S REAC("localCode")=X,REAC("vuid")=$$VUID^NHINV(+X,Y)
739"RTN","NHINVART",39,0)
740 S X=$P(NHY,U,6) S:$L(X) REAC("mechanism")=X
741"RTN","NHINVART",40,0)
742 S X=$P(NHY,U,5),REAC("source")=$E(X)
743"RTN","NHINVART",41,0)
744 S REAC("adverseEventType")=$S($L(GMRA):$P(GMRA,U,7),1:$$DFO($P(NHY,U,7)))
745"RTN","NHINVART",42,0)
746 I $P(NHY,U,4)="VERIFIED",$P(NHY,U,9) S REAC("verified")=$P(NHY,U,9)
747"RTN","NHINVART",43,0)
748 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
749"RTN","NHINVART",44,0)
750 S:$L(SEV) REAC("severity")=SEV
751"RTN","NHINVART",45,0)
752 ; reactions
753"RTN","NHINVART",46,0)
754 S I=0 F S I=$O(NHY("S",I)) Q:I<1 D
755"RTN","NHINVART",47,0)
756 . S X=NHY("S",I),NM=$P(X," (") S:NM="" NM="OTHER REACTION"
757"RTN","NHINVART",48,0)
758 . S Y=+$$FIND1^DIC(120.83,,"QX",NM)
759"RTN","NHINVART",49,0)
760 . S REAC("reaction",I)=NM_U_$$VUID^NHINV(Y,120.83)
761"RTN","NHINVART",50,0)
762 ; comments
763"RTN","NHINVART",51,0)
764 S I=0 F S I=$O(NHY("C",I)) Q:I<1 D
765"RTN","NHINVART",52,0)
766 . S X=$G(NHY("C",I)) K TXT
767"RTN","NHINVART",53,0)
768 . S Y=$$VA200($P(X,U,3))_U_$P(X,U)
769"RTN","NHINVART",54,0)
770 . S Y=Y_U_$S($L($P(X,U,2)):$E($P(X,U,2)),1:"E")
771"RTN","NHINVART",55,0)
772 . 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
773"RTN","NHINVART",56,0)
774 . K X S X=$$STRING^NHINV(.TXT)
775"RTN","NHINVART",57,0)
776 . S REAC("comment",I)=Y_U_X ;ien^name^date^type^text
777"RTN","NHINVART",58,0)
778 ; drug info
779"RTN","NHINVART",59,0)
780 I $D(NHY("I")) D
781"RTN","NHINVART",60,0)
782 . N ROOT S ROOT=$$B^PSN50P41
783"RTN","NHINVART",61,0)
784 . S I=0 F S I=$O(NHY("I",I)) Q:I<1 S X=$G(NHY("I",I)) D
785"RTN","NHINVART",62,0)
786 .. N IEN S IEN=$O(@ROOT@(X,0))
787"RTN","NHINVART",63,0)
788 .. S REAC("drugIngredient",I)=X_U_$$VUID^NHINV(IEN,50.416)
789"RTN","NHINVART",64,0)
790 I $D(NHY("V")) D
791"RTN","NHINVART",65,0)
792 . S I=0 F S I=$O(NHY("V",I)) Q:I<1 S X=$G(NHY("V",I)) D
793"RTN","NHINVART",66,0)
794 .. D C^PSN50P65("",$P(X,U,2),"PSN")
795"RTN","NHINVART",67,0)
796 .. N IEN S IEN=+$O(^TMP($J,"PSN","C",$P(X,U),0))
797"RTN","NHINVART",68,0)
798 .. S REAC("drugClass",I)=$P(X,U,2)_U_$$VUID^NHINV(IEN,50.605)
799"RTN","NHINVART",69,0)
800 I GMRA="" S REAC("removed")=1 ;entered in error
801"RTN","NHINVART",70,0)
802 Q
803"RTN","NHINVART",71,0)
804 ;
805"RTN","NHINVART",72,0)
806VA200(NAME) ; -- Return ien^name from #200
807"RTN","NHINVART",73,0)
808 N Y S NAME=$G(NAME),Y="^"
809"RTN","NHINVART",74,0)
810 I $L(NAME) S Y=+$O(^VA(200,"B",NAME,0))_U_NAME
811"RTN","NHINVART",75,0)
812 Q Y
813"RTN","NHINVART",76,0)
814 ;
815"RTN","NHINVART",77,0)
816DATE(X) ; -- Return internal form of date X
817"RTN","NHINVART",78,0)
818 N %DT,Y
819"RTN","NHINVART",79,0)
820 S %DT="TX" D ^%DT
821"RTN","NHINVART",80,0)
822 Q Y
823"RTN","NHINVART",81,0)
824 ;
825"RTN","NHINVART",82,0)
826DFO(X) ; -- Return 'DFO' string for mechanism name(s)
827"RTN","NHINVART",83,0)
828 N I,P,Y S Y=""
829"RTN","NHINVART",84,0)
830 F I=1:1:$L(X,",") S P=$P(X,",",I),Y=Y_$S($E(P)=" ":$E(P,2),1:$E(P))
831"RTN","NHINVART",85,0)
832 S:Y="" Y=$G(X)
833"RTN","NHINVART",86,0)
834 Q Y
835"RTN","NHINVART",87,0)
836 ;
837"RTN","NHINVART",88,0)
838 ; ------------ Return data to middle tier ------------
839"RTN","NHINVART",89,0)
840 ;
841"RTN","NHINVART",90,0)
842XML(REAC) ; -- Return patient reaction as XML
843"RTN","NHINVART",91,0)
844 ; as <element code='123' displayName='ABC' />
845"RTN","NHINVART",92,0)
846 N ATT,X,Y,I,P,NM,TAG
847"RTN","NHINVART",93,0)
848 D ADD("<allergy>") S NHINTOTL=$G(NHINTOTL)+1
849"RTN","NHINVART",94,0)
850 S ATT="" F S ATT=$O(REAC(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
851"RTN","NHINVART",95,0)
852 . I ATT="comment" D S Y="" Q
853"RTN","NHINVART",96,0)
854 .. S I=0,Y="<comments>" D ADD(Y)
855"RTN","NHINVART",97,0)
856 .. F S I=$O(REAC(ATT,I)) Q:I<1 S X=$G(REAC(ATT,I)) D
857"RTN","NHINVART",98,0)
858 ... S Y="<comment id='"_I
859"RTN","NHINVART",99,0)
860 ... S:$L($P(X,U,3)) Y=Y_"' entered='"_$P(X,U,3)
861"RTN","NHINVART",100,0)
862 ... S:$L($P(X,U,2)) Y=Y_"' enteredBy='"_$$ESC^NHINV($P(X,U,2))
863"RTN","NHINVART",101,0)
864 ... S:$L($P(X,U,4)) Y=Y_"' commentType='"_$P(X,U,4)
865"RTN","NHINVART",102,0)
866 ... S:$L($P(X,U,5)) Y=Y_"' commentText='"_$$ESC^NHINV($P(X,U,5))
867"RTN","NHINVART",103,0)
868 ... S Y=Y_"' />" D ADD(Y)
869"RTN","NHINVART",104,0)
870 .. D ADD("</comments>")
871"RTN","NHINVART",105,0)
872 . I $O(REAC(ATT,0)) D S Y="" Q
873"RTN","NHINVART",106,0)
874 .. S NM=ATT_$S($E(ATT,$L(ATT))="s":"es",1:"s") D ADD("<"_NM_">")
875"RTN","NHINVART",107,0)
876 .. S I=0 F S I=$O(REAC(ATT,I)) Q:I<1 D
877"RTN","NHINVART",108,0)
878 ... S X=$G(REAC(ATT,I)),Y="<"_ATT_" "
879"RTN","NHINVART",109,0)
880 ... 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))_"' "
881"RTN","NHINVART",110,0)
882 ... S Y=Y_"/>" D ADD(Y)
883"RTN","NHINVART",111,0)
884 .. D ADD("</"_NM_">")
885"RTN","NHINVART",112,0)
886 . S X=$G(REAC(ATT)),Y="" Q:'$L(X)
887"RTN","NHINVART",113,0)
888 . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
889"RTN","NHINVART",114,0)
890 . I $L(X)>1 D S Y=""
891"RTN","NHINVART",115,0)
892 .. S Y="<"_ATT_" "
893"RTN","NHINVART",116,0)
894 .. 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))_"' "
895"RTN","NHINVART",117,0)
896 .. S Y=Y_"/>" D ADD(Y)
897"RTN","NHINVART",118,0)
898 D ADD("</allergy>")
899"RTN","NHINVART",119,0)
900 Q
901"RTN","NHINVART",120,0)
902 ;
903"RTN","NHINVART",121,0)
904ADD(X) ; Add a line @NHIN@(n)=X
905"RTN","NHINVART",122,0)
906 S NHINI=$G(NHINI)+1
907"RTN","NHINVART",123,0)
908 S @NHIN@(NHINI)=X
909"RTN","NHINVART",124,0)
910 Q
911"RTN","NHINVART",125,0)
912 ;
913"RTN","NHINVART",126,0)
914C32(REAC) ; -- convert iens to C32 codes
915"RTN","NHINVART",127,0)
916 N X,Y,I
917"RTN","NHINVART",128,0)
918 S X=$G(REAC("product")) I X S $P(REAC("product"),U)=$$VUID^NHINV(+X,120.82)
919"RTN","NHINVART",129,0)
920 S X=$P($G(REAC("type")),U),Y=$P($G(REAC("mechanism")),U)
921"RTN","NHINVART",130,0)
922 I $L(X) D S $P(REAC("type"),U)=I
923"RTN","NHINVART",131,0)
924 . I Y="A" S I=$S(X["D":416098002,X["F":414285001,1:419199007) Q
925"RTN","NHINVART",132,0)
926 . I Y="P" S I=$S(X["D":59037007,X["F":235719002,1:420134006) Q
927"RTN","NHINVART",133,0)
928 . S I=$S(X["D":419511003,X["F":418471000,1:418038007)
929"RTN","NHINVART",134,0)
930 S X=+$G(REAC("severity")) I X D
931"RTN","NHINVART",135,0)
932 . S X=$S(X=1:255604002,X=2:6736007,X=3:24484000,1:X)
933"RTN","NHINVART",136,0)
934 . S $P(REAC("severity"),U)=X
935"RTN","NHINVART",137,0)
936 S I=0 F S I=$O(REAC("reaction",I)) Q:I<1 D
937"RTN","NHINVART",138,0)
938 . S X=$G(REAC("reaction",I)) Q:'X
939"RTN","NHINVART",139,0)
940 . S $P(REAC("reaction",I),U)=$$VUID^NHINV(+X,120.83)
941"RTN","NHINVART",140,0)
942 S I=0 F S I=$O(REAC("drugClass",I)) Q:I<1 D
943"RTN","NHINVART",141,0)
944 . S X=$G(REAC("drugClass",I)) Q:'X
945"RTN","NHINVART",142,0)
946 . S $P(REAC("drugClass",I),U)=$$VUID^NHINV(+X,50.605)
947"RTN","NHINVART",143,0)
948 S I=0 F S I=$O(REAC("drugIngredient",I)) Q:I<1 D
949"RTN","NHINVART",144,0)
950 . S X=$G(REAC("drugIngredient",I)) Q:'X
951"RTN","NHINVART",145,0)
952 . S $P(REAC("drugIngredient",I),U)=$$VUID^NHINV(+X,50.416)
953"RTN","NHINVART",146,0)
954 Q
955"RTN","NHINVIMM")
9560^14^B9313203^n/a
957"RTN","NHINVIMM",1,0)
958NHINVIMM ;SLC/MKB -- Immunizations extract
959"RTN","NHINVIMM",2,0)
960 ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
961"RTN","NHINVIMM",3,0)
962 ;
963"RTN","NHINVIMM",4,0)
964 ; External References DBIA#
965"RTN","NHINVIMM",5,0)
966 ; ------------------- -----
967"RTN","NHINVIMM",6,0)
968 ; ^DIC(4 10090
969"RTN","NHINVIMM",7,0)
970 ; ^VA(200 10060
971"RTN","NHINVIMM",8,0)
972 ; DIC 2051
973"RTN","NHINVIMM",9,0)
974 ; DIQ 2056
975"RTN","NHINVIMM",10,0)
976 ; PXRHS03,^TMP("PXI",$J) 1239
977"RTN","NHINVIMM",11,0)
978 ; XUAF4 2171
979"RTN","NHINVIMM",12,0)
980 ;
981"RTN","NHINVIMM",13,0)
982 ; ------------ Get immunizations from VistA ------------
983"RTN","NHINVIMM",14,0)
984 ;
985"RTN","NHINVIMM",15,0)
986EN(DFN,BEG,END,MAX,IFN) ; -- find patient's immunizations
987"RTN","NHINVIMM",16,0)
988 N NHITM,NHICNT,NM,IDT,X
989"RTN","NHINVIMM",17,0)
990 S DFN=+$G(DFN) Q:DFN<1 ;invalid patient
991"RTN","NHINVIMM",18,0)
992 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999),NHICNT=0
993"RTN","NHINVIMM",19,0)
994 K ^TMP("PXI",$J) D IMMUN^PXRHS03(DFN)
995"RTN","NHINVIMM",20,0)
996 ;
997"RTN","NHINVIMM",21,0)
998 ; get one immunization
999"RTN","NHINVIMM",22,0)
1000 I $G(IFN) D Q
1001"RTN","NHINVIMM",23,0)
1002 . N DONE S DONE=0
1003"RTN","NHINVIMM",24,0)
1004 . S NM="" F S NM=$O(^TMP("PXI",$J,NM)) Q:NM="" D Q:DONE
1005"RTN","NHINVIMM",25,0)
1006 .. S IDT=0 F S IDT=$O(^TMP("PXI",$J,NM,IDT)) Q:IDT<1 I $D(^(IDT,IFN)) D Q
1007"RTN","NHINVIMM",26,0)
1008 ... D EN1(.NHITM),XML(.NHITM)
1009"RTN","NHINVIMM",27,0)
1010 ... S DONE=1
1011"RTN","NHINVIMM",28,0)
1012 . K ^TMP("PXI",$J)
1013"RTN","NHINVIMM",29,0)
1014 ;
1015"RTN","NHINVIMM",30,0)
1016 ; get all immunizations
1017"RTN","NHINVIMM",31,0)
1018 S X=BEG,BEG=9999999-END-.000001,END=9999999-X I $L(END,".")<2 S END=END_".2359"
1019"RTN","NHINVIMM",32,0)
1020 S NM="" F S NM=$O(^TMP("PXI",$J,NM)) Q:NM="" D
1021"RTN","NHINVIMM",33,0)
1022 . S IDT=BEG F S IDT=$O(^TMP("PXI",$J,NM,IDT)) Q:IDT<1!(IDT>END) D
1023"RTN","NHINVIMM",34,0)
1024 .. S IFN=0 F S IFN=$O(^TMP("PXI",$J,NM,IDT,IFN)) Q:IFN<1 D Q:NHICNT'<MAX
1025"RTN","NHINVIMM",35,0)
1026 ... K NHITM D EN1(.NHITM),XML(.NHITM)
1027"RTN","NHINVIMM",36,0)
1028 ... S NHICNT=NHICNT+1
1029"RTN","NHINVIMM",37,0)
1030 K ^TMP("PXI",$J)
1031"RTN","NHINVIMM",38,0)
1032 Q
1033"RTN","NHINVIMM",39,0)
1034 ;
1035"RTN","NHINVIMM",40,0)
1036EN1(IMM) ; -- return an immunization in IMM("attribute")=value
1037"RTN","NHINVIMM",41,0)
1038 ; Expects ^TMP("PXI",$J,NM,IDT,IFN) from IMMUN^PXRHS03
1039"RTN","NHINVIMM",42,0)
1040 N X0,X1,CPT,DA,X,Y K IMM
1041"RTN","NHINVIMM",43,0)
1042 S X0=$G(^TMP("PXI",$J,NM,IDT,IFN,0)),X1=$G(^(1)),X=$G(^("COM"))
1043"RTN","NHINVIMM",44,0)
1044 S:$L(X) IMM("comment")=X
1045"RTN","NHINVIMM",45,0)
1046 S IMM("id")=IFN,IMM("name")=$P(X0,U)
1047"RTN","NHINVIMM",46,0)
1048 S IMM("administered")=+$P(X0,U,3)
1049"RTN","NHINVIMM",47,0)
1050 S IMM("series")=$P(X0,U,5)
1051"RTN","NHINVIMM",48,0)
1052 S IMM("reaction")=$P(X0,U,6)
1053"RTN","NHINVIMM",49,0)
1054 S IMM("contraindicated")=+$P(X0,U,7)
1055"RTN","NHINVIMM",50,0)
1056 S IMM("location")=$P(X1,U)
1057"RTN","NHINVIMM",51,0)
1058 S X=$P(X1,U,3) I $L(X) D
1059"RTN","NHINVIMM",52,0)
1060 . S Y=$$LKUP^XUAF4(X) ;ien
1061"RTN","NHINVIMM",53,0)
1062 . I Y<1 S Y=+$O(^DIC(4,"B",X,0)) ;dupl -> get 1st
1063"RTN","NHINVIMM",54,0)
1064 . S IMM("facility")=$$STA^XUAF4(Y)_U_X
1065"RTN","NHINVIMM",55,0)
1066 I '$D(IMM("facility")) S IMM("facility")=$$FAC^NHINV
1067"RTN","NHINVIMM",56,0)
1068 S X=$P(X0,U,9) S:'$L(X) X=$P(X0,U,8)
1069"RTN","NHINVIMM",57,0)
1070 I $L(X) S IMM("provider")=+$O(^VA(200,"B",X,0))_U_X
1071"RTN","NHINVIMM",58,0)
1072 ;
1073"RTN","NHINVIMM",59,0)
1074 S DA=+$$GET1^DIQ(9000010.11,IFN_",",.01,"I") Q:'DA
1075"RTN","NHINVIMM",60,0)
1076 S X=+$$FIND1^DIC(811.1,,"QX",DA_";AUTTIMM(","B") I X>0 D
1077"RTN","NHINVIMM",61,0)
1078 . S Y=$$GET1^DIQ(811.1,X_",",.02,"I") Q:Y<1
1079"RTN","NHINVIMM",62,0)
1080 . S CPT=$G(@(U_$P(Y,";",2)_+Y_",0)"))
1081"RTN","NHINVIMM",63,0)
1082 . S IMM("cpt")=$P(CPT,U,1,2)
1083"RTN","NHINVIMM",64,0)
1084 Q
1085"RTN","NHINVIMM",65,0)
1086 ;
1087"RTN","NHINVIMM",66,0)
1088 ; ------------ Return data to middle tier ------------
1089"RTN","NHINVIMM",67,0)
1090 ;
1091"RTN","NHINVIMM",68,0)
1092XML(IMM) ; -- Return immunizations as XML
1093"RTN","NHINVIMM",69,0)
1094 N ATT,X,Y,I,P,NAMES,TAG
1095"RTN","NHINVIMM",70,0)
1096 D ADD("<immunization>") S NHINTOTL=$G(NHINTOTL)+1
1097"RTN","NHINVIMM",71,0)
1098 S ATT="" F S ATT=$O(IMM(ATT)) Q:ATT="" D
1099"RTN","NHINVIMM",72,0)
1100 . S X=$G(IMM(ATT)),Y="" Q:'$L(X)
1101"RTN","NHINVIMM",73,0)
1102 . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" D ADD(Y) Q
1103"RTN","NHINVIMM",74,0)
1104 . I $L(X)>1 D
1105"RTN","NHINVIMM",75,0)
1106 .. S Y="<"_ATT_" "
1107"RTN","NHINVIMM",76,0)
1108 .. 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))_"' "
1109"RTN","NHINVIMM",77,0)
1110 .. S Y=Y_"/>" D ADD(Y)
1111"RTN","NHINVIMM",78,0)
1112 D ADD("</immunization>")
1113"RTN","NHINVIMM",79,0)
1114 Q
1115"RTN","NHINVIMM",80,0)
1116 ;
1117"RTN","NHINVIMM",81,0)
1118ADD(X) ; -- Add a line @NHIN@(n)=X
1119"RTN","NHINVIMM",82,0)
1120 S NHINI=$G(NHINI)+1
1121"RTN","NHINVIMM",83,0)
1122 S @NHIN@(NHINI)=X
1123"RTN","NHINVIMM",84,0)
1124 Q
1125"RTN","NHINVIT")
11260^4^B33591565^n/a
1127"RTN","NHINVIT",1,0)
1128NHINVIT ;SLC/MKB -- Vitals extract
1129"RTN","NHINVIT",2,0)
1130 ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
1131"RTN","NHINVIT",3,0)
1132 ;
1133"RTN","NHINVIT",4,0)
1134 ; External References DBIA#
1135"RTN","NHINVIT",5,0)
1136 ; ------------------- -----
1137"RTN","NHINVIT",6,0)
1138 ; ^SC 10040
1139"RTN","NHINVIT",7,0)
1140 ; ^VA(200 10060
1141"RTN","NHINVIT",8,0)
1142 ; DIC 2051
1143"RTN","NHINVIT",9,0)
1144 ; DIQ 2056
1145"RTN","NHINVIT",10,0)
1146 ; GMRVUT0,^UTILITY($J,"GMRVD") 1446
1147"RTN","NHINVIT",11,0)
1148 ; GMVPXRM 3647
1149"RTN","NHINVIT",12,0)
1150 ;
1151"RTN","NHINVIT",13,0)
1152 ; ------------ Get vitals from VistA ------------
1153"RTN","NHINVIT",14,0)
1154 ;
1155"RTN","NHINVIT",15,0)
1156EN(DFN,BEG,END,MAX,IFN) ; -- find patient's vitals
1157"RTN","NHINVIT",16,0)
1158 N NHITM,NHIPRM,GMRVSTR,IDT,TYPE,VIT,CNT,X0,X,Y,I,N
1159"RTN","NHINVIT",17,0)
1160 S DFN=+$G(DFN) Q:DFN<1
1161"RTN","NHINVIT",18,0)
1162 ;
1163"RTN","NHINVIT",19,0)
1164 ; get one measurement
1165"RTN","NHINVIT",20,0)
1166 I $G(IFN) D EN1(IFN,.NHITM),XML(.NHITM) Q
1167"RTN","NHINVIT",21,0)
1168 ;
1169"RTN","NHINVIT",22,0)
1170 ; get all measurements
1171"RTN","NHINVIT",23,0)
1172 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
1173"RTN","NHINVIT",24,0)
1174 S GMRVSTR="BP;T;R;P;HT;WT;CVP;CG;PO2;PN",GMRVSTR(0)=BEG_U_END_U_MAX_"^1"
1175"RTN","NHINVIT",25,0)
1176 K ^UTILITY($J,"GMRVD") D EN1^GMRVUT0
1177"RTN","NHINVIT",26,0)
1178 S (IDT,CNT)=0 F S IDT=$O(^UTILITY($J,"GMRVD",IDT)) Q:IDT<1 D Q:CNT'<MAX
1179"RTN","NHINVIT",27,0)
1180 . K VIT S VIT("taken")=9999999-IDT,CNT=CNT+1,N=0
1181"RTN","NHINVIT",28,0)
1182 . S TYPE="" F S TYPE=$O(^UTILITY($J,"GMRVD",IDT,TYPE)) Q:TYPE="" D
1183"RTN","NHINVIT",29,0)
1184 .. N NAME,VUID,RESULT,UNIT,MRES,MUNT,HIGH,LOW,QUAL
1185"RTN","NHINVIT",30,0)
1186 .. S IFN=+$O(^UTILITY($J,"GMRVD",IDT,TYPE,0)),X0=$G(^(IFN))
1187"RTN","NHINVIT",31,0)
1188 .. S X=+$P(X0,U,3),NAME=$$GET1^DIQ(120.5,IFN_",",.03)
1189"RTN","NHINVIT",32,0)
1190 .. S VUID=$$VUID^NHINV(X,120.51),RESULT=$P(X0,U,8)
1191"RTN","NHINVIT",33,0)
1192 .. S UNIT=$S(TYPE="T":"F",TYPE="HT":"in",TYPE="WT":"lb",TYPE="CVP":"cmH2O",TYPE="CG":"in",1:"")
1193"RTN","NHINVIT",34,0)
1194 .. S (MRES,MUNT)="" I $L($P(X0,U,13)) D
1195"RTN","NHINVIT",35,0)
1196 ... S X=$S(TYPE="T":"C",TYPE="HT":"cm",TYPE="WT":"kg",TYPE="CG":"cm",1:"")
1197"RTN","NHINVIT",36,0)
1198 ... S MRES=$P(X0,U,13) S:$L(X) MUNT=X
1199"RTN","NHINVIT",37,0)
1200 .. S X=$$RANGE(TYPE),(HIGH,LOW)="" I $L(X) S HIGH=$P(X,U),LOW=$P(X,U,2)
1201"RTN","NHINVIT",38,0)
1202 .. S N=N+1,VIT("measurement",N)=IFN_U_VUID_U_NAME_U_RESULT_U_UNIT_U_MRES_U_MUNT_U_HIGH_U_LOW
1203"RTN","NHINVIT",39,0)
1204 .. S QUAL=$P(X0,U,17) I $L(QUAL) F I=1:1:$L(QUAL,";") D
1205"RTN","NHINVIT",40,0)
1206 ... S X=$P(QUAL,";",I),Y=$$FIND1^DIC(120.52,,"QX",X)
1207"RTN","NHINVIT",41,0)
1208 ... I Y S VIT("measurement",N,"qualifier",I)=X_U_$$VUID^NHINV(Y,120.52)
1209"RTN","NHINVIT",42,0)
1210 . S VIT("entered")=$P($G(X0),U,4) ;use last one
1211"RTN","NHINVIT",43,0)
1212 . S X=+$P($G(X0),U,5) S:X VIT("location")=$$LOC(X)
1213"RTN","NHINVIT",44,0)
1214 . S VIT("facility")=$$FAC^NHINV(X)
1215"RTN","NHINVIT",45,0)
1216 . D XML(.VIT)
1217"RTN","NHINVIT",46,0)
1218 K ^UTILITY($J,"GMRVD")
1219"RTN","NHINVIT",47,0)
1220 Q
1221"RTN","NHINVIT",48,0)
1222 ;
1223"RTN","NHINVIT",49,0)
1224EN1(ID,VIT) ; -- return a vital/measurement in VIT("attribute")
1225"RTN","NHINVIT",50,0)
1226 K VIT S ID=+$G(ID) Q:ID<1 ;invalid ien
1227"RTN","NHINVIT",51,0)
1228 N NHY,DFN,TYPE,X,Y,NAME,VUID,RESULT,UNIT,MRES,MUNT,HIGH,LOW,I
1229"RTN","NHINVIT",52,0)
1230 D EN^GMVPXRM(.NHY,ID,"B")
1231"RTN","NHINVIT",53,0)
1232 S DFN=+$G(NHY(2)) Q:DFN<1
1233"RTN","NHINVIT",54,0)
1234 S TYPE=$$GET1^DIQ(120.51,+NHY(3)_",",1)
1235"RTN","NHINVIT",55,0)
1236 S VIT("facility")=$$FAC^NHINV(+NHY(5)),VIT("location")=NHY(5)
1237"RTN","NHINVIT",56,0)
1238 S NAME=$P(NHY(3),U,2),VUID=$$VUID^NHINV(+NHY(3),120.51)
1239"RTN","NHINVIT",57,0)
1240 S X=$P(NHY(7),U,2),RESULT=X,(UNIT,MRES,MUNT)=""
1241"RTN","NHINVIT",58,0)
1242 I TYPE="T" S UNIT="F",MUNT="C" S MRES=$J(X-32*5/9,0,1) ; EN1^GMRVUTL
1243"RTN","NHINVIT",59,0)
1244 I TYPE="HT" S UNIT="in",MUNT="cm" S MRES=$J(2.54*X,0,2) ; EN2^GMRVUTL
1245"RTN","NHINVIT",60,0)
1246 I TYPE="WT" S UNIT="lb",MUNT="kg" S MRES=$J(X/2.2,0,2) ; EN3^GMRVUTL
1247"RTN","NHINVIT",61,0)
1248 I TYPE="CG" S UNIT="in",MUNT="cm" S MRES=$J(2.54*X,0,2)
1249"RTN","NHINVIT",62,0)
1250 I TYPE="CVP" S UNIT="cmH2O"
1251"RTN","NHINVIT",63,0)
1252 S VIT("taken")=+NHY(1),VIT("entered")=+NHY(4),(HIGH,LOW)=""
1253"RTN","NHINVIT",64,0)
1254 S X=$$RANGE(TYPE) I $L(X) S HIGH=$P(X,U),LOW=$P(X,U,2)
1255"RTN","NHINVIT",65,0)
1256 S VIT("measurement",1)=ID_U_VUID_U_NAME_U_RESULT_U_UNIT_U_MRES_U_MUNT_U_HIGH_U_LOW
1257"RTN","NHINVIT",66,0)
1258 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)
1259"RTN","NHINVIT",67,0)
1260 I $G(NHY(9)) D ;entered in error/reasons
1261"RTN","NHINVIT",68,0)
1262 . S I=0 F S I=$O(NHY(11,I)) Q:I<1 S VIT("removed",I)=$P(NHY(11,I),U,2)
1263"RTN","NHINVIT",69,0)
1264 Q
1265"RTN","NHINVIT",70,0)
1266 ;
1267"RTN","NHINVIT",71,0)
1268USER(X) ; -- Return ien^name for person# X
1269"RTN","NHINVIT",72,0)
1270 N Y S X=+$G(X)
1271"RTN","NHINVIT",73,0)
1272 S Y=$S(X:X_U_$P($G(^VA(200,X,0)),U),1:"^")
1273"RTN","NHINVIT",74,0)
1274 Q Y
1275"RTN","NHINVIT",75,0)
1276 ;
1277"RTN","NHINVIT",76,0)
1278LOC(X) ; -- Return ien^name for hospital location X
1279"RTN","NHINVIT",77,0)
1280 N Y S X=+$G(X)
1281"RTN","NHINVIT",78,0)
1282 S Y=$S(X:X_U_$P($G(^SC(X,0)),U),1:"^")
1283"RTN","NHINVIT",79,0)
1284 Q Y
1285"RTN","NHINVIT",80,0)
1286 ;
1287"RTN","NHINVIT",81,0)
1288RANGE(TYPE) ; -- return high^low range of values for TYPE
1289"RTN","NHINVIT",82,0)
1290 N Y S Y="" I '$D(NHIPRM) D ;get parameter values
1291"RTN","NHINVIT",83,0)
1292 . N VAL D GETS^DIQ(120.57,"1,","5:7","","VAL")
1293"RTN","NHINVIT",84,0)
1294 . M NHIPRM=VAL(120.57,"1,")
1295"RTN","NHINVIT",85,0)
1296 I TYPE="T" S Y=$G(NHIPRM(5.1))_U_$G(NHIPRM(5.2))
1297"RTN","NHINVIT",86,0)
1298 I TYPE="P" S Y=$G(NHIPRM(5.3))_U_$G(NHIPRM(5.4))
1299"RTN","NHINVIT",87,0)
1300 I TYPE="R" S Y=$G(NHIPRM(5.5))_U_$G(NHIPRM(5.6))
1301"RTN","NHINVIT",88,0)
1302 I TYPE="CVP" S Y=$G(NHIPRM(6.1))_U_$G(NHIPRM(6.2))
1303"RTN","NHINVIT",89,0)
1304 I TYPE="PO2" S Y="100^"_$G(NHIPRM(6.3))
1305"RTN","NHINVIT",90,0)
1306 I TYPE="BP" D
1307"RTN","NHINVIT",91,0)
1308 . S Y=$G(NHIPRM(5.7))_"/"_$G(NHIPRM(5.71))_U
1309"RTN","NHINVIT",92,0)
1310 . S Y=Y_$G(NHIPRM(5.8))_"/"_$G(NHIPRM(5.81))
1311"RTN","NHINVIT",93,0)
1312 Q Y
1313"RTN","NHINVIT",94,0)
1314 ;
1315"RTN","NHINVIT",95,0)
1316 ; ------------ Return data to middle tier ------------
1317"RTN","NHINVIT",96,0)
1318 ;
1319"RTN","NHINVIT",97,0)
1320NAME(X) ; -- Return name of measurement type X for XML element
1321"RTN","NHINVIT",98,0)
1322 N Y S X=$G(X),Y=""
1323"RTN","NHINVIT",99,0)
1324 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:"")
1325"RTN","NHINVIT",100,0)
1326 Q Y
1327"RTN","NHINVIT",101,0)
1328 ;
1329"RTN","NHINVIT",102,0)
1330XML(VIT) ; -- Return vital measurement as XML in @NHIN@(#)
1331"RTN","NHINVIT",103,0)
1332 N ATT,X,Y,I,J,P,NAMES,TAG
1333"RTN","NHINVIT",104,0)
1334 D ADD("<vital>") S NHINTOTL=$G(NHINTOTL)+1
1335"RTN","NHINVIT",105,0)
1336 S ATT="" F S ATT=$O(VIT(ATT)) Q:ATT="" D
1337"RTN","NHINVIT",106,0)
1338 . I ATT="measurement" D Q
1339"RTN","NHINVIT",107,0)
1340 .. D ADD("<measurements>")
1341"RTN","NHINVIT",108,0)
1342 .. S NAMES="id^vuid^name^value^units^metricValue^metricUnits^high^low^Z"
1343"RTN","NHINVIT",109,0)
1344 .. S I=0 F S I=$O(VIT(ATT,I)) Q:I<1 D
1345"RTN","NHINVIT",110,0)
1346 ... S X=$G(VIT(ATT,I)),Y="<"_ATT_" "
1347"RTN","NHINVIT",111,0)
1348 ... 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))_"' "
1349"RTN","NHINVIT",112,0)
1350 ... I '$D(VIT(ATT,I,"qualifier")) S Y=Y_"/>" D ADD(Y) Q
1351"RTN","NHINVIT",113,0)
1352 ... S Y=Y_">" D ADD(Y),ADD("<qualifiers>")
1353"RTN","NHINVIT",114,0)
1354 ... S J=0 F S J=$O(VIT(ATT,I,"qualifier",J)) Q:J<1 D
1355"RTN","NHINVIT",115,0)
1356 .... S Y="<qualifier ",X=$G(VIT(ATT,I,"qualifier",J))
1357"RTN","NHINVIT",116,0)
1358 .... 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))_"' "
1359"RTN","NHINVIT",117,0)
1360 .... S Y=Y_"/>" D ADD(Y)
1361"RTN","NHINVIT",118,0)
1362 ... D ADD("</qualifiers>"),ADD("</measurement>")
1363"RTN","NHINVIT",119,0)
1364 .. D ADD("</measurements>")
1365"RTN","NHINVIT",120,0)
1366 . I ATT="removed" D Q
1367"RTN","NHINVIT",121,0)
1368 .. D ADD("<removed>")
1369"RTN","NHINVIT",122,0)
1370 .. S I=0 F S I=$O(VIT(ATT,I)) Q:I<1 S Y="<reason value='"_$G(VIT(ATT,I))_"' />" D ADD(Y)
1371"RTN","NHINVIT",123,0)
1372 .. D ADD("</removed>")
1373"RTN","NHINVIT",124,0)
1374 . S X=$G(VIT(ATT)),Y="" Q:'$L(X)
1375"RTN","NHINVIT",125,0)
1376 . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" D ADD(Y) Q
1377"RTN","NHINVIT",126,0)
1378 . I $L(X)>1 D
1379"RTN","NHINVIT",127,0)
1380 .. S Y="<"_ATT_" "
1381"RTN","NHINVIT",128,0)
1382 .. 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))_"' "
1383"RTN","NHINVIT",129,0)
1384 .. S Y=Y_"/>" D ADD(Y)
1385"RTN","NHINVIT",130,0)
1386 D ADD("</vital>")
1387"RTN","NHINVIT",131,0)
1388 Q
1389"RTN","NHINVIT",132,0)
1390 ;
1391"RTN","NHINVIT",133,0)
1392ADD(X) ; Add a line @NHIN@(n)=X
1393"RTN","NHINVIT",134,0)
1394 S NHINI=$G(NHINI)+1
1395"RTN","NHINVIT",135,0)
1396 S @NHIN@(NHINI)=X
1397"RTN","NHINVIT",136,0)
1398 Q
1399"RTN","NHINVLR")
14000^5^B25540846^n/a
1401"RTN","NHINVLR",1,0)
1402NHINVLR ;SLC/MKB -- Laboratory extract
1403"RTN","NHINVLR",2,0)
1404 ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
1405"RTN","NHINVLR",3,0)
1406 ;
1407"RTN","NHINVLR",4,0)
1408 ; External References DBIA#
1409"RTN","NHINVLR",5,0)
1410 ; ------------------- -----
1411"RTN","NHINVLR",6,0)
1412 ; ^DPT 10035
1413"RTN","NHINVLR",7,0)
1414 ; ^LAB(60 10054
1415"RTN","NHINVLR",8,0)
1416 ; ^LRO(69 2407
1417"RTN","NHINVLR",9,0)
1418 ; ^LR 525
1419"RTN","NHINVLR",10,0)
1420 ; DIC 2051
1421"RTN","NHINVLR",11,0)
1422 ; DIQ 2056
1423"RTN","NHINVLR",12,0)
1424 ; LR7OR1,^TMP("LRRR",$J) 2503
1425"RTN","NHINVLR",13,0)
1426 ;
1427"RTN","NHINVLR",14,0)
1428 ; ------------ Get results from VistA ------------
1429"RTN","NHINVLR",15,0)
1430 ;
1431"RTN","NHINVLR",16,0)
1432EN(DFN,BEG,END,MAX,ID) ; -- find patient's lab results
1433"RTN","NHINVLR",17,0)
1434 N NHSUB,NHIDT,NHI,NHITM,LRDFN,SUB
1435"RTN","NHINVLR",18,0)
1436 S DFN=+$G(DFN) Q:$G(DFN)<1
1437"RTN","NHINVLR",19,0)
1438 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
1439"RTN","NHINVLR",20,0)
1440 K ^TMP("LRRR",$J,DFN) S LRDFN=$G(^DPT(DFN,"LR")),NHSUB="CH"
1441"RTN","NHINVLR",21,0)
1442 ;
1443"RTN","NHINVLR",22,0)
1444 ; get result(s)
1445"RTN","NHINVLR",23,0)
1446 I $L($G(ID)) D Q:NHI ;done
1447"RTN","NHINVLR",24,0)
1448 . S NHSUB=$P(ID,";"),NHIDT=+$P(ID,";",2),(BEG,END)=9999999-NHIDT
1449"RTN","NHINVLR",25,0)
1450 . S NHI=$P(ID,";",3) I NHI D ;skip loop - single result
1451"RTN","NHINVLR",26,0)
1452 .. D RR^LR7OR1(DFN,,BEG,END,NHSUB)
1453"RTN","NHINVLR",27,0)
1454 .. S SUB=$S("CH^MI"[NHSUB:NHSUB,1:"AP")_"(.NHITM)"
1455"RTN","NHINVLR",28,0)
1456 .. D @SUB,XML(.NHITM)
1457"RTN","NHINVLR",29,0)
1458 .. K ^TMP("LRRR",$J,DFN)
1459"RTN","NHINVLR",30,0)
1460 ;
1461"RTN","NHINVLR",31,0)
1462 D RR^LR7OR1(DFN,,BEG,END,NHSUB,,,MAX)
1463"RTN","NHINVLR",32,0)
1464 S NHSUB="" F S NHSUB=$O(^TMP("LRRR",$J,DFN,NHSUB)) Q:NHSUB="" D
1465"RTN","NHINVLR",33,0)
1466 . S NHIDT=0 F S NHIDT=$O(^TMP("LRRR",$J,DFN,NHSUB,NHIDT)) Q:NHIDT<1 D
1467"RTN","NHINVLR",34,0)
1468 .. S NHI=0 F S NHI=$O(^TMP("LRRR",$J,DFN,NHSUB,NHIDT,NHI)) Q:NHI<1 D
1469"RTN","NHINVLR",35,0)
1470 ... K NHITM S SUB=$S("CH^MI"[NHSUB:NHSUB,1:"AP")_"(.NHITM)"
1471"RTN","NHINVLR",36,0)
1472 ... D @SUB,XML(.NHITM)
1473"RTN","NHINVLR",37,0)
1474 K ^TMP("LRRR",$J,DFN)
1475"RTN","NHINVLR",38,0)
1476 Q
1477"RTN","NHINVLR",39,0)
1478 ;
1479"RTN","NHINVLR",40,0)
1480CH(LAB) ; -- return a Chemistry result in LAB("attribute")=value
1481"RTN","NHINVLR",41,0)
1482 ; Expects ^TMP("LRRR",$J,DFN,"CH",NHIDT,NHI),LRDFN
1483"RTN","NHINVLR",42,0)
1484 N CDT,LR0,LRI,X0,X,LOINC,ORD,CMMT K LAB
1485"RTN","NHINVLR",43,0)
1486 S LAB("id")="CH;"_NHIDT_";"_NHI,LAB("type")="CH"
1487"RTN","NHINVLR",44,0)
1488 S CDT=9999999-NHIDT,LAB("collected")=CDT
1489"RTN","NHINVLR",45,0)
1490 S LR0=$G(^LR(LRDFN,"CH",NHIDT,0)),LRI=$G(^(NHI))
1491"RTN","NHINVLR",46,0)
1492 S LAB("status")="completed",LAB("resulted")=$P(LR0,U,3)
1493"RTN","NHINVLR",47,0)
1494 S X0=$G(^TMP("LRRR",$J,DFN,"CH",NHIDT,NHI))
1495"RTN","NHINVLR",48,0)
1496 S LAB("test")=$P($G(^LAB(60,+X0,0)),U) ;$P(X0,U,10)?
1497"RTN","NHINVLR",49,0)
1498 S:$L($P(X0,U,2)) LAB("result")=$P(X0,U,2)
1499"RTN","NHINVLR",50,0)
1500 S:$L($P(X0,U,4)) LAB("units")=$P(X0,U,4)
1501"RTN","NHINVLR",51,0)
1502 S:$L($P(X0,U,3)) LAB("interpretation")=$P(X0,U,3)
1503"RTN","NHINVLR",52,0)
1504 S X=$P(X0,U,5) I $L(X),X["-" S LAB("low")=$P(X,"-"),LAB("high")=$P(X,"-",2)
1505"RTN","NHINVLR",53,0)
1506 S LAB("localName")=$S($L($P(X0,U,15)):$P(X0,U,15),1:LAB("test"))
1507"RTN","NHINVLR",54,0)
1508 S LAB("groupName")=$P(X0,U,16) ;accession#
1509"RTN","NHINVLR",55,0)
1510 S X=$P($P(LRI,U,3),"!",3) S:X LOINC=$$GET1^DIQ(95.3,X_",",.01)
1511"RTN","NHINVLR",56,0)
1512 S X=+$P(X0,U,19) I X D ;specimen
1513"RTN","NHINVLR",57,0)
1514 . N VUID,IENS,NHY S VUID="",IENS=X_","
1515"RTN","NHINVLR",58,0)
1516 . D GETS^DIQ(61,IENS,".01;2",,"NHY")
1517"RTN","NHINVLR",59,0)
1518 . S LAB("specimen")=$G(NHY(61,IENS,2))_U_$G(NHY(61,IENS,.01)) ;SNOMED^name
1519"RTN","NHINVLR",60,0)
1520 . S LAB("sample")=$$GET1^DIQ(61,X_",",4.1) ;name
1521"RTN","NHINVLR",61,0)
1522 . ; LOINC=+$G(^LAB(60,+X0,1,X,95.3))
1523"RTN","NHINVLR",62,0)
1524 . S:'$G(LOINC) LOINC=$$GET1^DIQ(60.01,X_","_+X0_",",95.3)
1525"RTN","NHINVLR",63,0)
1526 . I LOINC S LAB("loinc")=LOINC,VUID=$$VUID^NHINV(+LOINC,95.3)
1527"RTN","NHINVLR",64,0)
1528 . S:VUID LAB("vuid")=VUID
1529"RTN","NHINVLR",65,0)
1530 S ORD=+$P(X0,U,17) S:ORD LAB("labOrderID")=ORD
1531"RTN","NHINVLR",66,0)
1532 S X=$$ORDER(ORD,+X0) S:X LAB("orderID")=X
1533"RTN","NHINVLR",67,0)
1534 S X=$P(LR0,U,14)
1535"RTN","NHINVLR",68,0)
1536 S:X LAB("facility")=$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U)
1537"RTN","NHINVLR",69,0)
1538 I 'X S LAB("facility")=$$FAC^NHINV ;local stn#^name
1539"RTN","NHINVLR",70,0)
1540 I $D(^TMP("LRRR",$J,DFN,"CH",NHIDT,"N")) M CMMT=^("N") S LAB("comment")=$$STRING^NHINV(.CMMT)
1541"RTN","NHINVLR",71,0)
1542 Q
1543"RTN","NHINVLR",72,0)
1544 ;
1545"RTN","NHINVLR",73,0)
1546ORDER(LABORD,TEST) ; -- return #100 order for Lab order# & Test
1547"RTN","NHINVLR",74,0)
1548 N Y,D,S,T S Y=""
1549"RTN","NHINVLR",75,0)
1550 S D=$O(^LRO(69,"C",LABORD,0)) I D D
1551"RTN","NHINVLR",76,0)
1552 . S S=0 F S S=$O(^LRO(69,"C",LABORD,D,S)) Q:S<1 D
1553"RTN","NHINVLR",77,0)
1554 .. 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)
1555"RTN","NHINVLR",78,0)
1556 Q Y
1557"RTN","NHINVLR",79,0)
1558 ;
1559"RTN","NHINVLR",80,0)
1560MI(LAB) ; -- return a Microbiology result in LAB("attribute")=value
1561"RTN","NHINVLR",81,0)
1562 ; Expects ^TMP("LRRR",$J,DFN,"MI",NHIDT,NHI),LRDFN
1563"RTN","NHINVLR",82,0)
1564 N ID,CDT,X0,X,CMMT,LR0 K LAB
1565"RTN","NHINVLR",83,0)
1566 S X0=$G(^TMP("LRRR",$J,DFN,"MI",NHIDT,NHI)) Q:$L($P(X0,U))'>1
1567"RTN","NHINVLR",84,0)
1568 S LAB("id")="MI;"_NHIDT_"#"_NHI,LAB("status")="completed"
1569"RTN","NHINVLR",85,0)
1570 S LAB("type")="MI",CDT=9999999-NHIDT,LAB("collected")=CDT
1571"RTN","NHINVLR",86,0)
1572 S LR0=$G(^LR(LRDFN,"MI",NHIDT,0)),LAB("resulted")=$P(LR0,U,3)
1573"RTN","NHINVLR",87,0)
1574 S:$L($P(X0,U,2)) LAB("result")=$P(X0,U,2)
1575"RTN","NHINVLR",88,0)
1576 S:$L($P(X0,U,4)) LAB("units")=$P(X0,U,4)
1577"RTN","NHINVLR",89,0)
1578 S:$L($P(X0,U,3)) LAB("interpretation")=$P(X0,U,3)
1579"RTN","NHINVLR",90,0)
1580 S (LAB("test"),LAB("localName"))=$P(X0,U,15)
1581"RTN","NHINVLR",91,0)
1582 S X=+$P(X0,U,19) I X D ;specimen
1583"RTN","NHINVLR",92,0)
1584 . N IENS,NHY S IENS=X_","
1585"RTN","NHINVLR",93,0)
1586 . D GETS^DIQ(61,IENS,".01;2",,"NHY")
1587"RTN","NHINVLR",94,0)
1588 . S LAB("specimen")=$G(NHY(61,IENS,2))_U_$G(NHY(61,IENS,.01)) ;SNOMED^name
1589"RTN","NHINVLR",95,0)
1590 . S LAB("sample")=$$GET1^DIQ(61,X_",",4.1) ;name
1591"RTN","NHINVLR",96,0)
1592 S X=$P(LR0,U,14)
1593"RTN","NHINVLR",97,0)
1594 S:X LAB("facility")=$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U)
1595"RTN","NHINVLR",98,0)
1596 I 'X S LAB("facility")=$$FAC^NHINV ;local stn#^name
1597"RTN","NHINVLR",99,0)
1598 I $D(^TMP("LRRR",$J,DFN,"MI",NHIDT,"N")) M CMMT=^("N") S LAB("comment")=$$STRING^NHINV(.CMMT)
1599"RTN","NHINVLR",100,0)
1600 Q
1601"RTN","NHINVLR",101,0)
1602 ;
1603"RTN","NHINVLR",102,0)
1604AP(LAB) ; -- return a Pathology result in LAB("attribute")=value
1605"RTN","NHINVLR",103,0)
1606 K LAB ;not implemented yet
1607"RTN","NHINVLR",104,0)
1608 Q
1609"RTN","NHINVLR",105,0)
1610 ;
1611"RTN","NHINVLR",106,0)
1612TYPE(X) ; -- Return name of lab section
1613"RTN","NHINVLR",107,0)
1614 N NHIY,Y S Y=X
1615"RTN","NHINVLR",108,0)
1616 D FIND^DIC(68,,.01,"PQX",X,,"B",,,"NHIY")
1617"RTN","NHINVLR",109,0)
1618 S:$G(NHIY("DILIST",1,0)) Y=$P(NHIY("DILIST",1,0),U,2) ;name
1619"RTN","NHINVLR",110,0)
1620 Q Y
1621"RTN","NHINVLR",111,0)
1622 ;
1623"RTN","NHINVLR",112,0)
1624 ; ------------ Return data to middle tier ------------
1625"RTN","NHINVLR",113,0)
1626 ;
1627"RTN","NHINVLR",114,0)
1628XML(LAB) ; -- Return result as XML in @NHIN@(#)
1629"RTN","NHINVLR",115,0)
1630 N ATT,X,Y,P,NAMES,TAG
1631"RTN","NHINVLR",116,0)
1632 D ADD("<lab>") S NHINTOTL=$G(NHINTOTL)+1
1633"RTN","NHINVLR",117,0)
1634 S ATT="" F S ATT=$O(LAB(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
1635"RTN","NHINVLR",118,0)
1636 . S X=$G(LAB(ATT)),Y="" Q:'$L(X)
1637"RTN","NHINVLR",119,0)
1638 . I ATT="comment" S Y="<"_ATT_" xml:space='preserve'>"_$$ESC^NHINV(X)_"</"_ATT_">" Q
1639"RTN","NHINVLR",120,0)
1640 . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
1641"RTN","NHINVLR",121,0)
1642 . I $L(X)>1 D S Y=""
1643"RTN","NHINVLR",122,0)
1644 .. S Y="<"_ATT_" ",NAMES="code^name^Z"
1645"RTN","NHINVLR",123,0)
1646 .. 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))_"' "
1647"RTN","NHINVLR",124,0)
1648 .. S Y=Y_"/>" D ADD(Y)
1649"RTN","NHINVLR",125,0)
1650 D ADD("</lab>")
1651"RTN","NHINVLR",126,0)
1652 Q
1653"RTN","NHINVLR",127,0)
1654 ;
1655"RTN","NHINVLR",128,0)
1656ADD(X) ; -- Add a line @NHIN@(n)=X
1657"RTN","NHINVLR",129,0)
1658 S NHINI=$G(NHINI)+1
1659"RTN","NHINVLR",130,0)
1660 S @NHIN@(NHINI)=X
1661"RTN","NHINVLR",131,0)
1662 Q
1663"RTN","NHINVLRA")
16640^21^B45252098^n/a
1665"RTN","NHINVLRA",1,0)
1666NHINVLRA ;SLC/MKB -- Laboratory extract by accession
1667"RTN","NHINVLRA",2,0)
1668 ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
1669"RTN","NHINVLRA",3,0)
1670 ;
1671"RTN","NHINVLRA",4,0)
1672 ; External References DBIA#
1673"RTN","NHINVLRA",5,0)
1674 ; ------------------- -----
1675"RTN","NHINVLRA",6,0)
1676 ; ^DPT 10035
1677"RTN","NHINVLRA",7,0)
1678 ; ^LAB(60 10054
1679"RTN","NHINVLRA",8,0)
1680 ; ^LRO(69 2407
1681"RTN","NHINVLRA",9,0)
1682 ; ^LR 525
1683"RTN","NHINVLRA",10,0)
1684 ; ^VA(200 10060
1685"RTN","NHINVLRA",11,0)
1686 ; DIC 2051
1687"RTN","NHINVLRA",12,0)
1688 ; DIQ 2056
1689"RTN","NHINVLRA",13,0)
1690 ; LR7OR1,^TMP("LRRR",$J) 2503
1691"RTN","NHINVLRA",14,0)
1692 ; LR7OSUM,^TMP("LRC") 2766
1693"RTN","NHINVLRA",15,0)
1694 ; PXAPI 1894
1695"RTN","NHINVLRA",16,0)
1696 ; XUAF4 2171
1697"RTN","NHINVLRA",17,0)
1698 ;
1699"RTN","NHINVLRA",18,0)
1700 ; ------------ Get results from VistA ------------
1701"RTN","NHINVLRA",19,0)
1702 ;
1703"RTN","NHINVLRA",20,0)
1704EN(DFN,BEG,END,MAX,ID) ; -- find patient's lab results
1705"RTN","NHINVLRA",21,0)
1706 N NHSUB,NHIDT,NHI,NHITM,LRDFN,LR0,ORD,X
1707"RTN","NHINVLRA",22,0)
1708 S DFN=+$G(DFN) Q:$G(DFN)<1
1709"RTN","NHINVLRA",23,0)
1710 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
1711"RTN","NHINVLRA",24,0)
1712 S LRDFN=$G(^DPT(DFN,"LR")),NHSUB=""
1713"RTN","NHINVLRA",25,0)
1714 K ^TMP("LRRR",$J,DFN)
1715"RTN","NHINVLRA",26,0)
1716 ;
1717"RTN","NHINVLRA",27,0)
1718 ; get result(s)
1719"RTN","NHINVLRA",28,0)
1720 I $L($G(ID)) D ;reset search parameters
1721"RTN","NHINVLRA",29,0)
1722 . S NHSUB=$P(ID,";"),NHIDT=+$P(ID,";",2)
1723"RTN","NHINVLRA",30,0)
1724 . S:NHIDT (BEG,END)=9999999-NHIDT
1725"RTN","NHINVLRA",31,0)
1726 ;
1727"RTN","NHINVLRA",32,0)
1728 D RR^LR7OR1(DFN,,BEG,END,NHSUB,,,MAX)
1729"RTN","NHINVLRA",33,0)
1730 S NHSUB="" F S NHSUB=$O(^TMP("LRRR",$J,DFN,NHSUB)) Q:NHSUB="" D
1731"RTN","NHINVLRA",34,0)
1732 . S NHIDT=0 F S NHIDT=$O(^TMP("LRRR",$J,DFN,NHSUB,NHIDT)) Q:NHIDT<1 I $O(^(NHIDT,0)) D
1733"RTN","NHINVLRA",35,0)
1734 .. K NHITM,CMMT I "CH^MI"'[NHSUB D AP(.NHITM),XML(.NHITM) Q
1735"RTN","NHINVLRA",36,0)
1736 .. S NHITM("type")=NHSUB,NHITM("id")=NHSUB_";"_NHIDT
1737"RTN","NHINVLRA",37,0)
1738 .. S NHITM("collected")=9999999-NHIDT,NHITM("status")="completed"
1739"RTN","NHINVLRA",38,0)
1740 .. S LR0=$G(^LR(LRDFN,NHSUB,NHIDT,0))
1741"RTN","NHINVLRA",39,0)
1742 .. S NHITM("resulted")=$P(LR0,U,3),X=+$P(LR0,U,5) I X D
1743"RTN","NHINVLRA",40,0)
1744 ... N IENS,NHY S IENS=X_","
1745"RTN","NHINVLRA",41,0)
1746 ... D GETS^DIQ(61,IENS,".01:2",,"NHY")
1747"RTN","NHINVLRA",42,0)
1748 ... S NHITM("specimen")=$G(NHY(61,IENS,2))_U_$G(NHY(61,IENS,.01)) ;SNOMED^name
1749"RTN","NHINVLRA",43,0)
1750 ... S NHITM("sample")=$$GET1^DIQ(61,X_",",4.1) ;name
1751"RTN","NHINVLRA",44,0)
1752 .. S NHITM("groupName")=$P(LR0,U,6),X=+$P(LR0,U,14)
1753"RTN","NHINVLRA",45,0)
1754 .. S:X NHITM("facility")=$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U)
1755"RTN","NHINVLRA",46,0)
1756 .. I 'X S NHITM("facility")=$$FAC^NHINV ;local stn#^name
1757"RTN","NHINVLRA",47,0)
1758 .. S:NHSUB="MI" NHITM("content")=$$TEXT(DFN,NHSUB,NHIDT)
1759"RTN","NHINVLRA",48,0)
1760 .. S NHI=0 F S NHI=$O(^TMP("LRRR",$J,DFN,NHSUB,NHIDT,NHI)) Q:NHI<1 D
1761"RTN","NHINVLRA",49,0)
1762 ... S X=$S(NHSUB="MI":$$MI,1:$$CH)
1763"RTN","NHINVLRA",50,0)
1764 ... S:$L(X) NHITM("lab",NHI)=X
1765"RTN","NHINVLRA",51,0)
1766 ... S:$G(ORD) NHITM("labOrderID")=ORD
1767"RTN","NHINVLRA",52,0)
1768 .. I $D(^TMP("LRRR",$J,DFN,NHSUB,NHIDT,"N")) M CMMT=^("N") S NHITM("comment")=$$STRING^NHINV(.CMMT)
1769"RTN","NHINVLRA",53,0)
1770 .. D XML(.NHITM)
1771"RTN","NHINVLRA",54,0)
1772 K ^TMP("LRRR",$J,DFN)
1773"RTN","NHINVLRA",55,0)
1774 Q
1775"RTN","NHINVLRA",56,0)
1776 ;
1777"RTN","NHINVLRA",57,0)
1778CH() ; -- return a Chemistry result as:
1779"RTN","NHINVLRA",58,0)
1780 ; id^test^result^interpretation^units^low^high^loinc^vuid^order
1781"RTN","NHINVLRA",59,0)
1782 ; Expects ^TMP("LRRR",$J,DFN,"CH",NHIDT,NHI),LRDFN
1783"RTN","NHINVLRA",60,0)
1784 N X,Y,X0,NODE,CMMT,LOINC
1785"RTN","NHINVLRA",61,0)
1786 S X0=$G(^TMP("LRRR",$J,DFN,"CH",NHIDT,NHI)),NODE=$G(^LR(LRDFN,"CH",NHIDT,NHI))
1787"RTN","NHINVLRA",62,0)
1788 S X=$P($G(^LAB(60,+X0,0)),U)
1789"RTN","NHINVLRA",63,0)
1790 S Y="CH;"_NHIDT_";"_NHI_U_X_U_$P(X0,U,2,4)
1791"RTN","NHINVLRA",64,0)
1792 S X=$P(X0,U,5) I $L(X),X["-" S X=$TR(X,"- ","^"),$P(Y,U,6,7)=X
1793"RTN","NHINVLRA",65,0)
1794 S X=$P($P(NODE,U,3),"!",3) S:X LOINC=$$GET1^DIQ(95.3,X_",",.01)
1795"RTN","NHINVLRA",66,0)
1796 I '$G(LOINC) S X=+$P(X0,U,19) S:X LOINC=$$LOINC(+X0,X)
1797"RTN","NHINVLRA",67,0)
1798 S $P(Y,U,8,9)=$G(LOINC)_U_$$VUID^NHINV(+LOINC,95.3)
1799"RTN","NHINVLRA",68,0)
1800 S ORD=+$P(X0,U,17),X=$$ORDER(ORD,+X0) S:X $P(Y,U,10)=X
1801"RTN","NHINVLRA",69,0)
1802 Q Y
1803"RTN","NHINVLRA",70,0)
1804 ;
1805"RTN","NHINVLRA",71,0)
1806MI() ; -- return a Microbiology result as:
1807"RTN","NHINVLRA",72,0)
1808 ; id^test^result^interpretation^units
1809"RTN","NHINVLRA",73,0)
1810 ; Expects ^TMP("LRRR",$J,DFN,"MI",NHIDT,NHI)
1811"RTN","NHINVLRA",74,0)
1812 N Y,X0
1813"RTN","NHINVLRA",75,0)
1814 S X0=$G(^TMP("LRRR",$J,DFN,"MI",NHIDT,NHI)),Y=""
1815"RTN","NHINVLRA",76,0)
1816 S:$L($P(X0,U))>1 Y="MI;"_NHIDT_";"_NHI_U_$P(X0,U,1,4)
1817"RTN","NHINVLRA",77,0)
1818 Q Y
1819"RTN","NHINVLRA",78,0)
1820 ;
1821"RTN","NHINVLRA",79,0)
1822AP(LAB) ; -- return a Pathology result in LAB("attribute")=value
1823"RTN","NHINVLRA",80,0)
1824 N LR0,X,I,NODE
1825"RTN","NHINVLRA",81,0)
1826 S LR0=$G(^LR(LRDFN,NHSUB,NHIDT,0))
1827"RTN","NHINVLRA",82,0)
1828 S LAB("type")=NHSUB,LAB("id")=NHSUB_";"_NHIDT
1829"RTN","NHINVLRA",83,0)
1830 S LAB("collected")=9999999-NHIDT,LAB("status")="completed"
1831"RTN","NHINVLRA",84,0)
1832 S LAB("resulted")=$P(LR0,U,11),LAB("groupName")=$P(LR0,U,6)
1833"RTN","NHINVLRA",85,0)
1834 S X="",I=0 F S I=$O(^LR(LRDFN,NHSUB,NHIDT,.1,I)) Q:I<1 S X=X_$S($L(X):", ",1:"")_$P($G(^(I,0)),U)
1835"RTN","NHINVLRA",86,0)
1836 S:$L(X) LAB("specimen")=U_X
1837"RTN","NHINVLRA",87,0)
1838 S LAB("facility")=$$FAC^NHINV
1839"RTN","NHINVLRA",88,0)
1840 S NODE=$S(NHSUB="AU":$NA(^LR(LRDFN,101)),1:$NA(^LR(LRDFN,NHSUB,NHIDT,.05)))
1841"RTN","NHINVLRA",89,0)
1842 S I=0 F S I=$O(@NODE@(I)) Q:I<1 S X=+$P($G(@NODE@(I,0)),U,2) I X D
1843"RTN","NHINVLRA",90,0)
1844 . N LT,NT
1845"RTN","NHINVLRA",91,0)
1846 . S LT=$$GET1^DIQ(8925,+X_",",.01) Q:$P(LT," ")="Addendum"
1847"RTN","NHINVLRA",92,0)
1848 . S NT=$$GET1^DIQ(8925,+X_",",".01:1501")
1849"RTN","NHINVLRA",93,0)
1850 . S LAB("document",I)=+X_U_LT_U_NT
1851"RTN","NHINVLRA",94,0)
1852 I '$O(NHITM("document",0)) S NHITM("content")=$$TEXT(DFN,NHSUB,NHIDT)
1853"RTN","NHINVLRA",95,0)
1854 Q
1855"RTN","NHINVLRA",96,0)
1856 ;
1857"RTN","NHINVLRA",97,0)
1858LOINC(TEST,SPEC) ; -- Look up LOINC code, if not mapped
1859"RTN","NHINVLRA",98,0)
1860 N Y,LAM,NHIN,IENS S Y=""
1861"RTN","NHINVLRA",99,0)
1862 S TEST=+$G(TEST),SPEC=+$G(SPEC)
1863"RTN","NHINVLRA",100,0)
1864 S LAM=$G(^LAB(60,TEST,64)),LAM=$S($P(LAM,U,2):$P(LAM,U,2),1:+LAM)
1865"RTN","NHINVLRA",101,0)
1866 D GETS^DIQ(64.01,SPEC_","_LAM_",","30*",,"NHIN")
1867"RTN","NHINVLRA",102,0)
1868 S IENS=$O(NHIN(64.02,"")) S:IENS Y=$G(NHIN(64.02,IENS,4))
1869"RTN","NHINVLRA",103,0)
1870 S:'Y Y=$$GET1^DIQ(60.01,SPEC_","_TEST_",",95.3)
1871"RTN","NHINVLRA",104,0)
1872 Q Y
1873"RTN","NHINVLRA",105,0)
1874 ;
1875"RTN","NHINVLRA",106,0)
1876ORDER(LABORD,TEST) ; -- return #100 order for Lab order# & Test
1877"RTN","NHINVLRA",107,0)
1878 N Y,D,S,T S Y=""
1879"RTN","NHINVLRA",108,0)
1880 S D=$O(^LRO(69,"C",LABORD,0)) I D D
1881"RTN","NHINVLRA",109,0)
1882 . S S=0 F S S=$O(^LRO(69,"C",LABORD,D,S)) Q:S<1 D
1883"RTN","NHINVLRA",110,0)
1884 .. 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)
1885"RTN","NHINVLRA",111,0)
1886 Q Y
1887"RTN","NHINVLRA",112,0)
1888 ;
1889"RTN","NHINVLRA",113,0)
1890NAME(X) ; -- Return name of subscript X
1891"RTN","NHINVLRA",114,0)
1892 I X="AU" Q "AUTOPSY"
1893"RTN","NHINVLRA",115,0)
1894 I X="BB" Q "BLOOD BANK"
1895"RTN","NHINVLRA",116,0)
1896 I X="CH" Q "CHEM,HEM,TOX,RIA,SER,etc."
1897"RTN","NHINVLRA",117,0)
1898 I X="CY" Q "CYTOLOGY"
1899"RTN","NHINVLRA",118,0)
1900 I X="EM" Q "ELECTRON MICROSCOPY"
1901"RTN","NHINVLRA",119,0)
1902 I X="MI" Q "MICROBIOLOGY"
1903"RTN","NHINVLRA",120,0)
1904 I X="SP" Q "SURGICAL PATHOLOGY"
1905"RTN","NHINVLRA",121,0)
1906 Q "ANATOMIC PATHOLOGY"
1907"RTN","NHINVLRA",122,0)
1908 ;
1909"RTN","NHINVLRA",123,0)
1910RPT(DFN,ID,RPT) ; -- return report as a TIU document
1911"RTN","NHINVLRA",124,0)
1912 S DFN=+$G(DFN),ID=$G(ID) Q:DFN<1 Q:'$L(ID)
1913"RTN","NHINVLRA",125,0)
1914 N SUB,IDT,LRDFN,LR0,X
1915"RTN","NHINVLRA",126,0)
1916 S SUB=$P(ID,";"),IDT=+$P(ID,";",2)
1917"RTN","NHINVLRA",127,0)
1918 S LRDFN=$G(^DPT(DFN,"LR")),LR0=$G(^LR(LRDFN,SUB,IDT,0))
1919"RTN","NHINVLRA",128,0)
1920 S RPT("id")=ID,RPT("referenceDateTime")=9999999-IDT
1921"RTN","NHINVLRA",129,0)
1922 S RPT("localTitle")=$$NAME(SUB),RPT("status")="COMPLETED"
1923"RTN","NHINVLRA",130,0)
1924 S X=+$P(LR0,U,14),RPT("facility")=$$FAC^NHINV(X)
1925"RTN","NHINVLRA",131,0)
1926 S X=$P(LR0,U,13) I X["SC(" D
1927"RTN","NHINVLRA",132,0)
1928 . N CDT,HLOC S HLOC=+X,CDT=9999999-IDT
1929"RTN","NHINVLRA",133,0)
1930 . S X=$$GETENC^PXAPI(DFN,CDT,HLOC)
1931"RTN","NHINVLRA",134,0)
1932 . S:X RPT("encounter")=+X
1933"RTN","NHINVLRA",135,0)
1934 S X=+$P(LR0,U,4) S:X RPT("clinician",1)=X_U_$P($G(^VA(200,X,0)),U)
1935"RTN","NHINVLRA",136,0)
1936 S RPT("content")=$$TEXT(DFN,SUB,IDT)
1937"RTN","NHINVLRA",137,0)
1938 Q
1939"RTN","NHINVLRA",138,0)
1940 ;
1941"RTN","NHINVLRA",139,0)
1942TEXT(DFN,SUB,IDT) ; -- return report text as a string
1943"RTN","NHINVLRA",140,0)
1944 N LRDFN,DATE,NAME,NHS,NHY,I,X,Y
1945"RTN","NHINVLRA",141,0)
1946 K ^TMP("LRC",$J),^TMP("LRH",$J),^TMP("LRT",$J)
1947"RTN","NHINVLRA",142,0)
1948 S DATE=9999999-+$G(IDT),NAME=$$NAME(SUB),NHS(NAME)=""
1949"RTN","NHINVLRA",143,0)
1950 D EN^LR7OSUM(.NHY,DFN,DATE,DATE,,,.NHS)
1951"RTN","NHINVLRA",144,0)
1952 S I=+$G(^TMP("LRH",$J,NAME))+1,Y=$G(^TMP("LRC",$J,I,0)) ;LRH=header: Y=1st line
1953"RTN","NHINVLRA",145,0)
1954 F S I=$O(^TMP("LRC",$J,I)) Q:I<1 S X=$G(^(I,0)) Q:X?1."=" S Y=Y_$C(13,10)_X
1955"RTN","NHINVLRA",146,0)
1956 K ^TMP("LRC",$J),^TMP("LRH",$J),^TMP("LRT",$J)
1957"RTN","NHINVLRA",147,0)
1958 Q Y
1959"RTN","NHINVLRA",148,0)
1960 ;
1961"RTN","NHINVLRA",149,0)
1962 ; ------------ Return data to middle tier ------------
1963"RTN","NHINVLRA",150,0)
1964 ;
1965"RTN","NHINVLRA",151,0)
1966XML(LAB) ; -- Return result as XML in @NHIN@(#)
1967"RTN","NHINVLRA",152,0)
1968 N ATT,X,Y,NAMES
1969"RTN","NHINVLRA",153,0)
1970 D ADD("<accession>") S NHINTOTL=$G(NHINTOTL)+1
1971"RTN","NHINVLRA",154,0)
1972 S ATT="" F S ATT=$O(LAB(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
1973"RTN","NHINVLRA",155,0)
1974 . I $O(LAB(ATT,0)) D S Y="" Q
1975"RTN","NHINVLRA",156,0)
1976 .. D ADD("<"_ATT_"s>")
1977"RTN","NHINVLRA",157,0)
1978 .. S NAMES=$S(ATT="document":"id^localTitle^nationalTitle^Z",ATT="lab":"id^test^result^interpretation^units^low^high^loinc^vuid^order^Z",1:"code^name^Z")
1979"RTN","NHINVLRA",158,0)
1980 .. S I=0 F S I=$O(LAB(ATT,I)) Q:I<1 D
1981"RTN","NHINVLRA",159,0)
1982 ... S X=$G(LAB(ATT,I))
1983"RTN","NHINVLRA",160,0)
1984 ... S Y="<"_ATT_" "_$$LOOP_"/>" D ADD(Y)
1985"RTN","NHINVLRA",161,0)
1986 .. D ADD("</"_ATT_"s>")
1987"RTN","NHINVLRA",162,0)
1988 . S X=$G(LAB(ATT)),Y="" Q:'$L(X)
1989"RTN","NHINVLRA",163,0)
1990 . I ATT="comment" S Y="<"_ATT_" xml:space='preserve'>"_$$ESC^NHINV(X)_"</"_ATT_">" Q
1991"RTN","NHINVLRA",164,0)
1992 . I ATT="content" S Y="<"_ATT_" xml:space='preserve'>"_$$ESC^NHINV(X)_"</"_ATT_">" Q
1993"RTN","NHINVLRA",165,0)
1994 . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
1995"RTN","NHINVLRA",166,0)
1996 . I $L(X)>1 D S Y=""
1997"RTN","NHINVLRA",167,0)
1998 .. S NAMES="code^name^Z"
1999"RTN","NHINVLRA",168,0)
2000 .. S Y="<"_ATT_" "_$$LOOP_"/>" D ADD(Y)
2001"RTN","NHINVLRA",169,0)
2002 D ADD("</accession>")
2003"RTN","NHINVLRA",170,0)
2004 Q
2005"RTN","NHINVLRA",171,0)
2006 ;
2007"RTN","NHINVLRA",172,0)
2008LOOP() ; -- build sub-items string from NAMES and X
2009"RTN","NHINVLRA",173,0)
2010 N STR,P,TAG S STR=""
2011"RTN","NHINVLRA",174,0)
2012 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))_"' "
2013"RTN","NHINVLRA",175,0)
2014 Q STR
2015"RTN","NHINVLRA",176,0)
2016 ;
2017"RTN","NHINVLRA",177,0)
2018ADD(X) ; -- Add a line @NHIN@(n)=X
2019"RTN","NHINVLRA",178,0)
2020 S NHINI=$G(NHINI)+1
2021"RTN","NHINVLRA",179,0)
2022 S @NHIN@(NHINI)=X
2023"RTN","NHINVLRA",180,0)
2024 Q
2025"RTN","NHINVLRO")
20260^22^B32647424^n/a
2027"RTN","NHINVLRO",1,0)
2028NHINVLRO ;SLC/MKB -- Laboratory extract by order/panel
2029"RTN","NHINVLRO",2,0)
2030 ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
2031"RTN","NHINVLRO",3,0)
2032 ;
2033"RTN","NHINVLRO",4,0)
2034 ; External References DBIA#
2035"RTN","NHINVLRO",5,0)
2036 ; ------------------- -----
2037"RTN","NHINVLRO",6,0)
2038 ; ^DPT 10035
2039"RTN","NHINVLRO",7,0)
2040 ; ^LAB(60 67,91,10054
2041"RTN","NHINVLRO",8,0)
2042 ; ^LRO(69 2407
2043"RTN","NHINVLRO",9,0)
2044 ; ^LR 525
2045"RTN","NHINVLRO",10,0)
2046 ; DIQ 2056
2047"RTN","NHINVLRO",11,0)
2048 ; LR7OR1,^TMP("LRRR",$J) 2503
2049"RTN","NHINVLRO",12,0)
2050 ; XUAF4 2171
2051"RTN","NHINVLRO",13,0)
2052 ;
2053"RTN","NHINVLRO",14,0)
2054 ; ------------ Get results from VistA ------------
2055"RTN","NHINVLRO",15,0)
2056 ;
2057"RTN","NHINVLRO",16,0)
2058EN(DFN,BEG,END,MAX,ID) ; -- find patient's lab results
2059"RTN","NHINVLRO",17,0)
2060 N NHSUB,NHIDT,NHI,NHT,NHITM,CMMT,LRDFN,LR0,X
2061"RTN","NHINVLRO",18,0)
2062 S DFN=+$G(DFN) Q:$G(DFN)<1
2063"RTN","NHINVLRO",19,0)
2064 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
2065"RTN","NHINVLRO",20,0)
2066 S LRDFN=$G(^DPT(DFN,"LR")),NHSUB="CH"
2067"RTN","NHINVLRO",21,0)
2068 K ^TMP("LRRR",$J,DFN)
2069"RTN","NHINVLRO",22,0)
2070 ;
2071"RTN","NHINVLRO",23,0)
2072 ; get result(s)
2073"RTN","NHINVLRO",24,0)
2074 I $G(ID) D RR^LR7OR1(DFN,ID)
2075"RTN","NHINVLRO",25,0)
2076 I '$G(ID) D ;no id, or accession format (no lab order)
2077"RTN","NHINVLRO",26,0)
2078 . S:$G(ID)'="" NHSUB=$P(ID,";"),(BEG,END)=9999999-$P(ID,";",2)
2079"RTN","NHINVLRO",27,0)
2080 . D RR^LR7OR1(DFN,,BEG,END,NHSUB,,,MAX)
2081"RTN","NHINVLRO",28,0)
2082 ;
2083"RTN","NHINVLRO",29,0)
2084 S NHSUB="" F S NHSUB=$O(^TMP("LRRR",$J,DFN,NHSUB)) Q:NHSUB="" D
2085"RTN","NHINVLRO",30,0)
2086 . S NHIDT=0 F S NHIDT=$O(^TMP("LRRR",$J,DFN,NHSUB,NHIDT)) Q:NHIDT<1 I $O(^(NHIDT,0)) D
2087"RTN","NHINVLRO",31,0)
2088 .. I "CH^MI"'[NHSUB Q
2089"RTN","NHINVLRO",32,0)
2090 .. D SORT ;group accession by lab orders > NHLRO(panel,NHI)=data node
2091"RTN","NHINVLRO",33,0)
2092 .. S NHT="" F S NHT=$O(NHLRO(NHT)) Q:NHT="" D
2093"RTN","NHINVLRO",34,0)
2094 ... K NHITM,CMMT S X=$G(NHLRO(NHT))
2095"RTN","NHINVLRO",35,0)
2096 ... I $G(ID),ID'=$P(X,U,3) Q ;single order only
2097"RTN","NHINVLRO",36,0)
2098 ... S NHITM("id")=$P(X,U,3),NHITM("order")=$P(X,U,1,2)
2099"RTN","NHINVLRO",37,0)
2100 ... S NHITM("type")=NHSUB,NHITM("status")="completed"
2101"RTN","NHINVLRO",38,0)
2102 ... S NHITM("collected")=9999999-NHIDT
2103"RTN","NHINVLRO",39,0)
2104 ... S LR0=$G(^LR(LRDFN,NHSUB,NHIDT,0))
2105"RTN","NHINVLRO",40,0)
2106 ... S NHITM("resulted")=$P(LR0,U,3),X=+$P(LR0,U,5) I X D ;specimen
2107"RTN","NHINVLRO",41,0)
2108 .... N IENS,NHY S IENS=X_","
2109"RTN","NHINVLRO",42,0)
2110 .... D GETS^DIQ(61,IENS,".01:2",,"NHY")
2111"RTN","NHINVLRO",43,0)
2112 .... S NHITM("specimen")=$G(NHY(61,IENS,2))_U_$G(NHY(61,IENS,.01)) ;SNOMED^name
2113"RTN","NHINVLRO",44,0)
2114 .... S NHITM("sample")=$$GET1^DIQ(61,X_",",4.1) ;name
2115"RTN","NHINVLRO",45,0)
2116 ... S NHITM("groupName")=$P(LR0,U,6),X=+$P(LR0,U,14)
2117"RTN","NHINVLRO",46,0)
2118 ... S:X NHITM("facility")=$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U)
2119"RTN","NHINVLRO",47,0)
2120 ... I 'X S NHITM("facility")=$$FAC^NHINV ;local stn#^name
2121"RTN","NHINVLRO",48,0)
2122 ... S NHI=0 F S NHI=$O(NHLRO(NHT,NHI)) Q:NHI<1 D
2123"RTN","NHINVLRO",49,0)
2124 .... S X=$G(NHLRO(NHT,NHI))
2125"RTN","NHINVLRO",50,0)
2126 .... S:NHSUB="CH" NHITM("value",NHI)=$$CH(X)
2127"RTN","NHINVLRO",51,0)
2128 .... S:NHSUB="MI" NHITM("value",NHI)=$$MI(X)
2129"RTN","NHINVLRO",52,0)
2130 ... I $D(^TMP("LRRR",$J,DFN,NHSUB,NHIDT,"N")) M CMMT=^("N") S NHITM("comment")=$$STRING^NHINV(.CMMT)
2131"RTN","NHINVLRO",53,0)
2132 ... D XML(.NHITM)
2133"RTN","NHINVLRO",54,0)
2134 K ^TMP("LRRR",$J,DFN)
2135"RTN","NHINVLRO",55,0)
2136 Q
2137"RTN","NHINVLRO",56,0)
2138 ;
2139"RTN","NHINVLRO",57,0)
2140SORT ; -- return NHLRO(PANEL) = CPRS order# ^ panel/test name ^ Lab Order string
2141"RTN","NHINVLRO",58,0)
2142 ; NHLRO(PANEL,NHI) = result node
2143"RTN","NHINVLRO",59,0)
2144 N X0,NUM,ORD,ODT,SN,T,T0,I,NHY,NHLRT K NHLRO
2145"RTN","NHINVLRO",60,0)
2146 S NHI=$O(^TMP("LRRR",$J,DFN,NHSUB,NHIDT,0)),X0=$G(^(NHI)) ;first
2147"RTN","NHINVLRO",61,0)
2148 S NUM=$P(X0,U,16),ORD=$P(X0,U,17),ODT=+$P(9999999-NHIDT,".")
2149"RTN","NHINVLRO",62,0)
2150 ; - build NHLRT list of result nodes for each test/panel
2151"RTN","NHINVLRO",63,0)
2152 I ORD S SN=0 F S SN=$O(^LRO(69,"C",ORD,ODT,SN)) Q:SN<1 D Q:$D(NHLRT)
2153"RTN","NHINVLRO",64,0)
2154 . I $G(ID),$P(ID,";",3)'=SN Q
2155"RTN","NHINVLRO",65,0)
2156 . S T=0 F S T=+$O(^LRO(69,ODT,1,SN,2,T)) Q:T<1 D
2157"RTN","NHINVLRO",66,0)
2158 .. I $G(ID),T'=$P(ID,";",4) Q
2159"RTN","NHINVLRO",67,0)
2160 .. S T0=$G(^LRO(69,ODT,1,SN,2,T,0))
2161"RTN","NHINVLRO",68,0)
2162 .. ; is test/panel part of same accession?
2163"RTN","NHINVLRO",69,0)
2164 .. Q:$P(T0,U,5)'=+$P(NUM," ",3)
2165"RTN","NHINVLRO",70,0)
2166 .. Q:$$GET1^DIQ(68,$P(T0,U,4)_",",.09)'=$P(NUM," ")
2167"RTN","NHINVLRO",71,0)
2168 .. ; expand panel into unit tests
2169"RTN","NHINVLRO",72,0)
2170 .. K NHY D EXPAND(+T0,.NHY)
2171"RTN","NHINVLRO",73,0)
2172 .. S I=0 F S I=$O(NHY(I)) Q:I<1 S NHLRT(I,+T0)="" ;NHLRT(test,panel)=""
2173"RTN","NHINVLRO",74,0)
2174 .. S NHLRO(+T0)=$P(T0,U,7)_U_$P($G(^LAB(60,+T0,0)),U)_U_ORD_";"_ODT_";"_SN_";"_T
2175"RTN","NHINVLRO",75,0)
2176 S:'$D(NHLRO) NHLRO(0)=$S(NHSUB="MI":"^MICROBIOLOGY^MI;",1:"^ACCESSION^CH;")_NHIDT ;no Lab Order
2177"RTN","NHINVLRO",76,0)
2178 ; - build NHLRO(panel#,NHI) = ^TMP node
2179"RTN","NHINVLRO",77,0)
2180 S NHI=0 F S NHI=$O(^TMP("LRRR",$J,DFN,"CH",NHIDT,NHI)) Q:NHI<1 S X0=$G(^(NHI)) D
2181"RTN","NHINVLRO",78,0)
2182 . I '$D(NHLRT(+X0)) S NHLRO(0,NHI)=X0 Q ;no Lab Order
2183"RTN","NHINVLRO",79,0)
2184 . S T=0 F S T=$O(NHLRT(+X0,T)) Q:T<1 S NHLRO(T,NHI)=X0
2185"RTN","NHINVLRO",80,0)
2186 Q
2187"RTN","NHINVLRO",81,0)
2188 ;
2189"RTN","NHINVLRO",82,0)
2190EXPAND(TEST,ARAY) ;Expand a lab test panel [LR7OU1]
2191"RTN","NHINVLRO",83,0)
2192 ;TEST=Test ptr to file 60
2193"RTN","NHINVLRO",84,0)
2194 ;Expanded panel returned in ARAY(TEST)
2195"RTN","NHINVLRO",85,0)
2196 N INARAY
2197"RTN","NHINVLRO",86,0)
2198 D EX(TEST)
2199"RTN","NHINVLRO",87,0)
2200 M ARAY=INARAY
2201"RTN","NHINVLRO",88,0)
2202 Q
2203"RTN","NHINVLRO",89,0)
2204EX(TST) ;
2205"RTN","NHINVLRO",90,0)
2206 N J,X,SUB
2207"RTN","NHINVLRO",91,0)
2208 Q:'$D(^LAB(60,TST,0)) S SUB=$P(^(0),"^",5)
2209"RTN","NHINVLRO",92,0)
2210 I $L(SUB) S:'$D(INARAY(+TST)) INARAY(+TST)="" Q
2211"RTN","NHINVLRO",93,0)
2212 S J=0 F S J=$O(^LAB(60,+TST,2,J)) Q:J<1 S X=^(J,0) D EX(+X)
2213"RTN","NHINVLRO",94,0)
2214 Q
2215"RTN","NHINVLRO",95,0)
2216 ;
2217"RTN","NHINVLRO",96,0)
2218ACC(NUM,ODT,SN) ; -- Return 1 or 0, if Specimen entry matches accession
2219"RTN","NHINVLRO",97,0)
2220 N T,T0,Y S Y=0
2221"RTN","NHINVLRO",98,0)
2222 S T=+$O(^LRO(69,ODT,1,SN,2,0)),T0=$G(^(T,0))
2223"RTN","NHINVLRO",99,0)
2224 I $P(T0,U,5)=+$P(NUM," ",3),$$GET1^DIQ(68,$P(T0,U,4)_",",.09)=$P(NUM," ") S Y=1
2225"RTN","NHINVLRO",100,0)
2226 Q Y
2227"RTN","NHINVLRO",101,0)
2228 ;
2229"RTN","NHINVLRO",102,0)
2230CH(X0) ; -- return a Chemistry result as:
2231"RTN","NHINVLRO",103,0)
2232 ; id^test^result^interpretation^units^low^high^loinc^vuid
2233"RTN","NHINVLRO",104,0)
2234 ; Expects X0=^TMP("LRRR",$J,DFN,"CH",NHIDT,NHI),LRDFN
2235"RTN","NHINVLRO",105,0)
2236 N X,Y,NODE,LOINC
2237"RTN","NHINVLRO",106,0)
2238 S NODE=$G(^LR(LRDFN,"CH",NHIDT,NHI))
2239"RTN","NHINVLRO",107,0)
2240 S X=$P($G(^LAB(60,+X0,0)),U)
2241"RTN","NHINVLRO",108,0)
2242 S Y="CH;"_NHIDT_";"_NHI_U_X_U_$P(X0,U,2,4)
2243"RTN","NHINVLRO",109,0)
2244 S X=$P(X0,U,5) I $L(X),X["-" S X=$TR(X,"- ","^"),$P(Y,U,6,7)=X
2245"RTN","NHINVLRO",110,0)
2246 S X=$P($P(NODE,U,3),"!",3) S:X LOINC=$$GET1^DIQ(95.3,X_",",.01)
2247"RTN","NHINVLRO",111,0)
2248 I '$G(LOINC) S X=+$P(X0,U,19) S:X LOINC=$$LOINC(+X0,X)
2249"RTN","NHINVLRO",112,0)
2250 S $P(Y,U,8,9)=$G(LOINC)_U_$$VUID^NHINV(+$G(LOINC),95.3)
2251"RTN","NHINVLRO",113,0)
2252 Q Y
2253"RTN","NHINVLRO",114,0)
2254 ;
2255"RTN","NHINVLRO",115,0)
2256LOINC(TEST,SPEC) ; -- Look up LOINC code, if not mapped
2257"RTN","NHINVLRO",116,0)
2258 N Y,LAM,NHIN,IENS S Y=""
2259"RTN","NHINVLRO",117,0)
2260 S TEST=+$G(TEST),SPEC=+$G(SPEC)
2261"RTN","NHINVLRO",118,0)
2262 S LAM=$G(^LAB(60,TEST,64)),LAM=$S($P(LAM,U,2):$P(LAM,U,2),1:+LAM)
2263"RTN","NHINVLRO",119,0)
2264 D GETS^DIQ(64.01,SPEC_","_LAM_",","30*",,"NHIN")
2265"RTN","NHINVLRO",120,0)
2266 S IENS=$O(NHIN(64.02,"")) S:IENS Y=$G(NHIN(64.02,IENS,4))
2267"RTN","NHINVLRO",121,0)
2268 S:'Y Y=$$GET1^DIQ(60.01,SPEC_","_TEST_",",95.3)
2269"RTN","NHINVLRO",122,0)
2270 Q Y
2271"RTN","NHINVLRO",123,0)
2272 ;
2273"RTN","NHINVLRO",124,0)
2274MI(X0) ; -- return a Microbiology result as:
2275"RTN","NHINVLRO",125,0)
2276 ; id^test^result^interpretation^units
2277"RTN","NHINVLRO",126,0)
2278 ; Expects X0=^TMP("LRRR",$J,DFN,"MI",NHIDT,NHI)
2279"RTN","NHINVLRO",127,0)
2280 N Y S Y=""
2281"RTN","NHINVLRO",128,0)
2282 S:$L($P(X0,U))>1 Y="MI;"_NHIDT_";"_NHI_U_$P(X0,U,1,4)
2283"RTN","NHINVLRO",129,0)
2284 Q Y
2285"RTN","NHINVLRO",130,0)
2286 ;
2287"RTN","NHINVLRO",131,0)
2288 ; ------------ Return data to middle tier ------------
2289"RTN","NHINVLRO",132,0)
2290 ;
2291"RTN","NHINVLRO",133,0)
2292XML(LAB) ; -- Return result as XML in @NHIN@(#)
2293"RTN","NHINVLRO",134,0)
2294 N ATT,X,Y,I,J,P,NAMES,TAG
2295"RTN","NHINVLRO",135,0)
2296 D ADD("<panel>") S NHINTOTL=$G(NHINTOTL)+1
2297"RTN","NHINVLRO",136,0)
2298 S ATT="" F S ATT=$O(LAB(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
2299"RTN","NHINVLRO",137,0)
2300 . I $O(LAB(ATT,0)) D S Y="" Q
2301"RTN","NHINVLRO",138,0)
2302 .. D ADD("<"_ATT_"s>")
2303"RTN","NHINVLRO",139,0)
2304 .. I ATT="value" S NAMES="id^test^result^interpretation^units^low^high^loinc^vuid^Z"
2305"RTN","NHINVLRO",140,0)
2306 .. E S NAMES="code^name^Z"
2307"RTN","NHINVLRO",141,0)
2308 .. S I=0 F S I=$O(LAB(ATT,I)) Q:I<1 D
2309"RTN","NHINVLRO",142,0)
2310 ... S X=$G(LAB(ATT,I)),Y="<"_ATT_" "_$$LOOP_"/>" D ADD(Y)
2311"RTN","NHINVLRO",143,0)
2312 .. D ADD("</"_ATT_"s>")
2313"RTN","NHINVLRO",144,0)
2314 . S X=$G(LAB(ATT)),Y="" Q:'$L(X)
2315"RTN","NHINVLRO",145,0)
2316 . I ATT="comment" S Y="<"_ATT_" xml:space='preserve'>"_$$ESC^NHINV(X)_"</"_ATT_">" Q
2317"RTN","NHINVLRO",146,0)
2318 . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
2319"RTN","NHINVLRO",147,0)
2320 . I $L(X)>1 S NAMES="code^name^Z",Y="<"_ATT_" "_$$LOOP_"/>"
2321"RTN","NHINVLRO",148,0)
2322 D ADD("</panel>")
2323"RTN","NHINVLRO",149,0)
2324 Q
2325"RTN","NHINVLRO",150,0)
2326 ;
2327"RTN","NHINVLRO",151,0)
2328LOOP() ; -- build sub-items string from NAMES and X
2329"RTN","NHINVLRO",152,0)
2330 N STR,P,TAG S STR=""
2331"RTN","NHINVLRO",153,0)
2332 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))_"' "
2333"RTN","NHINVLRO",154,0)
2334 Q STR
2335"RTN","NHINVLRO",155,0)
2336 ;
2337"RTN","NHINVLRO",156,0)
2338ADD(X) ; -- Add a line @NHIN@(n)=X
2339"RTN","NHINVLRO",157,0)
2340 S NHINI=$G(NHINI)+1
2341"RTN","NHINVLRO",158,0)
2342 S @NHIN@(NHINI)=X
2343"RTN","NHINVLRO",159,0)
2344 Q
2345"RTN","NHINVPL")
23460^26^B19846807^n/a
2347"RTN","NHINVPL",1,0)
2348NHINVPL ;SLC/MKB -- Problem extract
2349"RTN","NHINVPL",2,0)
2350 ;;1.0;NHIN;**1**;Dec 01, 2009;Build 11
2351"RTN","NHINVPL",3,0)
2352 ;
2353"RTN","NHINVPL",4,0)
2354 ; External References DBIA#
2355"RTN","NHINVPL",5,0)
2356 ; ------------------- -----
2357"RTN","NHINVPL",6,0)
2358 ; ^VA(200 10060
2359"RTN","NHINVPL",7,0)
2360 ; %DT 10003
2361"RTN","NHINVPL",8,0)
2362 ; DIQ 2056
2363"RTN","NHINVPL",9,0)
2364 ; GMPLUTL2 2741
2365"RTN","NHINVPL",10,0)
2366 ; XUAF4 2171
2367"RTN","NHINVPL",11,0)
2368 ;
2369"RTN","NHINVPL",12,0)
2370 ; ------------ Get problems from VistA ------------
2371"RTN","NHINVPL",13,0)
2372 ;
2373"RTN","NHINVPL",14,0)
2374EN(DFN,BEG,END,MAX,IFN) ; -- find patient's problems
2375"RTN","NHINVPL",15,0)
2376 N NHIPROB,NHI,NHITM,NHICNT,X
2377"RTN","NHINVPL",16,0)
2378 ;
2379"RTN","NHINVPL",17,0)
2380 ; get one problem
2381"RTN","NHINVPL",18,0)
2382 I $G(IFN) D EN1(IFN,.NHITM),XML(.NHITM) Q
2383"RTN","NHINVPL",19,0)
2384 ;
2385"RTN","NHINVPL",20,0)
2386 ; get all patient problems
2387"RTN","NHINVPL",21,0)
2388 S DFN=+$G(DFN) Q:DFN<1
2389"RTN","NHINVPL",22,0)
2390 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999),NHICNT=0
2391"RTN","NHINVPL",23,0)
2392 D LIST^GMPLUTL2(.NHIPROB,DFN,"") ;all problems
2393"RTN","NHINVPL",24,0)
2394 S NHI=0 F S NHI=$O(NHIPROB(NHI)) Q:(NHI<1)!(NHICNT'<MAX) D
2395"RTN","NHINVPL",25,0)
2396 . S X=$P(NHIPROB(NHI),U,5) I X,(X<BEG)!(X>END) Q ;onset
2397"RTN","NHINVPL",26,0)
2398 . S X=+NHIPROB(NHI) K NHITM ;ien
2399"RTN","NHINVPL",27,0)
2400 . D EN1(X,.NHITM),XML(.NHITM)
2401"RTN","NHINVPL",28,0)
2402 . S NHICNT=NHICNT+1
2403"RTN","NHINVPL",29,0)
2404 Q
2405"RTN","NHINVPL",30,0)
2406 ;
2407"RTN","NHINVPL",31,0)
2408EN1(ID,PROB) ; -- return a problem in PROB("attribute")=value
2409"RTN","NHINVPL",32,0)
2410 N NHPL,X,I,J K PROB
2411"RTN","NHINVPL",33,0)
2412 S ID=+$G(ID) Q:ID<1 ;invalid ien
2413"RTN","NHINVPL",34,0)
2414 D DETAIL^GMPLUTL2(ID,.NHPL) Q:'$D(NHPL) ;doesn't exist
2415"RTN","NHINVPL",35,0)
2416 S PROB("id")=ID ;,PROB("lexiconID")=+X1 ;SNOMED?
2417"RTN","NHINVPL",36,0)
2418 S PROB("name")=$G(NHPL("NARRATIVE"))
2419"RTN","NHINVPL",37,0)
2420 S X=$G(NHPL("MODIFIED")) S:$L(X) PROB("updated")=$$DATE(X)
2421"RTN","NHINVPL",38,0)
2422 S PROB("icd")=$G(NHPL("DIAGNOSIS"))
2423"RTN","NHINVPL",39,0)
2424 S X=$G(NHPL("STATUS")) S:$L(X) PROB("status")=$E(X)
2425"RTN","NHINVPL",40,0)
2426 S X=$G(NHPL("HISTORY")) S:$L(X) PROB("history")=$E(X)
2427"RTN","NHINVPL",41,0)
2428 S X=$G(NHPL("PRIORITY")) S:$L(X) PROB("acuity")=$E(X)
2429"RTN","NHINVPL",42,0)
2430 S X=$G(NHPL("ONSET")) S:$L(X) PROB("onset")=$$DATE(X)
2431"RTN","NHINVPL",43,0)
2432 S X=$$GET1^DIQ(9000011,ID_",",1.07,"I") S:X PROB("resolved")=X
2433"RTN","NHINVPL",44,0)
2434 S X=$P($G(NHPL("ENTERED")),U) S:$L(X) PROB("entered")=$$DATE(X)
2435"RTN","NHINVPL",45,0)
2436 S X=$$GET1^DIQ(9000011,ID_",",1.02,"I")
2437"RTN","NHINVPL",46,0)
2438 S:X="P" PROB("unverified")=0,PROB("removed")=0
2439"RTN","NHINVPL",47,0)
2440 S:X="T" PROB("unverified")=1,PROB("removed")=0
2441"RTN","NHINVPL",48,0)
2442 S:X="H" PROB("unverified")=0,PROB("removed")=1
2443"RTN","NHINVPL",49,0)
2444 S X=$G(NHPL("SC")),X=$S(X="YES":1,X="NO":0,1:"")
2445"RTN","NHINVPL",50,0)
2446 S:$L(X) PROB("sc")=X I $G(NHPL("EXPOSURE")) D ;ao^rad^pgulf^hnc^mst^cv
2447"RTN","NHINVPL",51,0)
2448 . S I=0 F S I=$O(NHPL("EXPOSURE",I)) Q:I<1 D
2449"RTN","NHINVPL",52,0)
2450 .. S X=$G(NHPL("EXPOSURE",I))
2451"RTN","NHINVPL",53,0)
2452 .. S PROB("exposure",I)=$$EXP(X)
2453"RTN","NHINVPL",54,0)
2454 S X=$G(NHPL("PROVIDER")) S:$L(X) PROB("provider")=$$VA200(X)_U_X
2455"RTN","NHINVPL",55,0)
2456 S X=$$GET1^DIQ(9000011,ID_",",1.06) S:$L(X) PROB("service")=X
2457"RTN","NHINVPL",56,0)
2458 S X=$G(NHPL("CLINIC")) S:$L(X) PROB("location")=X
2459"RTN","NHINVPL",57,0)
2460 S X=+$$GET1^DIQ(9000011,ID_",",.06,"I")
2461"RTN","NHINVPL",58,0)
2462 S:X PROB("facility")=$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U)
2463"RTN","NHINVPL",59,0)
2464 I 'X S PROB("facility")=$$FAC^NHINV ;local stn#^name
2465"RTN","NHINVPL",60,0)
2466CMT ; comments
2467"RTN","NHINVPL",61,0)
2468 Q:'$G(NHPL("COMMENT"))
2469"RTN","NHINVPL",62,0)
2470 S I=0 F S I=$O(NHPL("COMMENT",I)) Q:I<1 D
2471"RTN","NHINVPL",63,0)
2472 . S X=$G(NHPL("COMMENT",I))
2473"RTN","NHINVPL",64,0)
2474 . S PROB("comment",I)=$$DATE($P(X,U))_U_$P(X,U,2,3)
2475"RTN","NHINVPL",65,0)
2476 . ; = date ^ name of author ^ text
2477"RTN","NHINVPL",66,0)
2478 Q
2479"RTN","NHINVPL",67,0)
2480 ;
2481"RTN","NHINVPL",68,0)
2482DATE(X) ; -- Return internal form of date X
2483"RTN","NHINVPL",69,0)
2484 N %DT,Y
2485"RTN","NHINVPL",70,0)
2486 S %DT="" D ^%DT S:Y<1 Y=X
2487"RTN","NHINVPL",71,0)
2488 Q Y
2489"RTN","NHINVPL",72,0)
2490 ;
2491"RTN","NHINVPL",73,0)
2492VA200(X) ; -- Return ien of New Person X
2493"RTN","NHINVPL",74,0)
2494 N Y S Y=$S($L($G(X)):+$O(^VA(200,"B",X,0)),1:"")
2495"RTN","NHINVPL",75,0)
2496 Q Y
2497"RTN","NHINVPL",76,0)
2498 ;
2499"RTN","NHINVPL",77,0)
2500EXP(X) ; -- Return code for exposure name X
2501"RTN","NHINVPL",78,0)
2502 N Y S Y="",X=$E($G(X))
2503"RTN","NHINVPL",79,0)
2504 I X="A" S Y="AO" ;agent orange
2505"RTN","NHINVPL",80,0)
2506 I X="R" S Y="IR" ;ionizing radiation
2507"RTN","NHINVPL",81,0)
2508 I X="E" S Y="PG" ;persian gulf
2509"RTN","NHINVPL",82,0)
2510 I X="H" S Y="HNC" ;head/neck cancer
2511"RTN","NHINVPL",83,0)
2512 I X="M" S Y="MST" ;military sexual trauma
2513"RTN","NHINVPL",84,0)
2514 I X="C" S Y="CV" ;combat vet
2515"RTN","NHINVPL",85,0)
2516 I X="S" S Y="SHAD"
2517"RTN","NHINVPL",86,0)
2518 Q Y
2519"RTN","NHINVPL",87,0)
2520 ;
2521"RTN","NHINVPL",88,0)
2522 ; ------------ Return data to middle tier ------------
2523"RTN","NHINVPL",89,0)
2524 ;
2525"RTN","NHINVPL",90,0)
2526XML(PROB) ; -- Return patient problem as XML in @NHIN@(I)
2527"RTN","NHINVPL",91,0)
2528 N ATT,I,X,Y,P,TAG
2529"RTN","NHINVPL",92,0)
2530 D ADD("<problem>") S NHINTOTL=$G(NHINTOTL)+1
2531"RTN","NHINVPL",93,0)
2532 S ATT="" F S ATT=$O(PROB(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
2533"RTN","NHINVPL",94,0)
2534 . I ATT="exposure" D S Y="" Q
2535"RTN","NHINVPL",95,0)
2536 .. S Y="<exposures>" D ADD(Y)
2537"RTN","NHINVPL",96,0)
2538 .. 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)
2539"RTN","NHINVPL",97,0)
2540 .. D ADD("</exposures>")
2541"RTN","NHINVPL",98,0)
2542 . I ATT="comment" D S Y="" Q
2543"RTN","NHINVPL",99,0)
2544 .. D ADD("<comments>")
2545"RTN","NHINVPL",100,0)
2546 .. S I=0 F S I=$O(PROB(ATT,I)) Q:I<1 S X=$G(PROB(ATT,I)) D
2547"RTN","NHINVPL",101,0)
2548 ... S Y="<comment id='"_I
2549"RTN","NHINVPL",102,0)
2550 ... S:$L($P(X,U,1)) Y=Y_"' entered='"_$P(X,U)
2551"RTN","NHINVPL",103,0)
2552 ... S:$L($P(X,U,2)) Y=Y_"' enteredBy='"_$$ESC^NHINV($P(X,U,2))
2553"RTN","NHINVPL",104,0)
2554 ... S:$L($P(X,U,3)) Y=Y_"' commentText='"_$$ESC^NHINV($P(X,U,3))
2555"RTN","NHINVPL",105,0)
2556 ... S Y=Y_"' />" D ADD(Y)
2557"RTN","NHINVPL",106,0)
2558 .. D ADD("</comments>")
2559"RTN","NHINVPL",107,0)
2560 . S X=$G(PROB(ATT)),Y="" Q:'$L(X)
2561"RTN","NHINVPL",108,0)
2562 . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
2563"RTN","NHINVPL",109,0)
2564 . I $L(X)>1 D S Y=""
2565"RTN","NHINVPL",110,0)
2566 .. S Y="<"_ATT_" "
2567"RTN","NHINVPL",111,0)
2568 .. 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))_"' "
2569"RTN","NHINVPL",112,0)
2570 .. S Y=Y_"/>" D ADD(Y)
2571"RTN","NHINVPL",113,0)
2572 D ADD("</problem>")
2573"RTN","NHINVPL",114,0)
2574 Q
2575"RTN","NHINVPL",115,0)
2576 ;
2577"RTN","NHINVPL",116,0)
2578ADD(X) ; Add a line @NHIN@(n)=X
2579"RTN","NHINVPL",117,0)
2580 S NHINI=$G(NHINI)+1
2581"RTN","NHINVPL",118,0)
2582 S @NHIN@(NHINI)=X
2583"RTN","NHINVPL",119,0)
2584 Q
2585"RTN","NHINVPRC")
25860^16^B6896734^n/a
2587"RTN","NHINVPRC",1,0)
2588NHINVPRC ;SLC/MKB -- Procedure extract
2589"RTN","NHINVPRC",2,0)
2590 ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
2591"RTN","NHINVPRC",3,0)
2592 ;
2593"RTN","NHINVPRC",4,0)
2594 ; External References DBIA#
2595"RTN","NHINVPRC",5,0)
2596 ; ------------------- -----
2597"RTN","NHINVPRC",6,0)
2598 ; RAO7PC1 2043
2599"RTN","NHINVPRC",7,0)
2600 ; SROESTV 3533
2601"RTN","NHINVPRC",8,0)
2602 ;
2603"RTN","NHINVPRC",9,0)
2604 ; ------------ Get procedure(s) from VistA ------------
2605"RTN","NHINVPRC",10,0)
2606 ;
2607"RTN","NHINVPRC",11,0)
2608EN(DFN,BEG,END,MAX,ID) ; -- find patient's procedures
2609"RTN","NHINVPRC",12,0)
2610 S DFN=+$G(DFN) Q:DFN<1
2611"RTN","NHINVPRC",13,0)
2612 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
2613"RTN","NHINVPRC",14,0)
2614 ;
2615"RTN","NHINVPRC",15,0)
2616 N NHI,NHICNT,NHITM,NHY
2617"RTN","NHINVPRC",16,0)
2618 ;
2619"RTN","NHINVPRC",17,0)
2620 ; get one procedure
2621"RTN","NHINVPRC",18,0)
2622 I $G(ID) D D:$D(NHITM) XML(.NHITM) Q
2623"RTN","NHINVPRC",19,0)
2624 . I ID'["-" D EN1^NHINVSR(ID,.NHITM) Q
2625"RTN","NHINVPRC",20,0)
2626 . S (BEG,END)=9999999.9999=+ID
2627"RTN","NHINVPRC",21,0)
2628 . D EN1^RAO7PC1(DFN,BEG,END),EN1^NHINVRA(ID,.NHITM)
2629"RTN","NHINVPRC",22,0)
2630 ;
2631"RTN","NHINVPRC",23,0)
2632 ; get all surgeries
2633"RTN","NHINVPRC",24,0)
2634 N SHOWADD S SHOWADD=1 ;to omit leading '+' with note titles
2635"RTN","NHINVPRC",25,0)
2636 D LIST^SROESTV(.NHY,DFN,BEG,END,MAX,1)
2637"RTN","NHINVPRC",26,0)
2638 S NHI=0 F S NHI=$O(@NHY@(NHI)) Q:NHI<1 D
2639"RTN","NHINVPRC",27,0)
2640 . K NHITM D ONE^NHINVSR(NHI,.NHITM) Q:'$D(NHITM)
2641"RTN","NHINVPRC",28,0)
2642 . ;Q:$G(NHITM("status"))'?1"COMP".E
2643"RTN","NHINVPRC",29,0)
2644 . D XML(.NHITM)
2645"RTN","NHINVPRC",30,0)
2646 K @NHY
2647"RTN","NHINVPRC",31,0)
2648 ;
2649"RTN","NHINVPRC",32,0)
2650 ; get all radiology exams
2651"RTN","NHINVPRC",33,0)
2652 K ^TMP($J,"RAE1") D EN1^RAO7PC1(DFN,BEG,END,MAX)
2653"RTN","NHINVPRC",34,0)
2654 S NHICNT=0,NHI=""
2655"RTN","NHINVPRC",35,0)
2656 F S NHI=$O(^TMP($J,"RAE1",DFN,NHI)) Q:NHI="" D Q:NHICNT'<MAX ;I $P($P($G(^(NHI)),U,6),"~",2)?1"COMP".E
2657"RTN","NHINVPRC",36,0)
2658 . K NHITM D EN1^NHINVRA(NHI,.NHITM) Q:'$D(NHITM)
2659"RTN","NHINVPRC",37,0)
2660 . D XML(.NHITM) S NHICNT=NHICNT+1
2661"RTN","NHINVPRC",38,0)
2662 K ^TMP($J,"RAE1")
2663"RTN","NHINVPRC",39,0)
2664 ;
2665"RTN","NHINVPRC",40,0)
2666 ; Consults/ClinProc
2667"RTN","NHINVPRC",41,0)
2668 ; V-files [CPT, Exam, Treatment, Patient ED]
2669"RTN","NHINVPRC",42,0)
2670 ;
2671"RTN","NHINVPRC",43,0)
2672 Q
2673"RTN","NHINVPRC",44,0)
2674 ;
2675"RTN","NHINVPRC",45,0)
2676 ; ------------ Return data to middle tier ------------
2677"RTN","NHINVPRC",46,0)
2678 ;
2679"RTN","NHINVPRC",47,0)
2680XML(PRC) ; -- Return procedures as XML
2681"RTN","NHINVPRC",48,0)
2682 N ATT,X,Y,I,NAMES
2683"RTN","NHINVPRC",49,0)
2684 D ADD("<procedure>") S NHINTOTL=$G(NHINTOTL)+1
2685"RTN","NHINVPRC",50,0)
2686 S ATT="" F S ATT=$O(PRC(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
2687"RTN","NHINVPRC",51,0)
2688 . S NAMES=$S(ATT="document"!(ATT="opReport"):"id^localTitle^nationalTitle^status^Z",1:"code^name^Z")
2689"RTN","NHINVPRC",52,0)
2690 . I $O(PRC(ATT,0)) D S Y="" Q ;multiples
2691"RTN","NHINVPRC",53,0)
2692 .. D ADD("<"_ATT_"s>")
2693"RTN","NHINVPRC",54,0)
2694 .. S I=0 F S I=$O(PRC(ATT,I)) Q:I<1 D
2695"RTN","NHINVPRC",55,0)
2696 ... S X=$G(PRC(ATT,I))
2697"RTN","NHINVPRC",56,0)
2698 ... S Y="<"_ATT_" "_$$LOOP_"/>" D ADD(Y)
2699"RTN","NHINVPRC",57,0)
2700 .. D ADD("</"_ATT_"s>")
2701"RTN","NHINVPRC",58,0)
2702 . S X=$G(PRC(ATT)),Y="" Q:'$L(X)
2703"RTN","NHINVPRC",59,0)
2704 . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
2705"RTN","NHINVPRC",60,0)
2706 . I $L(X)>1 S Y="<"_ATT_" "_$$LOOP_"/>"
2707"RTN","NHINVPRC",61,0)
2708 D ADD("</procedure>")
2709"RTN","NHINVPRC",62,0)
2710 Q
2711"RTN","NHINVPRC",63,0)
2712 ;
2713"RTN","NHINVPRC",64,0)
2714LOOP() ; -- build sub-items string from NAMES and X
2715"RTN","NHINVPRC",65,0)
2716 N STR,P,TAG S STR=""
2717"RTN","NHINVPRC",66,0)
2718 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))_"' "
2719"RTN","NHINVPRC",67,0)
2720 Q STR
2721"RTN","NHINVPRC",68,0)
2722 ;
2723"RTN","NHINVPRC",69,0)
2724ADD(X) ; -- Add a line @NHIN@(n)=X
2725"RTN","NHINVPRC",70,0)
2726 S NHINI=$G(NHINI)+1
2727"RTN","NHINVPRC",71,0)
2728 S @NHIN@(NHINI)=X
2729"RTN","NHINVPRC",72,0)
2730 Q
2731"RTN","NHINVPS")
27320^27^B14129801^n/a
2733"RTN","NHINVPS",1,0)
2734NHINVPS ;SLC/MKB -- Pharmacy extract
2735"RTN","NHINVPS",2,0)
2736 ;;1.0;NHIN;**1**;Dec 01, 2009;Build 11
2737"RTN","NHINVPS",3,0)
2738 ;
2739"RTN","NHINVPS",4,0)
2740 ; External References DBIA#
2741"RTN","NHINVPS",5,0)
2742 ; ------------------- -----
2743"RTN","NHINVPS",6,0)
2744 ; DIQ 2056
2745"RTN","NHINVPS",7,0)
2746 ; PSOORRL,^TMP("PS",$J) 2400
2747"RTN","NHINVPS",8,0)
2748 ; PSS50,^TMP($J 4483
2749"RTN","NHINVPS",9,0)
2750 ;
2751"RTN","NHINVPS",10,0)
2752 ; ------------ Get medications from VistA ------------
2753"RTN","NHINVPS",11,0)
2754 ;
2755"RTN","NHINVPS",12,0)
2756EN(DFN,BEG,END,MAX,ID) ; -- find patient's meds
2757"RTN","NHINVPS",13,0)
2758 N PS0,NHI,NHITM,IV K ^TMP("PS",$J)
2759"RTN","NHINVPS",14,0)
2760 S DFN=+$G(DFN) Q:DFN<1
2761"RTN","NHINVPS",15,0)
2762 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
2763"RTN","NHINVPS",16,0)
2764 ;
2765"RTN","NHINVPS",17,0)
2766 ; get one med
2767"RTN","NHINVPS",18,0)
2768 I $G(ID) D D:$D(NHITM)>9 XML(.NHITM) K ^TMP("PS",$J) Q
2769"RTN","NHINVPS",19,0)
2770 . I ID["N" D NVA^NHINVPSO(ID,.NHITM) Q
2771"RTN","NHINVPS",20,0)
2772 . I ID["O",(ID'["P")&(ID'["S") D RX^NHINVPSO(ID,.NHITM) Q
2773"RTN","NHINVPS",21,0)
2774 . D OEL^PSOORRL(DFN,ID)
2775"RTN","NHINVPS",22,0)
2776 . I ID["O",(ID["P")!(ID["S") D PEN1^NHINVPSO(ID,.NHITM) Q
2777"RTN","NHINVPS",23,0)
2778 . S IV=$S(ID["V":1,$G(^TMP("PS",$J,"B",0)):1,1:0)
2779"RTN","NHINVPS",24,0)
2780 . D @($S(IV:"IV1",1:"IN1")_"^NHINVPSI(ID,.NHITM)")
2781"RTN","NHINVPS",25,0)
2782 ;
2783"RTN","NHINVPS",26,0)
2784 ; get all meds
2785"RTN","NHINVPS",27,0)
2786 D OCL^PSOORRL(DFN,BEG,END)
2787"RTN","NHINVPS",28,0)
2788 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)
2789"RTN","NHINVPS",29,0)
2790 . S ID=$P(PS0,U) K NHITM
2791"RTN","NHINVPS",30,0)
2792 . I ID["N" D NVA^NHINVPSO(ID,.NHITM) Q
2793"RTN","NHINVPS",31,0)
2794 . I ID["O" D RX^NHINVPSO(ID,.NHITM) Q
2795"RTN","NHINVPS",32,0)
2796 . S IV=$S(ID["V":1,$G(^TMP("PS",$J,NHI,"B",0)):1,1:0)
2797"RTN","NHINVPS",33,0)
2798 . D @($S(IV:"IV",1:"IN")_"^NHINVPSI(ID,.NHITM)")
2799"RTN","NHINVPS",34,0)
2800 K ^TMP("PS",$J)
2801"RTN","NHINVPS",35,0)
2802 Q
2803"RTN","NHINVPS",36,0)
2804 ;
2805"RTN","NHINVPS",37,0)
2806NDF(DRUG,I) ; -- Set NDF data for dispense DRUG ien
2807"RTN","NHINVPS",38,0)
2808 N VUID,X
2809"RTN","NHINVPS",39,0)
2810 S DRUG=+$G(DRUG) Q:'DRUG
2811"RTN","NHINVPS",40,0)
2812 D NDF^PSS50(DRUG,,,,,"NDF") S I=+$G(I)+1
2813"RTN","NHINVPS",41,0)
2814 S MED("product",I)=DRUG_U_$G(^TMP($J,"NDF",DRUG,.01))_"^^D" ;Drug
2815"RTN","NHINVPS",42,0)
2816 S X=$G(^TMP($J,"NDF",DRUG,20)),VUID=$$GET1^DIQ(50.6,+X_",",99.99)
2817"RTN","NHINVPS",43,0)
2818 S MED("product",I,"G")=X_U_VUID ;VA Generic
2819"RTN","NHINVPS",44,0)
2820 S X=$G(^TMP($J,"NDF",DRUG,22)),VUID=$$GET1^DIQ(50.68,+X_",",99.99)
2821"RTN","NHINVPS",45,0)
2822 S MED("product",I,"P")=X_U_VUID ;VA Product
2823"RTN","NHINVPS",46,0)
2824 S MED("product",I,"C")=$P($G(^TMP($J,"NDF",+DRUG,25)),U,3) ;display name
2825"RTN","NHINVPS",47,0)
2826 K ^TMP($J,"NDF",DRUG)
2827"RTN","NHINVPS",48,0)
2828 Q
2829"RTN","NHINVPS",49,0)
2830 ;
2831"RTN","NHINVPS",50,0)
2832 ; ------------ Return data to middle tier ------------
2833"RTN","NHINVPS",51,0)
2834 ;
2835"RTN","NHINVPS",52,0)
2836XML(MED) ; -- Return patient meds as XML
2837"RTN","NHINVPS",53,0)
2838 N ATT,X,Y,I,NAMES
2839"RTN","NHINVPS",54,0)
2840 D ADD("<med>") S NHINTOTL=$G(NHINTOTL)+1
2841"RTN","NHINVPS",55,0)
2842 S ATT="" F S ATT=$O(MED(ATT)) Q:ATT="" D I $L(Y) D ADD(Y)
2843"RTN","NHINVPS",56,0)
2844 . I $O(MED(ATT,0)) D S Y="" Q ;multiples
2845"RTN","NHINVPS",57,0)
2846 .. D ADD("<"_ATT_"s>")
2847"RTN","NHINVPS",58,0)
2848 .. S I=0 F S I=$O(MED(ATT,I)) Q:I<1 D
2849"RTN","NHINVPS",59,0)
2850 ... S X=$G(MED(ATT,I)),NAMES=""
2851"RTN","NHINVPS",60,0)
2852 ... I ATT="dose" S NAMES="dose^units^unitsPerDose^noun^route^schedule^duration^conjunction^doseStart^doseStop^Z"
2853"RTN","NHINVPS",61,0)
2854 ... I ATT="fill" S NAMES="fillDate^fillRouting^releaseDate^fillQuantity^fillDaysSupply^partial^Z"
2855"RTN","NHINVPS",62,0)
2856 ... I ATT="product" S NAMES="code^name^vuid^role^concentration^Z"
2857"RTN","NHINVPS",63,0)
2858 ... S Y="<"_ATT_" "_$$LOOP_$S(ATT'="product":"/>",1:">") D ADD(Y)
2859"RTN","NHINVPS",64,0)
2860 ... Q:ATT'="product"
2861"RTN","NHINVPS",65,0)
2862 ... S X=$G(MED(ATT,I,"C")) I $L(X) S Y="<class "_$$LOOP_"/>" D ADD(Y)
2863"RTN","NHINVPS",66,0)
2864 ... S X=$G(MED(ATT,I,"G")) I $L(X) S Y="<vaGeneric "_$$LOOP_"/>" D ADD(Y)
2865"RTN","NHINVPS",67,0)
2866 ... S X=$G(MED(ATT,I,"P")) I $L(X) S Y="<vaProduct "_$$LOOP_"/>" D ADD(Y)
2867"RTN","NHINVPS",68,0)
2868 ... D ADD("</product>")
2869"RTN","NHINVPS",69,0)
2870 .. D ADD("</"_ATT_"s>")
2871"RTN","NHINVPS",70,0)
2872 . S X=$G(MED(ATT)),Y="" Q:'$L(X)
2873"RTN","NHINVPS",71,0)
2874 . I ATT="sig"!(ATT?1"ptIn"1.A) S Y="<"_ATT_" xml:space='preserve'>"_$$ESC^NHINV(X)_"</"_ATT_">" Q
2875"RTN","NHINVPS",72,0)
2876 . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
2877"RTN","NHINVPS",73,0)
2878 . I $L(X)>1 S NAMES="code^name^Z",Y="<"_ATT_" "_$$LOOP_"/>"
2879"RTN","NHINVPS",74,0)
2880 D ADD("</med>")
2881"RTN","NHINVPS",75,0)
2882 Q
2883"RTN","NHINVPS",76,0)
2884 ;
2885"RTN","NHINVPS",77,0)
2886LOOP() ; -- build sub-items string from NAMES and X
2887"RTN","NHINVPS",78,0)
2888 N STR,P,TAG S STR=""
2889"RTN","NHINVPS",79,0)
2890 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))_"' "
2891"RTN","NHINVPS",80,0)
2892 Q STR
2893"RTN","NHINVPS",81,0)
2894 ;
2895"RTN","NHINVPS",82,0)
2896ADD(X) ; Add a line @NHIN@(n)=X
2897"RTN","NHINVPS",83,0)
2898 S NHINI=$G(NHINI)+1
2899"RTN","NHINVPS",84,0)
2900 S @NHIN@(NHINI)=X
2901"RTN","NHINVPS",85,0)
2902 Q
2903"RTN","NHINVPSI")
29040^24^B41411886^n/a
2905"RTN","NHINVPSI",1,0)
2906NHINVPSI ;SLC/MKB -- Inpatient Pharmacy extract
2907"RTN","NHINVPSI",2,0)
2908 ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
2909"RTN","NHINVPSI",3,0)
2910 ;
2911"RTN","NHINVPSI",4,0)
2912 ; External References DBIA#
2913"RTN","NHINVPSI",5,0)
2914 ; ------------------- -----
2915"RTN","NHINVPSI",6,0)
2916 ; ^SC 10040
2917"RTN","NHINVPSI",7,0)
2918 ; DIQ 2056
2919"RTN","NHINVPSI",8,0)
2920 ; ORX8 2467
2921"RTN","NHINVPSI",9,0)
2922 ; PSOORRL,^TMP("PS",$J) 2400
2923"RTN","NHINVPSI",10,0)
2924 ; PSS50P7 4662
2925"RTN","NHINVPSI",11,0)
2926 ; XLFSTR 10104
2927"RTN","NHINVPSI",12,0)
2928 ;
2929"RTN","NHINVPSI",13,0)
2930 ; ------------ Get medications from VistA ------------
2931"RTN","NHINVPSI",14,0)
2932 ;
2933"RTN","NHINVPSI",15,0)
2934EN(DFN,BEG,END,MAX,ID) ; -- find patient's UD/IV meds
2935"RTN","NHINVPSI",16,0)
2936 N PS0,NHI,NHITM,IV K ^TMP("PS",$J)
2937"RTN","NHINVPSI",17,0)
2938 S DFN=+$G(DFN) Q:DFN<1
2939"RTN","NHINVPSI",18,0)
2940 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
2941"RTN","NHINVPSI",19,0)
2942 ;
2943"RTN","NHINVPSI",20,0)
2944 ; get one med
2945"RTN","NHINVPSI",21,0)
2946 I $G(ID) D Q
2947"RTN","NHINVPSI",22,0)
2948 . Q:ID["N" Q:ID["O" ;inpatient only
2949"RTN","NHINVPSI",23,0)
2950 . D OEL^PSOORRL(DFN,ID)
2951"RTN","NHINVPSI",24,0)
2952 . S IV=$S(ID["V":1,$G(^TMP("PS",$J,"B",0)):1,1:0)
2953"RTN","NHINVPSI",25,0)
2954 . D @($S(IV:"IV1",1:"IN1")_"(ID,.NHITM)")
2955"RTN","NHINVPSI",26,0)
2956 . I $D(NHITM)>9 D XML^NHINVPS(.NHITM)
2957"RTN","NHINVPSI",27,0)
2958 . K ^TMP("PS",$J)
2959"RTN","NHINVPSI",28,0)
2960 ;
2961"RTN","NHINVPSI",29,0)
2962 ; get all meds
2963"RTN","NHINVPSI",30,0)
2964 D OCL^PSOORRL(DFN,BEG,END)
2965"RTN","NHINVPSI",31,0)
2966 S NHI=0 F S NHI=$O(^TMP("PS",$J,NHI)) Q:NHI<1!(NHI>MAX) S PS0=$G(^(NHI,0)) D
2967"RTN","NHINVPSI",32,0)
2968 . S ID=$P(PS0,U) K NHITM
2969"RTN","NHINVPSI",33,0)
2970 . Q:ID["N" Q:ID["O" ;inpatient only
2971"RTN","NHINVPSI",34,0)
2972 . S IV=$S(ID["V":1,$G(^TMP("PS",$J,NHI,"B",0)):1,1:0)
2973"RTN","NHINVPSI",35,0)
2974 . D @($S(IV:"IV",1:"IN")_"(ID,.NHITM)")
2975"RTN","NHINVPSI",36,0)
2976 . I $D(NHITM)>9 D XML^NHINVPS(.NHITM)
2977"RTN","NHINVPSI",37,0)
2978 K ^TMP("PS",$J)
2979"RTN","NHINVPSI",38,0)
2980 Q
2981"RTN","NHINVPSI",39,0)
2982 ;
2983"RTN","NHINVPSI",40,0)
2984IN(ID,MED) ; -- return a medication in MED("attribute")=value
2985"RTN","NHINVPSI",41,0)
2986 ; [expects PS0,OCL^PSOORRL data]
2987"RTN","NHINVPSI",42,0)
2988 N X,PS,ORDER,DOSE,UNTS,RTE,SCH,OI,PSOI,LOC K MED
2989"RTN","NHINVPSI",43,0)
2990 M PS=^TMP("PS",$J,NHI)
2991"RTN","NHINVPSI",44,0)
2992 S MED("id")=ID,MED("vaType")="I"
2993"RTN","NHINVPSI",45,0)
2994 S X=$P(PS0,U,15) S:X MED("start")=X
2995"RTN","NHINVPSI",46,0)
2996 S X=$P(PS0,U,4) S:X MED("stop")=X
2997"RTN","NHINVPSI",47,0)
2998 S MED("name")=$P(PS0,U,2),X=$P(PS0,U,9),MED("vaStatus")=X,X=$E(X,1,3)
2999"RTN","NHINVPSI",48,0)
3000 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)))
3001"RTN","NHINVPSI",49,0)
3002 S DOSE=$P(PS0,U,6) S:DOSE="" DOSE=$G(PS("SIG",1,0))
3003"RTN","NHINVPSI",50,0)
3004 S RTE=$G(PS("MDR",1,0)),SCH=$P($G(PS("SCH",1,0)),U)
3005"RTN","NHINVPSI",51,0)
3006 S MED("dose",1)=DOSE_"^^^^"_RTE_U_SCH
3007"RTN","NHINVPSI",52,0)
3008 S MED("sig")="Give: "_DOSE_" "_RTE_" "_SCH I $G(PS("SIO",0)) D
3009"RTN","NHINVPSI",53,0)
3010 . N SIO M SIO=PS("SIO")
3011"RTN","NHINVPSI",54,0)
3012 . S MED("sig")=MED("sig")_$C(13,10)_$$STRING^NHINV(.SIO)
3013"RTN","NHINVPSI",55,0)
3014 I $D(PS("P",0)) S MED("orderingProvider")=PS("P",0)
3015"RTN","NHINVPSI",56,0)
3016 I $G(PS("CLINIC",0)) S MED("IMO")=1
3017"RTN","NHINVPSI",57,0)
3018 S MED("facility")=$$FAC^NHINV ;local stn#^name
3019"RTN","NHINVPSI",58,0)
3020 S ORDER=+$P(PS0,U,8) D:ORDER ORD
3021"RTN","NHINVPSI",59,0)
3022 Q
3023"RTN","NHINVPSI",60,0)
3024 ;
3025"RTN","NHINVPSI",61,0)
3026IN1(ID,MED) ; -- return a medication in MED("attribute")=value
3027"RTN","NHINVPSI",62,0)
3028 ; [expects OEL^PSOORRL data]
3029"RTN","NHINVPSI",63,0)
3030 N X,PS,PS0,ORDER,DOSE,UNTS,RTE,SCH,OI,PSOI,DRUG,LOC K MED
3031"RTN","NHINVPSI",64,0)
3032 M PS=^TMP("PS",$J) S PS0=PS(0)
3033"RTN","NHINVPSI",65,0)
3034 S MED("id")=ID,MED("vaType")="I"
3035"RTN","NHINVPSI",66,0)
3036 S X=$P(PS0,U,5) S:X MED("start")=X
3037"RTN","NHINVPSI",67,0)
3038 S X=$P(PS0,U,3) S:X MED("stop")=X
3039"RTN","NHINVPSI",68,0)
3040 S MED("name")=$P(PS0,U),X=$P(PS0,U,6),MED("vaStatus")=X,X=$E(X,1,3)
3041"RTN","NHINVPSI",69,0)
3042 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)))
3043"RTN","NHINVPSI",70,0)
3044 S DOSE=$P(PS0,U,9) S:DOSE="" DOSE=$G(PS("SIG",1,0))
3045"RTN","NHINVPSI",71,0)
3046 S RTE=$G(PS("MDR",1,0)),SCH=$P($G(PS("SCH",1,0)),U)
3047"RTN","NHINVPSI",72,0)
3048 S MED("dose",1)=DOSE_"^^^^"_RTE_U_SCH
3049"RTN","NHINVPSI",73,0)
3050 S MED("sig")="Give: "_DOSE_" "_RTE_" "_SCH I $G(PS("SIO",0)) D
3051"RTN","NHINVPSI",74,0)
3052 . N SIO M SIO=PS("SIO")
3053"RTN","NHINVPSI",75,0)
3054 . S MED("sig")=MED("sig")_$C(13,10)_$$STRING^NHINV(.SIO)
3055"RTN","NHINVPSI",76,0)
3056 I $D(PS("P",0)) S MED("orderingProvider")=PS("P",0)
3057"RTN","NHINVPSI",77,0)
3058 S MED("facility")=$$FAC^NHINV ;local stn#^name
3059"RTN","NHINVPSI",78,0)
3060 S ORDER=+$P(PS0,U,11) D:ORDER ORD
3061"RTN","NHINVPSI",79,0)
3062 I $D(^SC("AE",1,+$G(LOC))) S MED("IMO")=1
3063"RTN","NHINVPSI",80,0)
3064 Q
3065"RTN","NHINVPSI",81,0)
3066 ;
3067"RTN","NHINVPSI",82,0)
3068ORD ; get rest of inpatient data from ORDER
3069"RTN","NHINVPSI",83,0)
3070 S OI=$$OI^ORX8(ORDER),PSOI=+$P(OI,U,3)
3071"RTN","NHINVPSI",84,0)
3072 S MED("name")=$P(OI,U,2) I PSOI D
3073"RTN","NHINVPSI",85,0)
3074 . D ZERO^PSS50P7(PSOI,,,"OI")
3075"RTN","NHINVPSI",86,0)
3076 . S MED("form")=$P($G(^TMP($J,"OI",PSOI,.02)),U,2)
3077"RTN","NHINVPSI",87,0)
3078 S X=$$VALUE^ORX8(ORDER,"DOSE"),DOSE=DOSE_"^^^"
3079"RTN","NHINVPSI",88,0)
3080 S DRUG="" I X'="",X["&" D
3081"RTN","NHINVPSI",89,0)
3082 . S DRUG=+$P(X,"&",6)
3083"RTN","NHINVPSI",90,0)
3084 . S DOSE=$TR($P(X,"&",1,4),"&","^")
3085"RTN","NHINVPSI",91,0)
3086 . S $P(MED("dose",1),U,1,4)=DOSE
3087"RTN","NHINVPSI",92,0)
3088 S:'DRUG DRUG=+$$VALUE^ORX8(ORDER,"DRUG")
3089"RTN","NHINVPSI",93,0)
3090 D:DRUG NDF^NHINVPS(DRUG)
3091"RTN","NHINVPSI",94,0)
3092 K ^TMP($J,"OI")
3093"RTN","NHINVPSI",95,0)
3094ORDLOC ; enter here for just order# and location
3095"RTN","NHINVPSI",96,0)
3096 S MED("orderID")=ORDER
3097"RTN","NHINVPSI",97,0)
3098 S LOC=+$$GET1^DIQ(100,ORDER_",",6,"I") I LOC D
3099"RTN","NHINVPSI",98,0)
3100 . S MED("location")=LOC_U_$P($G(^SC(LOC,0)),U)
3101"RTN","NHINVPSI",99,0)
3102 . S MED("facility")=$$FAC^NHINV(LOC)
3103"RTN","NHINVPSI",100,0)
3104 Q
3105"RTN","NHINVPSI",101,0)
3106 ;
3107"RTN","NHINVPSI",102,0)
3108IV(ID,MED) ; -- return an infusion in MED("attribute")=value
3109"RTN","NHINVPSI",103,0)
3110 ; [expects PS0,OCL^PSOORRL data]
3111"RTN","NHINVPSI",104,0)
3112 N PS,X,ORDER,LOC K MED
3113"RTN","NHINVPSI",105,0)
3114 M PS=^TMP("PS",$J,NHI)
3115"RTN","NHINVPSI",106,0)
3116 S MED("id")=ID,MED("vaType")="V",MED("name")=$P(PS0,U,2)
3117"RTN","NHINVPSI",107,0)
3118 S X=$P(PS0,U,15) S:X MED("start")=X
3119"RTN","NHINVPSI",108,0)
3120 S X=$P(PS0,U,4) S:X MED("stop")=X
3121"RTN","NHINVPSI",109,0)
3122 S MED("vaStatus")=$P(PS0,U,9),X=$E($P(PS0,U,9),1,3)
3123"RTN","NHINVPSI",110,0)
3124 S MED("status")=$S(X="DIS"!(X="PEN"):"not active",X="EXP"!(X="PUR"):"historical",X="HOL":"hold",1:"active")
3125"RTN","NHINVPSI",111,0)
3126 S MED("dose",1)="^^^^"_$G(PS("MDR",1,0))_U_$P($G(PS("SCH",1,0)),U)
3127"RTN","NHINVPSI",112,0)
3128 S MED("rate")=$P(PS0,U,3) D IVP
3129"RTN","NHINVPSI",113,0)
3130 S X=$G(PS("IVLIM",0)) S:$L(X) MED("ivLimit")=$$IVLIM(X)
3131"RTN","NHINVPSI",114,0)
3132 I $G(PS("CLINIC",0)) S MED("IMO")=1
3133"RTN","NHINVPSI",115,0)
3134 I $G(PS("P",0)) S MED("orderingProvider")=PS("P",0)
3135"RTN","NHINVPSI",116,0)
3136 S MED("facility")=$$FAC^NHINV ;local stn#^name
3137"RTN","NHINVPSI",117,0)
3138 S ORDER=+$P(PS0,U,8) D:ORDER ORDLOC
3139"RTN","NHINVPSI",118,0)
3140 Q
3141"RTN","NHINVPSI",119,0)
3142 ;
3143"RTN","NHINVPSI",120,0)
3144IV1(ID,MED) ; -- return an infusion in MED("attribute")=value
3145"RTN","NHINVPSI",121,0)
3146 ; [expects OEL^PSOORRL data]
3147"RTN","NHINVPSI",122,0)
3148 N PS,PS0,X,ORDER,LOC K MED
3149"RTN","NHINVPSI",123,0)
3150 M PS=^TMP("PS",$J) S PS0=PS(0)
3151"RTN","NHINVPSI",124,0)
3152 S MED("id")=ID,MED("vaType")="V",MED("name")=$P(PS0,U)
3153"RTN","NHINVPSI",125,0)
3154 S X=$P(PS0,U,5) S:X MED("start")=X
3155"RTN","NHINVPSI",126,0)
3156 S X=$P(PS0,U,3) S:X MED("stop")=X
3157"RTN","NHINVPSI",127,0)
3158 S MED("vaStatus")=$P(PS0,U,6),X=$E($P(PS0,U,6),1,3)
3159"RTN","NHINVPSI",128,0)
3160 S MED("status")=$S(X="DIS"!(X="PEN"):"not active",X="EXP"!(X="PUR"):"historical",X="HOL":"hold",1:"active")
3161"RTN","NHINVPSI",129,0)
3162 S MED("dose",1)="^^^^"_$G(PS("MDR",1,0))_U_$P($G(PS("SCH",1,0)),U)
3163"RTN","NHINVPSI",130,0)
3164 S MED("rate")=$P(PS0,U,2) D IVP
3165"RTN","NHINVPSI",131,0)
3166 S X=$G(PS("IVLIM",0)) S:$L(X) MED("ivLimit")=$$IVLIM(X)
3167"RTN","NHINVPSI",132,0)
3168 I $G(PS("P",0)) S MED("orderingProvider")=PS("P",0)
3169"RTN","NHINVPSI",133,0)
3170 S MED("facility")=$$FAC^NHINV ;local stn#^name
3171"RTN","NHINVPSI",134,0)
3172 S ORDER=+$P(PS0,U,11) D:ORDER ORDLOC
3173"RTN","NHINVPSI",135,0)
3174 I $D(^SC("AE",1,+$G(LOC))) S MED("IMO")=1
3175"RTN","NHINVPSI",136,0)
3176 Q
3177"RTN","NHINVPSI",137,0)
3178 ;
3179"RTN","NHINVPSI",138,0)
3180IVP ; -- add IV products for ID,DFN
3181"RTN","NHINVPSI",139,0)
3182 N I,N,FILE,IENS,NHIN,LIST,IEN,DRUG,STR
3183"RTN","NHINVPSI",140,0)
3184 S FILE=$S(ID["P":53.157,1:55.02),N=0
3185"RTN","NHINVPSI",141,0)
3186 S IENS=","_+ID_","_$S(ID["P":"",1:DFN_",")
3187"RTN","NHINVPSI",142,0)
3188 F I=1:1 K NHIN D GETS^DIQ(FILE,I_IENS,"*","IE","NHIN") Q:'$D(NHIN) D
3189"RTN","NHINVPSI",143,0)
3190 . K LIST M LIST=NHIN(FILE,I_IENS)
3191"RTN","NHINVPSI",144,0)
3192 . S IEN=LIST(.01,"I"),DRUG=$$GET1^DIQ(52.6,IEN_",",1,"I")
3193"RTN","NHINVPSI",145,0)
3194 . D:DRUG NDF^NHINVPS(DRUG,.N) S:'DRUG N=N+1
3195"RTN","NHINVPSI",146,0)
3196 . S STR=$S(FILE=53.157:LIST(1,"E"),1:LIST(.02,"E"))
3197"RTN","NHINVPSI",147,0)
3198 . S MED("product",N)=IEN_U_LIST(.01,"E")_"^^A^"_STR
3199"RTN","NHINVPSI",148,0)
3200 S FILE=$S(ID["P":53.158,1:55.11)
3201"RTN","NHINVPSI",149,0)
3202 F I=1:1 K NHIN D GETS^DIQ(FILE,I_IENS,"*","IE","NHIN") Q:'$D(NHIN) D
3203"RTN","NHINVPSI",150,0)
3204 . K LIST M LIST=NHIN(FILE,I_IENS)
3205"RTN","NHINVPSI",151,0)
3206 . S IEN=LIST(.01,"I"),DRUG=$$GET1^DIQ(52.7,IEN_",",1,"I")
3207"RTN","NHINVPSI",152,0)
3208 . D:DRUG NDF^NHINVPS(DRUG,.N) S:'DRUG N=N+1
3209"RTN","NHINVPSI",153,0)
3210 . S MED("product",N)=IEN_U_LIST(.01,"E")_"^^B^"_LIST(1,"E")
3211"RTN","NHINVPSI",154,0)
3212 Q
3213"RTN","NHINVPSI",155,0)
3214 ;
3215"RTN","NHINVPSI",156,0)
3216IVLIM(X) ; -- Return expanded version of IV Limit X
3217"RTN","NHINVPSI",157,0)
3218 I '$L($G(X)) Q ""
3219"RTN","NHINVPSI",158,0)
3220 N Y,VAL,UNT,I
3221"RTN","NHINVPSI",159,0)
3222 S Y="",X=$$UP^XLFSTR(X)
3223"RTN","NHINVPSI",160,0)
3224 I X?1"DOSES".E S X="A"_$P(X,"DOSES",2)
3225"RTN","NHINVPSI",161,0)
3226 S UNT=$E(X),VAL=0 F I=2:1:$L(X) I $E(X,I) S VAL=$E(X,I,$L(X)) Q
3227"RTN","NHINVPSI",162,0)
3228 I UNT="A" S Y=+VAL_$S(+VAL>1:" doses",1:" dose")
3229"RTN","NHINVPSI",163,0)
3230 I UNT="D" S Y=+VAL_$S(+VAL>1:" days",1:" day")
3231"RTN","NHINVPSI",164,0)
3232 I UNT="H" S Y=+VAL_$S(+VAL>1:" hours",1:" hour")
3233"RTN","NHINVPSI",165,0)
3234 I UNT="C" S Y=+VAL_" CC"
3235"RTN","NHINVPSI",166,0)
3236 I UNT="M" S Y=+VAL_" ml"
3237"RTN","NHINVPSI",167,0)
3238 I UNT="L" S Y=+VAL_" L"
3239"RTN","NHINVPSI",168,0)
3240 Q Y
3241"RTN","NHINVPSO")
32420^28^B65991145^n/a
3243"RTN","NHINVPSO",1,0)
3244NHINVPSO ;SLC/MKB -- Outpatient Pharmacy extract
3245"RTN","NHINVPSO",2,0)
3246 ;;1.0;NHIN;**1**;Dec 01, 2009;Build 11
3247"RTN","NHINVPSO",3,0)
3248 ;
3249"RTN","NHINVPSO",4,0)
3250 ; External References DBIA#
3251"RTN","NHINVPSO",5,0)
3252 ; ------------------- -----
3253"RTN","NHINVPSO",6,0)
3254 ; ^SC 10040
3255"RTN","NHINVPSO",7,0)
3256 ; ^VA(200) 10060
3257"RTN","NHINVPSO",8,0)
3258 ; DIQ 2056
3259"RTN","NHINVPSO",9,0)
3260 ; ORX8 2467
3261"RTN","NHINVPSO",10,0)
3262 ; PSO5241 4821
3263"RTN","NHINVPSO",11,0)
3264 ; PSOORDER,^TMP("PSOR",$J) 1878
3265"RTN","NHINVPSO",12,0)
3266 ; PSOORRL,^TMP("PS",$J) 2400
3267"RTN","NHINVPSO",13,0)
3268 ; PSS50P7 4662
3269"RTN","NHINVPSO",14,0)
3270 ; PSS51P2 4548
3271"RTN","NHINVPSO",15,0)
3272 ; XLFDT 10103
3273"RTN","NHINVPSO",16,0)
3274 ;
3275"RTN","NHINVPSO",17,0)
3276 ; ------------ Get medications from VistA ------------
3277"RTN","NHINVPSO",18,0)
3278 ;
3279"RTN","NHINVPSO",19,0)
3280EN(DFN,BEG,END,MAX,ID) ; -- find patient's meds
3281"RTN","NHINVPSO",20,0)
3282 N PS0,NHI,NHITM K ^TMP("PS",$J)
3283"RTN","NHINVPSO",21,0)
3284 S DFN=+$G(DFN) Q:DFN<1
3285"RTN","NHINVPSO",22,0)
3286 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
3287"RTN","NHINVPSO",23,0)
3288 ;
3289"RTN","NHINVPSO",24,0)
3290 ; get one med
3291"RTN","NHINVPSO",25,0)
3292 I $G(ID) D D:$D(NHITM)>9 XML^NHINVPS(.NHITM) Q
3293"RTN","NHINVPSO",26,0)
3294 . Q:ID["I"
3295"RTN","NHINVPSO",27,0)
3296 . I ID["N" D NVA(ID,.NHITM) Q
3297"RTN","NHINVPSO",28,0)
3298 . I ID'["P",ID'["S" D RX(ID,.NHITM) Q
3299"RTN","NHINVPSO",29,0)
3300 . D OEL^PSOORRL(DFN,ID),PEN1(ID,.NHITM)
3301"RTN","NHINVPSO",30,0)
3302 . K ^TMP("PS",$J)
3303"RTN","NHINVPSO",31,0)
3304 ;
3305"RTN","NHINVPSO",32,0)
3306 ; get all meds
3307"RTN","NHINVPSO",33,0)
3308 D OCL^PSOORRL(DFN,BEG,END)
3309"RTN","NHINVPSO",34,0)
3310 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)
3311"RTN","NHINVPSO",35,0)
3312 . S ID=$P(PS0,U) K NHITM Q:ID["I"
3313"RTN","NHINVPSO",36,0)
3314 . I ID["N" D NVA(ID,.NHITM) Q
3315"RTN","NHINVPSO",37,0)
3316 . I ID["O" D RX(ID,.NHITM) Q
3317"RTN","NHINVPSO",38,0)
3318 K ^TMP("PS",$J)
3319"RTN","NHINVPSO",39,0)
3320 Q
3321"RTN","NHINVPSO",40,0)
3322 ;
3323"RTN","NHINVPSO",41,0)
3324RX(ID,MED) ; -- return a prescription in MED("attribute")=value
3325"RTN","NHINVPSO",42,0)
3326 I ID["P"!(ID["S") G PEND ;pending order
3327"RTN","NHINVPSO",43,0)
3328 N RX0,RX1,DRUG,PSOI,X,I,START,STOP,ORIFN,FILL,RFD,PRV K MED
3329"RTN","NHINVPSO",44,0)
3330 K ^TMP("PSOR",$J) D EN^PSOORDER(DFN,+ID)
3331"RTN","NHINVPSO",45,0)
3332 S RX0=$G(^TMP("PSOR",$J,+ID,0)),RX1=$G(^(1)),DRUG=$G(^("DRUG",0))
3333"RTN","NHINVPSO",46,0)
3334 S MED("id")=ID,MED("vaType")="O",MED("type")="Prescription"
3335"RTN","NHINVPSO",47,0)
3336 S ORIFN=+$P(RX1,U,8) S:ORIFN MED("orderID")=ORIFN
3337"RTN","NHINVPSO",48,0)
3338 S PSOI=$G(^TMP("PSOR",$J,+ID,"DRUGOI",0)) I PSOI D
3339"RTN","NHINVPSO",49,0)
3340 . S MED("name")=$P(PSOI,";",2)
3341"RTN","NHINVPSO",50,0)
3342 . D ZERO^PSS50P7(+PSOI,,,"OI")
3343"RTN","NHINVPSO",51,0)
3344 . S MED("form")=$P($G(^TMP($J,"OI",+PSOI,.02)),U,2)
3345"RTN","NHINVPSO",52,0)
3346 D:DRUG NDF^NHINVPS(+DRUG) ;add NDF data
3347"RTN","NHINVPSO",53,0)
3348 S START=$P(RX0,U) S:START MED("start")=START
3349"RTN","NHINVPSO",54,0)
3350 S STOP=$P(RX0,U,12) S:STOP MED("stop")=STOP ;_".2359"?
3351"RTN","NHINVPSO",55,0)
3352 S X=$$GET1^DIQ(52,+ID_",",26,"I") S:X MED("expires")=X
3353"RTN","NHINVPSO",56,0)
3354 S X=$P(RX0,U,17) S:X MED("ordered")=X
3355"RTN","NHINVPSO",57,0)
3356 S MED("vaStatus")=$P($P(RX0,U,4),";",2),X=$P($P(RX0,U,4),";")
3357"RTN","NHINVPSO",58,0)
3358 S MED("status")=$S(X="H":"hold",X="DC":"not active",X="D"!(X="E"):"historical",1:"active")
3359"RTN","NHINVPSO",59,0)
3360 S MED("quantity")=$P(RX0,U,6),MED("daysSupply")=$P(RX0,U,7)
3361"RTN","NHINVPSO",60,0)
3362 S MED("fillsAllowed")=$P(RX0,U,8),MED("fillsRemaining")=$P(RX0,U,9)
3363"RTN","NHINVPSO",61,0)
3364 S MED("routing")=$P($P(RX1,U,6),";"),MED("prescription")=$P(RX0,U,5)
3365"RTN","NHINVPSO",62,0)
3366 S MED("lastFilled")=$P(RX0,U,3) K FILL
3367"RTN","NHINVPSO",63,0)
3368 S I=0 F S I=$O(^TMP("PSOR",$J,+ID,"REF",I)) Q:I<1 S X=$G(^(I,0)),FILL(+X)=X
3369"RTN","NHINVPSO",64,0)
3370 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
3371"RTN","NHINVPSO",65,0)
3372 S (I,RFD,PRV)=0 F S RFD=$O(FILL(RFD)) Q:RFD<1 S X=$G(FILL(RFD)) D ;sort 1st
3373"RTN","NHINVPSO",66,0)
3374 . N MW,REL S I=I+1
3375"RTN","NHINVPSO",67,0)
3376 . S MW=$P($P(X,U,10),";"),REL=$P($P(X,U,8),".")
3377"RTN","NHINVPSO",68,0)
3378 . S MED("fill",I)=$P(RFD,".")_U_MW_U_REL_U_$P(X,U,4,5)_$S($P(X,U,14):"^1",1:"")
3379"RTN","NHINVPSO",69,0)
3380 . S:$P(X,U,2) PRV=$P(X,U,2) ;save last provider
3381"RTN","NHINVPSO",70,0)
3382 . ; fill comments?
3383"RTN","NHINVPSO",71,0)
3384 S X=$S($P(RX0,U,11):$P(RX0,U,11),$P(RX0,U,10):$P(RX0,U,10),1:0)
3385"RTN","NHINVPSO",72,0)
3386 S:X MED("fillCost")=X
3387"RTN","NHINVPSO",73,0)
3388 S X=$G(^TMP("PSOR",$J,+ID,"SIG",1,0)),I=1
3389"RTN","NHINVPSO",74,0)
3390 F S I=$O(^TMP("PSOR",$J,+ID,"SIG",I)) Q:I<1 S X=X_$G(^(I,0))
3391"RTN","NHINVPSO",75,0)
3392 S MED("sig")=X
3393"RTN","NHINVPSO",76,0)
3394 S X=$G(^TMP("PSOR",$J,+ID,"PI",1,0)),I=1
3395"RTN","NHINVPSO",77,0)
3396 F S I=$O(^TMP("PSOR",$J,+ID,"PI",I)) Q:I<1 S X=X_$G(^(I,0))
3397"RTN","NHINVPSO",78,0)
3398 S:$L(X) MED("ptInstructions")=X
3399"RTN","NHINVPSO",79,0)
3400 S I=0 F S I=$O(^TMP("PSOR",$J,+ID,"MI",I)) Q:I<1 S X=$G(^(I,0)) D
3401"RTN","NHINVPSO",80,0)
3402 . N UD,NOUN,DOSE,UNIT,RTE,SCH,DUR,CONJ,END
3403"RTN","NHINVPSO",81,0)
3404 . S UD=$P(X,U,2),NOUN=$P(X,U,4)
3405"RTN","NHINVPSO",82,0)
3406 . S DOSE=$P(X,U),UNIT=$P($P(X,U,3),";",2)
3407"RTN","NHINVPSO",83,0)
3408 . S RTE=+$P(X,U,7) D ALL^PSS51P2(RTE,,,,"MR")
3409"RTN","NHINVPSO",84,0)
3410 . S RTE=$G(^TMP($J,"MR",RTE,1))
3411"RTN","NHINVPSO",85,0)
3412 . S DUR=$P(X,U,5),CONJ=$P(X,U,6),SCH=$P(X,U,8)
3413"RTN","NHINVPSO",86,0)
3414 . S END=$S(DUR:$$STOP(START,DUR),1:STOP)
3415"RTN","NHINVPSO",87,0)
3416 . S MED("dose",I)=DOSE_U_UNIT_U_UD_U_NOUN_U_RTE_U_SCH_U_DUR_U_CONJ_U_START_U_STOP
3417"RTN","NHINVPSO",88,0)
3418 . I $E(CONJ)="T",DUR S START=END
3419"RTN","NHINVPSO",89,0)
3420 S:RX1 X=$TR($P(RX1,U),";","^"),MED("orderingProvider")=X,MED("currentProvider")=X
3421"RTN","NHINVPSO",90,0)
3422 S:$G(PRV) MED("currentProvider")=$TR(PRV,";","^")
3423"RTN","NHINVPSO",91,0)
3424 S:$P(RX1,U,9) MED("pharmacist")=$TR($P(RX1,U,9),";","^")
3425"RTN","NHINVPSO",92,0)
3426 S:$P(RX1,U,4) MED("location")=$TR($P(RX1,U,4),";","^")
3427"RTN","NHINVPSO",93,0)
3428 S MED("facility")=$$FAC^NHINV(+$P(RX1,U,4))
3429"RTN","NHINVPSO",94,0)
3430 K ^TMP("PSOR",$J),^TMP($J,"MR"),^TMP($J,"NDF"),^TMP($J,"OI")
3431"RTN","NHINVPSO",95,0)
3432 Q
3433"RTN","NHINVPSO",96,0)
3434 ;
3435"RTN","NHINVPSO",97,0)
3436PEND ; -- pending prescription
3437"RTN","NHINVPSO",98,0)
3438 ; [expects PS0,OCL^PSOORRL data]
3439"RTN","NHINVPSO",99,0)
3440 N I,X,NHIN K MED
3441"RTN","NHINVPSO",100,0)
3442 S MED("id")=ID,MED("vaType")="O",MED("type")="Prescription"
3443"RTN","NHINVPSO",101,0)
3444 S MED("vaStatus")=$P(PS0,U,9),MED("status")="not active"
3445"RTN","NHINVPSO",102,0)
3446 S X=+$P(PS0,U,8) S:X MED("orderID")=X
3447"RTN","NHINVPSO",103,0)
3448 S X=+$P(PS0,U,12) S:X MED("quantity")=X
3449"RTN","NHINVPSO",104,0)
3450 D GETS^DIQ(52.41,+ID_",","101;13;19;15;5;1.1","I","NHIN")
3451"RTN","NHINVPSO",105,0)
3452 S X=NHIN(52.41,+ID_",",101,"I") S:X MED("daysSupply")=X
3453"RTN","NHINVPSO",106,0)
3454 S X=NHIN(52.41,+ID_",",13,"I") S:X MED("fillsAllowed")=X
3455"RTN","NHINVPSO",107,0)
3456 S X=NHIN(52.41,+ID_",",19,"I") S:$L(X) MED("routing")=X
3457"RTN","NHINVPSO",108,0)
3458 S X=NHIN(52.41,+ID_",",15,"I") S:X MED("ordered")=X
3459"RTN","NHINVPSO",109,0)
3460 S X=NHIN(52.41,+ID_",",5,"I") S:X MED("orderingProvider")=X_U_$P($G(^VA(200,X,0)),U)
3461"RTN","NHINVPSO",110,0)
3462 S X=NHIN(52.41,+ID_",",1.1,"I") S:X MED("location")=X_U_$P($G(^SC(X,0)),U)
3463"RTN","NHINVPSO",111,0)
3464 S MED("facility")=$$FAC^NHINV(X)
3465"RTN","NHINVPSO",112,0)
3466 S X=$G(^TMP("PS",$J,NHI,"SIG",1,0)),I=1
3467"RTN","NHINVPSO",113,0)
3468 F S I=$O(^TMP("PS",$J,NHI,"SIG",I)) Q:I<1 S X=X_$C(13,10)_$G(^(I,0))
3469"RTN","NHINVPSO",114,0)
3470 S MED("sig")=X
3471"RTN","NHINVPSO",115,0)
3472 D PEN^PSO5241(DFN,"NHIN",+ID)
3473"RTN","NHINVPSO",116,0)
3474 S X=$G(^TMP($J,"NHIN",DFN,+ID,8)) I X D ;Pharmacy OI
3475"RTN","NHINVPSO",117,0)
3476 . S MED("name")=$P(X,U,2)_" "_$P(X,U,4),MED("form")=$P(X,U,4)
3477"RTN","NHINVPSO",118,0)
3478 S X=$G(^TMP($J,"NHIN",DFN,+ID,11)) D:X NDF^NHINVPS(+X) ;Dispense Drug
3479"RTN","NHINVPSO",119,0)
3480 D PDOSE K ^TMP($J,"NHIN")
3481"RTN","NHINVPSO",120,0)
3482 Q
3483"RTN","NHINVPSO",121,0)
3484 ;
3485"RTN","NHINVPSO",122,0)
3486PEN1(ID,MED) ; -- return a pending Rx in MED("attribute")=value
3487"RTN","NHINVPSO",123,0)
3488 ; [expects OEL^PSOORRL data]
3489"RTN","NHINVPSO",124,0)
3490 N PS,PS0,I,X,NHIN K MED
3491"RTN","NHINVPSO",125,0)
3492 M PS=^TMP("PS",$J) S PS0=PS(0)
3493"RTN","NHINVPSO",126,0)
3494 S MED("id")=ID,MED("vaType")="O",MED("type")="Prescription"
3495"RTN","NHINVPSO",127,0)
3496 S MED("vaStatus")=$P(PS0,U,6),MED("status")="not active"
3497"RTN","NHINVPSO",128,0)
3498 S X=+$P(PS0,U,11) S:X MED("orderID")=X
3499"RTN","NHINVPSO",129,0)
3500 S X=+$P(PS0,U,8) S:X MED("quantity")=X
3501"RTN","NHINVPSO",130,0)
3502 S X=+$P(PS0,U,4) S:X MED("fillsAllowed")=X
3503"RTN","NHINVPSO",131,0)
3504 S X=+$P(PS0,U,5) S:X MED("ordered")=X
3505"RTN","NHINVPSO",132,0)
3506 S X=$G(PS("DD",1,0)) D:X NDF^NHINVPS(+X) ;Dispense Drug
3507"RTN","NHINVPSO",133,0)
3508 D GETS^DIQ(52.41,+ID_",","101;19;5;1.1","I","NHIN")
3509"RTN","NHINVPSO",134,0)
3510 S X=NHIN(52.41,+ID_",",101,"I") S:X MED("daysSupply")=X
3511"RTN","NHINVPSO",135,0)
3512 S X=NHIN(52.41,+ID_",",19,"I") S:$L(X) MED("routing")=X
3513"RTN","NHINVPSO",136,0)
3514 S X=NHIN(52.41,+ID_",",5,"I") S:X MED("orderingProvider")=X_U_$P($G(^VA(200,X,0)),U)
3515"RTN","NHINVPSO",137,0)
3516 S X=NHIN(52.41,+ID_",",1.1,"I") S:X MED("location")=X_U_$P($G(^SC(X,0)),U)
3517"RTN","NHINVPSO",138,0)
3518 S MED("facility")=$$FAC^NHINV(X)
3519"RTN","NHINVPSO",139,0)
3520 S X=$G(PS("SIG",1,0)),I=1
3521"RTN","NHINVPSO",140,0)
3522 F S I=$O(PS("SIG",I)) Q:I<1 S X=X_$C(13,10)_$G(PS("SIG",I,0))
3523"RTN","NHINVPSO",141,0)
3524 S MED("sig")=X
3525"RTN","NHINVPSO",142,0)
3526 D PEN^PSO5241(DFN,"NHIN",+ID)
3527"RTN","NHINVPSO",143,0)
3528 S X=$G(^TMP($J,"NHIN",DFN,+ID,8)) I X D ;Pharmacy OI
3529"RTN","NHINVPSO",144,0)
3530 . S MED("name")=$P(X,U,2)_" "_$P(X,U,4),MED("form")=$P(X,U,4)
3531"RTN","NHINVPSO",145,0)
3532 D PDOSE K ^TMP($J,"NHIN")
3533"RTN","NHINVPSO",146,0)
3534 Q
3535"RTN","NHINVPSO",147,0)
3536 ;
3537"RTN","NHINVPSO",148,0)
3538PDOSE ; Pending file doses
3539"RTN","NHINVPSO",149,0)
3540 N QT,UNIT,UD,NOUN,DOSE,RTE,SCH,DUR,CONJ,BEG,END
3541"RTN","NHINVPSO",150,0)
3542 F I=1:1 K NHIN D GETS^DIQ(52.413,I_","_+ID_",","*",,"NHIN") Q:'$D(NHIN) D
3543"RTN","NHINVPSO",151,0)
3544 . K QT M QT=NHIN(52.413,I_","_+ID_",")
3545"RTN","NHINVPSO",152,0)
3546 . S (UNIT,UD,NOUN)="",(DOSE,X)=QT(.01) I X["&" D
3547"RTN","NHINVPSO",153,0)
3548 .. S DOSE=$P(X,"&"),UNIT=$P(X,"&",2)
3549"RTN","NHINVPSO",154,0)
3550 .. S UD=$P(X,"&",3),NOUN=$P(X,"&",4)
3551"RTN","NHINVPSO",155,0)
3552 . S SCH=QT(1),DUR=QT(2),CONJ=QT(6),BEG=QT(3),END=QT(4)
3553"RTN","NHINVPSO",156,0)
3554 . S RTE=$$GET1^DIQ(52.413,I_","_+ID_",","10:1")
3555"RTN","NHINVPSO",157,0)
3556 . S MED("dose",I)=DOSE_U_UNIT_U_UD_U_NOUN_U_RTE_U_SCH_U_DUR_U_CONJ_U_BEG_U_END
3557"RTN","NHINVPSO",158,0)
3558 Q
3559"RTN","NHINVPSO",159,0)
3560 ;
3561"RTN","NHINVPSO",160,0)
3562STOP(BEG,X) ; -- Return date after adding X to BEG
3563"RTN","NHINVPSO",161,0)
3564 N D,H,M,S,UNT,Y
3565"RTN","NHINVPSO",162,0)
3566 S Y=BEG,(D,H,M,S)=0,UNT=$P(X," ",2),X=+X
3567"RTN","NHINVPSO",163,0)
3568 S:UNT?1"MON".E D=30*X
3569"RTN","NHINVPSO",164,0)
3570 S:UNT?1"WEE".E D=7*X
3571"RTN","NHINVPSO",165,0)
3572 S:UNT?1"DAY".E D=X
3573"RTN","NHINVPSO",166,0)
3574 S:UNT?1"HOU".E H=X
3575"RTN","NHINVPSO",167,0)
3576 S:UNT?1"MIN".E M=X
3577"RTN","NHINVPSO",168,0)
3578 S:UNT?1"SEC".E S=X
3579"RTN","NHINVPSO",169,0)
3580 S Y=$$FMADD^XLFDT(BEG,D,H,M,S)
3581"RTN","NHINVPSO",170,0)
3582 Q Y
3583"RTN","NHINVPSO",171,0)
3584 ;
3585"RTN","NHINVPSO",172,0)
3586NVA(ID,MED) ; -- return a non-VA med in MED("attribute")=value
3587"RTN","NHINVPSO",173,0)
3588 N NVA,NHZ,ORIFN,DOSE,X K MED
3589"RTN","NHINVPSO",174,0)
3590 D GETS^DIQ(55.05,+ID_","_DFN_",",".01:8;11:13","IE","NHZ")
3591"RTN","NHINVPSO",175,0)
3592 M NVA=NHZ(55.05,+ID_","_DFN_",") K NHZ
3593"RTN","NHINVPSO",176,0)
3594 S MED("id")=ID,MED("type")="OTC",MED("vaType")="N"
3595"RTN","NHINVPSO",177,0)
3596 S ORIFN=+NVA(7,"I") S:ORIFN MED("orderID")=ORIFN
3597"RTN","NHINVPSO",178,0)
3598 I NVA(.01,"I") D ;orderable item
3599"RTN","NHINVPSO",179,0)
3600 . N FORM
3601"RTN","NHINVPSO",180,0)
3602 . S X=NVA(.01,"I") D ZERO^PSS50P7(+X,,,"PSOI")
3603"RTN","NHINVPSO",181,0)
3604 . S FORM=$P($G(^TMP($J,"PSOI",+X,.02)),U,2),MED("form")=FORM
3605"RTN","NHINVPSO",182,0)
3606 . S MED("name")=NVA(.01,"E")_" "_FORM
3607"RTN","NHINVPSO",183,0)
3608 S X=NVA(1,"I") D:X NDF^NHINVPS(+X) ;dispense drug
3609"RTN","NHINVPSO",184,0)
3610 S MED("sig")=NVA(2,"E")_" BY "_NVA(3,"E")_" "_NVA(4,"E")
3611"RTN","NHINVPSO",185,0)
3612 S X=NVA(2,"I"),NVA(2,"I")=+X_U_$P(X,+X,2) ;amt^unit
3613"RTN","NHINVPSO",186,0)
3614 S DOSE=NVA(2,"I")_"^^" I ORIFN D ;reformat from order
3615"RTN","NHINVPSO",187,0)
3616 . S X=$$VALUE^ORX8(ORIFN,"ROUTE") S:X NVA(3,"E")=$$GET1^DIQ(51.2,+X_",",1)
3617"RTN","NHINVPSO",188,0)
3618 . S X=$$VALUE^ORX8(ORIFN,"SCHEDULE") S:$L(X) NVA(4,"E")=X
3619"RTN","NHINVPSO",189,0)
3620 . S X=$$VALUE^ORX8(ORIFN,"DOSE"),DOSE=$TR($P(X,"&",1,4),"&","^")
3621"RTN","NHINVPSO",190,0)
3622 S MED("dose",1)=DOSE_U_NVA(3,"E")_U_NVA(4,"E")
3623"RTN","NHINVPSO",191,0)
3624 S:NVA(8,"I") MED("start")=NVA(8,"I")
3625"RTN","NHINVPSO",192,0)
3626 S:NVA(6,"I") MED("stop")=NVA(6,"I")
3627"RTN","NHINVPSO",193,0)
3628 S:NVA(11,"I") MED("ordered")=NVA(11,"I")
3629"RTN","NHINVPSO",194,0)
3630 S MED("status")=$S($G(NVA(5,"E")):"not active",1:"active")
3631"RTN","NHINVPSO",195,0)
3632 S:NVA(12,"I") MED("orderingProvider")=NVA(12,"I")_U_NVA(12,"E")
3633"RTN","NHINVPSO",196,0)
3634 S:NVA(13,"I") MED("location")=NVA(13,"I")_U_NVA(13,"E")
3635"RTN","NHINVPSO",197,0)
3636 S MED("facility")=$$FAC^NHINV(NVA(13,"I"))
3637"RTN","NHINVPSO",198,0)
3638 K ^TMP($J,"PSOI"),^TMP($J,"NDF")
3639"RTN","NHINVPSO",199,0)
3640 Q
3641"RTN","NHINVPSO",200,0)
3642 ;
3643"RTN","NHINVPSO",201,0)
3644ACTIVE(X) ; -- return 1 or 0, if X is an active status
3645"RTN","NHINVPSO",202,0)
3646 N Y S Y=1
3647"RTN","NHINVPSO",203,0)
3648 I X="PURGE" S Y=0
3649"RTN","NHINVPSO",204,0)
3650 I X="DELETED" S Y=0
3651"RTN","NHINVPSO",205,0)
3652 I X="EXPIRED" S Y=0 ;keep, to renew?
3653"RTN","NHINVPSO",206,0)
3654 I $P(X," ")="DISCONTINUED" S Y=0
3655"RTN","NHINVPSO",207,0)
3656 Q Y
3657"RTN","NHINVPT")
36580^25^B59592091^n/a
3659"RTN","NHINVPT",1,0)
3660NHINVPT ;SLC/MKB -- Patient demographics extract
3661"RTN","NHINVPT",2,0)
3662 ;;1.0;NHIN;**1**;Dec 01, 2009;Build 11
3663"RTN","NHINVPT",3,0)
3664 ;
3665"RTN","NHINVPT",4,0)
3666 ; External References DBIA#
3667"RTN","NHINVPT",5,0)
3668 ; ------------------- -----
3669"RTN","NHINVPT",6,0)
3670 ; ^DIC(42 10039
3671"RTN","NHINVPT",7,0)
3672 ; ^DPT 10035
3673"RTN","NHINVPT",8,0)
3674 ; DGCV 4156
3675"RTN","NHINVPT",9,0)
3676 ; DGMSTAPI 2716
3677"RTN","NHINVPT",10,0)
3678 ; DGNTAPI 3457
3679"RTN","NHINVPT",11,0)
3680 ; DGPFAPI 3860
3681"RTN","NHINVPT",12,0)
3682 ; DILFD 2055
3683"RTN","NHINVPT",13,0)
3684 ; DIQ 2056
3685"RTN","NHINVPT",14,0)
3686 ; MPIF001 2701
3687"RTN","NHINVPT",15,0)
3688 ; SDUTL3 1252
3689"RTN","NHINVPT",16,0)
3690 ; VADPT 10061
3691"RTN","NHINVPT",17,0)
3692 ; VAFCTFU1 2990
3693"RTN","NHINVPT",18,0)
3694 ; VASITE 10112
3695"RTN","NHINVPT",19,0)
3696 ; XUAF4 2171
3697"RTN","NHINVPT",20,0)
3698 ;
3699"RTN","NHINVPT",21,0)
3700 ; ------------ Get data from VistA ------------
3701"RTN","NHINVPT",22,0)
3702 ;
3703"RTN","NHINVPT",23,0)
3704EN(DFN,BEG,END,MAX,ID) ; -- find current patient demographics
3705"RTN","NHINVPT",24,0)
3706 ; [BEG,END,MAX,ID not currently used]
3707"RTN","NHINVPT",25,0)
3708 S DFN=+$G(DFN) Q:DFN<1 ;invalid patient
3709"RTN","NHINVPT",26,0)
3710 N PAT,SYS S SYS=$$SITE^VASITE
3711"RTN","NHINVPT",27,0)
3712 D DEM,SVC,PRF,ATC,SUPP,ALIAS,FAC
3713"RTN","NHINVPT",28,0)
3714 I $D(PAT)>9 D XML(.PAT)
3715"RTN","NHINVPT",29,0)
3716 Q
3717"RTN","NHINVPT",30,0)
3718 ;
3719"RTN","NHINVPT",31,0)
3720DEM ;-demographic data
3721"RTN","NHINVPT",32,0)
3722 N VADM,VA,VAERR,X
3723"RTN","NHINVPT",33,0)
3724 S X=+$$GETICN^MPIF001(DFN) S:X>1 PAT("icn")=X
3725"RTN","NHINVPT",34,0)
3726 D DEM^VADPT S X=VADM(1),PAT("fullName")=X
3727"RTN","NHINVPT",35,0)
3728 S PAT("familyName")=$P(X,","),PAT("givenNames")=$P(X,",",2,99)
3729"RTN","NHINVPT",36,0)
3730 S PAT("ssn")=$P(VADM(2),U),PAT("id")=DFN
3731"RTN","NHINVPT",37,0)
3732 S:$D(VA("BID")) PAT("bid")=$E(X)_VA("BID")
3733"RTN","NHINVPT",38,0)
3734 S PAT("dob")=+$P($P(VADM(3),U),".")
3735"RTN","NHINVPT",39,0)
3736 S PAT("gender")=$P(VADM(5),U)
3737"RTN","NHINVPT",40,0)
3738 S PAT("lrdfn")=+$G(^DPT(DFN,"LR"))
3739"RTN","NHINVPT",41,0)
3740 S X=+$P($P(VADM(6),U),".") S:X PAT("died")=X
3741"RTN","NHINVPT",42,0)
3742 S X=$$GET1^DIQ(38.1,DFN_",",2,"I") S:$L(X) PAT("sensitive")=X
3743"RTN","NHINVPT",43,0)
3744 S X=+VADM(9) S:X PAT("religion")=X
3745"RTN","NHINVPT",44,0)
3746 S X=$P(VADM(10),U,2) S:$L(X) PAT("maritalStatus")=$E(X)
3747"RTN","NHINVPT",45,0)
3748 I VADM(11) D
3749"RTN","NHINVPT",46,0)
3750 . N I S I=0
3751"RTN","NHINVPT",47,0)
3752 . F S I=$O(VADM(11,I)) Q:I<1 S X=+VADM(11,I),PAT("ethnicity",X)=$$GET1^DIQ(10.2,X_",",4)
3753"RTN","NHINVPT",48,0)
3754 I VADM(12) D
3755"RTN","NHINVPT",49,0)
3756 . N I S I=0
3757"RTN","NHINVPT",50,0)
3758 . F S I=$O(VADM(12,I)) Q:I<1 S X=+VADM(12,I),PAT("race",X)=$$GET1^DIQ(10,X_",",4)
3759"RTN","NHINVPT",51,0)
3760 Q
3761"RTN","NHINVPT",52,0)
3762SVC ;-service data
3763"RTN","NHINVPT",53,0)
3764 N VAEL,VASV,VAERR,X,Y,I,AO,IR,PGF,HNC,MST,CV
3765"RTN","NHINVPT",54,0)
3766 D 7^VADPT
3767"RTN","NHINVPT",55,0)
3768 S PAT("veteran")=VAEL(4)
3769"RTN","NHINVPT",56,0)
3770 S PAT("sc")=+VAEL(3) S:VAEL(3) PAT("scPercent")=+$P(VAEL(3),U,2)
3771"RTN","NHINVPT",57,0)
3772 ;
3773"RTN","NHINVPT",58,0)
3774 ; exposures
3775"RTN","NHINVPT",59,0)
3776 S AO=VASV(2),IR=VASV(3)
3777"RTN","NHINVPT",60,0)
3778 S X=$P($G(^DPT(DFN,.322)),U,10),PGF=$S(X="Y":1,X="N":0,1:"")
3779"RTN","NHINVPT",61,0)
3780 S X=$$GETCUR^DGNTAPI(DFN,"HNC"),X=+($G(HNC("STAT")))
3781"RTN","NHINVPT",62,0)
3782 S HNC=$S(X=4:1,X=5:1,X=1:0,X=6:0,1:"")
3783"RTN","NHINVPT",63,0)
3784 S X=$P($$GETSTAT^DGMSTAPI(DFN),U,2),MST=$S(X="Y":1,X="N":0,1:"")
3785"RTN","NHINVPT",64,0)
3786 S X=$$CVEDT^DGCV(DFN),CV=$S(+X<0:"",+X=0:0,$P(X,U,3):1,1:0)
3787"RTN","NHINVPT",65,0)
3788 S PAT("exposures")=AO_U_IR_U_PGF_U_HNC_U_MST_U_CV
3789"RTN","NHINVPT",66,0)
3790 ;
3791"RTN","NHINVPT",67,0)
3792 ; rated disabilities [see DGRPDB]
3793"RTN","NHINVPT",68,0)
3794 S I=0 F S I=$O(^DPT(DFN,.372,I)) Q:I<1 D
3795"RTN","NHINVPT",69,0)
3796 . N DIS S DIS=$G(^DPT(DFN,.372,I,0))
3797"RTN","NHINVPT",70,0)
3798 . S Y=$$GET1^DIQ(31,+DIS_",",.01)
3799"RTN","NHINVPT",71,0)
3800 . S PAT("disability",+DIS)=Y_U_$P(DIS,U,2,3) ;name^%^sc
3801"RTN","NHINVPT",72,0)
3802 Q
3803"RTN","NHINVPT",73,0)
3804PRF ;-patient record flags
3805"RTN","NHINVPT",74,0)
3806 N NHINPF,I,NAME,TEXT
3807"RTN","NHINVPT",75,0)
3808 Q:'$$GETACT^DGPFAPI(DFN,"NHINPF")
3809"RTN","NHINVPT",76,0)
3810 S I=0 F S I=$O(NHINPF(I)) Q:I<1 D
3811"RTN","NHINVPT",77,0)
3812 . S NAME=$P(NHINPF(I,"FLAG"),U,2)
3813"RTN","NHINVPT",78,0)
3814 . M TEXT=NHINPF(I,"NARR")
3815"RTN","NHINVPT",79,0)
3816 . S PAT("flag",I)=NAME_U_$$STRING^NHINV(.TEXT)
3817"RTN","NHINVPT",80,0)
3818 Q
3819"RTN","NHINVPT",81,0)
3820ATC ;-address & telecom
3821"RTN","NHINVPT",82,0)
3822 N VAPA,I,X
3823"RTN","NHINVPT",83,0)
3824 S VAPA("P")="" D ADD^VADPT ;permanent address
3825"RTN","NHINVPT",84,0)
3826 S X="" F I=1:1:4 S X=X_VAPA(I)_U
3827"RTN","NHINVPT",85,0)
3828 S X=X_$P(VAPA(5),U,2)_U_$P(VAPA(11),U,2)
3829"RTN","NHINVPT",86,0)
3830 S PAT("address")=X ;street1^st2^st3^city^state^zip
3831"RTN","NHINVPT",87,0)
3832 S X=VAPA(8)_U_$$GET1^DIQ(2,DFN_",",.134)_U_$$GET1^DIQ(2,DFN_",",.132)
3833"RTN","NHINVPT",88,0)
3834 S PAT("telecom")=X ;home^cell^work phones
3835"RTN","NHINVPT",89,0)
3836 Q
3837"RTN","NHINVPT",90,0)
3838SUPP ;-support contacts
3839"RTN","NHINVPT",91,0)
3840 N VAOA,A,I,X,TYPE
3841"RTN","NHINVPT",92,0)
3842 F A="",1 K VAOA D
3843"RTN","NHINVPT",93,0)
3844 . S:A VAOA("A")=A D OAD^VADPT Q:'$L($G(VAOA(9)))
3845"RTN","NHINVPT",94,0)
3846 . S TYPE=$S(A=1:"ECON",1:"NOK")
3847"RTN","NHINVPT",95,0)
3848 . S PAT("support",TYPE)=VAOA(9)_U_VAOA(10) ;name^relationship
3849"RTN","NHINVPT",96,0)
3850 . S X="" F I=1:1:4 S X=X_VAOA(I)_U
3851"RTN","NHINVPT",97,0)
3852 . S X=X_$P(VAOA(5),U,2)_U_$P(VAOA(11),U,2)
3853"RTN","NHINVPT",98,0)
3854 . S PAT("support",TYPE,"address")=X ;street1^st2^st3^city^state^zip
3855"RTN","NHINVPT",99,0)
3856 . S I=$S(A=1:.33011,1:.21011),X=VAOA(8)_U_U_$$GET1^DIQ(2,DFN_",",I)
3857"RTN","NHINVPT",100,0)
3858 . S PAT("support",TYPE,"telecom")=X ;home^cell^work phones
3859"RTN","NHINVPT",101,0)
3860 Q
3861"RTN","NHINVPT",102,0)
3862ALIAS ;-other names used
3863"RTN","NHINVPT",103,0)
3864 N I,X
3865"RTN","NHINVPT",104,0)
3866 S I=0 F S I=$O(^DPT(DFN,.01,I)) Q:I<1 S X=$G(^(I,0)) D
3867"RTN","NHINVPT",105,0)
3868 . S PAT("alias",I)=$P(X,U)
3869"RTN","NHINVPT",106,0)
3870 Q
3871"RTN","NHINVPT",107,0)
3872FAC ;-treating facilities [see FACLIST^ORWCIRN]
3873"RTN","NHINVPT",108,0)
3874 N IFN S DFN=+$G(DFN) Q:DFN<1
3875"RTN","NHINVPT",109,0)
3876 N NHINY,HOME,I,X,IEN
3877"RTN","NHINVPT",110,0)
3878 I $L($T(TFL^VAFCTFU1)) D TFL^VAFCTFU1(.NHINY,DFN)
3879"RTN","NHINVPT",111,0)
3880 I $P($G(NHINY(1)),U)<0 D Q ;not setup
3881"RTN","NHINVPT",112,0)
3882 . S X=$$SITE^VASITE,PAT("facility",+X)=$P(X,U,3)_U_$P(X,U,2)
3883"RTN","NHINVPT",113,0)
3884 S HOME=+$P($G(^DPT(DFN,"MPI")),U,3) ;home facility
3885"RTN","NHINVPT",114,0)
3886 S I=0 F S I=$O(NHINY(I)) Q:I<1 D
3887"RTN","NHINVPT",115,0)
3888 . S X=NHINY(I) Q:$P(X,U)="" ;unknown
3889"RTN","NHINVPT",116,0)
3890 . S IEN=+$$IEN^XUAF4($P(X,U))
3891"RTN","NHINVPT",117,0)
3892 . I +X=776!(+X=200) S $P(X,U,2)="DEPT. OF DEFENSE"
3893"RTN","NHINVPT",118,0)
3894 . S PAT("facility",IEN)=$P(X,U,1,3) ;stn# ^ name ^ last date
3895"RTN","NHINVPT",119,0)
3896 . I IEN=HOME S $P(PAT("facility",IEN),U,4)=1
3897"RTN","NHINVPT",120,0)
3898 Q
3899"RTN","NHINVPT",121,0)
3900 ;
3901"RTN","NHINVPT",122,0)
3902INPT ;-current inpt status data
3903"RTN","NHINVPT",123,0)
3904 N ADM,X
3905"RTN","NHINVPT",124,0)
3906 S ADM=+$G(^DPT(DFN,.105)) I ADM D
3907"RTN","NHINVPT",125,0)
3908 . N VAIN,VAERR,HLOC,SVC
3909"RTN","NHINVPT",126,0)
3910 . D INP^VADPT S PAT("admitted")=ADM_U_+VAIN(7)
3911"RTN","NHINVPT",127,0)
3912 . S PAT("ward")=VAIN(4),PAT("roomBed")=VAIN(5)
3913"RTN","NHINVPT",128,0)
3914 . S HLOC=+$G(^DIC(42,+VAIN(4),44)),SVC=$P($G(^(0)),U,3)
3915"RTN","NHINVPT",129,0)
3916 . S PAT("location")=HLOC_U_$P(VAIN(4),U,2)
3917"RTN","NHINVPT",130,0)
3918 . S:$L(SVC) PAT("locSvc")=SVC_U_$$EXTERNAL^DILFD(42,.03,,SVC)
3919"RTN","NHINVPT",131,0)
3920 . S PAT("specialty")=VAIN(3)
3921"RTN","NHINVPT",132,0)
3922 . S PAT("attending")=VAIN(11)
3923"RTN","NHINVPT",133,0)
3924 . S X=$$FAC^NHINV(HLOC),PAT("site")=X
3925"RTN","NHINVPT",134,0)
3926 S PAT("inpatient")=$S(ADM:"true",1:"false")
3927"RTN","NHINVPT",135,0)
3928 S X=$$OUTPTPR^SDUTL3(DFN) S:X PAT("pcProvider")=X
3929"RTN","NHINVPT",136,0)
3930 S X=$$OUTPTTM^SDUTL3(DFN) S:X PAT("pcTeam")=X
3931"RTN","NHINVPT",137,0)
3932 Q
3933"RTN","NHINVPT",138,0)
3934 ;
3935"RTN","NHINVPT",139,0)
3936 ; ------------ Return data to middle tier ------------
3937"RTN","NHINVPT",140,0)
3938 ;
3939"RTN","NHINVPT",141,0)
3940XML(ITEM) ; -- Return patient data as XML in @NHIN@(n)
3941"RTN","NHINVPT",142,0)
3942 ; as <element code='123' displayName='ABC' />
3943"RTN","NHINVPT",143,0)
3944 N ATT,X,Y,I,ID
3945"RTN","NHINVPT",144,0)
3946 D ADD("<patient>") S NHINTOTL=$G(NHINTOTL)+1
3947"RTN","NHINVPT",145,0)
3948 S ATT="" F S ATT=$O(ITEM(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
3949"RTN","NHINVPT",146,0)
3950 . I ATT="exposures" D:X["1" S Y="" Q
3951"RTN","NHINVPT",147,0)
3952 .. S I=0,Y="<exposures>" D ADD(Y)
3953"RTN","NHINVPT",148,0)
3954 .. 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)
3955"RTN","NHINVPT",149,0)
3956 .. D ADD("</exposures>")
3957"RTN","NHINVPT",150,0)
3958 . I $L($O(ITEM(ATT,""))) D Q ;multiples
3959"RTN","NHINVPT",151,0)
3960 .. 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")
3961"RTN","NHINVPT",152,0)
3962 .. D ADD("<"_ID_">")
3963"RTN","NHINVPT",153,0)
3964 .. S I="" F S I=$O(ITEM(ATT,I)) Q:I="" D D:$L(Y) ADD(Y)
3965"RTN","NHINVPT",154,0)
3966 ... S X=ITEM(ATT,I),Y="<"_ATT_" "
3967"RTN","NHINVPT",155,0)
3968 ... I ATT="support" D S Y="" Q
3969"RTN","NHINVPT",156,0)
3970 .... 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)
3971"RTN","NHINVPT",157,0)
3972 .... S X=$G(ITEM(ATT,I,"address")) I $L(X) D ADDR(X)
3973"RTN","NHINVPT",158,0)
3974 .... S X=$G(ITEM(ATT,I,"telecom")) I $L(X) D PHONE(X)
3975"RTN","NHINVPT",159,0)
3976 .... D ADD("</support>")
3977"RTN","NHINVPT",160,0)
3978 ... 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
3979"RTN","NHINVPT",161,0)
3980 ... I ATT="flag" S Y=Y_"name='"_$$ESC^NHINV($P(X,U))_"' text='"_$$ESC^NHINV($P(X,U,2))_"' />" Q
3981"RTN","NHINVPT",162,0)
3982 ... 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
3983"RTN","NHINVPT",163,0)
3984 ... 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
3985"RTN","NHINVPT",164,0)
3986 ... S Y=Y_"value='"_$$ESC^NHINV(ITEM(ATT,I))_"' />"
3987"RTN","NHINVPT",165,0)
3988 .. D ADD("</"_ID_">") S Y=""
3989"RTN","NHINVPT",166,0)
3990 . S X=$G(ITEM(ATT)),Y="" Q:'$L(X)
3991"RTN","NHINVPT",167,0)
3992 . I ATT="address" D ADDR(X) S Y="" Q
3993"RTN","NHINVPT",168,0)
3994 . I ATT="telecom" D PHONE(X) S Y="" Q
3995"RTN","NHINVPT",169,0)
3996 . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
3997"RTN","NHINVPT",170,0)
3998 . S Y="<"_ATT_" code='"_$P(X,U)_"' name='"_$$ESC^NHINV($P(X,U,2))_"' />"
3999"RTN","NHINVPT",171,0)
4000 D ADD("</patient>")
4001"RTN","NHINVPT",172,0)
4002 Q
4003"RTN","NHINVPT",173,0)
4004 ;
4005"RTN","NHINVPT",174,0)
4006ADDR(X) ; -- XML address node from X=street1^st2^st3^city^state^zip
4007"RTN","NHINVPT",175,0)
4008 N I,Y Q:$L(X)'>5 ;no data
4009"RTN","NHINVPT",176,0)
4010 S Y="<address"
4011"RTN","NHINVPT",177,0)
4012 F I=1,2,3 I $L($P(X,U,I)) S Y=Y_" streetLine"_I_"='"_$$ESC^NHINV($P(X,U,I))_"'"
4013"RTN","NHINVPT",178,0)
4014 I $L($P(X,U,4)) S Y=Y_" city='"_$$ESC^NHINV($P(X,U,4))_"'"
4015"RTN","NHINVPT",179,0)
4016 I $L($P(X,U,5)) S Y=Y_" stateProvince='"_$P(X,U,5)_"'"
4017"RTN","NHINVPT",180,0)
4018 I $L($P(X,U,6)) S Y=Y_" postalCode='"_$P(X,U,6)_"'"
4019"RTN","NHINVPT",181,0)
4020 S Y=Y_" />" D ADD(Y)
4021"RTN","NHINVPT",182,0)
4022 Q
4023"RTN","NHINVPT",183,0)
4024 ;
4025"RTN","NHINVPT",184,0)
4026PHONE(X) ; -- XML telecom node from X=home^cell^work numbers
4027"RTN","NHINVPT",185,0)
4028 N I,Y Q:$L(X)'>2 ;no data
4029"RTN","NHINVPT",186,0)
4030 D ADD("<telecomList>")
4031"RTN","NHINVPT",187,0)
4032 I $L($P(X,U,1)) S Y="<telecom usageType='H' value='"_$P(X,U,1)_"' />" D ADD(Y)
4033"RTN","NHINVPT",188,0)
4034 I $L($P(X,U,2)) S Y="<telecom usageType='MC' value='"_$P(X,U,2)_"' />" D ADD(Y)
4035"RTN","NHINVPT",189,0)
4036 I $L($P(X,U,3)) S Y="<telecom usageType='WP' value='"_$P(X,U,3)_"' />" D ADD(Y)
4037"RTN","NHINVPT",190,0)
4038 D ADD("</telecomList>")
4039"RTN","NHINVPT",191,0)
4040 Q
4041"RTN","NHINVPT",192,0)
4042 ;
4043"RTN","NHINVPT",193,0)
4044ADD(X) ; Add a line @NHIN@(n)=X
4045"RTN","NHINVPT",194,0)
4046 S NHINI=$G(NHINI)+1
4047"RTN","NHINVPT",195,0)
4048 S @NHIN@(NHINI)=X
4049"RTN","NHINVPT",196,0)
4050 Q
4051"RTN","NHINVRA")
40520^11^B18363736^n/a
4053"RTN","NHINVRA",1,0)
4054NHINVRA ;SLC/MKB -- Radiology extract
4055"RTN","NHINVRA",2,0)
4056 ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
4057"RTN","NHINVRA",3,0)
4058 ;
4059"RTN","NHINVRA",4,0)
4060 ; External References DBIA#
4061"RTN","NHINVRA",5,0)
4062 ; ------------------- -----
4063"RTN","NHINVRA",6,0)
4064 ; ^SC( 10040
4065"RTN","NHINVRA",7,0)
4066 ; ^VA(200 10060
4067"RTN","NHINVRA",8,0)
4068 ; DIQ 2056
4069"RTN","NHINVRA",9,0)
4070 ; ICPTCOD 1995
4071"RTN","NHINVRA",10,0)
4072 ; RAO7PC1 2043
4073"RTN","NHINVRA",11,0)
4074 ; RAO7PC3 2877
4075"RTN","NHINVRA",12,0)
4076 ;
4077"RTN","NHINVRA",13,0)
4078 ; ------------ Get exam(s) from VistA ------------
4079"RTN","NHINVRA",14,0)
4080 ;
4081"RTN","NHINVRA",15,0)
4082EN(DFN,BEG,END,MAX,ID) ; -- find patient's radiology exams
4083"RTN","NHINVRA",16,0)
4084 N NHITM,NHICNT,NHXID
4085"RTN","NHINVRA",17,0)
4086 S DFN=+$G(DFN) Q:DFN<1
4087"RTN","NHINVRA",18,0)
4088 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
4089"RTN","NHINVRA",19,0)
4090 K ^TMP($J,"RAE1") D EN1^RAO7PC1(DFN,BEG,END,MAX)
4091"RTN","NHINVRA",20,0)
4092 ;
4093"RTN","NHINVRA",21,0)
4094 ; get exam(s)
4095"RTN","NHINVRA",22,0)
4096 I $G(ID) D EN1(ID,.NHITM),XML(.NHITM) Q
4097"RTN","NHINVRA",23,0)
4098 ;
4099"RTN","NHINVRA",24,0)
4100 ; get all exams
4101"RTN","NHINVRA",25,0)
4102 S NHICNT=0,NHXID=""
4103"RTN","NHINVRA",26,0)
4104 F S NHXID=$O(^TMP($J,"RAE1",DFN,NHXID)) Q:NHXID="" D Q:NHICNT'<MAX
4105"RTN","NHINVRA",27,0)
4106 . K NHITM D EN1(NHXID,.NHITM) Q:'$D(NHITM)
4107"RTN","NHINVRA",28,0)
4108 . D XML(.NHITM) S NHICNT=NHICNT+1
4109"RTN","NHINVRA",29,0)
4110 K ^TMP($J,"RAE1")
4111"RTN","NHINVRA",30,0)
4112 Q
4113"RTN","NHINVRA",31,0)
4114 ;
4115"RTN","NHINVRA",32,0)
4116EN1(ID,EXM) ; -- return an exam in EXM("attribute")=value
4117"RTN","NHINVRA",33,0)
4118 ; Expects ^TMP($J,"RAE1",DFN,ID) from EN1^RAO7PC1
4119"RTN","NHINVRA",34,0)
4120 N VPRN,VPR,X0,DATE,LOC,X,Y,IENS,NHMOD K EXM
4121"RTN","NHINVRA",35,0)
4122 S X0=$G(^TMP($J,"RAE1",DFN,ID))
4123"RTN","NHINVRA",36,0)
4124 S EXM("id")=ID,EXM("name")=$P(X0,U),EXM("case")=$P(X0,U,2)
4125"RTN","NHINVRA",37,0)
4126 S DATE=9999999.9999-+ID,EXM("dateTime")=DATE
4127"RTN","NHINVRA",38,0)
4128 I $P(X0,U,5) S EXM("document",1)=ID_U_$P(X0,U)_"^^"_$P(X0,U,3) ;id^localTitle^^status, if rpt exists
4129"RTN","NHINVRA",39,0)
4130 S:$L($P(X0,U,6)) EXM("status")=$P($P(X0,U,6),"~",2)
4131"RTN","NHINVRA",40,0)
4132 S X=$P(X0,U,7),LOC="" I $L(X) D
4133"RTN","NHINVRA",41,0)
4134 . S LOC=+$O(^SC("B",X,0)),EXM("location")=LOC_U_X
4135"RTN","NHINVRA",42,0)
4136 S EXM("facility")=$$FAC^NHINV(LOC)
4137"RTN","NHINVRA",43,0)
4138 I $L($P(X0,U,8)) S X=$TR($P(X0,U,8),"~","^"),EXM("imagingType")=X
4139"RTN","NHINVRA",44,0)
4140 S IENS=$P(ID,"-",2)_","_+ID_","_DFN_","
4141"RTN","NHINVRA",45,0)
4142 S X=$P(X0,U,10) I X D
4143"RTN","NHINVRA",46,0)
4144 . S EXM("type")=$$CPT(X)
4145"RTN","NHINVRA",47,0)
4146 . I $D(^TMP($J,"RAE1",DFN,ID,"CMOD")) M EXM("modifier")=^("CMOD")
4147"RTN","NHINVRA",48,0)
4148 S EXM("hasImages")=$S($P(X0,U,12)="Y":1,1:0)
4149"RTN","NHINVRA",49,0)
4150 I $P(X0,U,4)="Y"!($P(X0,U,9)="Y") S EXM("interpretation")="ABNORMAL"
4151"RTN","NHINVRA",50,0)
4152 S EXM("encounter")=$$GET1^DIQ(70.03,IENS,27,"I")
4153"RTN","NHINVRA",51,0)
4154 S X=$$GET1^DIQ(70.03,IENS,15,"I") ;S:'X X=$$GET1^DIQ(70.03,IENS,12,"I")
4155"RTN","NHINVRA",52,0)
4156 I X S EXM("provider")=X_U_$P($G(^VA(200,X,0)),U)
4157"RTN","NHINVRA",53,0)
4158 S EXM("category")="RA"
4159"RTN","NHINVRA",54,0)
4160 Q
4161"RTN","NHINVRA",55,0)
4162 ;
4163"RTN","NHINVRA",56,0)
4164CPT(IEN) ; -- return code^description for CPT code, or "^" if error
4165"RTN","NHINVRA",57,0)
4166 N X0,NHX,N,I,X,Y S IEN=+$G(IEN)
4167"RTN","NHINVRA",58,0)
4168 S X0=$$CPT^ICPTCOD(IEN) I X0<0 Q "^"
4169"RTN","NHINVRA",59,0)
4170 S Y=$P(X0,U,2,3) ;CPT Code^Short Name
4171"RTN","NHINVRA",60,0)
4172 S N=$$CPTD^ICPTCOD($P(Y,U),"NHX") ;CPT Description
4173"RTN","NHINVRA",61,0)
4174 I N>0,$L($G(NHX(1))) D
4175"RTN","NHINVRA",62,0)
4176 . S X=$G(NHX(1)),I=1
4177"RTN","NHINVRA",63,0)
4178 . F S I=$O(NHX(I)) Q:I<1 Q:NHX(I)=" " S X=X_" "_NHX(I)
4179"RTN","NHINVRA",64,0)
4180 . S $P(Y,U,2)=X
4181"RTN","NHINVRA",65,0)
4182 Q Y
4183"RTN","NHINVRA",66,0)
4184 ;
4185"RTN","NHINVRA",67,0)
4186RPT(DFN,ID,RPT) ; -- return report as a TIU document
4187"RTN","NHINVRA",68,0)
4188 S DFN=+$G(DFN),ID=$G(ID) Q:DFN<1 Q:ID<1
4189"RTN","NHINVRA",69,0)
4190 N EXAM,CASE,PROC,X0,I,X,Y,IENS
4191"RTN","NHINVRA",70,0)
4192 S EXAM=DFN_U_$TR(ID,"-","^") D
4193"RTN","NHINVRA",71,0)
4194 . N DFN D EN3^RAO7PC3(EXAM)
4195"RTN","NHINVRA",72,0)
4196 S CASE=$O(^TMP($J,"RAE3",DFN,0)),PROC=$O(^(CASE,"")),X0=$G(^(PROC))
4197"RTN","NHINVRA",73,0)
4198 S I=$O(^TMP($J,"RAE3",DFN,CASE,PROC,0)),Y=$G(^(I))
4199"RTN","NHINVRA",74,0)
4200 F S I=$O(^TMP($J,"RAE3",DFN,CASE,PROC,I)) Q:I<1 S X=^(I),Y=Y_$C(13,10)_X
4201"RTN","NHINVRA",75,0)
4202 S RPT("id")=ID,RPT("content")=Y
4203"RTN","NHINVRA",76,0)
4204 S X=9999999.9999-(+ID),RPT("referenceDateTime")=X
4205"RTN","NHINVRA",77,0)
4206 S RPT("localTitle")=PROC,RPT("status")=$P(X0,U)
4207"RTN","NHINVRA",78,0)
4208 S IENS=+ID_","_DFN_",",X=$$GET1^DIQ(70.02,IENS,4,"I")
4209"RTN","NHINVRA",79,0)
4210 S RPT("facility")=$$FAC^NHINV(X)
4211"RTN","NHINVRA",80,0)
4212 S IENS=$P(ID,"-",2)_","_IENS
4213"RTN","NHINVRA",81,0)
4214 S RPT("encounter")=$$GET1^DIQ(70.03,IENS,27,"I")
4215"RTN","NHINVRA",82,0)
4216 S X=$$GET1^DIQ(70.03,IENS,15,"I") S:'X X=$$GET1^DIQ(70.03,IENS,12,"I")
4217"RTN","NHINVRA",83,0)
4218 I X S RPT("clinician",1)=X_U_$P($G(^VA(200,X,0)),U)
4219"RTN","NHINVRA",84,0)
4220 K ^TMP($J,"RAE3",DFN)
4221"RTN","NHINVRA",85,0)
4222 Q
4223"RTN","NHINVRA",86,0)
4224 ;
4225"RTN","NHINVRA",87,0)
4226 ; ------------ Return data to middle tier ------------
4227"RTN","NHINVRA",88,0)
4228 ;
4229"RTN","NHINVRA",89,0)
4230XML(EXM) ; -- Return exams as XML
4231"RTN","NHINVRA",90,0)
4232 N ATT,X,Y,NAMES
4233"RTN","NHINVRA",91,0)
4234 D ADD("<radiology>") S NHINTOTL=$G(NHINTOTL)+1
4235"RTN","NHINVRA",92,0)
4236 S ATT="" F S ATT=$O(EXM(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
4237"RTN","NHINVRA",93,0)
4238 . S NAMES=$S(ATT="document":"id^localTitle^nationalTitle^status^Z",1:"code^name^Z")
4239"RTN","NHINVRA",94,0)
4240 . I $O(EXM(ATT,0)) D S Y="" Q ;multiples
4241"RTN","NHINVRA",95,0)
4242 .. D ADD("<"_ATT_"s>")
4243"RTN","NHINVRA",96,0)
4244 .. S I=0 F S I=$O(EXM(ATT,I)) Q:I<1 D
4245"RTN","NHINVRA",97,0)
4246 ... S X=$G(EXM(ATT,I))
4247"RTN","NHINVRA",98,0)
4248 ... S Y="<"_ATT_" "_$$LOOP_"/>" D ADD(Y)
4249"RTN","NHINVRA",99,0)
4250 .. D ADD("</"_ATT_"s>")
4251"RTN","NHINVRA",100,0)
4252 . S X=$G(EXM(ATT)),Y="" Q:'$L(X)
4253"RTN","NHINVRA",101,0)
4254 . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
4255"RTN","NHINVRA",102,0)
4256 . I $L(X)>1 S Y="<"_ATT_" "_$$LOOP_"/>"
4257"RTN","NHINVRA",103,0)
4258 D ADD("</radiology>")
4259"RTN","NHINVRA",104,0)
4260 Q
4261"RTN","NHINVRA",105,0)
4262 ;
4263"RTN","NHINVRA",106,0)
4264LOOP() ; -- build sub-items string from NAMES and X
4265"RTN","NHINVRA",107,0)
4266 N STR,P,TAG S STR=""
4267"RTN","NHINVRA",108,0)
4268 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))_"' "
4269"RTN","NHINVRA",109,0)
4270 Q STR
4271"RTN","NHINVRA",110,0)
4272 ;
4273"RTN","NHINVRA",111,0)
4274ADD(X) ; -- Add a line @NHIN@(n)=X
4275"RTN","NHINVRA",112,0)
4276 S NHINI=$G(NHINI)+1
4277"RTN","NHINVRA",113,0)
4278 S @NHIN@(NHINI)=X
4279"RTN","NHINVRA",114,0)
4280 Q
4281"RTN","NHINVSIT")
42820^15^B60599762^n/a
4283"RTN","NHINVSIT",1,0)
4284NHINVSIT ;SLC/MKB -- Visit/Encounter extract
4285"RTN","NHINVSIT",2,0)
4286 ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
4287"RTN","NHINVSIT",3,0)
4288 ;
4289"RTN","NHINVSIT",4,0)
4290 ; External References DBIA#
4291"RTN","NHINVSIT",5,0)
4292 ; ------------------- -----
4293"RTN","NHINVSIT",6,0)
4294 ; ^AUPNVSIT 2028
4295"RTN","NHINVSIT",7,0)
4296 ; ^DIC(40.7 557
4297"RTN","NHINVSIT",8,0)
4298 ; ^DIC(42 10039
4299"RTN","NHINVSIT",9,0)
4300 ; ^SC 10040
4301"RTN","NHINVSIT",10,0)
4302 ; ^SCE 2065
4303"RTN","NHINVSIT",11,0)
4304 ; ^VA(200 10060
4305"RTN","NHINVSIT",12,0)
4306 ; DIC 2051
4307"RTN","NHINVSIT",13,0)
4308 ; DIQ 2056
4309"RTN","NHINVSIT",14,0)
4310 ; ICDCODE 3990
4311"RTN","NHINVSIT",15,0)
4312 ; ICPTCOD 1995
4313"RTN","NHINVSIT",16,0)
4314 ; PXAPI,^TMP("PXKENC",$J 1894,1895
4315"RTN","NHINVSIT",17,0)
4316 ; VADPT 10061
4317"RTN","NHINVSIT",18,0)
4318 ; XUAF4 2171
4319"RTN","NHINVSIT",19,0)
4320 ;
4321"RTN","NHINVSIT",20,0)
4322 ; ------------ Get encounter(s) from VistA ------------
4323"RTN","NHINVSIT",21,0)
4324 ;
4325"RTN","NHINVSIT",22,0)
4326EN(DFN,BEG,END,MAX,ID) ; -- find patient's visits and appointments
4327"RTN","NHINVSIT",23,0)
4328 N NHICNT,NHITM,NHDT,NHLOC,NHDA
4329"RTN","NHINVSIT",24,0)
4330 S DFN=+$G(DFN) Q:DFN<1
4331"RTN","NHINVSIT",25,0)
4332 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
4333"RTN","NHINVSIT",26,0)
4334 ;
4335"RTN","NHINVSIT",27,0)
4336 ; get one visit
4337"RTN","NHINVSIT",28,0)
4338 I $G(ID) D EN1(ID,.NHITM),XML(.NHITM) Q
4339"RTN","NHINVSIT",29,0)
4340 ;
4341"RTN","NHINVSIT",30,0)
4342 ; -- get all visits
4343"RTN","NHINVSIT",31,0)
4344 I END,END'["." S END=END_".24" ;assume end of day
4345"RTN","NHINVSIT",32,0)
4346 S NHICNT=0
4347"RTN","NHINVSIT",33,0)
4348 ;F S IDX=$Q(@IDX,-1) Q:DFN'=$P(IDX,",",2) Q:$P(IDX,",",3)<BEG I $P(IDX,",",5)["P" D
4349"RTN","NHINVSIT",34,0)
4350 S NHDT=END F S NHDT=$O(^AUPNVSIT("AET",DFN,NHDT),-1) Q:NHDT<BEG D Q:NHICNT'<MAX
4351"RTN","NHINVSIT",35,0)
4352 . S NHLOC=0 F S NHLOC=$O(^AUPNVSIT("AET",DFN,NHDT,NHLOC)) Q:NHLOC<1 D
4353"RTN","NHINVSIT",36,0)
4354 .. S NHDA=0 F S NHDA=$O(^AUPNVSIT("AET",DFN,NHDT,NHLOC,"P",NHDA)) Q:NHDA<1 D
4355"RTN","NHINVSIT",37,0)
4356 ... K NHITM D EN1(NHDA,.NHITM) Q:'$D(NHITM)
4357"RTN","NHINVSIT",38,0)
4358 ... D XML(.NHITM) S NHICNT=NHICNT+1
4359"RTN","NHINVSIT",39,0)
4360 Q
4361"RTN","NHINVSIT",40,0)
4362 ;
4363"RTN","NHINVSIT",41,0)
4364ENAA(DFN,BEG,END,MAX,ID) ; -- find patient's visits and appointments [AA]
4365"RTN","NHINVSIT",42,0)
4366 N IDT,DA,NHICNT,NHITM
4367"RTN","NHINVSIT",43,0)
4368 S DFN=+$G(DFN) Q:DFN<1
4369"RTN","NHINVSIT",44,0)
4370 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
4371"RTN","NHINVSIT",45,0)
4372 I $G(ID) D EN1(ID,.NHITM),XML(.NHITM) Q ;one visit
4373"RTN","NHINVSIT",46,0)
4374 D IDT S NHICNT=0
4375"RTN","NHINVSIT",47,0)
4376 S IDT=BEG F S IDT=$O(^AUPNVSIT("AA",DFN,IDT)) Q:IDT<1!(IDT>END) D Q:NHICNT'<MAX
4377"RTN","NHINVSIT",48,0)
4378 . S DA=0 F S DA=$O(^AUPNVSIT("AA",DFN,IDT,DA)) Q:DA<1 D
4379"RTN","NHINVSIT",49,0)
4380 .. K NHITM D EN1(DA,.NHITM) Q:'$D(NHITM)
4381"RTN","NHINVSIT",50,0)
4382 .. D XML(.NHITM) S NHICNT=NHICNT+1
4383"RTN","NHINVSIT",51,0)
4384 Q
4385"RTN","NHINVSIT",52,0)
4386IDT ; -- invert BEG and END dates for visit format:
4387"RTN","NHINVSIT",53,0)
4388 ; IDT=(9999999-$P(VDT,"."))_"."_$P(VDT,".",2)
4389"RTN","NHINVSIT",54,0)
4390 N X S X=BEG
4391"RTN","NHINVSIT",55,0)
4392 S BEG=(9999999-$P(END,"."))
4393"RTN","NHINVSIT",56,0)
4394 S END=(9999999-$P(X,"."))_".2359"
4395"RTN","NHINVSIT",57,0)
4396 Q
4397"RTN","NHINVSIT",58,0)
4398 ;
4399"RTN","NHINVSIT",59,0)
4400EN1(IEN,VST) ; -- return a visit in VST("attribute")=value
4401"RTN","NHINVSIT",60,0)
4402 N X0,X15,X,FAC,LOC,CATG,INPT,DA
4403"RTN","NHINVSIT",61,0)
4404 S IEN=+$G(IEN) Q:IEN<1 ;invalid ien
4405"RTN","NHINVSIT",62,0)
4406 D ENCEVENT^PXAPI(IEN)
4407"RTN","NHINVSIT",63,0)
4408 S X0=$G(^TMP("PXKENC",$J,IEN,"VST",IEN,0)),X15=$G(^(150))
4409"RTN","NHINVSIT",64,0)
4410 Q:$P(X15,U,3)'="P" Q:$P(X0,U,7)="E" ;want primary, not historical
4411"RTN","NHINVSIT",65,0)
4412 I $P(X0,U,7)="H" D ADM(IEN,+X0,.VST) Q
4413"RTN","NHINVSIT",66,0)
4414 S VST("id")=IEN,VST("dateTime")=+X0
4415"RTN","NHINVSIT",67,0)
4416 S FAC=+$P(X0,U,6),CATG=$P(X0,U,7),LOC=+$P(X0,U,22)
4417"RTN","NHINVSIT",68,0)
4418 S:FAC VST("facility")=$$STA^XUAF4(FAC)_U_$P($$NS^XUAF4(FAC),U)
4419"RTN","NHINVSIT",69,0)
4420 S VST("serviceCategory")=CATG_U_$$CATG(CATG)
4421"RTN","NHINVSIT",70,0)
4422 S VST("visitString")=LOC_";"_+X0_";"_CATG
4423"RTN","NHINVSIT",71,0)
4424 S INPT=$P(X15,U,2) S:INPT="" INPT=$S("H^I^R^D"[CATG:1,1:0)
4425"RTN","NHINVSIT",72,0)
4426 S X=$$CPT(IEN) S:X VST("type")=$P($$CPT^ICPTCOD(X),U,2,3)
4427"RTN","NHINVSIT",73,0)
4428 I 'X S VST("type")=U_$S('INPT&LOC:$P($G(^SC(LOC,0)),U)_" VISIT",1:$$CATG(CATG))
4429"RTN","NHINVSIT",74,0)
4430 S VST("patientClass")=$S(INPT:"IMP",1:"AMB")
4431"RTN","NHINVSIT",75,0)
4432 S X=$P(X0,U,8) S:X VST("stopCode")=$$AMIS(X) I LOC D
4433"RTN","NHINVSIT",76,0)
4434 . N L0 S L0=$G(^SC(LOC,0))
4435"RTN","NHINVSIT",77,0)
4436 . I 'X S VST("stopCode")=$$AMIS($P(L0,U,7))
4437"RTN","NHINVSIT",78,0)
4438 . S VST("location")=$P(L0,U),VST("service")=$$SERV($P(L0,U,20))
4439"RTN","NHINVSIT",79,0)
4440 . S X=$P(L0,U,18) S:X VST("creditStopCode")=$$AMIS(X)
4441"RTN","NHINVSIT",80,0)
4442 . S:'FAC VST("facility")=$$FAC^NHINV(LOC)
4443"RTN","NHINVSIT",81,0)
4444 S VST("reason")=$$POV(IEN)
4445"RTN","NHINVSIT",82,0)
4446 ; provider(s)
4447"RTN","NHINVSIT",83,0)
4448 S DA=0 F S DA=$O(^TMP("PXKENC",$J,IEN,"PRV",DA)) Q:DA<1 S X0=$G(^(DA,0)) D
4449"RTN","NHINVSIT",84,0)
4450 . S VST("provider",DA)=+X0_U_$P($G(^VA(200,+X0,0)),U)_$S($P(X0,U,4)="P":"^P^1",1:"^S^")
4451"RTN","NHINVSIT",85,0)
4452 ; note(s)
4453"RTN","NHINVSIT",86,0)
4454 D TIU(IEN)
4455"RTN","NHINVSIT",87,0)
4456 K ^TMP("PXKENC",$J,IEN)
4457"RTN","NHINVSIT",88,0)
4458 Q
4459"RTN","NHINVSIT",89,0)
4460 ;
4461"RTN","NHINVSIT",90,0)
4462TIU(VISIT) ; -- add notes to VST("document")
4463"RTN","NHINVSIT",91,0)
4464 N X,Y,I,NHIN,LT,NT,DA,CNT
4465"RTN","NHINVSIT",92,0)
4466 D FIND^DIC(8925,,.01,"QX",+$G(VISIT),,"V",,,"NHIN")
4467"RTN","NHINVSIT",93,0)
4468 S Y="",(I,CNT)=0
4469"RTN","NHINVSIT",94,0)
4470 F S I=$O(NHIN("DILIST",1,I)) Q:I<1 D
4471"RTN","NHINVSIT",95,0)
4472 . S LT=$G(NHIN("DILIST","ID",I,.01)) Q:$P(LT," ")="Addendum"
4473"RTN","NHINVSIT",96,0)
4474 . S DA=$G(NHIN("DILIST",2,I))
4475"RTN","NHINVSIT",97,0)
4476 . S NT=$$GET1^DIQ(8925,+DA_",",".01:1501")
4477"RTN","NHINVSIT",98,0)
4478 . S CNT=CNT+1,VST("document",CNT)=DA_U_LT_U_NT
4479"RTN","NHINVSIT",99,0)
4480 Q
4481"RTN","NHINVSIT",100,0)
4482 ;
4483"RTN","NHINVSIT",101,0)
4484POV(VISIT) ; -- return the primary Purpose of Visit as ICD^ProviderNarrative
4485"RTN","NHINVSIT",102,0)
4486 N DA,Y,X,X0,ICD S Y=""
4487"RTN","NHINVSIT",103,0)
4488 S DA=0 F S DA=$O(^TMP("PXKENC",$J,VISIT,"POV",DA)) Q:DA<1 S X0=$G(^(DA,0)) I $P(X0,U,12)="P" D Q:$L(Y)
4489"RTN","NHINVSIT",104,0)
4490 . S X=+$P(X0,U,4),ICD=$$ICD(+X0)
4491"RTN","NHINVSIT",105,0)
4492 . S Y=ICD_U_$$GET1^DIQ(9999999.27,X_",",.01)
4493"RTN","NHINVSIT",106,0)
4494 Q Y
4495"RTN","NHINVSIT",107,0)
4496 ;
4497"RTN","NHINVSIT",108,0)
4498ICD(IEN) ; -- return code^description for ICD code, or "^" if error
4499"RTN","NHINVSIT",109,0)
4500 N X0,NHX,N,I,X,Y S IEN=+$G(IEN)
4501"RTN","NHINVSIT",110,0)
4502 S X0=$$ICDDX^ICDCODE(IEN) I X0<0 Q "^"
4503"RTN","NHINVSIT",111,0)
4504 S Y=$P(X0,U,2)_U_$P(X0,U,4) ;ICD Code^Dx name
4505"RTN","NHINVSIT",112,0)
4506 S N=$$ICDD^ICDCODE($P(Y,U),"NHX") ;ICD Description
4507"RTN","NHINVSIT",113,0)
4508 I N>0,$L($G(NHX(1))) S $P(Y,U,2)=NHX(1)
4509"RTN","NHINVSIT",114,0)
4510 Q Y
4511"RTN","NHINVSIT",115,0)
4512 ;
4513"RTN","NHINVSIT",116,0)
4514CPT(VISIT) ; -- Return CPT code of encounter type
4515"RTN","NHINVSIT",117,0)
4516 N DA,Y,X,X0 S Y=""
4517"RTN","NHINVSIT",118,0)
4518 S DA=0 F S DA=$O(^TMP("PXKENC",$J,VISIT,"CPT",DA)) Q:DA<1 S X0=$G(^(DA,0)) D Q:$L(Y)
4519"RTN","NHINVSIT",119,0)
4520 . S X=$P(X0,U) I X?1"992"2N S Y=X Q
4521"RTN","NHINVSIT",120,0)
4522 Q Y
4523"RTN","NHINVSIT",121,0)
4524 ;
4525"RTN","NHINVSIT",122,0)
4526AMIS(X) ; -- return the AMIS code^name of Credit Stop X
4527"RTN","NHINVSIT",123,0)
4528 N Y S Y=""
4529"RTN","NHINVSIT",124,0)
4530 S X0=$G(^DIC(40.7,+$G(X),0)) S:$L(X0) Y=$P(X0,U,2)_U_$P(X0,U)
4531"RTN","NHINVSIT",125,0)
4532 Q Y
4533"RTN","NHINVSIT",126,0)
4534 ;
4535"RTN","NHINVSIT",127,0)
4536CATG(X) ; -- Return name of visit Service Category code X
4537"RTN","NHINVSIT",128,0)
4538 N Y S Y=""
4539"RTN","NHINVSIT",129,0)
4540 I X="A" S Y="AMBULATORY"
4541"RTN","NHINVSIT",130,0)
4542 I X="H" S Y="HOSPITALIZATION"
4543"RTN","NHINVSIT",131,0)
4544 I X="I" S Y="IN HOSPITAL"
4545"RTN","NHINVSIT",132,0)
4546 I X="C" S Y="CHART REVIEW"
4547"RTN","NHINVSIT",133,0)
4548 I X="T" S Y="TELECOMMUNICATIONS"
4549"RTN","NHINVSIT",134,0)
4550 I X="N" S Y="NOT FOUND"
4551"RTN","NHINVSIT",135,0)
4552 I X="S" S Y="DAY SURGERY"
4553"RTN","NHINVSIT",136,0)
4554 I X="O" S Y="OBSERVATION"
4555"RTN","NHINVSIT",137,0)
4556 I X="E" S Y="EVENT (HISTORICAL)"
4557"RTN","NHINVSIT",138,0)
4558 I X="R" S Y="NURSING HOME"
4559"RTN","NHINVSIT",139,0)
4560 I X="D" S Y="DAILY HOSPITALIZATION DATA"
4561"RTN","NHINVSIT",140,0)
4562 I X="X" S Y="ANCILLARY PACKAGE DAILY DATA"
4563"RTN","NHINVSIT",141,0)
4564 Q Y
4565"RTN","NHINVSIT",142,0)
4566 ;
4567"RTN","NHINVSIT",143,0)
4568SERV(FTS) ; -- Return #42.4 Service for a Facility Treating Specialty
4569"RTN","NHINVSIT",144,0)
4570 N Y S Y="",FTS=+$G(FTS)
4571"RTN","NHINVSIT",145,0)
4572 S Y=$$GET1^DIQ(45.7,FTS_",","1:3","E")
4573"RTN","NHINVSIT",146,0)
4574 Q Y
4575"RTN","NHINVSIT",147,0)
4576 ;
4577"RTN","NHINVSIT",148,0)
4578ADM(IEN,DATE,ADM) ; -- return an admission in ADM("attribute")=value
4579"RTN","NHINVSIT",149,0)
4580 N VAIP,VAERR,HLOC,ICD,I K ADM
4581"RTN","NHINVSIT",150,0)
4582 S IEN=+$G(IEN),DATE=+$G(DATE) Q:IEN<1 Q:DATE<1 ;invalid
4583"RTN","NHINVSIT",151,0)
4584 S VAIP("D")=DATE D IN5^VADPT Q:'$G(VAIP(1)) ;deleted
4585"RTN","NHINVSIT",152,0)
4586 S ADM("id")=IEN,ADM("patientClass")="IMP"
4587"RTN","NHINVSIT",153,0)
4588 ; ADM("admitType")=$P($G(VAIP(4)),U,2)
4589"RTN","NHINVSIT",154,0)
4590 S DATE=+$G(VAIP(3)),(ADM("dateTime"),ADM("arrivalDateTime"))=DATE,I=0
4591"RTN","NHINVSIT",155,0)
4592 S:$G(VAIP(7)) I=I+1,ADM("provider",I)=VAIP(7)_"^P^1" ;primary
4593"RTN","NHINVSIT",156,0)
4594 S:$G(VAIP(18)) I=I+1,ADM("provider",I)=VAIP(18)_"^A" ;attending
4595"RTN","NHINVSIT",157,0)
4596 S ADM("specialty")=$P($G(VAIP(8)),U,2)
4597"RTN","NHINVSIT",158,0)
4598 S X=$$SERV(+$G(VAIP(8))),ADM("service")=X
4599"RTN","NHINVSIT",159,0)
4600 S X=$$POV(IEN) S:X ADM("reason")=X_U_$G(VAIP(9)) I 'X D
4601"RTN","NHINVSIT",160,0)
4602 . S X=$$GET1^DIQ(405,+VAIP(1)_",",".16:79","I") ;Mvt>PTF>ICD ien
4603"RTN","NHINVSIT",161,0)
4604 . I 'X S ADM("reason")=U_U_$G(VAIP(9)) Q ;Dx text
4605"RTN","NHINVSIT",162,0)
4606 . S ICD=$$ICD(X),ADM("reason")=ICD_U_$G(VAIP(9))
4607"RTN","NHINVSIT",163,0)
4608 S HLOC=+$G(^DIC(42,+$G(VAIP(5)),44))
4609"RTN","NHINVSIT",164,0)
4610 S:HLOC ADM("location")=$P($G(^SC(HLOC,0)),U)
4611"RTN","NHINVSIT",165,0)
4612 S ADM("facility")=$$FAC^NHINV(+HLOC),ADM("roomBed")=$P(VAIP(6),U,2)
4613"RTN","NHINVSIT",166,0)
4614 S ADM("serviceCategory")="H^HOSPITALIZATION"
4615"RTN","NHINVSIT",167,0)
4616 S X=$$CPT(IEN),ADM("type")=$S(X:$P($$CPT^ICPTCOD(X),U,2,3),1:U_$$CATG("H"))
4617"RTN","NHINVSIT",168,0)
4618 I $G(VAIP(17)) D
4619"RTN","NHINVSIT",169,0)
4620 . S ADM("departureDateTime")=+$G(VAIP(17,1))
4621"RTN","NHINVSIT",170,0)
4622 . ; ADM("disposition")=$G(VAIP(17,3)) ;Discharge Mvt Type
4623"RTN","NHINVSIT",171,0)
4624 S ADM("visitString")=HLOC_";"_DATE_";H"
4625"RTN","NHINVSIT",172,0)
4626 Q
4627"RTN","NHINVSIT",173,0)
4628 ;
4629"RTN","NHINVSIT",174,0)
4630ENC(IEN,ENC) ; -- return an encounter in ENC("attribute")=value
4631"RTN","NHINVSIT",175,0)
4632 N X0,DATE,HLOC,TYPE,STS,X,Y K ENC
4633"RTN","NHINVSIT",176,0)
4634 S IEN=+$G(IEN) Q:IEN<1 ;invalid ien
4635"RTN","NHINVSIT",177,0)
4636 S ENC("id")="E"_IEN,X0=$G(^SCE(IEN,0))
4637"RTN","NHINVSIT",178,0)
4638 S DATE=+X0,ENC("dateTime")=DATE
4639"RTN","NHINVSIT",179,0)
4640 S HLOC=+$P(X0,U,4) I HLOC D
4641"RTN","NHINVSIT",180,0)
4642 . S HLOC=HLOC_U_$P($G(^SC(HLOC,0)),U)
4643"RTN","NHINVSIT",181,0)
4644 . S ENC("location")=$P(HLOC,U,2)
4645"RTN","NHINVSIT",182,0)
4646 . S X=$$GET1^DIQ(44,+HLOC_",",9.5,"I")
4647"RTN","NHINVSIT",183,0)
4648 . I X S ENC("service")=$$SERV(X)
4649"RTN","NHINVSIT",184,0)
4650 S ENC("facility")=$$FAC^NHINV(+HLOC)
4651"RTN","NHINVSIT",185,0)
4652 S STS=$$GET1^DIQ(409.68,IEN_",",.12,"E")
4653"RTN","NHINVSIT",186,0)
4654 S X=$S(STS?1"INP".E:"IMP",1:"AMB"),ENC("patientClass")=X,TYPE=$E(X)
4655"RTN","NHINVSIT",187,0)
4656 S ENC("type")=U_$S(HLOC:$P(HLOC,U,2)_" VISIT",1:$$CATG(TYPE))
4657"RTN","NHINVSIT",188,0)
4658 S ENC("serviceCategory")=TYPE_U_$$CATG(TYPE)
4659"RTN","NHINVSIT",189,0)
4660 S ENC("visitString")=+HLOC_";"_DATE_";"_TYPE
4661"RTN","NHINVSIT",190,0)
4662 Q
4663"RTN","NHINVSIT",191,0)
4664 ;
4665"RTN","NHINVSIT",192,0)
4666 ; ------------ Return data to middle tier ------------
4667"RTN","NHINVSIT",193,0)
4668 ;
4669"RTN","NHINVSIT",194,0)
4670XML(VISIT) ; -- Return patient visit as XML
4671"RTN","NHINVSIT",195,0)
4672 N ATT,X,Y,NAMES
4673"RTN","NHINVSIT",196,0)
4674 D ADD("<visit>") S NHINTOTL=$G(NHINTOTL)+1
4675"RTN","NHINVSIT",197,0)
4676 S ATT="" F S ATT=$O(VISIT(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
4677"RTN","NHINVSIT",198,0)
4678 . I $O(VISIT(ATT,0)) D S Y="" Q ;multiples
4679"RTN","NHINVSIT",199,0)
4680 .. D ADD("<"_ATT_"s>")
4681"RTN","NHINVSIT",200,0)
4682 .. S I=0 F S I=$O(VISIT(ATT,I)) Q:I<1 D
4683"RTN","NHINVSIT",201,0)
4684 ... S X=$G(VISIT(ATT,I)),NAMES=""
4685"RTN","NHINVSIT",202,0)
4686 ... I ATT="document" S NAMES="id^localTitle^nationalTitle^Z"
4687"RTN","NHINVSIT",203,0)
4688 ... I ATT="provider" S NAMES="code^name^role^primary^Z"
4689"RTN","NHINVSIT",204,0)
4690 ... S Y="<"_ATT_" "_$$LOOP_"/>" D ADD(Y)
4691"RTN","NHINVSIT",205,0)
4692 .. D ADD("</"_ATT_"s>")
4693"RTN","NHINVSIT",206,0)
4694 . S X=$G(VISIT(ATT)),Y="" Q:'$L(X)
4695"RTN","NHINVSIT",207,0)
4696 . S NAMES="code^name^"_$S(ATT="reason":"narrative^",1:"")_"Z"
4697"RTN","NHINVSIT",208,0)
4698 . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
4699"RTN","NHINVSIT",209,0)
4700 . I $L(X)>1 S Y="<"_ATT_" "_$$LOOP_"/>"
4701"RTN","NHINVSIT",210,0)
4702 D ADD("</visit>")
4703"RTN","NHINVSIT",211,0)
4704 Q
4705"RTN","NHINVSIT",212,0)
4706 ;
4707"RTN","NHINVSIT",213,0)
4708LOOP() ; -- build sub-items string from NAMES and X
4709"RTN","NHINVSIT",214,0)
4710 N STR,P,TAG S STR=""
4711"RTN","NHINVSIT",215,0)
4712 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))_"' "
4713"RTN","NHINVSIT",216,0)
4714 Q STR
4715"RTN","NHINVSIT",217,0)
4716 ;
4717"RTN","NHINVSIT",218,0)
4718ADD(X) ; -- Add a line @NHIN@(n)=X
4719"RTN","NHINVSIT",219,0)
4720 S NHINI=$G(NHINI)+1
4721"RTN","NHINVSIT",220,0)
4722 S @NHIN@(NHINI)=X
4723"RTN","NHINVSIT",221,0)
4724 Q
4725"RTN","NHINVSR")
47260^12^B25931760^n/a
4727"RTN","NHINVSR",1,0)
4728NHINVSR ;SLC/MKB -- Surgical Procedures
4729"RTN","NHINVSR",2,0)
4730 ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
4731"RTN","NHINVSR",3,0)
4732 ;
4733"RTN","NHINVSR",4,0)
4734 ; External References DBIA#
4735"RTN","NHINVSR",5,0)
4736 ; ------------------- -----
4737"RTN","NHINVSR",6,0)
4738 ; DIQ 2056
4739"RTN","NHINVSR",7,0)
4740 ; STATUS^GMTSROB 3969
4741"RTN","NHINVSR",8,0)
4742 ; ICPTCOD 1995
4743"RTN","NHINVSR",9,0)
4744 ; ICPTMOD 1996
4745"RTN","NHINVSR",10,0)
4746 ; SROESTV 3533
4747"RTN","NHINVSR",11,0)
4748 ; TIUSRVR1 2944
4749"RTN","NHINVSR",12,0)
4750 ;
4751"RTN","NHINVSR",13,0)
4752 ; ------------ Get surgery(ies) from VistA ------------
4753"RTN","NHINVSR",14,0)
4754 ;
4755"RTN","NHINVSR",15,0)
4756EN(DFN,BEG,END,MAX,ID) ; -- find patient's surgeries
4757"RTN","NHINVSR",16,0)
4758 N NHI,NHICNT,NHITM,NHY
4759"RTN","NHINVSR",17,0)
4760 S DFN=+$G(DFN) Q:DFN<1
4761"RTN","NHINVSR",18,0)
4762 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
4763"RTN","NHINVSR",19,0)
4764 ;
4765"RTN","NHINVSR",20,0)
4766 ; get one surgery
4767"RTN","NHINVSR",21,0)
4768 I $G(ID) D EN1(ID,.NHITM),XML(.NHITM) Q
4769"RTN","NHINVSR",22,0)
4770 ;
4771"RTN","NHINVSR",23,0)
4772 ; get all surgeries
4773"RTN","NHINVSR",24,0)
4774 Q:'$L($T(LIST^SROESTV))
4775"RTN","NHINVSR",25,0)
4776 N SHOWADD S SHOWADD=1 ;to omit leading '+' with note titles
4777"RTN","NHINVSR",26,0)
4778 D LIST^SROESTV(.NHY,DFN,BEG,END,MAX,1)
4779"RTN","NHINVSR",27,0)
4780 S NHI=0 F S NHI=$O(@NHY@(NHI)) Q:NHI<1 D
4781"RTN","NHINVSR",28,0)
4782 . K NHITM D ONE(NHI,.NHITM)
4783"RTN","NHINVSR",29,0)
4784 . I $D(NHITM) D XML(.NHITM)
4785"RTN","NHINVSR",30,0)
4786 K @NHY
4787"RTN","NHINVSR",31,0)
4788 Q
4789"RTN","NHINVSR",32,0)
4790 ;
4791"RTN","NHINVSR",33,0)
4792ONE(NUM,SURG) ; -- return a surgery in SURG("attribute")=value
4793"RTN","NHINVSR",34,0)
4794 ; Expects DFN, @NHY@(NUM) from LIST^SROESTV
4795"RTN","NHINVSR",35,0)
4796 N IEN,NHX,X,Y,I,NHMOD,NHOTH
4797"RTN","NHINVSR",36,0)
4798 S NHX=$G(@NHY@(NUM))
4799"RTN","NHINVSR",37,0)
4800 S IEN=+$P(NHX,U) Q:IEN<1 K SURG
4801"RTN","NHINVSR",38,0)
4802 S SURG("id")=IEN,SURG("name")=$P(NHX,U,2)
4803"RTN","NHINVSR",39,0)
4804 S SURG("dateTime")=$P(NHX,U,3)
4805"RTN","NHINVSR",40,0)
4806 S X=$P(NHX,U,4) S:X SURG("provider")=$TR(X,";","^")
4807"RTN","NHINVSR",41,0)
4808 S SURG("status")=$$STATUS(IEN,$P(NHX,U,3))
4809"RTN","NHINVSR",42,0)
4810 S X=$$GET1^DIQ(130,IEN_",",50,"I"),SURG("facility")=$$FAC^NHINV(X)
4811"RTN","NHINVSR",43,0)
4812 S SURG("encounter")=$$GET1^DIQ(130,IEN_",",.015,"I")
4813"RTN","NHINVSR",44,0)
4814 S X=$$GET1^DIQ(130,IEN_",",27,"I") I X D
4815"RTN","NHINVSR",45,0)
4816 . S SURG("type")=$$CPT(X)
4817"RTN","NHINVSR",46,0)
4818 . D GETS^DIQ(130,IEN_",","28*","I","NHMOD") ;CPT modifiers
4819"RTN","NHINVSR",47,0)
4820 . S I="" F S I=$O(NHMOD(130.028,I)) Q:I="" D
4821"RTN","NHINVSR",48,0)
4822 .. S X=+$G(NHMOD(130.028,I,.01,"I")),Y=$$MOD^ICPTMOD(X,"I")
4823"RTN","NHINVSR",49,0)
4824 .. S SURG("modifier",+I)=$P(Y,U,2,3)
4825"RTN","NHINVSR",50,0)
4826 D GETS^DIQ(130,IEN_",",".42*","I","NHOTH") ;other procedures
4827"RTN","NHINVSR",51,0)
4828 S I="" F S I=$O(NHOTH(130.16,I)) Q:I="" D
4829"RTN","NHINVSR",52,0)
4830 . S X=+$G(NHOTH(130.16,I,3,"I")) Q:'X
4831"RTN","NHINVSR",53,0)
4832 . S SURG("otherProcedure",+I)=$$CPT(X)
4833"RTN","NHINVSR",54,0)
4834 S I=0 F S I=$O(@NHY@(NUM,I)) Q:I<1 S X=$G(@NHY@(NUM,I)) I X D
4835"RTN","NHINVSR",55,0)
4836 . N LT,NT S LT=$P(X,U,2) Q:$P(LT," ")="Addendum"
4837"RTN","NHINVSR",56,0)
4838 . S NT=$$GET1^DIQ(8925,+X_",",".01:1501")
4839"RTN","NHINVSR",57,0)
4840 . S SURG("document",I)=+X_U_LT_U_NT
4841"RTN","NHINVSR",58,0)
4842 . I LT["OPERATION REPORT"!(LT["PROCEDURE REPORT") S SURG("opReport")=+X_U_LT_U_NT
4843"RTN","NHINVSR",59,0)
4844 S SURG("category")="SR"
4845"RTN","NHINVSR",60,0)
4846 Q
4847"RTN","NHINVSR",61,0)
4848 ;
4849"RTN","NHINVSR",62,0)
4850EN1(IEN,SURG) ; -- return a surgery in SURG("attribute")=value
4851"RTN","NHINVSR",63,0)
4852 N NHX,NHY,X,Y,I,NHMOD,NHOTH,SHOWADD
4853"RTN","NHINVSR",64,0)
4854 S SHOWADD=1 ;to omit leading '+' with note titles
4855"RTN","NHINVSR",65,0)
4856 D ONE^SROESTV("NHY",IEN) S NHX=$G(NHY(IEN)) Q:NHX=""
4857"RTN","NHINVSR",66,0)
4858 S SURG("id")=IEN,SURG("name")=$P(NHX,U,2),SURG("dateTime")=$P(NHX,U,3)
4859"RTN","NHINVSR",67,0)
4860 S X=$P(NHX,U,4) S:X SURG("provider")=$TR(X,";","^")
4861"RTN","NHINVSR",68,0)
4862 S SURG("status")=$$STATUS(IEN,$P(NHX,U,3))
4863"RTN","NHINVSR",69,0)
4864 S X=$$GET1^DIQ(130,IEN_",",50,"I"),SURG("facility")=$$FAC^NHINV(X)
4865"RTN","NHINVSR",70,0)
4866 S SURG("encounter")=$$GET1^DIQ(130,IEN_",",.015,"I")
4867"RTN","NHINVSR",71,0)
4868 S X=$$GET1^DIQ(130,IEN_",",27,"I") I X D
4869"RTN","NHINVSR",72,0)
4870 . S SURG("type")=$$CPT(X)
4871"RTN","NHINVSR",73,0)
4872 . D GETS^DIQ(130,IEN_",","28*","I","NHMOD") ;CPT modifiers
4873"RTN","NHINVSR",74,0)
4874 . S I="" F S I=$O(NHMOD(130.028,I)) Q:I="" D
4875"RTN","NHINVSR",75,0)
4876 .. S X=+$G(NHMOD(130.028,I,.01,"I")),Y=$$MOD^ICPTMOD(X,"I")
4877"RTN","NHINVSR",76,0)
4878 .. S SURG("modifier",+I)=$P(Y,U,2,3)
4879"RTN","NHINVSR",77,0)
4880 D GETS^DIQ(130,"28,",".42*","I","NHOTH") ;other procedures
4881"RTN","NHINVSR",78,0)
4882 S I="" F S I=$O(NHOTH(130.16,I)) Q:I="" D
4883"RTN","NHINVSR",79,0)
4884 . S X=+$G(NHOTH(130.16,I,3,"I")) Q:'X
4885"RTN","NHINVSR",80,0)
4886 . S SURG("otherProcedure",+I)=$$CPT(X)
4887"RTN","NHINVSR",81,0)
4888 S I=0 F S I=$O(NHY(IEN,I)) Q:I<1 S X=$G(NHY(IEN,I)) I X D
4889"RTN","NHINVSR",82,0)
4890 . N LT,NT S LT=$P(X,U,2) Q:$P(LT," ")="Addendum"
4891"RTN","NHINVSR",83,0)
4892 . S NT=$$GET1^DIQ(8925,+X_",",".01:1501")
4893"RTN","NHINVSR",84,0)
4894 . S SURG("document",I)=+X_U_LT_U_NT
4895"RTN","NHINVSR",85,0)
4896 . I LT["OPERATION REPORT"!(LT["PROCEDURE REPORT") S SURG("opReport")=+X_U_LT_U_NT
4897"RTN","NHINVSR",86,0)
4898 S SURG("category")="SR"
4899"RTN","NHINVSR",87,0)
4900 Q
4901"RTN","NHINVSR",88,0)
4902 ;
4903"RTN","NHINVSR",89,0)
4904CPT(IEN) ; -- return code^description for CPT code, or "^" if error
4905"RTN","NHINVSR",90,0)
4906 N X0,NHX,N,I,X,Y S IEN=+$G(IEN)
4907"RTN","NHINVSR",91,0)
4908 S X0=$$CPT^ICPTCOD(IEN) I X0<0 Q "^"
4909"RTN","NHINVSR",92,0)
4910 S Y=$P(X0,U,2,3) ;CPT Code^Short Name
4911"RTN","NHINVSR",93,0)
4912 S N=$$CPTD^ICPTCOD($P(Y,U),"NHX") ;CPT Description
4913"RTN","NHINVSR",94,0)
4914 I N>0,$L($G(NHX(1))) D
4915"RTN","NHINVSR",95,0)
4916 . S X=$G(NHX(1)),I=1
4917"RTN","NHINVSR",96,0)
4918 . F S I=$O(NHX(I)) Q:I<1 Q:NHX(I)=" " S X=X_" "_NHX(I)
4919"RTN","NHINVSR",97,0)
4920 . S $P(Y,U,2)=X
4921"RTN","NHINVSR",98,0)
4922 Q Y
4923"RTN","NHINVSR",99,0)
4924 ;
4925"RTN","NHINVSR",100,0)
4926STATUS(GMN,GMDT) ; -- get current STATUS of request
4927"RTN","NHINVSR",101,0)
4928 N STATUS S STATUS="UNKNOWN"
4929"RTN","NHINVSR",102,0)
4930 I $G(GMN),$G(GMDT) D STATUS^GMTSROB
4931"RTN","NHINVSR",103,0)
4932 I $E(STATUS)="(" S STATUS=$P($P(STATUS,"(",2),")")
4933"RTN","NHINVSR",104,0)
4934 Q STATUS
4935"RTN","NHINVSR",105,0)
4936 ;
4937"RTN","NHINVSR",106,0)
4938 ; ------------ Return data to middle tier ------------
4939"RTN","NHINVSR",107,0)
4940 ;
4941"RTN","NHINVSR",108,0)
4942XML(SURG) ; -- Return surgery as XML
4943"RTN","NHINVSR",109,0)
4944 N ATT,X,Y,NAMES
4945"RTN","NHINVSR",110,0)
4946 D ADD("<surgery>") S NHINTOTL=$G(NHINTOTL)+1
4947"RTN","NHINVSR",111,0)
4948 S ATT="" F S ATT=$O(SURG(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
4949"RTN","NHINVSR",112,0)
4950 . I $O(SURG(ATT,0)) D S Y="" Q ;multiples
4951"RTN","NHINVSR",113,0)
4952 .. D ADD("<"_ATT_"s>")
4953"RTN","NHINVSR",114,0)
4954 .. S I=0 F S I=$O(SURG(ATT,I)) Q:I<1 D
4955"RTN","NHINVSR",115,0)
4956 ... S X=$G(SURG(ATT,I)),NAMES=""
4957"RTN","NHINVSR",116,0)
4958 ... S NAMES=$S(ATT="document":"id^localTitle^nationalTitle^Z",1:"code^name^Z")
4959"RTN","NHINVSR",117,0)
4960 ... S Y="<"_ATT_" "_$$LOOP_"/>" D ADD(Y)
4961"RTN","NHINVSR",118,0)
4962 .. D ADD("</"_ATT_"s>")
4963"RTN","NHINVSR",119,0)
4964 . S X=$G(SURG(ATT)),Y="" Q:'$L(X)
4965"RTN","NHINVSR",120,0)
4966 . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
4967"RTN","NHINVSR",121,0)
4968 . S NAMES=$S(ATT="opReport":"id^localTitle^nationalTitle^Z",1:"code^name^Z")
4969"RTN","NHINVSR",122,0)
4970 . I $L(X)>1 S Y="<"_ATT_" "_$$LOOP_"/>"
4971"RTN","NHINVSR",123,0)
4972 D ADD("</surgery>")
4973"RTN","NHINVSR",124,0)
4974 Q
4975"RTN","NHINVSR",125,0)
4976 ;
4977"RTN","NHINVSR",126,0)
4978LOOP() ; -- build sub-items string from NAMES and X
4979"RTN","NHINVSR",127,0)
4980 N STR,P,TAG S STR=""
4981"RTN","NHINVSR",128,0)
4982 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))_"' "
4983"RTN","NHINVSR",129,0)
4984 Q STR
4985"RTN","NHINVSR",130,0)
4986 ;
4987"RTN","NHINVSR",131,0)
4988ADD(X) ; -- Add a line @NHIN@(n)=X
4989"RTN","NHINVSR",132,0)
4990 S NHINI=$G(NHINI)+1
4991"RTN","NHINVSR",133,0)
4992 S @NHIN@(NHINI)=X
4993"RTN","NHINVSR",134,0)
4994 Q
4995"RTN","NHINVSR",135,0)
4996 ;
4997"RTN","NHINVSR",136,0)
4998RPT(NHY,ID) ; -- Return report in NHY(n)
4999"RTN","NHINVSR",137,0)
5000 S ID=+$G(ID) Q:ID<1
5001"RTN","NHINVSR",138,0)
5002 D TGET^TIUSRVR1(.NHY,ID)
5003"RTN","NHINVSR",139,0)
5004 Q
5005"RTN","NHINVTIU")
50060^13^B18326219^n/a
5007"RTN","NHINVTIU",1,0)
5008NHINVTIU ;SLC/MKB -- TIU extract
5009"RTN","NHINVTIU",2,0)
5010 ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
5011"RTN","NHINVTIU",3,0)
5012 ;
5013"RTN","NHINVTIU",4,0)
5014 ; External References DBIA#
5015"RTN","NHINVTIU",5,0)
5016 ; ------------------- -----
5017"RTN","NHINVTIU",6,0)
5018 ; ^SC( 10040
5019"RTN","NHINVTIU",7,0)
5020 ; ^VA(200 10060
5021"RTN","NHINVTIU",8,0)
5022 ; DIQ 2056
5023"RTN","NHINVTIU",9,0)
5024 ; TIUSRVLO 2834,2865
5025"RTN","NHINVTIU",10,0)
5026 ; TIUSRVR1 2944
5027"RTN","NHINVTIU",11,0)
5028 ;
5029"RTN","NHINVTIU",12,0)
5030 ; ------------ Get documents from VistA ------------
5031"RTN","NHINVTIU",13,0)
5032 ;
5033"RTN","NHINVTIU",14,0)
5034EN(DFN,BEG,END,MAX,ID) ; -- find patient's documents
5035"RTN","NHINVTIU",15,0)
5036 N NHITM,NHI,NHX,NHY,NHDAD
5037"RTN","NHINVTIU",16,0)
5038 S DFN=+$G(DFN) Q:$G(DFN)<1
5039"RTN","NHINVTIU",17,0)
5040 S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
5041"RTN","NHINVTIU",18,0)
5042 ;
5043"RTN","NHINVTIU",19,0)
5044 ; get one document
5045"RTN","NHINVTIU",20,0)
5046 I $L($G(ID)),ID[";" D RPT^NHINVLRA(DFN,ID,.NHITM),XML(.NHITM) Q ;Lab
5047"RTN","NHINVTIU",21,0)
5048 I $G(ID),ID["-" D RPT^NHINVRA(DFN,ID,.NHITM),XML(.NHITM) Q ;Radiology
5049"RTN","NHINVTIU",22,0)
5050 I $G(ID) D Q
5051"RTN","NHINVTIU",23,0)
5052 . N SHOWADD S SHOWADD=1
5053"RTN","NHINVTIU",24,0)
5054 . S NHX=ID_U_$$RESOLVE^TIUSRVLO(ID)
5055"RTN","NHINVTIU",25,0)
5056 . D EN1(ID,.NHITM),XML(.NHITM)
5057"RTN","NHINVTIU",26,0)
5058 ;
5059"RTN","NHINVTIU",27,0)
5060 ; get all documents via
5061"RTN","NHINVTIU",28,0)
5062 D CONTEXT^TIUSRVLO(.NHY,3,1,DFN,BEG,END,,MAX,,1)
5063"RTN","NHINVTIU",29,0)
5064 S NHI=0 F S NHI=$O(@NHY@(NHI)) Q:NHI<1 D
5065"RTN","NHINVTIU",30,0)
5066 . S NHX=$G(@NHY@(NHI)),IFN=+NHX
5067"RTN","NHINVTIU",31,0)
5068 . K NHITM D EN1(IFN,.NHITM)
5069"RTN","NHINVTIU",32,0)
5070 . D:$D(NHITM) XML(.NHITM)
5071"RTN","NHINVTIU",33,0)
5072 Q
5073"RTN","NHINVTIU",34,0)
5074 ;
5075"RTN","NHINVTIU",35,0)
5076EN1(IEN,DOC) ; -- return a document in DOC("attribute")=value
5077"RTN","NHINVTIU",36,0)
5078 ; Expects DFN, NHX=IEN ^ $$RESOLVE^TIUSRVLO(IEN)
5079"RTN","NHINVTIU",37,0)
5080 N X,NAME,NHINX,ES,I K DOC
5081"RTN","NHINVTIU",38,0)
5082 S IEN=+$G(IEN) Q:IEN<1 ;invalid ien
5083"RTN","NHINVTIU",39,0)
5084 Q:"UNKNOWN"[$P($G(NHX),U,2) ;null or invalid
5085"RTN","NHINVTIU",40,0)
5086 S DOC("id")=IEN,NAME=$P(NHX,U,2),DOC("localTitle")=NAME
5087"RTN","NHINVTIU",41,0)
5088 I $P(NHX,U,14),$P(NAME," ")="Addendum" D Q
5089"RTN","NHINVTIU",42,0)
5090 . N DATE,PARENT K DOC
5091"RTN","NHINVTIU",43,0)
5092 . S DATE=$P(NHX,U,3),PARENT=$P(NHX,U,14)
5093"RTN","NHINVTIU",44,0)
5094 . I DATE,PARENT>1 S NHDAD(PARENT,DATE)=NHX
5095"RTN","NHINVTIU",45,0)
5096 S X=$$GET1^DIQ(8925,IEN_",",".01:1501") S:$L(X) DOC("nationalTitle")=X
5097"RTN","NHINVTIU",46,0)
5098 S X=$$GET1^DIQ(8925,IEN_",",".01:1501:99.99") S:$L(X) DOC("nationalTitleCode")=X
5099"RTN","NHINVTIU",47,0)
5100 S X=$$GET1^DIQ(8925,IEN_",",.04) S:$L(X) DOC("documentClass")=X
5101"RTN","NHINVTIU",48,0)
5102 S DOC("referenceDateTime")=$P(NHX,U,3)
5103"RTN","NHINVTIU",49,0)
5104 S X=$P(NHX,U,6) D ;S:$L(X) DOC("location")=X
5105"RTN","NHINVTIU",50,0)
5106 . N LOC S LOC=$S($L(X):+$O(^SC("B",X,0)),1:0)
5107"RTN","NHINVTIU",51,0)
5108 . S DOC("facility")=$$FAC^NHINV(LOC)
5109"RTN","NHINVTIU",52,0)
5110 S X=$P(NHX,U,7) S:$L(X) DOC("status")=X
5111"RTN","NHINVTIU",53,0)
5112 S:$L($P(NHX,U,12)) DOC("subject")=$P(NHX,U,12)
5113"RTN","NHINVTIU",54,0)
5114 ; X=$S($P(NHX,U,13)[">":"C",$P(NHX,U,13)["<":"I",1:"") ;componentType
5115"RTN","NHINVTIU",55,0)
5116 S DOC("encounter")=$$GET1^DIQ(8925,IEN_",",.03,"I") ;$$VSTR(IEN)
5117"RTN","NHINVTIU",56,0)
5118 S DOC("content")=$$TEXT(IEN)
5119"RTN","NHINVTIU",57,0)
5120 ; providers &/or signatures
5121"RTN","NHINVTIU",58,0)
5122 S X=$P(NHX,U,5),I=0 S:X I=I+1,DOC("clinician",I)=+X_U_$P(X,";",3)_"^A" ;author
5123"RTN","NHINVTIU",59,0)
5124 D GETS^DIQ(8925,IEN_",","1501;1502;1507;1508","IE","NHINX")
5125"RTN","NHINVTIU",60,0)
5126 M ES=NHINX(8925,IEN_",") I ES(1501,"I") D
5127"RTN","NHINVTIU",61,0)
5128 . S I=I+1
5129"RTN","NHINVTIU",62,0)
5130 . S DOC("clinician",I)=ES(1502,"I")_U_ES(1502,"E")_"^S^"_ES(1501,"I")_U_$$SIG(ES(1502,"I"))
5131"RTN","NHINVTIU",63,0)
5132 I ES(1507,"I") D ; cosigner
5133"RTN","NHINVTIU",64,0)
5134 . S I=I+1
5135"RTN","NHINVTIU",65,0)
5136 . S DOC("clinician",I)=ES(1508,"I")_U_ES(1508,"E")_"^C^"_ES(1507,"I")_U_$$SIG(ES(1508,"I"))
5137"RTN","NHINVTIU",66,0)
5138 Q
5139"RTN","NHINVTIU",67,0)
5140 ;
5141"RTN","NHINVTIU",68,0)
5142VSTR(DA) ; -- get visit string for document DA
5143"RTN","NHINVTIU",69,0)
5144 ; Expects DFN, NHX = IEN ^ $$RESOLVE^TIUSRVLO(IEN)
5145"RTN","NHINVTIU",70,0)
5146 N VDT,VTYP,VLOC,Y
5147"RTN","NHINVTIU",71,0)
5148 S VDT=$P($P(NHX,U,8),";",2)
5149"RTN","NHINVTIU",72,0)
5150 S VTYP=$$GET1^DIQ(8925,DA_",",.13)
5151"RTN","NHINVTIU",73,0)
5152 S VLOC=$$GET1^DIQ(8925,DA_",",1211,"I")
5153"RTN","NHINVTIU",74,0)
5154 S Y=VLOC_";"_VDT_";"_VTYP
5155"RTN","NHINVTIU",75,0)
5156 Q Y
5157"RTN","NHINVTIU",76,0)
5158 ;
5159"RTN","NHINVTIU",77,0)
5160SIG(X) ; -- Return Signature Block Name_Title
5161"RTN","NHINVTIU",78,0)
5162 N X20,Y S X20=$G(^VA(200,+$G(X),20))
5163"RTN","NHINVTIU",79,0)
5164 S Y=$P(X20,U,2)_" "_$P(X20,U,3)
5165"RTN","NHINVTIU",80,0)
5166 Q Y
5167"RTN","NHINVTIU",81,0)
5168 ;
5169"RTN","NHINVTIU",82,0)
5170RPT(NHY,IFN) ; -- Return text of document in @NHY@(n)
5171"RTN","NHINVTIU",83,0)
5172 D TGET^TIUSRVR1(.NHY,IFN)
5173"RTN","NHINVTIU",84,0)
5174 Q
5175"RTN","NHINVTIU",85,0)
5176 ;
5177"RTN","NHINVTIU",86,0)
5178TEXT(IFN) ; -- Return document IFN as a text string
5179"RTN","NHINVTIU",87,0)
5180 N I,Y,NHY S IFN=+$G(IFN),Y=""
5181"RTN","NHINVTIU",88,0)
5182 I IFN D
5183"RTN","NHINVTIU",89,0)
5184 . D TGET^TIUSRVR1(.NHY,IFN)
5185"RTN","NHINVTIU",90,0)
5186 . S I=0 F S I=$O(@NHY@(I)) Q:I<1 S Y=Y_$S($L(Y):$C(13,10),1:"")_@NHY@(I)
5187"RTN","NHINVTIU",91,0)
5188 Q Y
5189"RTN","NHINVTIU",92,0)
5190 ;
5191"RTN","NHINVTIU",93,0)
5192 ; ------------ Return data to middle tier ------------
5193"RTN","NHINVTIU",94,0)
5194 ;
5195"RTN","NHINVTIU",95,0)
5196XML(DOC) ; -- Return patient documents as XML
5197"RTN","NHINVTIU",96,0)
5198 N ATT,X,Y,NAMES,TYPE
5199"RTN","NHINVTIU",97,0)
5200 D ADD("<document>") S NHINTOTL=$G(NHINTOTL)+1
5201"RTN","NHINVTIU",98,0)
5202 S ATT="" F S ATT=$O(DOC(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
5203"RTN","NHINVTIU",99,0)
5204 . I $O(DOC(ATT,0)) D S Y="" Q ;multiples
5205"RTN","NHINVTIU",100,0)
5206 .. D ADD("<"_ATT_"s>")
5207"RTN","NHINVTIU",101,0)
5208 .. S I=0 F S I=$O(DOC(ATT,I)) Q:I<1 D
5209"RTN","NHINVTIU",102,0)
5210 ... S X=$G(DOC(ATT,I)),NAMES=""
5211"RTN","NHINVTIU",103,0)
5212 ... I ATT="clinician" S NAMES="code^name^role^dateTime^signature^Z"
5213"RTN","NHINVTIU",104,0)
5214 ... S Y="<"_ATT_" "_$$LOOP_"/>" D ADD(Y)
5215"RTN","NHINVTIU",105,0)
5216 .. D ADD("</"_ATT_"s>")
5217"RTN","NHINVTIU",106,0)
5218 . S X=$G(DOC(ATT)),Y="" Q:'$L(X)
5219"RTN","NHINVTIU",107,0)
5220 . I ATT="content" S Y="<"_ATT_" xml:space='preserve'>"_$$ESC^NHINV(X)_"</"_ATT_">" Q
5221"RTN","NHINVTIU",108,0)
5222 . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
5223"RTN","NHINVTIU",109,0)
5224 . I $L(X)>1 S NAMES="code^name^Z",Y="<"_ATT_" "_$$LOOP_"/>"
5225"RTN","NHINVTIU",110,0)
5226 D ADD("</document>")
5227"RTN","NHINVTIU",111,0)
5228 Q
5229"RTN","NHINVTIU",112,0)
5230 ;
5231"RTN","NHINVTIU",113,0)
5232LOOP() ; -- build sub-items string from NAMES and X
5233"RTN","NHINVTIU",114,0)
5234 N STR,P,TAG S STR=""
5235"RTN","NHINVTIU",115,0)
5236 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))_"' "
5237"RTN","NHINVTIU",116,0)
5238 Q STR
5239"RTN","NHINVTIU",117,0)
5240 ;
5241"RTN","NHINVTIU",118,0)
5242ADD(X) ; Add a line @NHIN@(n)=X
5243"RTN","NHINVTIU",119,0)
5244 S NHINI=$G(NHINI)+1
5245"RTN","NHINVTIU",120,0)
5246 S @NHIN@(NHINI)=X
5247"RTN","NHINVTIU",121,0)
5248 Q
5249"VER")
52508.0^22.0
5251"BLD",7816,6)
5252^1
5253**END**
5254**END**
Note: See TracBrowser for help on using the repository browser.