HMPD ;SLC/MKB,ASMR/RRB,CK - Serve VistA data as XML via RPC ;Aug 29, 2016 20:06:27
 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**3**;Sep 01, 2011;Build 15
 ;Per VA Directive 6402, this routine should not be modified.
 ;
 ; External References          DBIA#
 ; -------------------          -----
 ; ^DPT                         10035
 ; ^SC                          10040
 ; DIQ                           2056
 ; MPIF001                       2701
 ; VASITE                       10112
 ; XLFDT                        10103
 ; XLFSTR                       10104
 ; XUAF4                         2171
 ;
 
Q
 
;
GET(HMP,DFN,TYPE,START,STOP,MAX,ID,FILTER) ; -- Return search results as XML in @HMP@(n) 
 ; RPC = HMP GET PATIENT DATA
 
ICN,HMPI,HMPTOTL,HMPTEXT
 
HMP=$NA(^TMP("HMP",$J)) @HMP
 
HMPTEXT=+$G(FILTER("text")) ;include report/document text?
 ;
 ; parse & validate input parameters
 
ICN=+$P($G(DFN),";",2),DFN=+$G(DFN),ID=$G(ID)
 
DFN<1,ICN DFN=+$$GETDFN^MPIF001(ICN)
 
TYPE=$$LOW^XLFSTR($G(TYPE)) TYPE="" TYPE=$$ALL
 
;next line, ICR 10035 ASF 11/2/15 DE2818, DE4496 19 August 2016
 
