VPRDJ03 ;SLC/MKB -- Consults,ClinProcedures,CLiO ;6/25/12 16:11
;;1.0;VIRTUAL PATIENT RECORD;**2,7**;Sep 01, 2011;Build 3
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; ^SC 10040
; ^TIU(8925.1 5677
; ^VA(200 10060
; %DT 10003
; DILFD 2055
; DIQ 2056
; GMRCAPI 6082
; GMRCGUIB 2980
; GMRCSLM1,^TMP("GMRCR" 2740
; MCARUTL3 3280
; MDPS1,^TMP("MDHSP" 4230
; ORX8 2467
; TIULQ 2693
; TIUSRVLO 2834
; XLFSTR 10104
; XUAF4 2171
;
; All tags expect DFN, ID, [VPRSTART, VPRSTOP, VPRMAX, VPRTEXT]
;
GMRC1(ID) ; -- consult/request VPRX=^TMP("GMRCR",$J,"CS",VPRN,0)
N CONS,ORDER,VPRD,X0,X,VPRJ,VPRTIU,NT,VPRSN
S CONS("localId")=+VPRX,CONS("uid")=$$SETUID^VPRUTILS("consult",DFN,+VPRX)
S CONS("dateTime")=$$JSONDT^VPRUTILS($P(VPRX,U,2))
S CONS("statusName")=$P(VPRX,U,3),CONS("service")=$P(VPRX,U,4)
S CONS("consultProcedure")=$P(VPRX,U,5)
I $P(VPRX,U,6)="*" S CONS("interpretation")="SIGNIFICANT FINDINGS"
S CONS("typeName")=$P(VPRX,U,7),CONS("category")=$P(VPRX,U,9)
S ORDER=+$P(VPRX,U,8),CONS("orderName")=$P($$OI^ORX8(ORDER),U,2)
S CONS("orderUid")=$$SETUID^VPRUTILS("order",DFN,ORDER)
;D DOCLIST^GMRCGUIB(.VPRD,+VPRX) S X0=$G(VPRD(0)) ;=^GMR(123,ID,0)
D GET^GMRCAPI(.VPRD,+VPRX) S X0=$G(VPRD(0)) ;=^GMR(123,ID,0)
S X=$P(X0,U,9) S:$L(X) CONS("urgency")=X
S X=+$P(X0,U,14) I X D ;ordering provider
. S CONS("providerUid")=$$SETUID^VPRUTILS("user",,X)
. S CONS("providerName")=$P($G(^VA(200,X,0)),U)
I $O(VPRD(20,0)) M VPRSN=VPRD(20) S CONS("reason")=$$STRING^VPRD(.VPRSN)
I $D(VPRD(30))!$D(VPRD(30.1)) D
. S:$D(VPRD(30)) CONS("provisionalDx","name")=VPRD(30)
. S:$D(VPRD(30.1)) CONS("provisionalDx","code")=$P(VPRD(30.1),U),CONS("provisionalDx","system")=$P(VPRD(30.1),U,3)
S VPRJ=0 F S VPRJ=$O(VPRD(50,VPRJ)) Q:VPRJ<1 S X=$G(VPRD(50,VPRJ)) D
. Q:'$D(@(U_$P(X,";",2)_+X_")")) ;text deleted
. S CONS("results",VPRJ,"uid")=$$SETUID^VPRUTILS("document",DFN,+X)
. D EXTRACT^TIULQ(+X,"VPRTIU",,.01)
. S CONS("results",VPRJ,"localTitle")=$G(VPRTIU(+X,.01,"E"))
. S NT=$$GET1^DIQ(8925.1,+$G(VPRTIU(+X,.01,"I"))_",",1501)
. S:$L(NT) CONS("results",VPRJ,"nationalTitle")=NT
S X=$P(X0,U,21),X=$S(X:$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U),1:$$FAC^VPRD)
D FACILITY^VPRUTILS(X,"CONS")
D ADD^VPRDJ("CONS","consult")
Q
;
MDPS1(DFN,BEG,END,MAX) ; -- perform CP search (scope variables)
N MCARCODE,MCARDT,MCARPROC,MCESKEY,MCESSEC,MCFILE,MDC,MDIMG,RES
S BEG=$G(BEG,1410101),END=$G(END,4141015),MAX=$G(MAX,9999)
K ^TMP("MDHSP",$J) S RES=""
D EN1^MDPS1(.RES,DFN,BEG,END,MAX,"",0) ;RES=^TMP("MDHSP",$J)
Q
;
MC1(ID) ; -- clinical procedure VPRX=^TMP("MDHSP",$J,VPRN)
N X,Y,%DT,DATE,RTN,GBL,CONS,TIUN,VPRD,X0,PROC,VPRT,LOC,FAC
S RTN=$P(VPRX,U,3,4) Q:RTN="PRPRO^MDPS4" ;skip non-CP items
S X=$P(VPRX,U,6),%DT="TXS" D ^%DT Q:Y'>0 S DATE=Y
S GBL=+$P(VPRX,U,2)_";"_$S(RTN="PR702^MDPS1":"MDD(702,",1:$$ROOT^VPRDMC(DFN,$P(VPRX,U,11),DATE))
Q:'GBL I $G(ID),ID'=GBL Q ;unknown, or not requested
;
S CONS=+$P(VPRX,U,13) D:CONS DOCLIST^GMRCGUIB(.VPRD,CONS) S X0=$G(VPRD(0)) ;=^GMR(123,ID,0)
S TIUN=+$P(VPRX,U,14) S:TIUN TIUN=TIUN_U_$$RESOLVE^TIUSRVLO(TIUN)
S PROC("localId")=GBL,PROC("category")="CP"
S PROC("uid")=$$SETUID^VPRUTILS("procedure",DFN,GBL)
S PROC("name")=$P(VPRX,U),PROC("dateTime")=$$JSONDT^VPRUTILS(DATE)
S X=$P(VPRX,U,7) S:$L(X) PROC("interpretation")=X
S PROC("kind")="Procedure"
I CONS,X0 D
. N VPRJ S PROC("requested")=$$JSONDT^VPRUTILS(+X0)
. S PROC("consultUid")=$$SETUID^VPRUTILS("consult",DFN,CONS)
. S PROC("orderUid")=$$SETUID^VPRUTILS("order",DFN,+$P(X0,U,3))
. S PROC("statusName")=$$EXTERNAL^DILFD(123,8,,$P(X0,U,12))
. S VPRJ=0 F S VPRJ=$O(VPRD(50,VPRJ)) Q:VPRJ<1 S X=+$G(VPRD(50,VPRJ)) D
.. D NOTE(X)
.. S:'TIUN TIUN=X_U_$$RESOLVE^TIUSRVLO(X)
I TIUN D
. S X=$P(TIUN,U,5) I X D
.. S PROC("providers",1,"providerUid")=$$SETUID^VPRUTILS("user",,+X)
.. S PROC("providers",1,"providerName")=$P(X,";",3)
. S:$P(TIUN,U,11) PROC("hasImages")="true"
. K VPRT D EXTRACT^TIULQ(+TIUN,"VPRT",,".03;.05;1211",,,"I")
. S X=+$G(VPRT(+TIUN,.03,"I")),PROC("encounterUid")=$$SETUID^VPRUTILS("visit",DFN,X)
. S LOC=+$G(VPRT(+TIUN,1211,"I")) I LOC S LOC=LOC_U_$P($G(^SC(LOC,0)),U)
. E S X=$P(TIUN,U,6) S:$L(X) LOC=+$O(^SC("B",X,0))_U_X
. S:LOC PROC("locationUid")=$$SETUID^VPRUTILS("location",,+LOC),PROC("locationName")=$P(LOC,U,2),FAC=$$FAC^VPRD(+LOC)
. I '$D(PROC("statusName")) S X=+$G(VPRT(+TIUN,.05,"I")),PROC("statusName")=$S(X<6:"PARTIAL RESULTS",1:"COMPLETE")
. I '$G(PROC("results",+TIUN)) D NOTE(+TIUN)
; if no consult or note/visit ...
S:'$D(PROC("statusName")) PROC("statusName")="COMPLETE"
I '$D(FAC) S X=$P(X0,U,21),FAC=$S(X:$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U),1:$$FAC^VPRD)
D FACILITY^VPRUTILS(FAC,"PROC")
D ADD^VPRDJ("PROC","procedure")
Q
;
NOTE(DA) ; -- add TIU note info
N VPRT,NT,TEXT
D EXTRACT^TIULQ(DA,"VPRT",,.01)
S PROC("results",DA,"uid")=$$SETUID^VPRUTILS("document",+$G(DFN),DA)
S PROC("results",DA,"localTitle")=$G(VPRT(DA,.01,"E"))
S NT=$$GET1^DIQ(8925.1,+$G(VPRT(DA,.01,"I"))_",",1501)
S:$L(NT) PROC("results",DA,"nationalTitle")=NT
Q
;
MDC1(ID) ; -- clinical observation
N GUID,CLIO,VPRC,VPRT,LOC,FAC,I,X,Y
S GUID=$G(ID) Q:GUID="" ;invalid GUID
D QRYOBS^VPRDMDC("VPRC",GUID) Q:'$D(VPRC) ;doesn't exist
Q:$L($G(VPRC("PARENT_ID","E"))) ;PARENT also in list
;
S CLIO("localId")=GUID,CLIO("uid")=$$SETUID^VPRUTILS("obs",DFN,GUID)
S X=$G(VPRC("TERM_ID","I")) S:X CLIO("typeVuid")="urn:va:vuid:"_X
S CLIO("typeCode")="urn:va:clioterminology:"_$G(VPRC("TERM_ID","GUID"))
S CLIO("typeName")=$G(VPRC("TERM_ID","E"))
S CLIO("result")=$G(VPRC("SVALUE","E"))
S X=$G(VPRC("UNIT_ID","ABBV")) S:$L(X) CLIO("units")=X
S X=$G(VPRC("ENTERED_DATE_TIME","I")),CLIO("entered")=$$JSONDT^VPRUTILS(X)
S X=$G(VPRC("OBSERVED_DATE_TIME","I")),CLIO("observed")=$$JSONDT^VPRUTILS(X)
D QRYTYPES^VPRDMDC("VPRT")
F I=3,5 S X=$G(VPRT(I,"XML")) I $L($G(VPRC(X,"E"))) D
. S Y=VPRT(I,"NAME"),Y=$S(Y="LOCATION":"bodySite",1:$$LOW^XLFSTR(Y))
. S CLIO(Y_"Code")=VPRC(X,"I"),CLIO(Y_"Name")=VPRC(X,"E")
F I=4,6,7 S X=$G(VPRT(I,"XML")) I $L($G(VPRC(X,"E"))) D
. S CLIO("qualifiers",I,"type")=$$LOW^XLFSTR(VPRT(I,"NAME"))
. S CLIO("qualifiers",I,"code")=VPRC(X,"I")
. S CLIO("qualifiers",I,"name")=VPRC(X,"E")
S X=$G(VPRC("RANGE","E")) I $L(X) D
. S Y=$S(X="Out of Bounds Low":"<",X="Out of Bounds High":">",1:$E(X))
. S CLIO("interpretationCode")="urn:hl7:observation-interpretation:"_Y
. S CLIO("interpretationName")=$S(X="<":"Low off scale",X=">":"High off scale",1:X)
; X=$G(VPRC("STATUS","E")) S:$L(X) CLIO("resultStatus")=$S(X="unverified":"active",1:"complete")
I $D(VPRC("SUPP_PAGE")) D ;add set info
. S CLIO("setID")=$G(VPRC("SUPP_PAGE","GUID"))
. S CLIO("setName")=$G(VPRC("SUPP_PAGE","DISPLAY_NAME"))
. S X=$G(VPRC("SUPP_PAGE","TYPE")) S:$L(X) CLIO("setType")=X
. S X=$G(VPRC("SUPP_PAGE","ACTIVATED_DATE_TIME")) S:X CLIO("setStart")=$$JSONDT^VPRUTILS(X)
. S X=$G(VPRC("SUPP_PAGE","DEACTIVATED_DATE_TIME")) S:X CLIO("setStop")=$$JSONDT^VPRUTILS(X)
S CLIO("statusCode")="urn:va:observation-status:complete",CLIO("statusName")="complete"
S LOC=$G(VPRC("HOSPITAL_LOCATION_ID","I")),FAC=$$FAC^VPRD(LOC)
S CLIO("locationUid")=$$SETUID^VPRUTILS("location",,LOC)
S CLIO("locationName")=$G(VPRC("HOSPITAL_LOCATION_ID","E"))
D FACILITY^VPRUTILS(FAC,"CLIO")
S X=$G(VPRC("COMMENT","E")) S:$L(X) CLIO("comment")=X
D ADD^VPRDJ("CLIO","obs")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRDJ03 7974 printed Apr 09, 2024@21:47:23 Page 2
VPRDJ03 ;SLC/MKB -- Consults,ClinProcedures,CLiO ;6/25/12 16:11
+1 ;;1.0;VIRTUAL PATIENT RECORD;**2,7**;Sep 01, 2011;Build 3
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; ^SC 10040
+7 ; ^TIU(8925.1 5677
+8 ; ^VA(200 10060
+9 ; %DT 10003
+10 ; DILFD 2055
+11 ; DIQ 2056
+12 ; GMRCAPI 6082
+13 ; GMRCGUIB 2980
+14 ; GMRCSLM1,^TMP("GMRCR" 2740
+15 ; MCARUTL3 3280
+16 ; MDPS1,^TMP("MDHSP" 4230
+17 ; ORX8 2467
+18 ; TIULQ 2693
+19 ; TIUSRVLO 2834
+20 ; XLFSTR 10104
+21 ; XUAF4 2171
+22 ;
+23 ; All tags expect DFN, ID, [VPRSTART, VPRSTOP, VPRMAX, VPRTEXT]
+24 ;
GMRC1(ID) ; -- consult/request VPRX=^TMP("GMRCR",$J,"CS",VPRN,0)
+1 NEW CONS,ORDER,VPRD,X0,X,VPRJ,VPRTIU,NT,VPRSN
+2 SET CONS("localId")=+VPRX
SET CONS("uid")=$$SETUID^VPRUTILS("consult",DFN,+VPRX)
+3 SET CONS("dateTime")=$$JSONDT^VPRUTILS($PIECE(VPRX,U,2))
+4 SET CONS("statusName")=$PIECE(VPRX,U,3)
SET CONS("service")=$PIECE(VPRX,U,4)
+5 SET CONS("consultProcedure")=$PIECE(VPRX,U,5)
+6 IF $PIECE(VPRX,U,6)="*"
SET CONS("interpretation")="SIGNIFICANT FINDINGS"
+7 SET CONS("typeName")=$PIECE(VPRX,U,7)
SET CONS("category")=$PIECE(VPRX,U,9)
+8 SET ORDER=+$PIECE(VPRX,U,8)
SET CONS("orderName")=$PIECE($$OI^ORX8(ORDER),U,2)
+9 SET CONS("orderUid")=$$SETUID^VPRUTILS("order",DFN,ORDER)
+10 ;D DOCLIST^GMRCGUIB(.VPRD,+VPRX) S X0=$G(VPRD(0)) ;=^GMR(123,ID,0)
+11 ;=^GMR(123,ID,0)
DO GET^GMRCAPI(.VPRD,+VPRX)
SET X0=$GET(VPRD(0))
+12 SET X=$PIECE(X0,U,9)
if $LENGTH(X)
SET CONS("urgency")=X
+13 ;ordering provider
SET X=+$PIECE(X0,U,14)
IF X
Begin DoDot:1
+14 SET CONS("providerUid")=$$SETUID^VPRUTILS("user",,X)
+15 SET CONS("providerName")=$PIECE($GET(^VA(200,X,0)),U)
End DoDot:1
+16 IF $ORDER(VPRD(20,0))
MERGE VPRSN=VPRD(20)
SET CONS("reason")=$$STRING^VPRD(.VPRSN)
+17 IF $DATA(VPRD(30))!$DATA(VPRD(30.1))
Begin DoDot:1
+18 if $DATA(VPRD(30))
SET CONS("provisionalDx","name")=VPRD(30)
+19 if $DATA(VPRD(30.1))
SET CONS("provisionalDx","code")=$PIECE(VPRD(30.1),U)
SET CONS("provisionalDx","system")=$PIECE(VPRD(30.1),U,3)
End DoDot:1
+20 SET VPRJ=0
FOR
SET VPRJ=$ORDER(VPRD(50,VPRJ))
if VPRJ<1
QUIT
SET X=$GET(VPRD(50,VPRJ))
Begin DoDot:1
+21 ;text deleted
if '$DATA(@(U_$PIECE(X,";",2)_+X_")"))
QUIT
+22 SET CONS("results",VPRJ,"uid")=$$SETUID^VPRUTILS("document",DFN,+X)
+23 DO EXTRACT^TIULQ(+X,"VPRTIU",,.01)
+24 SET CONS("results",VPRJ,"localTitle")=$GET(VPRTIU(+X,.01,"E"))
+25 SET NT=$$GET1^DIQ(8925.1,+$GET(VPRTIU(+X,.01,"I"))_",",1501)
+26 if $LENGTH(NT)
SET CONS("results",VPRJ,"nationalTitle")=NT
End DoDot:1
+27 SET X=$PIECE(X0,U,21)
SET X=$SELECT(X:$$STA^XUAF4(X)_U_$PIECE($$NS^XUAF4(X),U),1:$$FAC^VPRD)
+28 DO FACILITY^VPRUTILS(X,"CONS")
+29 DO ADD^VPRDJ("CONS","consult")
+30 QUIT
+31 ;
MDPS1(DFN,BEG,END,MAX) ; -- perform CP search (scope variables)
+1 NEW MCARCODE,MCARDT,MCARPROC,MCESKEY,MCESSEC,MCFILE,MDC,MDIMG,RES
+2 SET BEG=$GET(BEG,1410101)
SET END=$GET(END,4141015)
SET MAX=$GET(MAX,9999)
+3 KILL ^TMP("MDHSP",$JOB)
SET RES=""
+4 ;RES=^TMP("MDHSP",$J)
DO EN1^MDPS1(.RES,DFN,BEG,END,MAX,"",0)
+5 QUIT
+6 ;
MC1(ID) ; -- clinical procedure VPRX=^TMP("MDHSP",$J,VPRN)
+1 NEW X,Y,%DT,DATE,RTN,GBL,CONS,TIUN,VPRD,X0,PROC,VPRT,LOC,FAC
+2 ;skip non-CP items
SET RTN=$PIECE(VPRX,U,3,4)
if RTN="PRPRO^MDPS4"
QUIT
+3 SET X=$PIECE(VPRX,U,6)
SET %DT="TXS"
DO ^%DT
if Y'>0
QUIT
SET DATE=Y
+4 SET GBL=+$PIECE(VPRX,U,2)_";"_$SELECT(RTN="PR702^MDPS1":"MDD(702,",1:$$ROOT^VPRDMC(DFN,$PIECE(VPRX,U,11),DATE))
+5 ;unknown, or not requested
if 'GBL
QUIT
IF $GET(ID)
IF ID'=GBL
QUIT
+6 ;
+7 ;=^GMR(123,ID,0)
SET CONS=+$PIECE(VPRX,U,13)
if CONS
DO DOCLIST^GMRCGUIB(.VPRD,CONS)
SET X0=$GET(VPRD(0))
+8 SET TIUN=+$PIECE(VPRX,U,14)
if TIUN
SET TIUN=TIUN_U_$$RESOLVE^TIUSRVLO(TIUN)
+9 SET PROC("localId")=GBL
SET PROC("category")="CP"
+10 SET PROC("uid")=$$SETUID^VPRUTILS("procedure",DFN,GBL)
+11 SET PROC("name")=$PIECE(VPRX,U)
SET PROC("dateTime")=$$JSONDT^VPRUTILS(DATE)
+12 SET X=$PIECE(VPRX,U,7)
if $LENGTH(X)
SET PROC("interpretation")=X
+13 SET PROC("kind")="Procedure"
+14 IF CONS
IF X0
Begin DoDot:1
+15 NEW VPRJ
SET PROC("requested")=$$JSONDT^VPRUTILS(+X0)
+16 SET PROC("consultUid")=$$SETUID^VPRUTILS("consult",DFN,CONS)
+17 SET PROC("orderUid")=$$SETUID^VPRUTILS("order",DFN,+$PIECE(X0,U,3))
+18 SET PROC("statusName")=$$EXTERNAL^DILFD(123,8,,$PIECE(X0,U,12))
+19 SET VPRJ=0
FOR
SET VPRJ=$ORDER(VPRD(50,VPRJ))
if VPRJ<1
QUIT
SET X=+$GET(VPRD(50,VPRJ))
Begin DoDot:2
+20 DO NOTE(X)
+21 if 'TIUN
SET TIUN=X_U_$$RESOLVE^TIUSRVLO(X)
End DoDot:2
End DoDot:1
+22 IF TIUN
Begin DoDot:1
+23 SET X=$PIECE(TIUN,U,5)
IF X
Begin DoDot:2
+24 SET PROC("providers",1,"providerUid")=$$SETUID^VPRUTILS("user",,+X)
+25 SET PROC("providers",1,"providerName")=$PIECE(X,";",3)
End DoDot:2
+26 if $PIECE(TIUN,U,11)
SET PROC("hasImages")="true"
+27 KILL VPRT
DO EXTRACT^TIULQ(+TIUN,"VPRT",,".03;.05;1211",,,"I")
+28 SET X=+$GET(VPRT(+TIUN,.03,"I"))
SET PROC("encounterUid")=$$SETUID^VPRUTILS("visit",DFN,X)
+29 SET LOC=+$GET(VPRT(+TIUN,1211,"I"))
IF LOC
SET LOC=LOC_U_$PIECE($GET(^SC(LOC,0)),U)
+30 IF '$TEST
SET X=$PIECE(TIUN,U,6)
if $LENGTH(X)
SET LOC=+$ORDER(^SC("B",X,0))_U_X
+31 if LOC
SET PROC("locationUid")=$$SETUID^VPRUTILS("location",,+LOC)
SET PROC("locationName")=$PIECE(LOC,U,2)
SET FAC=$$FAC^VPRD(+LOC)
+32 IF '$DATA(PROC("statusName"))
SET X=+$GET(VPRT(+TIUN,.05,"I"))
SET PROC("statusName")=$SELECT(X<6:"PARTIAL RESULTS",1:"COMPLETE")
+33 IF '$GET(PROC("results",+TIUN))
DO NOTE(+TIUN)
End DoDot:1
+34 ; if no consult or note/visit ...
+35 if '$DATA(PROC("statusName"))
SET PROC("statusName")="COMPLETE"
+36 IF '$DATA(FAC)
SET X=$PIECE(X0,U,21)
SET FAC=$SELECT(X:$$STA^XUAF4(X)_U_$PIECE($$NS^XUAF4(X),U),1:$$FAC^VPRD)
+37 DO FACILITY^VPRUTILS(FAC,"PROC")
+38 DO ADD^VPRDJ("PROC","procedure")
+39 QUIT
+40 ;
NOTE(DA) ; -- add TIU note info
+1 NEW VPRT,NT,TEXT
+2 DO EXTRACT^TIULQ(DA,"VPRT",,.01)
+3 SET PROC("results",DA,"uid")=$$SETUID^VPRUTILS("document",+$GET(DFN),DA)
+4 SET PROC("results",DA,"localTitle")=$GET(VPRT(DA,.01,"E"))
+5 SET NT=$$GET1^DIQ(8925.1,+$GET(VPRT(DA,.01,"I"))_",",1501)
+6 if $LENGTH(NT)
SET PROC("results",DA,"nationalTitle")=NT
+7 QUIT
+8 ;
MDC1(ID) ; -- clinical observation
+1 NEW GUID,CLIO,VPRC,VPRT,LOC,FAC,I,X,Y
+2 ;invalid GUID
SET GUID=$GET(ID)
if GUID=""
QUIT
+3 ;doesn't exist
DO QRYOBS^VPRDMDC("VPRC",GUID)
if '$DATA(VPRC)
QUIT
+4 ;PARENT also in list
if $LENGTH($GET(VPRC("PARENT_ID","E")))
QUIT
+5 ;
+6 SET CLIO("localId")=GUID
SET CLIO("uid")=$$SETUID^VPRUTILS("obs",DFN,GUID)
+7 SET X=$GET(VPRC("TERM_ID","I"))
if X
SET CLIO("typeVuid")="urn:va:vuid:"_X
+8 SET CLIO("typeCode")="urn:va:clioterminology:"_$GET(VPRC("TERM_ID","GUID"))
+9 SET CLIO("typeName")=$GET(VPRC("TERM_ID","E"))
+10 SET CLIO("result")=$GET(VPRC("SVALUE","E"))
+11 SET X=$GET(VPRC("UNIT_ID","ABBV"))
if $LENGTH(X)
SET CLIO("units")=X
+12 SET X=$GET(VPRC("ENTERED_DATE_TIME","I"))
SET CLIO("entered")=$$JSONDT^VPRUTILS(X)
+13 SET X=$GET(VPRC("OBSERVED_DATE_TIME","I"))
SET CLIO("observed")=$$JSONDT^VPRUTILS(X)
+14 DO QRYTYPES^VPRDMDC("VPRT")
+15 FOR I=3,5
SET X=$GET(VPRT(I,"XML"))
IF $LENGTH($GET(VPRC(X,"E")))
Begin DoDot:1
+16 SET Y=VPRT(I,"NAME")
SET Y=$SELECT(Y="LOCATION":"bodySite",1:$$LOW^XLFSTR(Y))
+17 SET CLIO(Y_"Code")=VPRC(X,"I")
SET CLIO(Y_"Name")=VPRC(X,"E")
End DoDot:1
+18 FOR I=4,6,7
SET X=$GET(VPRT(I,"XML"))
IF $LENGTH($GET(VPRC(X,"E")))
Begin DoDot:1
+19 SET CLIO("qualifiers",I,"type")=$$LOW^XLFSTR(VPRT(I,"NAME"))
+20 SET CLIO("qualifiers",I,"code")=VPRC(X,"I")
+21 SET CLIO("qualifiers",I,"name")=VPRC(X,"E")
End DoDot:1
+22 SET X=$GET(VPRC("RANGE","E"))
IF $LENGTH(X)
Begin DoDot:1
+23 SET Y=$SELECT(X="Out of Bounds Low":"<",X="Out of Bounds High":">",1:$EXTRACT(X))
+24 SET CLIO("interpretationCode")="urn:hl7:observation-interpretation:"_Y
+25 SET CLIO("interpretationName")=$SELECT(X="<":"Low off scale",X=">":"High off scale",1:X)
End DoDot:1
+26 ; X=$G(VPRC("STATUS","E")) S:$L(X) CLIO("resultStatus")=$S(X="unverified":"active",1:"complete")
+27 ;add set info
IF $DATA(VPRC("SUPP_PAGE"))
Begin DoDot:1
+28 SET CLIO("setID")=$GET(VPRC("SUPP_PAGE","GUID"))
+29 SET CLIO("setName")=$GET(VPRC("SUPP_PAGE","DISPLAY_NAME"))
+30 SET X=$GET(VPRC("SUPP_PAGE","TYPE"))
if $LENGTH(X)
SET CLIO("setType")=X
+31 SET X=$GET(VPRC("SUPP_PAGE","ACTIVATED_DATE_TIME"))
if X
SET CLIO("setStart")=$$JSONDT^VPRUTILS(X)
+32 SET X=$GET(VPRC("SUPP_PAGE","DEACTIVATED_DATE_TIME"))
if X
SET CLIO("setStop")=$$JSONDT^VPRUTILS(X)
End DoDot:1
+33 SET CLIO("statusCode")="urn:va:observation-status:complete"
SET CLIO("statusName")="complete"
+34 SET LOC=$GET(VPRC("HOSPITAL_LOCATION_ID","I"))
SET FAC=$$FAC^VPRD(LOC)
+35 SET CLIO("locationUid")=$$SETUID^VPRUTILS("location",,LOC)
+36 SET CLIO("locationName")=$GET(VPRC("HOSPITAL_LOCATION_ID","E"))
+37 DO FACILITY^VPRUTILS(FAC,"CLIO")
+38 SET X=$GET(VPRC("COMMENT","E"))
if $LENGTH(X)
SET CLIO("comment")=X
+39 DO ADD^VPRDJ("CLIO","obs")
+40 QUIT
