- 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 Feb 19, 2025@00:11:03 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
