HMPDJ ;SLC/MKB,ASMR/RRB,CK -- Serve VistA data as JSON via RPC;Aug 29, 2016 20:06:27
 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,2,3**;May 15, 2016;Build 15
 ;Per VA Directive 6402, this routine should not be modified.
 ;
 ; External References          DBIA#
 ; -------------------          -----
 ; ^DPT                         10035
 ; MPIF001                       2701
 ; XLFDT                        10103
 ; XLFSTR                       10104
 ; XUPARAM                       2541
 ;
 ; DE2818/RRB - SQA findings 1st 3 lines of code.
 ;
 
Q
 
;
GET(HMP,FILTER) ; -- Return search results as JSON in @HMP@(n)
 ; RPC = HMP GET PATIENT DATA JSON
 ; where FILTER("patientId") = DFN or DFN;ICN
 ;       FILTER("domain")    = name of desired data type  (see HMPDJ0)
 ;       FILTER("text")      = boolean, to include document text [opt]
 ;       FILTER("start")     = start date.time of search         [opt]
 ;       FILTER("stop")      = stop date.time of search          [opt]
 ;       FILTER("max")       = maximum number of items to return [opt]
 ;       FILTER("id")        = single item id to return          [opt]
 ;       FILTER("uid")       = single record uid to return       [opt]
 ;       FILTER("noHead")    = flag, to omit header and commas   [opt]
 ;
 
ICN,DFN,HMPI,HMPSYS,HMPTYPE,HMPSTART,HMPSTOP,HMPMAX,HMPID,HMPTEXT,HMPP,TYPE,HMPTN,HMPERR
 
HMP=$NA(^TMP("HMP",$J)),HMPI=0 @HMP
 
HMPSYS=$$SYS^HMPUTILS
 
DT=$$DT^XLFDT  ;for crossing midnight
 ;
 ; parse & validate input parameters
 
I $G(FILTER("uid"))'="" SEPUID(.FILTER)
 
;
 
DFN=$G(FILTER("patientId"))
 
;
 
ICN=+$P($G(DFN),";",2),DFN=+$G(DFN)
 
'(DFN>0),ICN DFN=+$$GETDFN^MPIF001(ICN)  ;DE4496
 ;
 
HMPTYPE=$G(FILTER("domain")) S:HMPTYPE="" HMPTYPE=$$ALL
 
