| [1571] | 1 | C0SNHINV ;SLC/MKB - Serve VistA data as XML via RPC - Smart Container Version
|
|---|
| 2 | ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4
|
|---|
| 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 | ;
|
|---|
| 15 | GET(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 | ;
|
|---|
| 40 | GTQ ; end
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | RTN(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 | ;
|
|---|
| 66 | ALL() ; -- 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 | ;
|
|---|
| 70 | ERR(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 | ;
|
|---|
| 81 | ESC(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_"&"_$P(X,"&",I)
|
|---|
| 86 | S X=Y,Y=$P(X,"<") F I=2:1:$L(X,"<") S Y=Y_"<"_$P(X,"<",I)
|
|---|
| 87 | S X=Y,Y=$P(X,">") F I=2:1:$L(X,">") S Y=Y_">"_$P(X,">",I)
|
|---|
| 88 | S X=Y,Y=$P(X,"'") F I=2:1:$L(X,"'") S Y=Y_"'"_$P(X,"'",I)
|
|---|
| 89 | S X=Y,Y=$P(X,QOT) F I=2:1:$L(X,QOT) S Y=Y_"""_$P(X,QOT,I)
|
|---|
| 90 | Q Y
|
|---|
| 91 | ;
|
|---|
| 92 | ADD(X) ; Add a line @NHIN@(n)=X
|
|---|
| 93 | S NHINI=$G(NHINI)+1
|
|---|
| 94 | S @NHIN@(NHINI)=X
|
|---|
| 95 | Q
|
|---|
| 96 | ;
|
|---|
| 97 | STRING(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 | ;
|
|---|
| 107 | FAC(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 | ;
|
|---|
| 117 | VUID(IEN,FILE) ; -- Return VUID for item
|
|---|
| 118 | Q $$GET1^DIQ(FILE,IEN_",",99.99)
|
|---|
