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