HMPDJ07 ;SLC/MKB,ASMR/RRB,MBS - Radiology,Surgery;7/7/16 11:03
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;Sep 01, 2011;Build 28
;Per VA Directive 6402, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; ^SC 10040
; ^VA(200 10060
; DIC 2051
; DIQ 2056
; RAO7PC1 2043,2265
; SROESTV 3533
;
; All tags expect DFN, ID, [HMPSTART, HMPSTOP, HMPMAX, HMPTEXT, HMPMETA]
Q
;
RA1(ID) ; -- radiology exam ^TMP($J,"RAE1",DFN,ID)
N EXAM,X0,SET,PROC,DATE,LOC,X,Y,IENS,ID3,N
N $ES,$ET,ERRPAT,ERRMSG
S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
S ERRMSG="A problem occurred converting record "_ID_" for the radiology domain"
;
S X0=$G(^TMP($J,"RAE1",DFN,ID)),SET=$G(^(ID,"CPRS")),PROC=$P(X0,U) Q:X0=""
S EXAM("localId")=ID,EXAM("uid")=$$SETUID^HMPUTILS("image",DFN,ID)
S EXAM("name")=PROC,EXAM("case")=$P(X0,U,2),EXAM("category")="RA"
S DATE=9999999.9999-+ID,EXAM("dateTime")=$$JSONDT^HMPUTILS(DATE)
I $P(X0,U,5) D ;report exists
. N NM S NM=$S(+SET=2:$P(SET,U,2),1:PROC) ;2 = shared report
. S EXAM("results",1,"uid")=$$SETUID^HMPUTILS("document",DFN,ID)
. S EXAM("results",1,"localTitle")=NM
. S EXAM("verified")=$S($E($P(X0,U,3))="V":"true",1:"false")
S:$L($P(X0,U,6)) EXAM("statusName")=$P($P(X0,U,6),"~",2)
S X=$P(X0,U,7),LOC="" I $L(X) D
. S EXAM("imageLocation")=X,EXAM("locationName")=X
. S LOC=+$O(^SC("B",X,0)) ;ICR 10040 DE2818 ASF 11/10/15
. S EXAM("locationUid")=$$SETUID^HMPUTILS("location",,LOC)
S X=$$FAC^HMPD(LOC) D FACILITY^HMPUTILS(X,"EXAM")
I $L($P(X0,U,8)) S X=$P($P(X0,U,8),"~",2),EXAM("imagingTypeUid")=$$SETVURN^HMPUTILS("imaging-Type",X)
S X=$P(X0,U,10) I X D
. N CPT S CPT=$$CPT^HMPDRA(X)
. S (EXAM("typeName"),EXAM("summary"))=$P(CPT,U,2)
. ;I $D(^TMP($J,"RAE1",DFN,ID,"CMOD")) M EXAM("modifier")=^("CMOD")
I $P(X0,U,11) D
. S EXAM("orderUid")=$$SETUID^HMPUTILS("order",DFN,+$P(X0,U,11))
. S EXAM("orderName")=$S($L(SET):$P(SET,U,2),1:PROC)
S EXAM("hasImages")=$S($P(X0,U,12)="Y":"true",1:"false")
I $P(X0,U,4)="Y"!($P(X0,U,9)="Y") S EXAM("interpretation")="ABNORMAL"
S IENS=$P(ID,"-",2)_","_+ID_","_DFN_","
S X=$$GET1^DIQ(70.03,IENS,27,"I") I X D
. S EXAM("encounterUid")=$$SETUID^HMPUTILS("visit",DFN,+X)
. S EXAM("encounterName")=$$NAME^HMPDJ04(+X)
S ID3=DFN_U_$TR(ID,"-","^") D EN3^RAO7PC1(ID3) D ;get additional values
. S EXAM("reason")=$G(^TMP($J,"RAE2",DFN,+$P(ID3,U,3),PROC,"RFS"))
. ;Get list of providers
. S X=+$G(^TMP($J,"RAE2",DFN,+$P(ID3,U,3),PROC,"P")) D:X ADDPROV(.EXAM,X,"Primary") ;Primary Interpreting Staff
. S X=+$G(^TMP($J,"RAE2",DFN,+$P(ID3,U,3),PROC,"V")) D:X ADDPROV(.EXAM,X,"Verifier") ;Verifying Physician
. S X=$$GET1^DIQ(70.03,IENS,14,"I") D:X ADDPROV(.EXAM,X,"Requestor") ;Requesting Provider
. S N=0 F S N=$O(^TMP($J,"RAE2",DFN,+$P(ID3,U,3),PROC,"D",N)) Q:N<1 S X=$G(^(N)) D
.. S EXAM("diagnosis",N,"code")=X
.. S:N=1 EXAM("diagnosis",N,"primary")="true"
.. N EXP S EXP=$$LEX(X) S:EXP EXAM("diagnosis",N,"lexicon")=X
. K ^TMP($J,"RAE2",DFN)
S EXAM("kind")="Imaging"
S EXAM("lastUpdateTime")=$$EN^HMPSTMP("image") ;RHL 20150102
S EXAM("stampTime")=EXAM("lastUpdateTime") ; RHL 20150102
;US6734 - pre-compile metastamp
I $G(HMPMETA) D ADD^HMPMETA("image",EXAM("uid"),EXAM("stampTime")) Q:HMPMETA=1 ;US6734,US11019
D ADD^HMPDJ("EXAM","image")
Q
ADDPROV(EXAM,X,ROLE) ;Add a provider to the providers array
Q:'X
S I=$O(EXAM("providers",999),-1)+1
S EXAM("providers",I,"providerUid")=$$SETUID^HMPUTILS("user",,X)
S EXAM("providers",I,"providerName")=$P($G(^VA(200,X,0)),U) ;ICR 10060 DE2818 ASF 11/10/15
S:ROLE]"" EXAM("providers",I,"providerRole")=ROLE
Q
;
LEX(X) ; -- Return Lexicon ptr for a Dx Code
N Y,DIC,LEX
S DIC=78.3,DIC(0)="BFOXZ" D ^DIC
S LEX=$P($G(Y(0)),U,6)
Q LEX
;
SR1(ID) ; -- surgery
N SURG,HMPX,HMPY,X,Y,I
D ONE^SROESTV("HMPY",ID) S HMPX=$G(HMPY(ID)) Q:HMPX=""
N $ES,$ET,ERRPAT,ERRMSG
S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
S ERRMSG="A problem occurred converting record "_ID_" for the surgery domain"
;
S SURG("localId")=ID,SURG("uid")=$$SETUID^HMPUTILS("surgery",DFN,ID)
S X=$P(HMPX,U,2),SURG("statusName")="COMPLETED"
I X?1"* Aborted * ".E S X=$E(X,13,999),SURG("statusName")="ABORTED"
S (SURG("typeName"),SURG("summary"))=X
S SURG("dateTime")=$$JSONDT^HMPUTILS($P(HMPX,U,3))
S X=$P(HMPX,U,4) I X D
. S SURG("providers",1,"providerUid")=$$SETUID^HMPUTILS("user",,+X)
. S SURG("providers",1,"providerName")=$P(X,";",2)
S X=$$GET1^DIQ(130,ID_",",50,"I"),X=$$FAC^HMPD(X)
D FACILITY^HMPUTILS(X,"SURG")
S X=$$GET1^DIQ(130,ID_",",.015,"I") I X D
. S SURG("encounterUid")=$$SETUID^HMPUTILS("visit",DFN,+X)
. S SURG("encounterName")=$$NAME^HMPDJ04(+X)
S X=$$GET1^DIQ(136,ID_",",.02,"I") I X D
. S X=$$CPT^HMPDSR(X)
. S (SURG("typeName"),SURG("summary"))=$P(X,U,2)
. S SURG("typeCode")=$$SETNCS^HMPUTILS("cpt",+X)
S I=0 F S I=$O(HMPY(ID,I)) Q:I<1 S X=$G(HMPY(ID,I)) I X D
. N LT S LT=$P(X,U,2) Q:$P(LT," ")="Addendum"
. S SURG("results",I,"uid")=$$SETUID^HMPUTILS("document",DFN,+X)
. S SURG("results",I,"localTitle")=LT
S SURG("kind")="Surgery",SURG("category")="SR"
K ^TMP("TIULIST",$J)
S SURG("lastUpdateTime")=$$EN^HMPSTMP("surgery") ;RHL 20150102
S SURG("stampTime")=SURG("lastUpdateTime") ; RHL 20150102
;US6734 - pre-compile metastamp
I $G(HMPMETA) D ADD^HMPMETA("surgery",SURG("uid"),SURG("stampTime")) Q:HMPMETA=1 ;US6734,US11019
D ADD^HMPDJ("SURG","surgery")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPDJ07 5660 printed Apr 09, 2024@20:59:43 Page 2
HMPDJ07 ;SLC/MKB,ASMR/RRB,MBS - Radiology,Surgery;7/7/16 11:03
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;Sep 01, 2011;Build 28
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; ^SC 10040
+7 ; ^VA(200 10060
+8 ; DIC 2051
+9 ; DIQ 2056
+10 ; RAO7PC1 2043,2265
+11 ; SROESTV 3533
+12 ;
+13 ; All tags expect DFN, ID, [HMPSTART, HMPSTOP, HMPMAX, HMPTEXT, HMPMETA]
+14 QUIT
+15 ;
RA1(ID) ; -- radiology exam ^TMP($J,"RAE1",DFN,ID)
+1 NEW EXAM,X0,SET,PROC,DATE,LOC,X,Y,IENS,ID3,N
+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 radiology domain"
+5 ;
+6 SET X0=$GET(^TMP($JOB,"RAE1",DFN,ID))
SET SET=$GET(^(ID,"CPRS"))
SET PROC=$PIECE(X0,U)
if X0=""
QUIT
+7 SET EXAM("localId")=ID
SET EXAM("uid")=$$SETUID^HMPUTILS("image",DFN,ID)
+8 SET EXAM("name")=PROC
SET EXAM("case")=$PIECE(X0,U,2)
SET EXAM("category")="RA"
+9 SET DATE=9999999.9999-+ID
SET EXAM("dateTime")=$$JSONDT^HMPUTILS(DATE)
+10 ;report exists
IF $PIECE(X0,U,5)
Begin DoDot:1
+11 ;2 = shared report
NEW NM
SET NM=$SELECT(+SET=2:$PIECE(SET,U,2),1:PROC)
+12 SET EXAM("results",1,"uid")=$$SETUID^HMPUTILS("document",DFN,ID)
+13 SET EXAM("results",1,"localTitle")=NM
+14 SET EXAM("verified")=$SELECT($EXTRACT($PIECE(X0,U,3))="V":"true",1:"false")
End DoDot:1
+15 if $LENGTH($PIECE(X0,U,6))
SET EXAM("statusName")=$PIECE($PIECE(X0,U,6),"~",2)
+16 SET X=$PIECE(X0,U,7)
SET LOC=""
IF $LENGTH(X)
Begin DoDot:1
+17 SET EXAM("imageLocation")=X
SET EXAM("locationName")=X
+18 ;ICR 10040 DE2818 ASF 11/10/15
SET LOC=+$ORDER(^SC("B",X,0))
+19 SET EXAM("locationUid")=$$SETUID^HMPUTILS("location",,LOC)
End DoDot:1
+20 SET X=$$FAC^HMPD(LOC)
DO FACILITY^HMPUTILS(X,"EXAM")
+21 IF $LENGTH($PIECE(X0,U,8))
SET X=$PIECE($PIECE(X0,U,8),"~",2)
SET EXAM("imagingTypeUid")=$$SETVURN^HMPUTILS("imaging-Type",X)
+22 SET X=$PIECE(X0,U,10)
IF X
Begin DoDot:1
+23 NEW CPT
SET CPT=$$CPT^HMPDRA(X)
+24 SET (EXAM("typeName"),EXAM("summary"))=$PIECE(CPT,U,2)
+25 ;I $D(^TMP($J,"RAE1",DFN,ID,"CMOD")) M EXAM("modifier")=^("CMOD")
End DoDot:1
+26 IF $PIECE(X0,U,11)
Begin DoDot:1
+27 SET EXAM("orderUid")=$$SETUID^HMPUTILS("order",DFN,+$PIECE(X0,U,11))
+28 SET EXAM("orderName")=$SELECT($LENGTH(SET):$PIECE(SET,U,2),1:PROC)
End DoDot:1
+29 SET EXAM("hasImages")=$SELECT($PIECE(X0,U,12)="Y":"true",1:"false")
+30 IF $PIECE(X0,U,4)="Y"!($PIECE(X0,U,9)="Y")
SET EXAM("interpretation")="ABNORMAL"
+31 SET IENS=$PIECE(ID,"-",2)_","_+ID_","_DFN_","
+32 SET X=$$GET1^DIQ(70.03,IENS,27,"I")
IF X
Begin DoDot:1
+33 SET EXAM("encounterUid")=$$SETUID^HMPUTILS("visit",DFN,+X)
+34 SET EXAM("encounterName")=$$NAME^HMPDJ04(+X)
End DoDot:1
+35 ;get additional values
SET ID3=DFN_U_$TRANSLATE(ID,"-","^")
DO EN3^RAO7PC1(ID3)
Begin DoDot:1
+36 SET EXAM("reason")=$GET(^TMP($JOB,"RAE2",DFN,+$PIECE(ID3,U,3),PROC,"RFS"))
+37 ;Get list of providers
+38 ;Primary Interpreting Staff
SET X=+$GET(^TMP($JOB,"RAE2",DFN,+$PIECE(ID3,U,3),PROC,"P"))
if X
DO ADDPROV(.EXAM,X,"Primary")
+39 ;Verifying Physician
SET X=+$GET(^TMP($JOB,"RAE2",DFN,+$PIECE(ID3,U,3),PROC,"V"))
if X
DO ADDPROV(.EXAM,X,"Verifier")
+40 ;Requesting Provider
SET X=$$GET1^DIQ(70.03,IENS,14,"I")
if X
DO ADDPROV(.EXAM,X,"Requestor")
+41 SET N=0
FOR
SET N=$ORDER(^TMP($JOB,"RAE2",DFN,+$PIECE(ID3,U,3),PROC,"D",N))
if N<1
QUIT
SET X=$GET(^(N))
Begin DoDot:2
+42 SET EXAM("diagnosis",N,"code")=X
+43 if N=1
SET EXAM("diagnosis",N,"primary")="true"
+44 NEW EXP
SET EXP=$$LEX(X)
if EXP
SET EXAM("diagnosis",N,"lexicon")=X
End DoDot:2
+45 KILL ^TMP($JOB,"RAE2",DFN)
End DoDot:1
+46 SET EXAM("kind")="Imaging"
+47 ;RHL 20150102
SET EXAM("lastUpdateTime")=$$EN^HMPSTMP("image")
+48 ; RHL 20150102
SET EXAM("stampTime")=EXAM("lastUpdateTime")
+49 ;US6734 - pre-compile metastamp
+50 ;US6734,US11019
IF $GET(HMPMETA)
DO ADD^HMPMETA("image",EXAM("uid"),EXAM("stampTime"))
if HMPMETA=1
QUIT
+51 DO ADD^HMPDJ("EXAM","image")
+52 QUIT
ADDPROV(EXAM,X,ROLE) ;Add a provider to the providers array
+1 if 'X
QUIT
+2 SET I=$ORDER(EXAM("providers",999),-1)+1
+3 SET EXAM("providers",I,"providerUid")=$$SETUID^HMPUTILS("user",,X)
+4 ;ICR 10060 DE2818 ASF 11/10/15
SET EXAM("providers",I,"providerName")=$PIECE($GET(^VA(200,X,0)),U)
+5 if ROLE]""
SET EXAM("providers",I,"providerRole")=ROLE
+6 QUIT
+7 ;
LEX(X) ; -- Return Lexicon ptr for a Dx Code
+1 NEW Y,DIC,LEX
+2 SET DIC=78.3
SET DIC(0)="BFOXZ"
DO ^DIC
+3 SET LEX=$PIECE($GET(Y(0)),U,6)
+4 QUIT LEX
+5 ;
SR1(ID) ; -- surgery
+1 NEW SURG,HMPX,HMPY,X,Y,I
+2 DO ONE^SROESTV("HMPY",ID)
SET HMPX=$GET(HMPY(ID))
if HMPX=""
QUIT
+3 NEW $ESTACK,$ETRAP,ERRPAT,ERRMSG
+4 SET $ETRAP="D ERRHDLR^HMPDERRH"
SET ERRPAT=DFN
+5 SET ERRMSG="A problem occurred converting record "_ID_" for the surgery domain"
+6 ;
+7 SET SURG("localId")=ID
SET SURG("uid")=$$SETUID^HMPUTILS("surgery",DFN,ID)
+8 SET X=$PIECE(HMPX,U,2)
SET SURG("statusName")="COMPLETED"
+9 IF X?1"* Aborted * ".E
SET X=$EXTRACT(X,13,999)
SET SURG("statusName")="ABORTED"
+10 SET (SURG("typeName"),SURG("summary"))=X
+11 SET SURG("dateTime")=$$JSONDT^HMPUTILS($PIECE(HMPX,U,3))
+12 SET X=$PIECE(HMPX,U,4)
IF X
Begin DoDot:1
+13 SET SURG("providers",1,"providerUid")=$$SETUID^HMPUTILS("user",,+X)
+14 SET SURG("providers",1,"providerName")=$PIECE(X,";",2)
End DoDot:1
+15 SET X=$$GET1^DIQ(130,ID_",",50,"I")
SET X=$$FAC^HMPD(X)
+16 DO FACILITY^HMPUTILS(X,"SURG")
+17 SET X=$$GET1^DIQ(130,ID_",",.015,"I")
IF X
Begin DoDot:1
+18 SET SURG("encounterUid")=$$SETUID^HMPUTILS("visit",DFN,+X)
+19 SET SURG("encounterName")=$$NAME^HMPDJ04(+X)
End DoDot:1
+20 SET X=$$GET1^DIQ(136,ID_",",.02,"I")
IF X
Begin DoDot:1
+21 SET X=$$CPT^HMPDSR(X)
+22 SET (SURG("typeName"),SURG("summary"))=$PIECE(X,U,2)
+23 SET SURG("typeCode")=$$SETNCS^HMPUTILS("cpt",+X)
End DoDot:1
+24 SET I=0
FOR
SET I=$ORDER(HMPY(ID,I))
if I<1
QUIT
SET X=$GET(HMPY(ID,I))
IF X
Begin DoDot:1
+25 NEW LT
SET LT=$PIECE(X,U,2)
if $PIECE(LT," ")="Addendum"
QUIT
+26 SET SURG("results",I,"uid")=$$SETUID^HMPUTILS("document",DFN,+X)
+27 SET SURG("results",I,"localTitle")=LT
End DoDot:1
+28 SET SURG("kind")="Surgery"
SET SURG("category")="SR"
+29 KILL ^TMP("TIULIST",$JOB)
+30 ;RHL 20150102
SET SURG("lastUpdateTime")=$$EN^HMPSTMP("surgery")
+31 ; RHL 20150102
SET SURG("stampTime")=SURG("lastUpdateTime")
+32 ;US6734 - pre-compile metastamp
+33 ;US6734,US11019
IF $GET(HMPMETA)
DO ADD^HMPMETA("surgery",SURG("uid"),SURG("stampTime"))
if HMPMETA=1
QUIT
+34 DO ADD^HMPDJ("SURG","surgery")
+35 QUIT
