Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VPRDJ

VPRDJ.m

Go to the documentation of this file.
  1. VPRDJ ;SLC/MKB -- Serve VistA data as JSON via RPC ;10/18/12 6:26pm
  1. ;;1.0;VIRTUAL PATIENT RECORD;**2,32**;Sep 01, 2011;Build 6
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; External References DBIA#
  1. ; ------------------- -----
  1. ; ^DPT 10035
  1. ; MPIF001 2701
  1. ; XLFDT 10103
  1. ; XLFSTR 10104
  1. ; XUPARAM 2541
  1. ;
  1. GET(VPR,FILTER) ; -- Return search results as JSON in @VPR@(n)
  1. ; RPC = VPR GET PATIENT DATA JSON
  1. ; where FILTER("patientId") = DFN or DFN;ICN
  1. ; FILTER("domain") = name of desired data type (see VPRDJ0)
  1. ; FILTER("text") = boolean, to include document text [opt]
  1. ; FILTER("start") = start date.time of search [opt]
  1. ; FILTER("stop") = stop date.time of search [opt]
  1. ; FILTER("max") = maximum number of items to return [opt]
  1. ; FILTER("id") = single item id to return [opt]
  1. ; FILTER("uid") = single record uid to return [opt]
  1. ; FILTER("nowrap") = include line breaks in comments [opt]
  1. ;
  1. N ICN,DFN,VPRSYS,VPRTYPE,VPRSTART,VPRSTOP,VPRMAX,VPRI,VPRID,VPRTEXT,VPRP,VPRTN,VPRERR
  1. S VPR=$NA(^TMP("VPR",$J)),VPRI=0 K @VPR
  1. S VPRSYS=$$GET^XPAR("SYS","VPR SYSTEM NAME")
  1. S DT=$$DT^XLFDT ;for crossing midnight boundary
  1. ;
  1. I $G(FILTER("uid"))'="" D SEPUID(.FILTER)
  1. ; parse & validate input parameters
  1. S DFN=$G(FILTER("patientId"))
  1. S ICN=+$P($G(DFN),";",2),DFN=+$G(DFN)
  1. I DFN<1,ICN S DFN=+$$GETDFN^MPIF001(ICN)
  1. ;
  1. S VPRTYPE=$G(FILTER("domain")) S:VPRTYPE="" VPRTYPE=$$ALL
  1. I $D(ZTQUEUED) S VPR=$NA(^XTMP(VPRBATCH,DFN,VPRTYPE)) K @VPR
  1. I VPRTYPE'="new",DFN<1!'$D(^DPT(DFN)) S VPRERR=$$ERR(1,DFN) G GTQ
  1. ;
  1. S VPRSTART=+$G(FILTER("start"),1410102)
  1. S VPRSTOP=+$G(FILTER("stop"),4141015)
  1. S VPRMAX=+$G(FILTER("max"),9999)
  1. I VPRSTART,VPRSTOP,VPRSTOP<VPRSTART D
  1. . N X S X=VPRSTART,VPRSTART=VPRSTOP,VPRSTOP=X
  1. I VPRSTOP,$L(VPRSTOP,".")<2 S VPRSTOP=VPRSTOP_".24"
  1. ;
  1. S VPRID=$G(FILTER("id"))
  1. S VPRTEXT=+$G(FILTER("text"),1) ;default = true/text
  1. ;
  1. ; extract data
  1. ;I VPRTYPE="new",$L($T(EN^VPRDJX)) D EN^VPRDJX(VPRID,VPRMAX) Q ;HMP
  1. F VPRP=1:1:$L(VPRTYPE,";") S TYPE=$P(VPRTYPE,";",VPRP) I $L(TYPE) D
  1. . S VPRTN=$$TAG(TYPE)_"^VPRDJ0" Q:'$L($T(@VPRTN))
  1. . D @VPRTN
  1. ;
  1. GTQ ; add item count and terminating characters
  1. S @VPR@(.5)="{""apiVersion"":""1.01"",""params"":{"_$$SYS_"},"
  1. I $D(VPRERR) S @VPR@(.7)="""error"":{""message"":"""_VPRERR_"""}}" Q
  1. I '$D(@VPR)!'$G(VPRI) S @VPR@(.6)="""data"":{""totalItems"":0,""items"":[]}}" Q
  1. ;
  1. S @VPR@(.6)="""data"":{""updated"":"""_$$HL7NOW_""",""totalItems"":"_VPRI_",""items"":["
  1. S VPRI=VPRI+1,@VPR@(VPRI)="]}}"
  1. K ^TMP("VPRTEXT",$J)
  1. Q
  1. ;
  1. SEPUID(FILTER) ; -- separate uid into FILTER pieces
  1. N UID
  1. S UID=$G(FILTER("uid")) K FILTER("uid") Q:UID=""
  1. I $P(UID,":",4)'=VPRSYS Q
  1. S FILTER("patientId")=$P(UID,":",5)
  1. S FILTER("domain")=$P(UID,":",3)
  1. S FILTER("id")=$P(UID,":",6)
  1. Q
  1. ;
  1. SYS() ; -- return system info for JSON header
  1. Q """domain"":"""_$$KSP^XUPARAM("WHERE")_""",""systemId"":"""_VPRSYS_""""
  1. ;
  1. TAG(X) ; -- Return linetag in VPRDJ0 routine for clinical domain X
  1. N Y S X=$G(X,"Z")
  1. S Y=$E($$UP^XLFSTR(X),1,8)
  1. S:'$L($T(@(Y_"^VPRDJ0"))) Y="VPR"
  1. Q Y
  1. ;
  1. ALL() ; -- return string for all types of data
  1. Q "patient;problem;allergy;consult;vital;lab;procedure;obs;order;treatment;med;ptf;factor;immunization;exam;cpt;education;pov;skin;image;appointment;surgery;document;visit"
  1. ;
  1. ERR(X,VAL) ; -- return error message
  1. N MSG S MSG="Error"
  1. I X=1 S MSG="Patient with dfn '"_$G(VAL)_"' not found"
  1. I X=2 S MSG="Domain type '"_$G(VAL)_"' not recognized"
  1. I X=3 S MSG="UID '"_$G(VAL)_"' not found"
  1. I X=4 S MSG="Unable to create new object"
  1. I X=99 S MSG="Unknown request"
  1. Q MSG
  1. ;
  1. HL7NOW() ; -- Return current time in HL7 format
  1. Q $P($$FMTHL7^XLFDT($$NOW^XLFDT),"-")
  1. ;
  1. ADD(ITEM,COLL) ; -- add ITEM to results
  1. I $D(VPRCRC),$D(COLL) D ONE^VPRDCRC(ITEM,COLL) Q ;checksum
  1. ; -- add ITEM to @VPR@(VPRI) to return JSON
  1. N VPRY,VPRERR
  1. D ENCODE^VPRJSON(ITEM,"VPRY","VPRERR")
  1. I $D(VPRERR) D ;return ERRor instead of ITEM
  1. . N VPRTMP,VPRTXT,VPRITM
  1. . M VPRITM=@ITEM K VPRY
  1. . S VPRTXT(1)="Problem encoding json output."
  1. . D SETERROR^VPRUTILS(.VPRTMP,.VPRERR,.VPRTXT,.VPRITM)
  1. . K VPRERR D ENCODE^VPRJSON("VPRTMP","VPRY","VPRERR")
  1. I $D(VPRY) D
  1. . S VPRI=VPRI+1 S:VPRI>1 @VPR@(VPRI,.3)=","
  1. . M @VPR@(VPRI)=VPRY
  1. Q
  1. ;
  1. TEST(DFN,TYPE,ID,TEXT,IN) ; -- test GET, write results to screen
  1. N OUT,IDX
  1. S U="^"
  1. S:'$D(IN("systemID")) IN("systemID")=$$GET^XPAR("SYS","VPR SYSTEM NAME")
  1. S IN("patientId")=+$G(DFN)
  1. S IN("domain")=$G(TYPE)
  1. S:$D(ID) IN("id")=ID
  1. S:$D(TEXT) IN("text")=TEXT
  1. D GET(.OUT,.IN)
  1. ;
  1. S IDX=OUT
  1. F S IDX=$Q(@IDX) Q:IDX'?1"^TMP(""VPR"","1.N.E Q:+$P(IDX,",",2)'=$J W !,@IDX
  1. Q