HMPDJ08A ;SLC/MKB,ASMR/BL,CPC - TIU Documents continued;11/3/16 3:10:30pm
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**3**;Sep 01, 2011;Build 15
;Per VA Directive 6402, this routine should not be modified.
;
; Called by HMPDJ08
;
;pass HMPXX from CP1 section 12.2.14 agilex/js
;
; External References DBIA#
; ------------------- -----
; ^DPT 10035
; ^LR 525
; ^RADPT 2480
; ^RARPT 8000005
; ^SC 10040
; ^TMP("MDHSP" [MDPS1] 4230
; ^VA(200 10060
; %DT 10003
; DIQ 2056
; GMRCGUIB 2980
; LR7OR1,^TMP("LRRR" 2503
; MCARUTL3 3280
; PXAPI 1894
; RAO7PC1 2043,2265
; RAO7PC3 2877
;
; All tags expect DFN, ID, [HMPSTART, HMPSTOP, HMPMAX, HMPTEXT]
;
; ------------------------------------------------------------------
; documentClass = CLINICAL PROCEDURES
; nationalTitle = 4696566^PROCEDURE REPORT
; Service = 4696471^PROCEDURE
; Type = 4696123^REPORT
Q
;
CP(DFN,BEG,END,MAX) ; -- Medicine reports
N HMPN,HMPX,RTN,TIUN,CONS,HMPD,I,DA,X,Y,%DT,DATE,GBL
S DFN=+$G(DFN) Q:$G(DFN)<1
D MDPS1^HMPDJ03(DFN,BEG,END,MAX) ;gets ^TMP("MDHSP",$J)
S HMPN=0 F S HMPN=$O(^TMP("MDHSP",$J,HMPN)) Q:HMPN<1 S HMPX=$G(^(HMPN)) D
. N $ES,$ET,ERRPAT,ERRMSG
. S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
. S ERRMSG="A problem occurred converting a medicine report."
. S RTN=$P(HMPX,U,3,4) Q:RTN="PRPRO^MDPS4" ;skip non-CP items
. S TIUN=+$P(HMPX,U,14)
. I TIUN D EN1^HMPDJ08(TIUN,38) ;38=TIU Clinical Document
. S CONS=+$P(HMPX,U,13) D:CONS DOCLIST^GMRCGUIB(.HMPD,CONS)
. K DA S I=0 F S I=$O(HMPD(50,I)) Q:I<1 D
.. S DA=+HMPD(50,I) Q:DA=TIUN
.. D EN1^HMPDJ08(DA,38)
. Q:TIUN!$G(DA) ;done [got TIU note(s)]
. Q:RTN="PR702^MDPS1" ;CP, but no TIU note yet
. Q:RTN="PRPRO^MDPS4" ;non-CP procedure
. ; find ID for pre-TIU report
. S X=$P(HMPX,U,6),%DT="TXS" D ^%DT Q:Y'>0 S DATE=Y
. S GBL=+$P(HMPX,U,2)_";"_$$ROOT^HMPDMC(DFN,$P(HMPX,U,11),DATE)
. I GBL S X=$$CP1(DFN,GBL)
. I $G(HMPXX)]"" D EN1^HMPDJ08(HMPXX,"CP") ; pass HMPXX from CP1 section 12.2.14 js
K ^TMP("MDHSP",$J),^TMP("HMPTEXT",$J)
K HMPXX
Q
;
CP1(DFN,ID) ; -- return report data as TIU string [$$RESOLVE] /DE2818
S DFN=+$G(DFN),ID=$G(ID) I DFN<1!'$L(ID) Q ""
N Y,HMPY,HMPFN,X,NAME,DATE,STS,USER,SIGN,TEXT
S HMPFN=+$P(ID,"(",2) ; example 699.5
D MEDLKUP^MCARUTL3(.HMPY,HMPFN,+ID)
I HMPY<1 Q "" ;error in CP
S NAME=$P(HMPY,U,9),DATE=$P(HMPY,U,6)
S X=$$GET1^DIQ(HMPFN,+ID_",",1506)
S STS=$S($L(X):X,1:"COMPLETED")
S X=+$$GET1^DIQ(HMPFN,+ID_",",701,"I"),(USER,SIGN)=""
S:X USER=X_";;"_$P($G(^VA(200,X,0)),U) ;ICR 10060 DE2818 ASF 11/10/15
S X=+$$GET1^DIQ(HMPFN,+ID_",",1503,"I")
S:X SIGN="//"_X_";"_$P($G(^VA(200,X,0)),U)_";"_$$GET1^DIQ(HMPFN,+ID_",",1505,"I") ;ICR 10060 DE2818 ASF 11/10/15
; VST=$$GET1^DIQ(HMPFN,+ID_",",900,"I")
S Y=ID_U_NAME_U_DATE_U_U_USER_U_U_STS_"^^^2461^"_SIGN
S HMPXX=ID_U_NAME_U_DATE_U_U_USER_U_U_STS_"^^^2461^"_SIGN ; 12.2.14 js
S:$G(HMPTEXT) TEXT=$$TEXT^HMPDMC(DFN,ID,NAME) ;^TMP("HMPTEXT",$J,ID)
Q Y
;
; ------------------------------------------------------------------
; documentClass = LR LABORATORY REPORTS
; nationalTitle = 4697105^LABORATORY NOTE
; Subject = 4697104^LABORATORY
; Type = 4696120^NOTE
;
LR(DFN,BEG,END,MAX) ; -- Lab reports
N HMPSUB,HMPIDT,HMPITM,HMPTIU,HMPXID,LRDFN,IVDT,HMPN,DA
S DFN=+$G(DFN) Q:$G(DFN)<1
S BEG=$G(BEG,1410101),END=$G(END,4141015),MAX=$G(MAX,9999)
S LRDFN=+$G(^DPT(DFN,"LR")),IVDT=9999999-+$G(^LR(LRDFN,"AU")) ;LR7OB63D error
K ^TMP("LRRR",$J,DFN) D RR^LR7OR1(DFN,,BEG,END,"MIAP",,,MAX)
S HMPSUB="" F S HMPSUB=$O(^TMP("LRRR",$J,DFN,HMPSUB)) Q:HMPSUB="" D
. S HMPIDT=0 F S HMPIDT=$O(^TMP("LRRR",$J,DFN,HMPSUB,HMPIDT)) Q:HMPIDT<1 I $O(^(HMPIDT,0)) D
.. S HMPTIU=$S(HMPSUB="AU":$NA(^LR(LRDFN,101)),1:$NA(^LR(LRDFN,HMPSUB,HMPIDT,.05)))
.. K HMPITM S HMPXID=HMPSUB_";"_HMPIDT
.. I '$O(@HMPTIU@(0)) S HMPX=$$LR1(DFN,HMPXID) D EN1^HMPDJ08(HMPX,"LR") Q
.. S HMPN=0 F S HMPN=$O(@HMPTIU@(HMPN)) Q:HMPN<1 D ;38=TIU Clin Doc
... S DA=+$P($G(@HMPTIU@(HMPN,0)),U,2)
... D:DA EN1^HMPDJ08(DA,38)
K ^TMP("LRRR",$J,DFN),^TMP("HMPTEXT",$J)
Q
;
LR1(DFN,ID) ; -- return report data as TIU string [$$RESOLVE]
N $ES,$ET,ERRPAT,ERRMSG
S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
S ERRMSG="A problem occurred converting lab report "_ID
S DFN=+$G(DFN),ID=$G(ID) I DFN<1!'$L(ID) Q ""
N Y,SUB,IDT,LRDFN,LR,NAME,LOC,USER,VST,SIGN,TEXT
K ^TMP("HMPTEXT",$J,ID)
S SUB=$P(ID,";"),IDT=+$P(ID,";",2),LRDFN=$G(^DPT(DFN,"LR")) ;ICR 10035 DE 2818 ASF 11/10/15
S LR=$S(SUB="AU":$G(^LR(LRDFN,"AU")),1:$G(^LR(LRDFN,SUB,IDT,0)))
S NAME="LR "_$$NAME^HMPDLRA(SUB)_" REPORT"
S LOC=$P(LR,U,$S(SUB="AU":5,1:8)) D ;look-up visit
. N CDT,SC S CDT=9999999-IDT,SC="",X=0
. S:$L(LOC) SC=+$O(^SC("B",LOC,0)) ;ICR 10040 DE2818 ASF 11/10/15
. I CDT,LOC S X=$$GETENC^PXAPI(DFN,CDT,SC)
. S:X VST=+X
S X=+$P(LR,U,$S(SUB="AU":10,SUB="MI":4,1:2)) ;pathologist[author]
S USER=$S(X:X_";;"_$P($G(^VA(200,X,0)),U),1:""),SIGN="" ;ICR 10060 DE2818 ASF 11/10/15
S X=$S(SUB="AU":$P(LR,U,15,16),SUB="MI":$P(LR,U,3,4),1:$P(LR,U,11)_U_$P(LR,U,13)) ;released
S:X SIGN="//"_+$P(X,U,2)_";"_$P($G(^VA(200,+$P(X,U,2),0)),U)_";"_+X ;ICR 10060 DE2818 ASF 11/10/15
S Y=ID_U_NAME_U_(9999999-IDT)_U_U_USER_U_LOC_U_$S($P(LR,U,3):"COMPLETED",1:"REPORT INCOMPLETE")_U_$G(VST)_"^^2753^"_SIGN ;DE6322 check complete state
S:$G(HMPTEXT) TEXT=$$TEXT^HMPDLRA(DFN,SUB,IDT,LRDFN) ;^TMP("HMPTEXT",$J,ID)
Q Y
;
; ------------------------------------------------------------------
; nationalTitle = 4695068^RADIOLOGY REPORT
; Subject = 4693357^RADIOLOGY
; Type = 4696123^REPORT
;
RA(DFN,BEG,END,MAX) ; -- Radiology reports
N HMPXID,STS,PSET
S DFN=+$G(DFN) Q:DFN<1
S BEG=$G(BEG,1410101),END=$G(END,4141015),MAX=$G(MAX,9999)_"P"
K ^TMP($J,"RAE1") D EN1^RAO7PC1(DFN,BEG,END,MAX)
S HMPXID="" F S HMPXID=$O(^TMP($J,"RAE1",DFN,HMPXID)) Q:HMPXID="" D
. S STS=$P($G(^TMP($J,"RAE1",DFN,HMPXID)),U,3),PSET=$G(^(HMPXID,"CPRS"))
. Q:STS="No Report"!(STS="Deleted") ;!(STS["Draft")
. I +PSET=2,$G(PSET(+HMPXID,$P(PSET,U,2))) Q ;already have report
. S HMPX=$$RA1(DFN,HMPXID) D EN1^HMPDJ08(HMPX,"RA")
. I +PSET=2 S PSET(+HMPXID,$P(PSET,U,2))=$P(HMPXID,"-",2) ;parent
K ^TMP($J,"RAE1"),^TMP("HMPTEXT",$J)
Q
;
RA1(DFN,ID) ; -- return report data as TIU string [$$RESOLVE]
N $ES,$ET,ERRPAT,ERRMSG
S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
S ERRMSG="A problem occurred converting radiology report "_ID
S DFN=+$G(DFN),ID=$G(ID) I DFN<1!'$L(ID) Q ""
N EXAM,CASE,PROC,RAE3,RAE1,TEXT,I,X,Y,DATE,LOC,STS,IENS,VST,USER,SIGN
K RPT,^TMP("HMPTEXT",$J,ID)
S EXAM=DFN_U_$TR(ID,"-","^") D
. N DFN D EN3^RAO7PC3(EXAM) ;report
. D EN3^RAO7PC1(EXAM) ;add'l values
S CASE=$O(^TMP($J,"RAE3",DFN,0)),PROC=$O(^(CASE,"")),RAE3=$G(^(PROC))
S RAE1=$G(^TMP($J,"RAE1",DFN,ID))
I $G(HMPTEXT) D
. S TEXT=$NA(^TMP("HMPTEXT",$J,ID))
. S I=0 F S I=$O(^TMP($J,"RAE3",DFN,CASE,PROC,I)) Q:I<1 S X=^(I),@TEXT@(I)=X
S DATE=9999999.9999-(+ID),LOC=$P(RAE1,U,7),STS=$P(RAE3,U)
S IENS=$P(ID,"-",2)_","_+ID_","_DFN_","
S VST=$$GET1^DIQ(70.03,IENS,27,"I")
S X=+$G(^TMP($J,"RAE2",DFN,CASE,PROC,"P")),(USER,SIGN)=""
S:X USER=X_";;"_$P($G(^VA(200,X,0)),U) ;ICR 10060 DE2818 ASF 11/10/15
S X=$G(^TMP($J,"RAE2",DFN,CASE,PROC,"V"))
S:X SIGN="//"_+X_";"_$P($G(^VA(200,+X,0)),U)_";"_$$GET1^DIQ(74,+$P(RAE1,U,5)_",",7,"I") ;ICR 10060 DE2818 ASF 11/10/15
I $D(^TMP($J,"RAE3",DFN,"PRINT_SET")) S PROC=$G(^("ORD")) ;use parent, if printset
S Y=ID_U_PROC_U_DATE_U_U_USER_U_LOC_U_STS_U_VST_"^^1901^"_SIGN
K ^TMP($J,"RAE3",DFN),^TMP($J,"RAE2",DFN)
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPDJ08A 8111 printed Oct 16, 2024@17:54:08 Page 2
HMPDJ08A ;SLC/MKB,ASMR/BL,CPC - TIU Documents continued;11/3/16 3:10:30pm
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**3**;Sep 01, 2011;Build 15
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Called by HMPDJ08
+5 ;
+6 ;pass HMPXX from CP1 section 12.2.14 agilex/js
+7 ;
+8 ; External References DBIA#
+9 ; ------------------- -----
+10 ; ^DPT 10035
+11 ; ^LR 525
+12 ; ^RADPT 2480
+13 ; ^RARPT 8000005
+14 ; ^SC 10040
+15 ; ^TMP("MDHSP" [MDPS1] 4230
+16 ; ^VA(200 10060
+17 ; %DT 10003
+18 ; DIQ 2056
+19 ; GMRCGUIB 2980
+20 ; LR7OR1,^TMP("LRRR" 2503
+21 ; MCARUTL3 3280
+22 ; PXAPI 1894
+23 ; RAO7PC1 2043,2265
+24 ; RAO7PC3 2877
+25 ;
+26 ; All tags expect DFN, ID, [HMPSTART, HMPSTOP, HMPMAX, HMPTEXT]
+27 ;
+28 ; ------------------------------------------------------------------
+29 ; documentClass = CLINICAL PROCEDURES
+30 ; nationalTitle = 4696566^PROCEDURE REPORT
+31 ; Service = 4696471^PROCEDURE
+32 ; Type = 4696123^REPORT
+33 QUIT
+34 ;
CP(DFN,BEG,END,MAX) ; -- Medicine reports
+1 NEW HMPN,HMPX,RTN,TIUN,CONS,HMPD,I,DA,X,Y,%DT,DATE,GBL
+2 SET DFN=+$GET(DFN)
if $GET(DFN)<1
QUIT
+3 ;gets ^TMP("MDHSP",$J)
DO MDPS1^HMPDJ03(DFN,BEG,END,MAX)
+4 SET HMPN=0
FOR
SET HMPN=$ORDER(^TMP("MDHSP",$JOB,HMPN))
if HMPN<1
QUIT
SET HMPX=$GET(^(HMPN))
Begin DoDot:1
+5 NEW $ESTACK,$ETRAP,ERRPAT,ERRMSG
+6 SET $ETRAP="D ERRHDLR^HMPDERRH"
SET ERRPAT=DFN
+7 SET ERRMSG="A problem occurred converting a medicine report."
+8 ;skip non-CP items
SET RTN=$PIECE(HMPX,U,3,4)
if RTN="PRPRO^MDPS4"
QUIT
+9 SET TIUN=+$PIECE(HMPX,U,14)
+10 ;38=TIU Clinical Document
IF TIUN
DO EN1^HMPDJ08(TIUN,38)
+11 SET CONS=+$PIECE(HMPX,U,13)
if CONS
DO DOCLIST^GMRCGUIB(.HMPD,CONS)
+12 KILL DA
SET I=0
FOR
SET I=$ORDER(HMPD(50,I))
if I<1
QUIT
Begin DoDot:2
+13 SET DA=+HMPD(50,I)
if DA=TIUN
QUIT
+14 DO EN1^HMPDJ08(DA,38)
End DoDot:2
+15 ;done [got TIU note(s)]
if TIUN!$GET(DA)
QUIT
+16 ;CP, but no TIU note yet
if RTN="PR702^MDPS1"
QUIT
+17 ;non-CP procedure
if RTN="PRPRO^MDPS4"
QUIT
+18 ; find ID for pre-TIU report
+19 SET X=$PIECE(HMPX,U,6)
SET %DT="TXS"
DO ^%DT
if Y'>0
QUIT
SET DATE=Y
+20 SET GBL=+$PIECE(HMPX,U,2)_";"_$$ROOT^HMPDMC(DFN,$PIECE(HMPX,U,11),DATE)
+21 IF GBL
SET X=$$CP1(DFN,GBL)
+22 ; pass HMPXX from CP1 section 12.2.14 js
IF $GET(HMPXX)]""
DO EN1^HMPDJ08(HMPXX,"CP")
End DoDot:1
+23 KILL ^TMP("MDHSP",$JOB),^TMP("HMPTEXT",$JOB)
+24 KILL HMPXX
+25 QUIT
+26 ;
CP1(DFN,ID) ; -- return report data as TIU string [$$RESOLVE] /DE2818
+1 SET DFN=+$GET(DFN)
SET ID=$GET(ID)
IF DFN<1!'$LENGTH(ID)
QUIT ""
+2 NEW Y,HMPY,HMPFN,X,NAME,DATE,STS,USER,SIGN,TEXT
+3 ; example 699.5
SET HMPFN=+$PIECE(ID,"(",2)
+4 DO MEDLKUP^MCARUTL3(.HMPY,HMPFN,+ID)
+5 ;error in CP
IF HMPY<1
QUIT ""
+6 SET NAME=$PIECE(HMPY,U,9)
SET DATE=$PIECE(HMPY,U,6)
+7 SET X=$$GET1^DIQ(HMPFN,+ID_",",1506)
+8 SET STS=$SELECT($LENGTH(X):X,1:"COMPLETED")
+9 SET X=+$$GET1^DIQ(HMPFN,+ID_",",701,"I")
SET (USER,SIGN)=""
+10 ;ICR 10060 DE2818 ASF 11/10/15
if X
SET USER=X_";;"_$PIECE($GET(^VA(200,X,0)),U)
+11 SET X=+$$GET1^DIQ(HMPFN,+ID_",",1503,"I")
+12 ;ICR 10060 DE2818 ASF 11/10/15
if X
SET SIGN="//"_X_";"_$PIECE($GET(^VA(200,X,0)),U)_";"_$$GET1^DIQ(HMPFN,+ID_",",1505,"I")
+13 ; VST=$$GET1^DIQ(HMPFN,+ID_",",900,"I")
+14 SET Y=ID_U_NAME_U_DATE_U_U_USER_U_U_STS_"^^^2461^"_SIGN
+15 ; 12.2.14 js
SET HMPXX=ID_U_NAME_U_DATE_U_U_USER_U_U_STS_"^^^2461^"_SIGN
+16 ;^TMP("HMPTEXT",$J,ID)
if $GET(HMPTEXT)
SET TEXT=$$TEXT^HMPDMC(DFN,ID,NAME)
+17 QUIT Y
+18 ;
+19 ; ------------------------------------------------------------------
+20 ; documentClass = LR LABORATORY REPORTS
+21 ; nationalTitle = 4697105^LABORATORY NOTE
+22 ; Subject = 4697104^LABORATORY
+23 ; Type = 4696120^NOTE
+24 ;
LR(DFN,BEG,END,MAX) ; -- Lab reports
+1 NEW HMPSUB,HMPIDT,HMPITM,HMPTIU,HMPXID,LRDFN,IVDT,HMPN,DA
+2 SET DFN=+$GET(DFN)
if $GET(DFN)<1
QUIT
+3 SET BEG=$GET(BEG,1410101)
SET END=$GET(END,4141015)
SET MAX=$GET(MAX,9999)
+4 ;LR7OB63D error
SET LRDFN=+$GET(^DPT(DFN,"LR"))
SET IVDT=9999999-+$GET(^LR(LRDFN,"AU"))
+5 KILL ^TMP("LRRR",$JOB,DFN)
DO RR^LR7OR1(DFN,,BEG,END,"MIAP",,,MAX)
+6 SET HMPSUB=""
FOR
SET HMPSUB=$ORDER(^TMP("LRRR",$JOB,DFN,HMPSUB))
if HMPSUB=""
QUIT
Begin DoDot:1
+7 SET HMPIDT=0
FOR
SET HMPIDT=$ORDER(^TMP("LRRR",$JOB,DFN,HMPSUB,HMPIDT))
if HMPIDT<1
QUIT
IF $ORDER(^(HMPIDT,0))
Begin DoDot:2
+8 SET HMPTIU=$SELECT(HMPSUB="AU":$NAME(^LR(LRDFN,101)),1:$NAME(^LR(LRDFN,HMPSUB,HMPIDT,.05)))
+9 KILL HMPITM
SET HMPXID=HMPSUB_";"_HMPIDT
+10 IF '$ORDER(@HMPTIU@(0))
SET HMPX=$$LR1(DFN,HMPXID)
DO EN1^HMPDJ08(HMPX,"LR")
QUIT
+11 ;38=TIU Clin Doc
SET HMPN=0
FOR
SET HMPN=$ORDER(@HMPTIU@(HMPN))
if HMPN<1
QUIT
Begin DoDot:3
+12 SET DA=+$PIECE($GET(@HMPTIU@(HMPN,0)),U,2)
+13 if DA
DO EN1^HMPDJ08(DA,38)
End DoDot:3
End DoDot:2
End DoDot:1
+14 KILL ^TMP("LRRR",$JOB,DFN),^TMP("HMPTEXT",$JOB)
+15 QUIT
+16 ;
LR1(DFN,ID) ; -- return report data as TIU string [$$RESOLVE]
+1 NEW $ESTACK,$ETRAP,ERRPAT,ERRMSG
+2 SET $ETRAP="D ERRHDLR^HMPDERRH"
SET ERRPAT=DFN
+3 SET ERRMSG="A problem occurred converting lab report "_ID
+4 SET DFN=+$GET(DFN)
SET ID=$GET(ID)
IF DFN<1!'$LENGTH(ID)
QUIT ""
+5 NEW Y,SUB,IDT,LRDFN,LR,NAME,LOC,USER,VST,SIGN,TEXT
+6 KILL ^TMP("HMPTEXT",$JOB,ID)
+7 ;ICR 10035 DE 2818 ASF 11/10/15
SET SUB=$PIECE(ID,";")
SET IDT=+$PIECE(ID,";",2)
SET LRDFN=$GET(^DPT(DFN,"LR"))
+8 SET LR=$SELECT(SUB="AU":$GET(^LR(LRDFN,"AU")),1:$GET(^LR(LRDFN,SUB,IDT,0)))
+9 SET NAME="LR "_$$NAME^HMPDLRA(SUB)_" REPORT"
+10 ;look-up visit
SET LOC=$PIECE(LR,U,$SELECT(SUB="AU":5,1:8))
Begin DoDot:1
+11 NEW CDT,SC
SET CDT=9999999-IDT
SET SC=""
SET X=0
+12 ;ICR 10040 DE2818 ASF 11/10/15
if $LENGTH(LOC)
SET SC=+$ORDER(^SC("B",LOC,0))
+13 IF CDT
IF LOC
SET X=$$GETENC^PXAPI(DFN,CDT,SC)
+14 if X
SET VST=+X
End DoDot:1
+15 ;pathologist[author]
SET X=+$PIECE(LR,U,$SELECT(SUB="AU":10,SUB="MI":4,1:2))
+16 ;ICR 10060 DE2818 ASF 11/10/15
SET USER=$SELECT(X:X_";;"_$PIECE($GET(^VA(200,X,0)),U),1:"")
SET SIGN=""
+17 ;released
SET X=$SELECT(SUB="AU":$PIECE(LR,U,15,16),SUB="MI":$PIECE(LR,U,3,4),1:$PIECE(LR,U,11)_U_$PIECE(LR,U,13))
+18 ;ICR 10060 DE2818 ASF 11/10/15
if X
SET SIGN="//"_+$PIECE(X,U,2)_";"_$PIECE($GET(^VA(200,+$PIECE(X,U,2),0)),U)_";"_+X
+19 ;DE6322 check complete state
SET Y=ID_U_NAME_U_(9999999-IDT)_U_U_USER_U_LOC_U_$SELECT($PIECE(LR,U,3):"COMPLETED",1:"REPORT INCOMPLETE")_U_$GET(VST)_"^^2753^"_SIGN
+20 ;^TMP("HMPTEXT",$J,ID)
if $GET(HMPTEXT)
SET TEXT=$$TEXT^HMPDLRA(DFN,SUB,IDT,LRDFN)
+21 QUIT Y
+22 ;
+23 ; ------------------------------------------------------------------
+24 ; nationalTitle = 4695068^RADIOLOGY REPORT
+25 ; Subject = 4693357^RADIOLOGY
+26 ; Type = 4696123^REPORT
+27 ;
RA(DFN,BEG,END,MAX) ; -- Radiology reports
+1 NEW HMPXID,STS,PSET
+2 SET DFN=+$GET(DFN)
if DFN<1
QUIT
+3 SET BEG=$GET(BEG,1410101)
SET END=$GET(END,4141015)
SET MAX=$GET(MAX,9999)_"P"
+4 KILL ^TMP($JOB,"RAE1")
DO EN1^RAO7PC1(DFN,BEG,END,MAX)
+5 SET HMPXID=""
FOR
SET HMPXID=$ORDER(^TMP($JOB,"RAE1",DFN,HMPXID))
if HMPXID=""
QUIT
Begin DoDot:1
+6 SET STS=$PIECE($GET(^TMP($JOB,"RAE1",DFN,HMPXID)),U,3)
SET PSET=$GET(^(HMPXID,"CPRS"))
+7 ;!(STS["Draft")
if STS="No Report"!(STS="Deleted")
QUIT
+8 ;already have report
IF +PSET=2
IF $GET(PSET(+HMPXID,$PIECE(PSET,U,2)))
QUIT
+9 SET HMPX=$$RA1(DFN,HMPXID)
DO EN1^HMPDJ08(HMPX,"RA")
+10 ;parent
IF +PSET=2
SET PSET(+HMPXID,$PIECE(PSET,U,2))=$PIECE(HMPXID,"-",2)
End DoDot:1
+11 KILL ^TMP($JOB,"RAE1"),^TMP("HMPTEXT",$JOB)
+12 QUIT
+13 ;
RA1(DFN,ID) ; -- return report data as TIU string [$$RESOLVE]
+1 NEW $ESTACK,$ETRAP,ERRPAT,ERRMSG
+2 SET $ETRAP="D ERRHDLR^HMPDERRH"
SET ERRPAT=DFN
+3 SET ERRMSG="A problem occurred converting radiology report "_ID
+4 SET DFN=+$GET(DFN)
SET ID=$GET(ID)
IF DFN<1!'$LENGTH(ID)
QUIT ""
+5 NEW EXAM,CASE,PROC,RAE3,RAE1,TEXT,I,X,Y,DATE,LOC,STS,IENS,VST,USER,SIGN
+6 KILL RPT,^TMP("HMPTEXT",$JOB,ID)
+7 SET EXAM=DFN_U_$TRANSLATE(ID,"-","^")
Begin DoDot:1
+8 ;report
NEW DFN
DO EN3^RAO7PC3(EXAM)
+9 ;add'l values
DO EN3^RAO7PC1(EXAM)
End DoDot:1
+10 SET CASE=$ORDER(^TMP($JOB,"RAE3",DFN,0))
SET PROC=$ORDER(^(CASE,""))
SET RAE3=$GET(^(PROC))
+11 SET RAE1=$GET(^TMP($JOB,"RAE1",DFN,ID))
+12 IF $GET(HMPTEXT)
Begin DoDot:1
+13 SET TEXT=$NAME(^TMP("HMPTEXT",$JOB,ID))
+14 SET I=0
FOR
SET I=$ORDER(^TMP($JOB,"RAE3",DFN,CASE,PROC,I))
if I<1
QUIT
SET X=^(I)
SET @TEXT@(I)=X
End DoDot:1
+15 SET DATE=9999999.9999-(+ID)
SET LOC=$PIECE(RAE1,U,7)
SET STS=$PIECE(RAE3,U)
+16 SET IENS=$PIECE(ID,"-",2)_","_+ID_","_DFN_","
+17 SET VST=$$GET1^DIQ(70.03,IENS,27,"I")
+18 SET X=+$GET(^TMP($JOB,"RAE2",DFN,CASE,PROC,"P"))
SET (USER,SIGN)=""
+19 ;ICR 10060 DE2818 ASF 11/10/15
if X
SET USER=X_";;"_$PIECE($GET(^VA(200,X,0)),U)
+20 SET X=$GET(^TMP($JOB,"RAE2",DFN,CASE,PROC,"V"))
+21 ;ICR 10060 DE2818 ASF 11/10/15
if X
SET SIGN="//"_+X_";"_$PIECE($GET(^VA(200,+X,0)),U)_";"_$$GET1^DIQ(74,+$PIECE(RAE1,U,5)_",",7,"I")
+22 ;use parent, if printset
IF $DATA(^TMP($JOB,"RAE3",DFN,"PRINT_SET"))
SET PROC=$GET(^("ORD"))
+23 SET Y=ID_U_PROC_U_DATE_U_U_USER_U_LOC_U_STS_U_VST_"^^1901^"_SIGN
+24 KILL ^TMP($JOB,"RAE3",DFN),^TMP($JOB,"RAE2",DFN)
+25 QUIT Y
