HMPDJ03 ;SLC/MKB,ASMR/RRB,JD - Consults,ClinProcedures,CLiO ;4/4/16 15:33
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,2**;May 15, 2016;Build 28
;Per VA Directive 6402, this routine should not be modified.
;
; DE4173 - JD - 3/30/16: Send consult notes for "activities" and "results".
;
; 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, [HMPSTART, HMPSTOP, HMPMAX, HMPTEXT]
Q
;
GMRC1(ID) ; -- consult/request HMPX=^TMP("GMRCR",$J,"CS",HMPN,0)
N CONS,ORDER,HMPD,X0,X,HMPA,DA,ACT0,ACT2,ACT3,ACT,HMPEASON,HMPJ,HMPTIU
N $ES,$ET,ERRPAT,ERRMSG
S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
S ERRMSG="A problem occurred converting record "_ID_" for the consults domain"
;
S CONS("localId")=+HMPX,CONS("uid")=$$SETUID^HMPUTILS("consult",DFN,+HMPX)
S CONS("dateTime")=$$JSONDT^HMPUTILS($P(HMPX,U,2))
S CONS("statusName")=$P(HMPX,U,3),CONS("service")=$P(HMPX,U,4)
S CONS("consultProcedure")=$P(HMPX,U,5)
I $P(HMPX,U,6)="*" S CONS("interpretation")="SIGNIFICANT FINDINGS"
S CONS("typeName")=$P(HMPX,U,7),CONS("category")=$P(HMPX,U,9)
S ORDER=+$P(HMPX,U,8),CONS("orderName")=$P($$OI^ORX8(ORDER),U,2)
S CONS("orderUid")=$$SETUID^HMPUTILS("order",DFN,ORDER)
D GET^GMRCAPI(.HMPD,+HMPX) S X0=$G(HMPD(0)) ;=^GMR(123,ID,0)
S X=$P(X0,U,6) S:X CONS("fromService")=$$GET1^DIQ(44,X_",",.01) ;DE2818
S X=$P(X0,U,9) S:X]"" CONS("urgency")=X
S X=$P(X0,U,10) S:X]"" CONS("place")=X
S X=$P(X0,U,11) S:X CONS("attention")=$$GET1^DIQ(200,X_",",.01) ;DE2818
S X=$P(X0,U,13) S:X]"" CONS("lastAction")=X
S X=$P(X0,U,14) I X D ;ordering provider
. S CONS("providerUid")=$$SETUID^HMPUTILS("user",,+X)
. S CONS("providerName")=$$GET1^DIQ(200,X_",",.01) ;DE2818
S X=$P(X0,U,18) I $L(X) D
. S CONS("patientClassCode")="urn:va:patient-class:"_$S(X="I":"IMP",1:"AMB")
. S CONS("patientClassName")=$S(X="I":"Inpatient",1:"Ambulatory")
S X=+$P(X0,U,24) S:X CONS("earliestDate")=$$JSONDT^HMPUTILS(X)
I $P(HMPX,U,9)="M" S CONS("clinicalProcedure")=$G(HMPD(1))
I $D(HMPD(20)) M HMPEASON=HMPD(20) S CONS("reason")=$$STRING^HMPD(.HMPEASON)
S X=$G(HMPD(30)) S:$L(X) CONS("provisionalDx")=X
;
I $P(X0,U,23) D ;inter-facility
. N IFC S X=$$NS^XUAF4($P(X0,U,23))
. S CONS("remote","facilityCode")=$P(X,U,2),CONS("remote","facilityName")=$P(X,U)
. S:$P(X0,U,22) CONS("remote","id")=$P(X0,U,22)
. S IFC=$$IFC^GMRCAPI(ID)
. S X=$P(IFC,U) S:$L(X) CONS("remote","service")=X
. S X=$P(IFC,U,5) S:$L(X) CONS("remote","role")=$S(X="P":"Requesting facility",1:"Consulting facility")
. S CONS("remote","providerName")=$P(IFC,U,6)
. S X=$P(IFC,U,2) S:$L(X) CONS("remote","providerphone")=X
. S X=$P(IFC,U,3) S:$L(X) CONS("remote","providerpager")=X
;
D ACT^GMRCAPI(.HMPA,ID)
S DA=0 F S DA=$O(HMPA(DA)) Q:DA<1 D
. S ACT0=$G(HMPA(DA,0)),ACT2=$G(HMPA(DA,2)),ACT3=$G(HMPA(DA,3)) K ACT
. I $L(ACT2),$P(X0,U,23) S X=$$NS^XUAF4($P(X0,U,23)),ACT("facilityCode")=$P(X,U,2),ACT("facilityName")=$P(X,U)
. S ACT("name")=$P(ACT0,U,2)
. S ACT("entered")=$$JSONDT^HMPUTILS($P(ACT0,U))
. S ACT("dateTime")=$$JSONDT^HMPUTILS($P(ACT0,U,3))
. S:$L($P(ACT2,U,3)) ACT("timeZone")=$P(ACT2,U,3)
. I $L(ACT2) S ACT("enteredBy")=$P(ACT2,U),ACT("responsible")=$P(ACT2,U,2)
. E D ;remote vs. local users
.. S X=+$P(ACT0,U,4) S:X ACT("responsible")=$$GET1^DIQ(200,X_",",.01) ;DE2818
.. S X=+$P(ACT0,U,5) S:X ACT("enteredBy")=$$GET1^DIQ(200,X_",",.01) ;DE2818
. S X=$S($L(ACT3):ACT3,1:$P(ACT0,U,6)) S:$L(X) ACT("forwardedFrom")=X
. S X=$P(ACT0,U,7) S:X ACT("previousAttention")=$$GET1^DIQ(200,X_",",.01) ;DE2818
. S X=$P(ACT0,U,8) S:X ACT("device")=$$GET1^DIQ(3.5,X_",",.01)
. S X=$P(ACT0,U,9) I X,X["TIU" D
.. S ACT("resultUid")=$$SETUID^HMPUTILS("document",DFN,+X)
.. ;=== Start DE4173 for "activity" attribute
.. N HMP92,HMPNI
.. S HMPNI=$P($P(ACT0,U,9),";") ;Note (document) IEN --> ^TIU(8925,HMPNI
.. I HMPNI'>0 Q
.. D SETTEXT^HMPUTILS($NA(^TIU(8925,HMPNI,"TEXT")),"HMP92") ;Format a word processing field
.. M ACT("note","\")=HMP92
.. ;=== End DE4173 for "activity" attribute
. I $D(HMPA(DA,1)) M HMPEASON=HMPA(DA,1) S ACT("comment")=$$STRING^HMPD(.HMPEASON)
. M CONS("activity",DA)=ACT
;
S HMPJ=0 F S HMPJ=$O(HMPD(50,HMPJ)) Q:HMPJ<1 S X=$G(HMPD(50,HMPJ)) D
. Q:'$D(@(U_$P(X,";",2)_+X_")")) ;text deleted
. ;=== Start DE4173 for "results" attribute
. N HMP92,HMPNI
. S HMPNI=$P(X,";") ;Note (document) IEN --> ^TIU(8925,HMPNI
. I HMPNI>0 D
.. D SETTEXT^HMPUTILS($NA(^TIU(8925,HMPNI,"TEXT")),"HMP92") ;Format a word processing field
.. M CONS("results",HMPJ,"note","\")=HMP92
. ;=== End DE4173 for "results" attribute
. S CONS("results",HMPJ,"uid")=$$SETUID^HMPUTILS("document",DFN,+X)
. D EXTRACT^TIULQ(+X,"HMPTIU",,.01)
. S CONS("results",HMPJ,"localTitle")=$G(HMPTIU(+X,.01,"E"))
S X=$P(X0,U,21),X=$S(X:$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U),1:$$FAC^HMPD)
D FACILITY^HMPUTILS(X,"CONS")
S CONS("lastUpdateTime")=$$EN^HMPSTMP("consult")
S CONS("stampTime")=CONS("lastUpdateTime") ; RHL 20141231
;US6734 - pre-compile metastamp
I $G(HMPMETA) D ADD^HMPMETA("consult",CONS("uid"),CONS("stampTime")) Q:HMPMETA=1 ;US6734,US11019
D ADD^HMPDJ("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 HMPX=^TMP("MDHSP",$J,HMPN)
N X,Y,%DT,DATE,RTN,GBL,CONS,TIUN,HMPD,X0,PROC,HMPT,LOC,FAC
N $ES,$ET,ERRPAT,ERRMSG
S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
S ERRMSG="A problem occurred converting record "_ID_" for the clinical procedure domain"
;
S RTN=$P(HMPX,U,3,4) Q:RTN="PRPRO^MDPS4" ;skip non-CP items
S X=$P(HMPX,U,6),%DT="TXS" D ^%DT Q:Y'>0 S DATE=Y
S GBL=+$P(HMPX,U,2)_";"_$S(RTN="PR702^MDPS1":"MDD(702,",1:$$ROOT^HMPDMC(DFN,$P(HMPX,U,11),DATE))
Q:'GBL I $G(ID),ID'=GBL Q ;unknown, or not requested
;
S CONS=+$P(HMPX,U,13) D:CONS DOCLIST^GMRCGUIB(.HMPD,CONS) S X0=$G(HMPD(0)) ;=^GMR(123,ID,0)
S TIUN=+$P(HMPX,U,14) S:TIUN TIUN=TIUN_U_$$RESOLVE^TIUSRVLO(TIUN)
S PROC("localId")=GBL,PROC("category")="CP"
S PROC("uid")=$$SETUID^HMPUTILS("procedure",DFN,GBL)
S PROC("name")=$P(HMPX,U),PROC("dateTime")=$$JSONDT^HMPUTILS(DATE)
S X=$P(HMPX,U,7) S:$L(X) PROC("interpretation")=X
S PROC("kind")="Procedure"
I CONS,X0 D
. N HMPJ S PROC("requested")=$$JSONDT^HMPUTILS(+X0)
. S PROC("consultUid")=$$SETUID^HMPUTILS("consult",DFN,CONS)
. S PROC("orderUid")=$$SETUID^HMPUTILS("order",DFN,+$P(X0,U,3))
. S PROC("statusName")=$$EXTERNAL^DILFD(123,8,,$P(X0,U,12))
. S HMPJ=0 F S HMPJ=$O(HMPD(50,HMPJ)) Q:HMPJ<1 S X=+$G(HMPD(50,HMPJ)) 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^HMPUTILS("user",,+X)
.. S PROC("providers",1,"providerName")=$P(X,";",3)
. S:$P(TIUN,U,11) PROC("hasImages")="true"
. K HMPT D EXTRACT^TIULQ(+TIUN,"HMPT",,".03;.05;1211",,,"I")
. S X=+$G(HMPT(+TIUN,.03,"I")),PROC("encounterUid")=$$SETUID^HMPUTILS("visit",DFN,X)
. S LOC=+$G(HMPT(+TIUN,1211,"I")) I LOC S LOC=LOC_U_$$GET1^DIQ(44,LOC_",",.01) ;DE2818
. E S X=$P(TIUN,U,6) S:$L(X) LOC=+$O(^SC("B",X,0))_U_X ; DE2818, ICR 10040
. S:LOC PROC("locationUid")=$$SETUID^HMPUTILS("location",,+LOC),PROC("locationName")=$P(LOC,U,2),FAC=$$FAC^HMPD(+LOC)
. I '$D(PROC("statusName")) S X=+$G(HMPT(+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 ...
I 'CONS,'TIUN,RTN'="PR702^MDPS1" S PROC("results",1,"uid")=$$SETUID^HMPUTILS("document",DFN,GBL) ;DE1977 add link to report document
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^HMPD)
D FACILITY^HMPUTILS(FAC,"PROC")
S PROC("lastUpdateTime")=$$EN^HMPSTMP("procedure")
S PROC("stampTime")=PROC("lastUpdateTime") ; RHL 20141231
;US6734 - pre-compile metastamp
I $G(HMPMETA) D ADD^HMPMETA("procedure",PROC("uid"),PROC("stampTime")) Q:HMPMETA=1 ;US6734,US11019
D ADD^HMPDJ("PROC","procedure")
Q
;
NOTE(DA) ; -- add TIU note info
N HMPT,TEXT
D EXTRACT^TIULQ(DA,"HMPT",,.01)
S PROC("results",DA,"uid")=$$SETUID^HMPUTILS("document",+$G(DFN),DA)
S PROC("results",DA,"localTitle")=$G(HMPT(DA,.01,"E"))
Q
;
MDC1(ID) ; -- clinical observation
N GUID,CLIO,HMPC,HMPT,LOC,FAC,I,X,Y
S GUID=$G(ID) Q:GUID="" ;invalid GUID
D QRYOBS^HMPDMDC("HMPC",GUID) Q:'$D(HMPC) ;doesn't exist
Q:$L($G(HMPC("PARENT_ID","E"))) ;PARENT also in list
N $ES,$ET,ERRPAT,ERRMSG
S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
S ERRMSG="A problem occurred converting record "_ID_" for the clinical observation domain"
;
S CLIO("localId")=GUID,CLIO("uid")=$$SETUID^HMPUTILS("obs",DFN,GUID)
S X=$G(HMPC("TERM_ID","I")) S:X CLIO("typeVuid")="urn:va:vuid:"_X
S CLIO("typeCode")="urn:va:clioterminology:"_$G(HMPC("TERM_ID","GUID"))
S CLIO("typeName")=$G(HMPC("TERM_ID","E"))
S CLIO("result")=$G(HMPC("SVALUE","E"))
S X=$G(HMPC("UNIT_ID","ABBV")) S:$L(X) CLIO("units")=X
S X=$G(HMPC("ENTERED_DATE_TIME","I")),CLIO("entered")=$$JSONDT^HMPUTILS(X)
S X=$G(HMPC("OBSERVED_DATE_TIME","I")),CLIO("observed")=$$JSONDT^HMPUTILS(X)
D QRYTYPES^HMPDMDC("HMPT")
F I=3,5 S X=$G(HMPT(I,"XML")) I $L($G(HMPC(X,"E"))) D
. S Y=HMPT(I,"NAME"),Y=$S(Y="LOCATION":"bodySite",1:$$LOW^XLFSTR(Y))
. S CLIO(Y_"Code")=HMPC(X,"I"),CLIO(Y_"Name")=HMPC(X,"E")
F I=4,6,7 S X=$G(HMPT(I,"XML")) I $L($G(HMPC(X,"E"))) D
. S CLIO("qualifiers",I,"type")=$$LOW^XLFSTR(HMPT(I,"NAME"))
. S CLIO("qualifiers",I,"code")=HMPC(X,"I")
. S CLIO("qualifiers",I,"name")=HMPC(X,"E")
S X=$G(HMPC("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(HMPC("STATUS","E")) S:$L(X) CLIO("resultStatus")=$S(X="unverified":"active",1:"complete")
I $D(HMPC("SUPP_PAGE")) D ;add set info
. S CLIO("setID")=$G(HMPC("SUPP_PAGE","GUID"))
. S CLIO("setName")=$G(HMPC("SUPP_PAGE","DISPLAY_NAME"))
. S X=$G(HMPC("SUPP_PAGE","TYPE")) S:$L(X) CLIO("setType")=X
. S X=$G(HMPC("SUPP_PAGE","ACTIVATED_DATE_TIME")) S:X CLIO("setStart")=$$JSONDT^HMPUTILS(X)
. S X=$G(HMPC("SUPP_PAGE","DEACTIVATED_DATE_TIME")) S:X CLIO("setStop")=$$JSONDT^HMPUTILS(X)
S CLIO("statusCode")="urn:va:observation-status:complete",CLIO("statusName")="complete"
S LOC=$G(HMPC("HOSPITAL_LOCATION_ID","I")),FAC=$$FAC^HMPD(LOC)
S CLIO("locationUid")=$$SETUID^HMPUTILS("location",,LOC)
S CLIO("locationName")=$G(HMPC("HOSPITAL_LOCATION_ID","E"))
D FACILITY^HMPUTILS(FAC,"CLIO")
S X=$G(HMPC("COMMENT","E")) S:$L(X) CLIO("comment")=X
S CLIO("lastUpdateTime")=$$EN^HMPSTMP("obs") ; RHL 20141231
S CLIO("stampTime")=CLIO("lastUpdateTime") ; RHL 20141231
;US6734 - pre-compile metastamp
I $G(HMPMETA) D ADD^HMPMETA("obs",CLIO("uid"),CLIO("stampTime")) Q:HMPMETA=1 ;US6734,US11019
D ADD^HMPDJ("CLIO","obs")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPDJ03 11978 printed Sep 23, 2025@19:29:20 Page 2
HMPDJ03 ;SLC/MKB,ASMR/RRB,JD - Consults,ClinProcedures,CLiO ;4/4/16 15:33
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,2**;May 15, 2016;Build 28
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; DE4173 - JD - 3/30/16: Send consult notes for "activities" and "results".
+5 ;
+6 ; External References DBIA#
+7 ; ------------------- -----
+8 ; ^SC( 10040
+9 ; ^TIU(8925.1 5677
+10 ; ^VA(200 10060
+11 ; %DT 10003
+12 ; DILFD 2055
+13 ; DIQ 2056
+14 ; GMRCAPI 6082
+15 ; GMRCGUIB 2980
+16 ; GMRCSLM1,^TMP("GMRCR" 2740
+17 ; MCARUTL3 3280
+18 ; MDPS1,^TMP("MDHSP" 4230
+19 ; ORX8 2467
+20 ; TIULQ 2693
+21 ; TIUSRVLO 2834
+22 ; XLFSTR 10104
+23 ; XUAF4 2171
+24 ;
+25 ; All tags expect DFN, ID, [HMPSTART, HMPSTOP, HMPMAX, HMPTEXT]
+26 QUIT
+27 ;
GMRC1(ID) ; -- consult/request HMPX=^TMP("GMRCR",$J,"CS",HMPN,0)
+1 NEW CONS,ORDER,HMPD,X0,X,HMPA,DA,ACT0,ACT2,ACT3,ACT,HMPEASON,HMPJ,HMPTIU
+2 NEW $ESTACK,$ETRAP,ERRPAT,ERRMSG
+3 SET $ETRAP="D ERRHDLR^HMPDERRH"
SET ERRPAT=DFN
+4 SET ERRMSG="A problem occurred converting record "_ID_" for the consults domain"
+5 ;
+6 SET CONS("localId")=+HMPX
SET CONS("uid")=$$SETUID^HMPUTILS("consult",DFN,+HMPX)
+7 SET CONS("dateTime")=$$JSONDT^HMPUTILS($PIECE(HMPX,U,2))
+8 SET CONS("statusName")=$PIECE(HMPX,U,3)
SET CONS("service")=$PIECE(HMPX,U,4)
+9 SET CONS("consultProcedure")=$PIECE(HMPX,U,5)
+10 IF $PIECE(HMPX,U,6)="*"
SET CONS("interpretation")="SIGNIFICANT FINDINGS"
+11 SET CONS("typeName")=$PIECE(HMPX,U,7)
SET CONS("category")=$PIECE(HMPX,U,9)
+12 SET ORDER=+$PIECE(HMPX,U,8)
SET CONS("orderName")=$PIECE($$OI^ORX8(ORDER),U,2)
+13 SET CONS("orderUid")=$$SETUID^HMPUTILS("order",DFN,ORDER)
+14 ;=^GMR(123,ID,0)
DO GET^GMRCAPI(.HMPD,+HMPX)
SET X0=$GET(HMPD(0))
+15 ;DE2818
SET X=$PIECE(X0,U,6)
if X
SET CONS("fromService")=$$GET1^DIQ(44,X_",",.01)
+16 SET X=$PIECE(X0,U,9)
if X]""
SET CONS("urgency")=X
+17 SET X=$PIECE(X0,U,10)
if X]""
SET CONS("place")=X
+18 ;DE2818
SET X=$PIECE(X0,U,11)
if X
SET CONS("attention")=$$GET1^DIQ(200,X_",",.01)
+19 SET X=$PIECE(X0,U,13)
if X]""
SET CONS("lastAction")=X
+20 ;ordering provider
SET X=$PIECE(X0,U,14)
IF X
Begin DoDot:1
+21 SET CONS("providerUid")=$$SETUID^HMPUTILS("user",,+X)
+22 ;DE2818
SET CONS("providerName")=$$GET1^DIQ(200,X_",",.01)
End DoDot:1
+23 SET X=$PIECE(X0,U,18)
IF $LENGTH(X)
Begin DoDot:1
+24 SET CONS("patientClassCode")="urn:va:patient-class:"_$SELECT(X="I":"IMP",1:"AMB")
+25 SET CONS("patientClassName")=$SELECT(X="I":"Inpatient",1:"Ambulatory")
End DoDot:1
+26 SET X=+$PIECE(X0,U,24)
if X
SET CONS("earliestDate")=$$JSONDT^HMPUTILS(X)
+27 IF $PIECE(HMPX,U,9)="M"
SET CONS("clinicalProcedure")=$GET(HMPD(1))
+28 IF $DATA(HMPD(20))
MERGE HMPEASON=HMPD(20)
SET CONS("reason")=$$STRING^HMPD(.HMPEASON)
+29 SET X=$GET(HMPD(30))
if $LENGTH(X)
SET CONS("provisionalDx")=X
+30 ;
+31 ;inter-facility
IF $PIECE(X0,U,23)
Begin DoDot:1
+32 NEW IFC
SET X=$$NS^XUAF4($PIECE(X0,U,23))
+33 SET CONS("remote","facilityCode")=$PIECE(X,U,2)
SET CONS("remote","facilityName")=$PIECE(X,U)
+34 if $PIECE(X0,U,22)
SET CONS("remote","id")=$PIECE(X0,U,22)
+35 SET IFC=$$IFC^GMRCAPI(ID)
+36 SET X=$PIECE(IFC,U)
if $LENGTH(X)
SET CONS("remote","service")=X
+37 SET X=$PIECE(IFC,U,5)
if $LENGTH(X)
SET CONS("remote","role")=$SELECT(X="P":"Requesting facility",1:"Consulting facility")
+38 SET CONS("remote","providerName")=$PIECE(IFC,U,6)
+39 SET X=$PIECE(IFC,U,2)
if $LENGTH(X)
SET CONS("remote","providerphone")=X
+40 SET X=$PIECE(IFC,U,3)
if $LENGTH(X)
SET CONS("remote","providerpager")=X
End DoDot:1
+41 ;
+42 DO ACT^GMRCAPI(.HMPA,ID)
+43 SET DA=0
FOR
SET DA=$ORDER(HMPA(DA))
if DA<1
QUIT
Begin DoDot:1
+44 SET ACT0=$GET(HMPA(DA,0))
SET ACT2=$GET(HMPA(DA,2))
SET ACT3=$GET(HMPA(DA,3))
KILL ACT
+45 IF $LENGTH(ACT2)
IF $PIECE(X0,U,23)
SET X=$$NS^XUAF4($PIECE(X0,U,23))
SET ACT("facilityCode")=$PIECE(X,U,2)
SET ACT("facilityName")=$PIECE(X,U)
+46 SET ACT("name")=$PIECE(ACT0,U,2)
+47 SET ACT("entered")=$$JSONDT^HMPUTILS($PIECE(ACT0,U))
+48 SET ACT("dateTime")=$$JSONDT^HMPUTILS($PIECE(ACT0,U,3))
+49 if $LENGTH($PIECE(ACT2,U,3))
SET ACT("timeZone")=$PIECE(ACT2,U,3)
+50 IF $LENGTH(ACT2)
SET ACT("enteredBy")=$PIECE(ACT2,U)
SET ACT("responsible")=$PIECE(ACT2,U,2)
+51 ;remote vs. local users
IF '$TEST
Begin DoDot:2
+52 ;DE2818
SET X=+$PIECE(ACT0,U,4)
if X
SET ACT("responsible")=$$GET1^DIQ(200,X_",",.01)
+53 ;DE2818
SET X=+$PIECE(ACT0,U,5)
if X
SET ACT("enteredBy")=$$GET1^DIQ(200,X_",",.01)
End DoDot:2
+54 SET X=$SELECT($LENGTH(ACT3):ACT3,1:$PIECE(ACT0,U,6))
if $LENGTH(X)
SET ACT("forwardedFrom")=X
+55 ;DE2818
SET X=$PIECE(ACT0,U,7)
if X
SET ACT("previousAttention")=$$GET1^DIQ(200,X_",",.01)
+56 SET X=$PIECE(ACT0,U,8)
if X
SET ACT("device")=$$GET1^DIQ(3.5,X_",",.01)
+57 SET X=$PIECE(ACT0,U,9)
IF X
IF X["TIU"
Begin DoDot:2
+58 SET ACT("resultUid")=$$SETUID^HMPUTILS("document",DFN,+X)
+59 ;=== Start DE4173 for "activity" attribute
+60 NEW HMP92,HMPNI
+61 ;Note (document) IEN --> ^TIU(8925,HMPNI
SET HMPNI=$PIECE($PIECE(ACT0,U,9),";")
+62 IF HMPNI'>0
QUIT
+63 ;Format a word processing field
DO SETTEXT^HMPUTILS($NAME(^TIU(8925,HMPNI,"TEXT")),"HMP92")
+64 MERGE ACT("note","\")=HMP92
+65 ;=== End DE4173 for "activity" attribute
End DoDot:2
+66 IF $DATA(HMPA(DA,1))
MERGE HMPEASON=HMPA(DA,1)
SET ACT("comment")=$$STRING^HMPD(.HMPEASON)
+67 MERGE CONS("activity",DA)=ACT
End DoDot:1
+68 ;
+69 SET HMPJ=0
FOR
SET HMPJ=$ORDER(HMPD(50,HMPJ))
if HMPJ<1
QUIT
SET X=$GET(HMPD(50,HMPJ))
Begin DoDot:1
+70 ;text deleted
if '$DATA(@(U_$PIECE(X,";",2)_+X_")"))
QUIT
+71 ;=== Start DE4173 for "results" attribute
+72 NEW HMP92,HMPNI
+73 ;Note (document) IEN --> ^TIU(8925,HMPNI
SET HMPNI=$PIECE(X,";")
+74 IF HMPNI>0
Begin DoDot:2
+75 ;Format a word processing field
DO SETTEXT^HMPUTILS($NAME(^TIU(8925,HMPNI,"TEXT")),"HMP92")
+76 MERGE CONS("results",HMPJ,"note","\")=HMP92
End DoDot:2
+77 ;=== End DE4173 for "results" attribute
+78 SET CONS("results",HMPJ,"uid")=$$SETUID^HMPUTILS("document",DFN,+X)
+79 DO EXTRACT^TIULQ(+X,"HMPTIU",,.01)
+80 SET CONS("results",HMPJ,"localTitle")=$GET(HMPTIU(+X,.01,"E"))
End DoDot:1
+81 SET X=$PIECE(X0,U,21)
SET X=$SELECT(X:$$STA^XUAF4(X)_U_$PIECE($$NS^XUAF4(X),U),1:$$FAC^HMPD)
+82 DO FACILITY^HMPUTILS(X,"CONS")
+83 SET CONS("lastUpdateTime")=$$EN^HMPSTMP("consult")
+84 ; RHL 20141231
SET CONS("stampTime")=CONS("lastUpdateTime")
+85 ;US6734 - pre-compile metastamp
+86 ;US6734,US11019
IF $GET(HMPMETA)
DO ADD^HMPMETA("consult",CONS("uid"),CONS("stampTime"))
if HMPMETA=1
QUIT
+87 DO ADD^HMPDJ("CONS","consult")
+88 QUIT
+89 ;
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 HMPX=^TMP("MDHSP",$J,HMPN)
+1 NEW X,Y,%DT,DATE,RTN,GBL,CONS,TIUN,HMPD,X0,PROC,HMPT,LOC,FAC
+2 NEW $ESTACK,$ETRAP,ERRPAT,ERRMSG
+3 SET $ETRAP="D ERRHDLR^HMPDERRH"
SET ERRPAT=DFN
+4 SET ERRMSG="A problem occurred converting record "_ID_" for the clinical procedure domain"
+5 ;
+6 ;skip non-CP items
SET RTN=$PIECE(HMPX,U,3,4)
if RTN="PRPRO^MDPS4"
QUIT
+7 SET X=$PIECE(HMPX,U,6)
SET %DT="TXS"
DO ^%DT
if Y'>0
QUIT
SET DATE=Y
+8 SET GBL=+$PIECE(HMPX,U,2)_";"_$SELECT(RTN="PR702^MDPS1":"MDD(702,",1:$$ROOT^HMPDMC(DFN,$PIECE(HMPX,U,11),DATE))
+9 ;unknown, or not requested
if 'GBL
QUIT
IF $GET(ID)
IF ID'=GBL
QUIT
+10 ;
+11 ;=^GMR(123,ID,0)
SET CONS=+$PIECE(HMPX,U,13)
if CONS
DO DOCLIST^GMRCGUIB(.HMPD,CONS)
SET X0=$GET(HMPD(0))
+12 SET TIUN=+$PIECE(HMPX,U,14)
if TIUN
SET TIUN=TIUN_U_$$RESOLVE^TIUSRVLO(TIUN)
+13 SET PROC("localId")=GBL
SET PROC("category")="CP"
+14 SET PROC("uid")=$$SETUID^HMPUTILS("procedure",DFN,GBL)
+15 SET PROC("name")=$PIECE(HMPX,U)
SET PROC("dateTime")=$$JSONDT^HMPUTILS(DATE)
+16 SET X=$PIECE(HMPX,U,7)
if $LENGTH(X)
SET PROC("interpretation")=X
+17 SET PROC("kind")="Procedure"
+18 IF CONS
IF X0
Begin DoDot:1
+19 NEW HMPJ
SET PROC("requested")=$$JSONDT^HMPUTILS(+X0)
+20 SET PROC("consultUid")=$$SETUID^HMPUTILS("consult",DFN,CONS)
+21 SET PROC("orderUid")=$$SETUID^HMPUTILS("order",DFN,+$PIECE(X0,U,3))
+22 SET PROC("statusName")=$$EXTERNAL^DILFD(123,8,,$PIECE(X0,U,12))
+23 SET HMPJ=0
FOR
SET HMPJ=$ORDER(HMPD(50,HMPJ))
if HMPJ<1
QUIT
SET X=+$GET(HMPD(50,HMPJ))
Begin DoDot:2
+24 DO NOTE(X)
+25 if 'TIUN
SET TIUN=X_U_$$RESOLVE^TIUSRVLO(X)
End DoDot:2
End DoDot:1
+26 IF TIUN
Begin DoDot:1
+27 SET X=$PIECE(TIUN,U,5)
IF X
Begin DoDot:2
+28 SET PROC("providers",1,"providerUid")=$$SETUID^HMPUTILS("user",,+X)
+29 SET PROC("providers",1,"providerName")=$PIECE(X,";",3)
End DoDot:2
+30 if $PIECE(TIUN,U,11)
SET PROC("hasImages")="true"
+31 KILL HMPT
DO EXTRACT^TIULQ(+TIUN,"HMPT",,".03;.05;1211",,,"I")
+32 SET X=+$GET(HMPT(+TIUN,.03,"I"))
SET PROC("encounterUid")=$$SETUID^HMPUTILS("visit",DFN,X)
+33 ;DE2818
SET LOC=+$GET(HMPT(+TIUN,1211,"I"))
IF LOC
SET LOC=LOC_U_$$GET1^DIQ(44,LOC_",",.01)
+34 ; DE2818, ICR 10040
IF '$TEST
SET X=$PIECE(TIUN,U,6)
if $LENGTH(X)
SET LOC=+$ORDER(^SC("B",X,0))_U_X
+35 if LOC
SET PROC("locationUid")=$$SETUID^HMPUTILS("location",,+LOC)
SET PROC("locationName")=$PIECE(LOC,U,2)
SET FAC=$$FAC^HMPD(+LOC)
+36 IF '$DATA(PROC("statusName"))
SET X=+$GET(HMPT(+TIUN,.05,"I"))
SET PROC("statusName")=$SELECT(X<6:"PARTIAL RESULTS",1:"COMPLETE")
+37 IF '$GET(PROC("results",+TIUN))
DO NOTE(+TIUN)
End DoDot:1
+38 ; if no consult or note/visit ...
+39 ;DE1977 add link to report document
IF 'CONS
IF 'TIUN
IF RTN'="PR702^MDPS1"
SET PROC("results",1,"uid")=$$SETUID^HMPUTILS("document",DFN,GBL)
+40 if '$DATA(PROC("statusName"))
SET PROC("statusName")="COMPLETE"
+41 IF '$DATA(FAC)
SET X=$PIECE(X0,U,21)
SET FAC=$SELECT(X:$$STA^XUAF4(X)_U_$PIECE($$NS^XUAF4(X),U),1:$$FAC^HMPD)
+42 DO FACILITY^HMPUTILS(FAC,"PROC")
+43 SET PROC("lastUpdateTime")=$$EN^HMPSTMP("procedure")
+44 ; RHL 20141231
SET PROC("stampTime")=PROC("lastUpdateTime")
+45 ;US6734 - pre-compile metastamp
+46 ;US6734,US11019
IF $GET(HMPMETA)
DO ADD^HMPMETA("procedure",PROC("uid"),PROC("stampTime"))
if HMPMETA=1
QUIT
+47 DO ADD^HMPDJ("PROC","procedure")
+48 QUIT
+49 ;
NOTE(DA) ; -- add TIU note info
+1 NEW HMPT,TEXT
+2 DO EXTRACT^TIULQ(DA,"HMPT",,.01)
+3 SET PROC("results",DA,"uid")=$$SETUID^HMPUTILS("document",+$GET(DFN),DA)
+4 SET PROC("results",DA,"localTitle")=$GET(HMPT(DA,.01,"E"))
+5 QUIT
+6 ;
MDC1(ID) ; -- clinical observation
+1 NEW GUID,CLIO,HMPC,HMPT,LOC,FAC,I,X,Y
+2 ;invalid GUID
SET GUID=$GET(ID)
if GUID=""
QUIT
+3 ;doesn't exist
DO QRYOBS^HMPDMDC("HMPC",GUID)
if '$DATA(HMPC)
QUIT
+4 ;PARENT also in list
if $LENGTH($GET(HMPC("PARENT_ID","E")))
QUIT
+5 NEW $ESTACK,$ETRAP,ERRPAT,ERRMSG
+6 SET $ETRAP="D ERRHDLR^HMPDERRH"
SET ERRPAT=DFN
+7 SET ERRMSG="A problem occurred converting record "_ID_" for the clinical observation domain"
+8 ;
+9 SET CLIO("localId")=GUID
SET CLIO("uid")=$$SETUID^HMPUTILS("obs",DFN,GUID)
+10 SET X=$GET(HMPC("TERM_ID","I"))
if X
SET CLIO("typeVuid")="urn:va:vuid:"_X
+11 SET CLIO("typeCode")="urn:va:clioterminology:"_$GET(HMPC("TERM_ID","GUID"))
+12 SET CLIO("typeName")=$GET(HMPC("TERM_ID","E"))
+13 SET CLIO("result")=$GET(HMPC("SVALUE","E"))
+14 SET X=$GET(HMPC("UNIT_ID","ABBV"))
if $LENGTH(X)
SET CLIO("units")=X
+15 SET X=$GET(HMPC("ENTERED_DATE_TIME","I"))
SET CLIO("entered")=$$JSONDT^HMPUTILS(X)
+16 SET X=$GET(HMPC("OBSERVED_DATE_TIME","I"))
SET CLIO("observed")=$$JSONDT^HMPUTILS(X)
+17 DO QRYTYPES^HMPDMDC("HMPT")
+18 FOR I=3,5
SET X=$GET(HMPT(I,"XML"))
IF $LENGTH($GET(HMPC(X,"E")))
Begin DoDot:1
+19 SET Y=HMPT(I,"NAME")
SET Y=$SELECT(Y="LOCATION":"bodySite",1:$$LOW^XLFSTR(Y))
+20 SET CLIO(Y_"Code")=HMPC(X,"I")
SET CLIO(Y_"Name")=HMPC(X,"E")
End DoDot:1
+21 FOR I=4,6,7
SET X=$GET(HMPT(I,"XML"))
IF $LENGTH($GET(HMPC(X,"E")))
Begin DoDot:1
+22 SET CLIO("qualifiers",I,"type")=$$LOW^XLFSTR(HMPT(I,"NAME"))
+23 SET CLIO("qualifiers",I,"code")=HMPC(X,"I")
+24 SET CLIO("qualifiers",I,"name")=HMPC(X,"E")
End DoDot:1
+25 SET X=$GET(HMPC("RANGE","E"))
IF $LENGTH(X)
Begin DoDot:1
+26 SET Y=$SELECT(X="Out of Bounds Low":"<",X="Out of Bounds High":">",1:$EXTRACT(X))
+27 SET CLIO("interpretationCode")="urn:hl7:observation-interpretation:"_Y
+28 SET CLIO("interpretationName")=$SELECT(X="<":"Low off scale",X=">":"High off scale",1:X)
End DoDot:1
+29 ; X=$G(HMPC("STATUS","E")) S:$L(X) CLIO("resultStatus")=$S(X="unverified":"active",1:"complete")
+30 ;add set info
IF $DATA(HMPC("SUPP_PAGE"))
Begin DoDot:1
+31 SET CLIO("setID")=$GET(HMPC("SUPP_PAGE","GUID"))
+32 SET CLIO("setName")=$GET(HMPC("SUPP_PAGE","DISPLAY_NAME"))
+33 SET X=$GET(HMPC("SUPP_PAGE","TYPE"))
if $LENGTH(X)
SET CLIO("setType")=X
+34 SET X=$GET(HMPC("SUPP_PAGE","ACTIVATED_DATE_TIME"))
if X
SET CLIO("setStart")=$$JSONDT^HMPUTILS(X)
+35 SET X=$GET(HMPC("SUPP_PAGE","DEACTIVATED_DATE_TIME"))
if X
SET CLIO("setStop")=$$JSONDT^HMPUTILS(X)
End DoDot:1
+36 SET CLIO("statusCode")="urn:va:observation-status:complete"
SET CLIO("statusName")="complete"
+37 SET LOC=$GET(HMPC("HOSPITAL_LOCATION_ID","I"))
SET FAC=$$FAC^HMPD(LOC)
+38 SET CLIO("locationUid")=$$SETUID^HMPUTILS("location",,LOC)
+39 SET CLIO("locationName")=$GET(HMPC("HOSPITAL_LOCATION_ID","E"))
+40 DO FACILITY^HMPUTILS(FAC,"CLIO")
+41 SET X=$GET(HMPC("COMMENT","E"))
if $LENGTH(X)
SET CLIO("comment")=X
+42 ; RHL 20141231
SET CLIO("lastUpdateTime")=$$EN^HMPSTMP("obs")
+43 ; RHL 20141231
SET CLIO("stampTime")=CLIO("lastUpdateTime")
+44 ;US6734 - pre-compile metastamp
+45 ;US6734,US11019
IF $GET(HMPMETA)
DO ADD^HMPMETA("obs",CLIO("uid"),CLIO("stampTime"))
if HMPMETA=1
QUIT
+46 DO ADD^HMPDJ("CLIO","obs")
+47 QUIT
