source: smart/trunk/p/C0SNHINV.m@ 1666

Last change on this file since 1666 was 1591, checked in by Sam Habiel, 12 years ago

Updated license for routines

File size: 4.0 KB
Line 
1C0SNHINV ;SLC/MKB - Serve VistA data as XML via RPC - Smart Container Version
2 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5
3 ;
4 ; External References DBIA#
5 ; ------------------- -----
6 ; ^DPT 10035
7 ; ^SC 10040
8 ; DIQ 2056
9 ; MPIF001 2701
10 ; VASITE 10112
11 ; XLFDT 10103
12 ; XLFSTR 10104
13 ; XUAF4 2171
14 ;
15GET(NHIN,DFN,TYPE,START,STOP,MAX,ID) ; -- Return search results as XML in @NHIN@(n)
16 ; RPC = NHIN GET VISTA DATA
17 N ICN,NHINI,NHINTOTL
18 S NHIN=$NA(^TMP("NHINV",$J)) K @NHIN
19 ;
20 ; parse & validate input parameters
21 S ICN=+$P(DFN,";",2),DFN=+$G(DFN)
22 I 'DFN S DFN=+$$GETDFN^MPIF001(ICN)
23 I DFN<1!'$D(^DPT(DFN)) D ERR(1,DFN) G GTQ
24 S TYPE=$G(TYPE) I TYPE="" S TYPE=$$ALL
25 S:'$G(START) START=1410101 S:'$G(STOP) STOP=9999998 S:'$G(MAX) MAX=9999
26 I START,STOP,STOP<START N X S X=START,START=STOP,STOP=X ;switch
27 I STOP,$L(STOP,".")<2 S STOP=STOP_".24"
28 S ID=$G(ID)
29 ;
30 ; extract data
31 N NHINTYPE,NHINP,RTN
32 S NHINTYPE=TYPE D ADD("<results>")
33 F NHINP=1:1:$L(NHINTYPE,";") S TYPE=$P(NHINTYPE,";",NHINP) I $L(TYPE) D
34 . S RTN="EN^"_$$RTN(TYPE) Q:'$L($T(@RTN)) ;D ERR(2) Q
35 . D @(RTN_"(DFN,START,STOP,MAX,ID)")
36 D ADD("</results>")
37 ;
38 I $G(NHINTOTL),$G(@NHIN@(1))="<results>" S @NHIN@(1)="<results total='"_NHINTOTL_"' >"
39 ;
40GTQ ; end
41 Q
42 ;
43RTN(X) ; -- Return name of NHINVxxx routine for clinical domain X
44 S X=$$UP^XLFSTR(X),Y="NHINV"
45 I X="ACCESSION" S Y="NHINVLRA"
46 I X="ALLERGY" S Y="NHINVART"
47 I X="APPOINTMENT" S Y="NHINVAPT"
48 ; X="CONSULT" S Y="NHINVCON"
49 I X="DOCUMENT" S Y="NHINVTIU"
50 I X="IMMUNIZATION" S Y="NHINVIMM"
51 I X="LAB" S Y="NHINVLR"
52 I X="PANEL" S Y="NHINVLRO"
53 I X="MED" S Y="NHINVPS"
54 I X="RX" S Y="NHINVPSO"
55 ; X="ORDER" S Y="NHINVOR"
56 I X="PATIENT" S Y="NHINVPT"
57 I X="PROBLEM" S Y="NHINVPL"
58 I X="PROCEDURE" S Y="NHINVPRC"
59 I X="SURGERY" S Y="NHINVSR"
60 I X="VISIT" S Y="NHINVSIT"
61 I X="VITAL" S Y="NHINVIT"
62 I X="RADIOLOGY" S Y="NHINVRA"
63 I X="NEW" S Y="NHINVPR"
64 Q Y
65 ;
66ALL() ; -- return string for all types of data
67 ;Q "patient;allergy;problem;vital;lab;med;immunization;visit;appointment;document;procedure"
68 Q "patient;allergy;problem;vital;lab;med;immunization;visit;appointment;procedure"
69 ;
70ERR(X,VAL) ; -- return error message
71 N MSG S MSG="Error"
72 I X=1 S MSG="Patient with dfn '"_$G(VAL)_"' not found"
73 I X=2 S MSG="Requested domain type '"_$G(VAL)_"' not recognized"
74 I X=99 S MSG="Unknown request"
75 ;
76 D ADD("<error>")
77 D ADD("<message>"_MSG_"</message>")
78 D ADD("</error>")
79 Q
80 ;
81ESC(X) ; -- escape outgoing XML
82 ; Q $ZCONVERT(X,"O","HTML") ; uncomment for fastest performance on Cache
83 ;
84 N I,Y,QOT S QOT=""""
85 S Y=$P(X,"&") F I=2:1:$L(X,"&") S Y=Y_"&amp;"_$P(X,"&",I)
86 S X=Y,Y=$P(X,"<") F I=2:1:$L(X,"<") S Y=Y_"&lt;"_$P(X,"<",I)
87 S X=Y,Y=$P(X,">") F I=2:1:$L(X,">") S Y=Y_"&gt;"_$P(X,">",I)
88 S X=Y,Y=$P(X,"'") F I=2:1:$L(X,"'") S Y=Y_"&apos;"_$P(X,"'",I)
89 S X=Y,Y=$P(X,QOT) F I=2:1:$L(X,QOT) S Y=Y_"&quot;"_$P(X,QOT,I)
90 Q Y
91 ;
92ADD(X) ; Add a line @NHIN@(n)=X
93 S NHINI=$G(NHINI)+1
94 S @NHIN@(NHINI)=X
95 Q
96 ;
97STRING(ARRAY) ; -- Return text in ARRAY(n) or ARRAY(n,0) as a string
98 N I,X,Y S Y=""
99 S I=+$O(ARRAY("")) I I=0 S I=+$O(ARRAY(0))
100 S Y=$S($D(ARRAY(I,0)):ARRAY(I,0),1:$G(ARRAY(I)))
101 F S I=$O(ARRAY(I)) Q:I<1 D
102 . S X=$S($D(ARRAY(I,0)):ARRAY(I,0),1:ARRAY(I))
103 . I $E(X)=" " S Y=Y_$C(13,10)_X Q
104 . S Y=Y_$S($E(Y,$L(Y))=" ":"",1:" ")_X
105 Q Y
106 ;
107FAC(X) ; -- return Institution file station# for location X
108 N HLOC,FAC,Y0,Y S Y=""
109 S HLOC=$G(^SC(+$G(X),0)),FAC=$P(HLOC,U,4) ;Institution ien
110 ; Get P:4 via Med Ctr Div, if not directly linked
111 I 'FAC,$P(HLOC,U,15) S FAC=$$GET1^DIQ(40.8,+$P(HLOC,U,15)_",",.07,"I")
112 S Y0=$S(FAC:$$NS^XUAF4(FAC),1:$P($$SITE^VASITE,U,2,3)) ;name^stn#
113 S:$L(Y0) Y=$P(Y0,U,2)_U_$P(Y0,U) ;switch to stn#^name
114 I $L(Y),'Y S $P(Y,U)=FAC
115 Q Y
116 ;
117VUID(IEN,FILE) ; -- Return VUID for item
118 Q $$GET1^DIQ(FILE,IEN_",",99.99)
Note: See TracBrowser for help on using the repository browser.