Changeset 1569 for smart/trunk/p/C0SNHINV.m
- Timestamp:
- Oct 11, 2012, 1:42:56 PM (13 years ago)
- File:
-
- 1 edited
-
smart/trunk/p/C0SNHINV.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
smart/trunk/p/C0SNHINV.m
r1540 r1569 1 C0SNHINV ;SLC/MKB - Serve VistA data as XML via RPC - Smart Container Version2 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 2 3 ;4 ; External References DBIA#5 ; ------------------- -----6 ; ^DPT 100357 ; ^SC 100408 ; DIQ 20569 ; MPIF001 270110 ; VASITE 1011211 ; XLFDT 1010312 ; XLFSTR 1010413 ; XUAF4 217114 ;15 GET(NHIN,DFN,TYPE,START,STOP,MAX,ID) ; -- Return search results as XML in @NHIN@(n)16 ; RPC = NHIN GET VISTA DATA17 N ICN,NHINI,NHINTOTL18 S NHIN=$NA(^TMP("NHINV",$J)) K @NHIN19 ;20 ; parse & validate input parameters21 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 GTQ24 S TYPE=$G(TYPE) I TYPE="" S TYPE=$$ALL25 S:'$G(START) START=1410101 S:'$G(STOP) STOP=9999998 S:'$G(MAX) MAX=999926 I START,STOP,STOP<START N X S X=START,START=STOP,STOP=X ;switch27 I STOP,$L(STOP,".")<2 S STOP=STOP_".24"28 S ID=$G(ID)29 ;30 ; extract data31 N NHINTYPE,NHINP,RTN32 S NHINTYPE=TYPE D ADD("<results>")33 F NHINP=1:1:$L(NHINTYPE,";") S TYPE=$P(NHINTYPE,";",NHINP) I $L(TYPE) D34 . S RTN="EN^"_$$RTN(TYPE) Q:'$L($T(@RTN)) ;D ERR(2) Q35 . 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 ; end41 Q42 ;43 RTN(X) ; -- Return name of NHINVxxx routine for clinical domain X44 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 Y65 ;66 ALL() ; -- return string for all types of data67 ;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 message71 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 Q80 ;81 ESC(X) ; -- escape outgoing XML82 ; Q $ZCONVERT(X,"O","HTML") ; uncomment for fastest performance on Cache83 ;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 Y91 ;92 ADD(X) ; Add a line @NHIN@(n)=X93 S NHINI=$G(NHINI)+194 S @NHIN@(NHINI)=X95 Q96 ;97 STRING(ARRAY) ; -- Return text in ARRAY(n) or ARRAY(n,0) as a string98 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 D102 . S X=$S($D(ARRAY(I,0)):ARRAY(I,0),1:ARRAY(I))103 . I $E(X)=" " S Y=Y_$C(13,10)_X Q104 . S Y=Y_$S($E(Y,$L(Y))=" ":"",1:" ")_X105 Q Y106 ;107 FAC(X) ; -- return Institution file station# for location X108 N HLOC,FAC,Y0,Y S Y=""109 S HLOC=$G(^SC(+$G(X),0)),FAC=$P(HLOC,U,4) ;Institution ien110 ; Get P:4 via Med Ctr Div, if not directly linked111 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#^name114 I $L(Y),'Y S $P(Y,U)=FAC115 Q Y116 ;117 VUID(IEN,FILE) ; -- Return VUID for item118 Q $$GET1^DIQ(FILE,IEN_",",99.99)1 C0SNHINV ;SLC/MKB - Serve VistA data as XML via RPC - Smart Container Version 2 ;;1.0;C0S;**1**;Oct 25, 2010;Build 11 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)
Note:
See TracChangeset
for help on using the changeset viewer.