TYPE'="new",DFN<1!'$D(^DPT(DFN)) LOGDPT^HMPLOG(DFN),ERR(1,DFNGTQ
 
S:'$G(STARTSTART=1410102 S:'$G(STOPSTOP=4141015 S:'$G(MAXMAX=9999
 
START,STOP,STOP<START X=START,START=STOP,STOP=X  ;switch
 
STOP,$L(STOP,".")<2 STOP=STOP_".24"
 
ID="",$D(FILTER("id")) ID=FILTER("id")
 
;
 ; extract data
 
HMPTYPE,HMPP,HMPHDR,HMPTAG,HMPTN
 
HMPTYPE=TYPE ADD("<results version='1.1' timeZone='"_$$TZ^XLFDT_"' >")
 
HMPP=1:1:$L(HMPTYPE,";"HMPTAG=$P(HMPTYPE,";",HMPPI $L(HMPTAGD
 
HMPTN="EN^"_$$RTN(.HMPTAGQ:'$L($T(@HMPTN))  ;D ERR(2) Q
 
ADD("<"_HMPTAGHMPHDR=HMPI,HMPTOTL=0
 . 
@(HMPTN_"(DFN,START,STOP,MAX,ID)")
 . 
@HMP@(HMPHDR)=@HMP@(HMPHDR)_" total='"_+$G(HMPTOTL)_"' >" ADD("</"_HMPTAG_">")
 
ADD("</results>")
 
;
GTQ ; end
 
Q
 
;
RTN(X) ; -- Return name of HMPDxxxx routine for clinical domain X
 ;  X is also enforced as expected group tag name, if passed by ref
 
Y="HMPD",X=$G(XX="" Y
 
X["accession"    Y="HMPDLRA",X="accessions"
 
X["allerg"       Y="HMPDGMRA",X="reactions"
 
X["appointment"  Y="HMPDSDAM",X="appointments"
 
X["clinicalProc" Y="HMPDMC",X="clinicalProcedures"
 
X["consult"      Y="HMPDGMRC",X="consults"
 
X["demograph"    Y="HMPDPT",X="demographics"
 
X["document"     Y="HMPDTIU",X="documents"
 
X["factor"       Y="HMPDPXHF",X="healthFactors"
 
X["flag"         Y="HMPDGPF",X="flags"
 
X["immunization" Y="HMPDPXIM",X="immunizations"
 
X["skin"         Y="HMPDPXSK",X="skinTests"
 
X?1"exam".E      Y="HMPDPXAM",X="exams"
 
X["educat"       Y="HMPDPXED",X="educationTopics"
 
X["insur"        Y="HMPDIB",X="insurancePolicies"
 
X["polic"        Y="HMPDIB",X="insurancePolicies"
 
X["lab"          Y="HMPDLR",X="labs"
 
X["panel"        Y="HMPDLRO",X="panels"
 
X["med"          Y="HMPDPS",X="meds"
 
X["pharm"        Y="HMPDPSOR",X="meds"
 
X["observ"       Y="HMPDMDC",X="observations"
 
X["order"        Y="HMPDOR",X="orders"
 
X["patient"      Y="HMPDPT",X="demographics"
 
X["problem"      Y="HMPDGMPL",X="problems"
 
X["procedure"    Y="HMPDPROC",X="procedures"
 
X["reaction"     Y="HMPDGMRA",X="reactions"
 
X["surg"         Y="HMPDSR",X="surgeries"
 
X["visit"        Y="HMPDVSIT",X="visits"
 
X["vital"        Y="HMPDGMV",X="vitals"
 
X["rad"          Y="HMPDRA",X="radiologyExams"
 
X["xray"         Y="HMPDRA",X="radiologyExams"
 
X["new"          Y="HMPDX",X="patients"
 
Y
 
;
TAG(X) ; -- return plural name for group tags
 
S:X'?1.L X=$$LOW^XLFSTR(X)
 
I $E(X,$L(X))="s" Y=X
 
I $E(X,$L(X))="y" Y=$E(X,1,$L(X)-1)_"ies"
 
E  S Y=X_"s"
 
Y
 
;
ALL() ; -- return string for all types of data
 
"demographics;reactions;problems;vitals;labs;meds;immunizations;observation;visits;appointments;documents;procedures;consults;flags;factors;skinTests;exams;education;insurance"
 ;
ERR(X,VAL) ; -- return error message
 
MSG  MSG="Error"
 
X=1  MSG="Patient with dfn '"_$G(VAL)_"' not found"
 
X=2  MSG="Requested domain type '"_$G(VAL)_"' not recognized"
 
X=99 MSG="Unknown request"
 ;
 
ADD("<error>")
 
ADD("<message>"_MSG_"</message>")
 
ADD("</error>")
 
Q
 
;
ESC(X) ; -- escape outgoing XML
 ; Q $ZCONVERT(X,"O","HTML")  ; uncomment for fastest performance on Cache
 ;
 
I,Y,QOT QOT=""""
 
Y=$P(X,"&"I=2:1:$L(X,"&"Y=Y_"&amp;"_$P(X,"&",I)
 
X=Y,Y=$P(X,"<"I=2:1:$L(X,"<"Y=Y_"&lt;"_$P(X,"<",I)
 
X=Y,Y=$P(X,">"I=2:1:$L(X,">"Y=Y_"&gt;"_$P(X,">",I)
 
X=Y,Y=$P(X,"'"I=2:1:$L(X,"'"Y=Y_"&apos;"_$P(X,"'",I)
 
X=Y,Y=$P(X,QOTI=2:1:$L(X,QOTY=Y_"&quot;"_$P(X,QOT,I)
 
Y
 
;
ADD(X) ; Add a line @HMP@(n)=X
 
HMPI=$G(HMPI)+1
 
@HMP@(HMPI)=X
 
Q
 
;
STRING(ARY) ; -- Return text in ARY(n) or ARY(n,0) as a string, ARY passed by ref.
 ;DE3409 8/11/2106 CK - to prevent a MAXSTRING error, allow 30,000 characters
 
I,MXSTRNG,X,Y
 
MXSTRNG=30000
 
I=+$O(ARY("")) I=0 I=+$O(ARY(0))
 
Y=$S($D(ARY(I,0)):ARY(I,0),1:$G(ARY(I)))
 
F  S I=$O(ARY(I)) Q:I<1  D
 
X=$S($D(ARY(I,0)):ARY(I,0),1:ARY(I))
 . 
($L(Y)+$L(X))>MXSTRNG Y=Y_$E(X,1,(MXSTRNG-$L(Y))) Q
 
I $E(X)=" " Y=Y_$C(13,10)_Q
 
; add a space to separate each line of text
 
Y=Y_$S($E(Y,$L(Y))=" ":"",1:" ")_X
 
Y
 

FAC(X) ; -- return Institution file station# for location X
 
HLOC,FAC,Y0,Y=""
 
HLOC=$G(^SC(+$G(X),0)),FAC=$P(HLOC,U,4) ;ICR 10040 DE2818 ASF 11/5/15
 ; Get P:4 via Med Ctr Div, if not directly linked
 
'FAC,$P(HLOC,U,15) FAC=$$GET1^DIQ(44,+$G(X)_",","3.5:.07","I")
 
Y0=$S(FAC:$$NS^XUAF4(FAC),1:$P($$SITE^VASITE,U,2,3)) ;name^stn#
 
S:$L(Y0Y=$P(Y0,U,2)_U_$P(Y0,U;switch to stn#^name
 
I $L(Y),'S $P(Y,U)=FAC
 
Y
 
;
VUID(IEN,FILE) ; -- Return VUID for item
 
Q $$GET1^DIQ(FILE,IEN_",",99.99)
 
;
VERSION(RET) ; -- Return current version of data extracts
 
RET="1.01"
 
Q