I $D(ZTQUEUEDHMP=$NA(^XTMP(HMPBATCH,HMPFZTSK,HMPTYPE)) @HMP
 
;ICR 10035 DE2818 ASF 11/2/15, DE4496 August 19, 2016
 
HMPTYPE'="new",'(DFN>0)!'$D(^DPT(DFN)) LOGDPT^HMPLOG(DFNHMPERR=$$ERR(1,DFNGTQ
 
;
 ; -- initialize chunking if from DOMPT^HMPDJFSP ; i.e. HMPCHNK defined *S68-JCH*
 
CHNKINIT^HMPDJFSP(.HMP,.HMPI; *S68-JCH*
 ;
 
HMPSTART=+$G(FILTER("start"),1410102)
 
HMPSTOP=+$G(FILTER("stop"),4141015)
 
HMPMAX=+$G(FILTER("max"),999999)
 
HMPSTART,HMPSTOP,HMPSTOP<HMPSTART D
 
X=HMPSTART,HMPSTART=HMPSTOP,HMPSTOP=X
 
HMPSTOP,$L(HMPSTOP,".")<2 HMPSTOP=HMPSTOP_".24"
 ;
 
HMPID=$G(FILTER("id"))
 
HMPTEXT=+$G(FILTER("text"),1) ;default = true/text
 ;
 ;set error trap
 
^TMP($J,"HMP ERROR")
 
;
 ; extract data
 
HMPTYPE="new",$L($T(EN^HMPDJX)),'$G(^XTMP("HMP-off","GET")) EN^HMPDJX(HMPID,HMPMAXQ  ;data updates
 
HMPP=1:1:$L(HMPTYPE,";"TYPE=$P(HMPTYPE,";",HMPPI $L(TYPED
 
HMPTN=$$TAG(TYPE)_"^HMPDJ0" Q:'$L($T(@HMPTN))  ;D ERR(2) Q
 
N $ES,$ET,ERRPAT,ERRMSG
 
S $ET="D ERRHDLR^HMPDERRH",ERRMSG="A problem occurred when trying to load patient data from an API."
 
@HMPTN
 
;
GTQ ; add item count and terminating characters
 
ERROR I $D(^TMP($J,"HMP ERROR"))>0 BUILDERR(.ERROR)
 
+$G(FILTER("noHead"))=1 D  Q
 
.@HMP@("total")=+$G(HMPI)
 .
I $L($G(ERROR(1)))>1 @HMP@("error")=ERROR(1)
 
@HMP@(.5)="{""apiVersion"":""1.01"",""params"":{"_$$SYS_"},"
 
I $D(HMPERR@HMP@(1)="""error"":{""message"":"""_HMPERR_"""}}" Q
 I 
'$D(@HMP)!'$G(HMPID  Q
 
'$D(ERROR@HMP@(1)="""data"":{""totalItems"":0,""items"":[]}}" Q
 
@HMP@(1)="""data"":{""totalItems"":0,""items"":[]},"
 
@HMP@(2,1)=ERROR(1)_"}"
 ;
 
@HMP@(.6)="""data"":{""updated"":"""_$$HL7NOW_""",""totalItems"":"_HMPI_",""items"":["
 
HMPI=HMPI+1,@HMP@(HMPI)=$S($D(ERROR):"]}",1:"]}}")
 
I $D(ERROR)>0 HMPI=HMPI+1,@HMP@(HMPI,.3)=",",@HMP@(HMPI,1)=ERROR(1)_"}"
 
^TMP($J,"HMP ERROR"),^TMP("HMPTEXT",$J)
 
Q
 
;
SEPUID(FILTER) ; -- separate uid into FILTER pieces
 
UID
 
UID=$G(FILTER("uid")) FILTER("uid"Q:UID=""
 
I $P(UID,":",4)'=HMPSYS Q
 S 
FILTER("patientId")=$P(UID,":",5)
 
FILTER("domain")=$P(UID,":",3)
 
FILTER("id")=$P(UID,":",6)
 
Q
 
;
SYS() ; -- return system info for JSON header
 
"""domain"":"""_$$KSP^XUPARAM("WHERE")_""",""systemId"":"""_HMPSYS_""""
 ;
BUILDERR(RESULT,DFN) ; -- build error array
 
COUNT,MESSAGE,MSGCNT
 
COUNT=$G(^TMP($J,"HMP ERROR","# of Errors"))
 
MESSAGE="A mumps error occurred when extracting patient data. A total of "_COUNT_" occurred.\n\r"
 
MSGCNT=0 F  S MSGCNT=$O(^TMP($J,"HMP ERROR","ERROR MESSAGE",MSGCNT)) Q:MSGCNT'>0  D
 
MESSAGE=MESSAGE_$G(^TMP($J,"HMP ERROR","ERROR MESSAGE",MSGCNT))_"\n\r"
 
RESULT(1)="""error"":{""message"":"""_MESSAGE_"""}"
 
Q
 
;
TAG(X) ; -- Return linetag in HMPDJ0 routine for clinical domain X
 
X=$G(X,"Z")
 
Y=$E($$UP^XLFSTR(X),1,8)
 
S:'$L($T(@(Y_"^HMPDJ0"))) Y="HMP"
 
Y
 
;
ALL() ; -- return string for all types of data
 
"patient;problem;allergy;consult;vital;lab;procedure;obs;order;treatment;med;ptf;factor;immunization;exam;cpt;education;pov;skin;image;appointment;surgery;document;visit;mh"
 ;
ERR(X,VAL) ; -- return error message
 
MSG  MSG="Error"
 
X=1  MSG="Patient with dfn '"_$G(VAL)_"' not found"
 
X=2  MSG="Domain type '"_$G(VAL)_"' not recognized"
 
X=3  MSG="UID '"_$G(VAL)_"' not found"
 
X=4  MSG="Unable to create new object"
 
X=99 MSG="Unknown request"
 
MSG
 
;
HL7NOW() ; -- Return current time in HL7 format
 
Q $$FMTHL7^HMPSTMP($$NOW^XLFDT)  ; DE5016
 ;
ADD(ITEM,COLL) ; -- add ITEM to results
 
I $D(HMPCRC),$D(COLLONE^HMPDCRC(ITEM,COLLQ  ;checksum
 ; -- add ITEM to @HMP@(HMPI) to return JSON
 
HMPY,HMPERR
 
ENCODE^HMPJSON(ITEM,"HMPY","HMPERR")
 
I $D(HMPERRD  ;return ERRor instead of ITEM
 
HMPTMP,HMPTXT,HMPITM
 
HMPITM=@ITEM HMPY
 
HMPTXT(1)="Problem encoding json output."
 
SETERROR^HMPUTILS(.HMPTMP,.HMPERR,.HMPTXT,.HMPITM)
 . 
HMPERR ENCODE^HMPJSON("HMPTMP","HMPY","HMPERR")
 
I $D(HMPYD
 
HMPI=HMPI+1
 . 
HMPI>1 @HMP@(HMPI,.3)=","
 
@HMP@(HMPI)=HMPY
 
;
 
; -- chunk data if from DOMPT^HMPDJFSP ; i.e. HMPCHNK defined ; *S68-JCH*
 
CHNKCHK^HMPDJFSP(.HMP,.HMPI; *S68-JCH*
 
Q
 
;
TEST(DFN,TYPE,ID,TEXT,IN) ; -- test GET, write results to screen
 
OUT,IDX U="^"
 
S:'$D(IN("systemID")) IN("systemID")=$$SYS^HMPUTILS
 
IN("patientId")=+$G(DFN)
 
IN("domain")=$G(TYPE)
 
S:$D(IDIN("id")=ID
 
S:$D(TEXTIN("text")=TEXT
 
GET(.OUT,.IN)
 
;
 
IDX=OUT
 
F  S IDX=$Q(@IDXQ:IDX'?1"^TMP(""HMP"","1.N.E  Q:+$P(IDX,",",2)'=$J  W !,@IDX
 
Q
 
;