MAGJRPT ;WIRMFO/JHC - Display Rad reports ; 10/17/2022
;;3.0;IMAGING;**18,101,120,133,341**;Dec 21, 2022;Build 28
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
; Reference to EN2^RAUTL20 in ICR #3270
; Reference to EN3^RAO7PC3 #2877
; Reference to ^RAORD5 #3513
; Reference to SVTCOM^RAUTL11 in ICR #3508
; Reference to PHARM^RARTUTL in ICR #5946
; Reference to RDIO^RARTUTL in ICR #5946
;; ISI IMAGING;**99,104,102**
; Subroutines for fetching Exam Info for VistaRad Workstation
; RADRPT: Display Radiology Report -- RPC Call: MAGJ EXAM REPORT
; ORD: Display Radiology Requisition -- RPC Call: MAGJ RADORDERDISP
;
Q
ORD(MAGRPTY,DATA) ; Radiology Order Display
; RPC Call: MAGJ RADORDERDISP
; MAGRPTY holds indirect reference to returned data
;
S MAGRPTY=$NA(^TMP($J,"WSDAT")) K @MAGRPTY
N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJRPT"
N RARPT,RADFN,RADTI,RACNI,RAPGE,RAX,RAOIFN
N REPLY,POP,DFN,COMPLIC,XX,HDR,MAGRET,REQONLY,TMPDATA
N MEDS,RDIOPHARM
S REPLY="0^4~Attempting to display order info"
D OPENDEV
I POP S REPLY="0^4~Unable to open device 'IMAGING WORKSTATION'" G ORDZ
S RADFN=$P(DATA,U),RADTI=$P(DATA,U,2),RACNI=$P(DATA,U,3)
S RARPT=+$P(DATA,U,4),REQONLY=+$P(DATA,U,5)
I RADFN,RADTI,RACNI
E S REPLY="0^4~Request Contains Invalid Case Pointer ("_RADFN_" "_RADTI_" "_RACNI_" "_RARPT_")." G ORDZ
S RAOIFN=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,11)
I RAOIFN,$D(^RAO(75.1,RAOIFN,0))
E S REPLY="0^2~Order Information is NOT Available for this exam." G ORDZ
; Check for Database integrity problems ONLY if Req was explicitly
; requested (No check for Auto_Display of Req, cuz Exam Open does ck)
D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.MAGRET)
S RADATA=$G(^TMP($J,"MAGRAEX",1,1)),XX=$G(^(2)),HDR=""
S COMPLIC=$P(XX,U,4) ; Complications text
S MEDS=$P(XX,U,14),RDIOPHARM=$P(XX,U,15) ; Medications & RadioPharm indicators
F I=4,12,9 S HDR=HDR_$P(RADATA,U,I)_" " ; PtName, Case #, Procedure
S T=$P(XX,U,8) I T]"" S HDR=HDR_" ("_T_")" ; ISI Modifier
I REQONLY D CKINTEG(.REPLY,RADFN,RADTI,RACNI,RARPT,RADATA) I REPLY]"" S REPLY="0^7~"_REPLY G ORDZ ; Database integrity problems
S TMPDATA=MAGRPTY_"~"_RADTI_"~"_RACNI
S RAX="",RAPGE=0 D ^RAORD5
S MAGRPTY=$P(TMPDATA,"~"),RADTI=$P(TMPDATA,"~",2),RACNI=$P(TMPDATA,"~",3)
D:IO'=IO(0) ^%ZISC
S @MAGRPTY@(1)="REQ: "_HDR
D CLEANUP(MAGRPTY) ; ISI
D COMMENTS(RADFN,RADTI,RACNI,MAGRPTY,2,COMPLIC,MEDS,RDIOPHARM)
D TIUNOTE(RARPT,MAGRPTY,10000) ; append TIU note to reply at node 10000
S REPLY="1^OK"
K ^TMP($J,"MAGRAEX"),^("RAE2") ; ISI
ORDZ S @MAGRPTY@(0)=REPLY
Q
;
CLEANUP(MAGRPTY) ; strip extraneous lines of dashes ; ISI new subrtn
N HIT,I,X S HIT=0
S I=20 F S I=$O(@MAGRPTY@(I)) Q:'I S X=^(I) D
. I $L(X,"-")>20 S HIT=HIT+1 K:(HIT>1) @MAGRPTY@(I)
. E S HIT=0
Q
;
; Add Medications and Radiopharmaceuticals information to output
; RADFN, RADTI, & RACNI identify exam
; MAGRPTY is indirect reference wher output lines are to be stored
; DNODE holds reference for starting node for lines of output
; COMPLIC passes in complications data reference
; MEDS passes in Medications indicator
; RDIOPHARM passes in Radiopharmaceuticals reference
;
N QTMP,CT,XX,NOTES,NOTESTAT,T S CT=0 ; ISI begin
D STATUS^ISIJNOTE(.NOTESTAT,RADFN,RADTI,RACNI)
S T=+$P(NOTESTAT,U,2) I T D
. S @MAGRPTY@(DNODE)=" ",CT=CT+.01,@MAGRPTY@(DNODE+CT)=" * See "_T_" NOTE"_$S(T-1:"S",1:"")_" at end of report."
. S @MAGRPTY@(DNODE)=" ",CT=CT+.01,@MAGRPTY@(DNODE+CT)=" "
. D NOTE^ISIJNOTE(.NOTES,1_U_RADFN_U_RADTI_U_RACNI_U_RARPT)
. D NOTEDISP(.NOTES,MAGRPTY,5000)
. K @NOTES ; ISI end
I +$G(MAGJOB("USER",1)) ; Radiologist ; ISI--for RadTech Tool use
E I $D(^VA(200,"ARC","T",+DUZ)) ; Rad Tech
E Q ; Don't display for any other user type
S @MAGRPTY@(DNODE)=" ",CT=CT+.01,@MAGRPTY@(DNODE+CT)="Complications: "_$S(COMPLIC:$P($G(^RA(78.1,+COMPLIC,0)),U),1:"")
S X=$P(COMPLIC,"~",2)
I X S CT=CT+.01,@MAGRPTY@(DNODE+CT)=" "_$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"COMP")),U)
K ^TMP($J,"RAE2") D SVTCOM^RAUTL11(RADFN,RADTI,RACNI)
S QTMP="^TMP($J,""RAE2"")"
F S QTMP=$Q(@QTMP) Q:QTMP="" Q:QTMP'["RAE2" I QTMP["TCOM" D
. S XX=@(QTMP) N HI,TXT,LINE1 S LINE1=0
. F Q:XX="" S HI=$L(XX) S:HI>63 HI=63 F I=HI:-1:0 S:'I XX="" I HI<63!($E(XX,I)=" ") D Q
. . S TXT=$S('LINE1:"Tech Comments: ",1:" ")_$E(XX,1,I),XX=$E(XX,I+1,999),LINE1=1
. . I XX]"" F I=1:1:999 I $E(XX,I)'=" " S XX=$E(XX,I,999) Q
. . S CT=CT+.01,@MAGRPTY@(DNODE+CT)=TXT
K ^TMP($J,"RAE2")
I +$G(MEDS) D
. N REF,RAUTOE,RAACNT
. K ^TMP($J,"RA AUTOE")
. S REF=RACNI_","_RADTI_","_RADFN_","
. S RAUTOE="" ; if defined, directs output to ^TMP
. S RAACNT=1000 ; init counter for output to ^TMP
. D PHARM^RARTUTL(REF) ; get Medications data
. D PHARMAS("Medications",1001)
I +$G(RDIOPHARM) D
. N RAUTOE,RAACNT
. K ^TMP($J,"RA AUTOE")
. S RAUTOE="" ; if defined, directs output to ^TMP
. S RAACNT=1000 ; init counter for output to ^TMP
. D RDIO^RARTUTL(RDIOPHARM) ; get Radiopharm data
. D PHARMAS("Radiopharmaceuticals",1001)
I +$G(MEDS)!+$G(RDIOPHARM) D
. S CT=CT+.001,@MAGRPTY@(DNODE+CT)=" "_$TR($J(" ",66)," ","_")
. S CT=CT+.001,@MAGRPTY@(DNODE+CT)=" "
K ^TMP($J,"RA AUTOE")
Q
;
PHARMAS(TITLE,NODE) ; output lines of pharma data
N LINE
I $D(^TMP($J,"RA AUTOE",NODE)) D
. S CT=CT+.001,@MAGRPTY@(DNODE+CT)=" "
. S CT=CT+.001,@MAGRPTY@(DNODE+CT)=" ------------ "_TITLE_" ------------"
. S CT=CT+.001,@MAGRPTY@(DNODE+CT)=" "
. F S LINE=^TMP($J,"RA AUTOE",NODE) D S NODE=$O(^TMP($J,"RA AUTOE",NODE)) Q:'NODE
. . S CT=CT+.001,@MAGRPTY@(DNODE+CT)=LINE
. Q
Q
;
NOTEDISP(NOTES,MAGRPTY,DNODE) ; output notes ; ISI new subrtn
N IP,NOTE,X S NOTE=0
S DNODE=DNODE+1,@MAGRPTY@(DNODE)=" "
S DNODE=DNODE+1,@MAGRPTY@(DNODE)="================================== NOTES =================================="
S DNODE=DNODE+1,@MAGRPTY@(DNODE)=" "
S IP="" F S IP=$O(@NOTES@(IP)) Q:IP="" S X=(@NOTES@(IP)) D
. I X="*NOTES" S NOTE=1 Q
. I NOTE D
. . I X="*NOTES_END" S NOTE=0 Q
. . S DNODE=DNODE+1,@MAGRPTY@(DNODE)=X
Q
;
TIUNOTE(RARPT,MAGRPTY,DNODE) ; FUT-70/IHS append Rad TIU Notes to report
; 1/2011--only works at IHS where TIU notes may exist for Radiology exams
; test for this by presence of DOCTEXT^BEHOTIU
; RARPT--exam pointer
; MAGRPTY--indirect reference to output file
; DNODE--starting node for lines of output
;
N CT,QTMP,TEXT,XX
I RARPT,$L(MAGRPTY),DNODE,$L($T(DOCTEXT^BEHOTIU)) D
. D DOCTEXT^BEHOTIU("TEXT",RARPT_";RARPT(")
. I $D(TEXT) D
. . S CT=0,QTMP="TEXT"
. . S @MAGRPTY@(DNODE)=" "
. . F S QTMP=$Q(@QTMP) Q:QTMP="" S XX=@(QTMP) S CT=CT+.01,@MAGRPTY@(DNODE+CT)=XX
Q
;
OPENDEV ;
N IOP,%ZIS
S IOP="IMAGING WORKSTATION",%ZIS=0 D ^%ZIS
I POP
E U IO
Q
;
RADRPT(MAGRPTY,DATA) ; Display rad report; 1st must pass integrity checks
; Note: adds an additional line of output for the Report Window header
; RPC is MAGJ EXAM REPORT
;
; MAGRPTY holds $NA reference to return message; references to it use subscript indirection
;
S MAGRPTY=$NA(^TMP($J,"MAGJRADRPT")) K @MAGRPTY
N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJRPT"
N RARPT,RADATA,MAGDFN,MAGDTI,MAGCNI,X,MAGRET,HDR,REPLY,MAGPRC,COMPLIC,DNODE
N MEDS,RDIOPHARM
S MAGDFN=$P(DATA,U),MAGDTI=$P(DATA,U,2),MAGCNI=$P(DATA,U,3),RARPT=+$P(DATA,U,4)
I '(MAGDFN&MAGDTI&MAGCNI) D G RPTZ
. S REPLY="0^4~Request Contains Invalid Case Pointer ("_MAGDFN_" "_MAGDTI_" "_MAGCNI_")."
D GETEXAM2^MAGJUTL1(MAGDFN,MAGDTI,MAGCNI,"",.MAGRET)
S RADATA=$G(^TMP($J,"MAGRAEX",1,1)),XX=$G(^(2)),HDR=""
S COMPLIC=$P(XX,U,4) ; Complications text
S MEDS=$P(XX,U,14),RDIOPHARM=$P(XX,U,15) ; Medications & RadioPharm indicators
F I=4,12,9 S HDR=HDR_$P(RADATA,U,I)_" "
S T=$P(XX,U,8) I T]"" S HDR=HDR_" ("_T_")" ; ISI Modifier
D CKINTEG(.REPLY,MAGDFN,MAGDTI,MAGCNI,RARPT,RADATA)
I REPLY]"" S REPLY="0^7~"_REPLY G RPTZ ; DB integ problem
D EN3^RAO7PC3(MAGDFN_"^"_MAGDTI_"^"_MAGCNI)
I '$D(^TMP($J,"RAE3")) S REPLY="0^4~No report on file." G RPTZ
D COMMENTS(MAGDFN,MAGDTI,MAGCNI,MAGRPTY,2,COMPLIC,MEDS,RDIOPHARM)
S MAGPRC=$O(^TMP($J,"RAE3",MAGDFN,MAGCNI,"")),I=0,DNODE=2
F S I=$O(^TMP($J,"RAE3",MAGDFN,MAGCNI,MAGPRC,I)) Q:'I D
. S DNODE=DNODE+1
. S @MAGRPTY@(DNODE)=$G(^TMP($J,"RAE3",MAGDFN,MAGCNI,MAGPRC,I))
S DNODE=DNODE+1,@MAGRPTY@(DNODE)=" " ; ISI
S DNODE=DNODE+1,@MAGRPTY@(DNODE)="** END REPORT "_$$FMTE^XLFDT($$NOW^XLFDT,"1P")_" **" ; ISI
D TIUNOTE(RARPT,MAGRPTY,10000) ; append TIU note to reply at node 10000
S REPLY="1^1~Radiology Report"
RPTZ S @MAGRPTY@(0)=REPLY
I +$G(@MAGRPTY@(0)) S @MAGRPTY@(1)="RPT: "_HDR ; if a report exists, add header line to output
K ^TMP($J,"MAGRAEX"),^("RAE3")
Q
;
CKINTEG(REPLY,RADFN,RADTI,RACNI,RARPT,RADATA) ; check integrity between Exam, Report, and Image Group Headers
; This subroutine is used by other vrad programs
;
N IEN,MAGIEN,MIXEDUP,X,CKDFN,CKACN
S MIXEDUP=0,REPLY=""
I RARPT D G CK2:MIXEDUP
. S X=$G(^RARPT(RARPT,0)),CKDFN=$P(X,U,2),CKACN=$P(X,U,4)
. I CKDFN'=RADFN S MIXEDUP=1_U_+CKDFN Q
. I $G(RADATA)]"" D
. . I $P(RADATA,U,8)'=CKACN D
. . . N MAGPSET,RAPRTSET,ACN,OK S OK=0
. . . S RAPRTSET=0 D EN2^RAUTL20(.MAGPSET) I RAPRTSET D
. . . . N I,T ; P133 mod for MAGPSET Data ex.--Old= 256^154^190^4 SSAN= 660-080504-256^154^190^4
. . . . S I=0 F S I=$O(MAGPSET(I)) Q:'I S T=$P(MAGPSET(I),U) I $P(T,"-",$L(T,"-"))=CKACN S OK=1 Q
. . . I 'OK S MIXEDUP=5_U_CKACN_U_$P(RADATA,U,8)
I $D(^RARPT(+RARPT,2005)) S IEN=0 D G CK2:MIXEDUP
. F S IEN=$O(^RARPT(RARPT,2005,IEN)) Q:'IEN S MAGIEN=+$G(^(IEN,0)) D Q:MIXEDUP
. . S X=$P($G(^MAG(2005,MAGIEN,0)),U,7) I X'=RADFN S MIXEDUP=2_U_+X Q
. . S X=$P($G(^MAG(2005,MAGIEN,2)),U,7) I X'=RARPT S MIXEDUP=3_U_+X Q
CK2 I 'MIXEDUP Q ; no problems detected
I +MIXEDUP=1!(+MIXEDUP=2) D Q
. S X=$$PNAM^MAGJEX1($P(MIXEDUP,U,2))
. I +MIXEDUP=1 S REPLY="The Exam file for this exam has patient "_$$PNAM^MAGJEX1(RADFN)_"; the corresponding Report file has patient "_X_". This is a serious problem--immediately report it to Radiology management and Imaging support!"
. I +MIXEDUP=2 S REPLY="This exam is registered for "_$$PNAM^MAGJEX1(RADFN)_"; however, it is linked to images for patient "_X_". This is a serious problem--immediately report it to Radiology management and Imaging support staff!"
I +MIXEDUP=3 D Q
. N T S T=$P(MIXEDUP,U,2) S:'T T="Missing Link"
. S REPLY="This exam is linked to Report entry #"_RARPT_", but some of its images may be linked to Report entry #"_T_". This is a potentially serious problem--immediately report it to Radiology management and Imaging support staff!"
I +MIXEDUP=4 D Q
. N T S T=$P(MIXEDUP,U,2) S:'T T="Missing Reference"
. S X=" ("_RARPT_" and "_T_" )"
. S REPLY="This exam has problems in the Radiology Report file, with two different report entries referenced"_X_". This is a potentially serious problem--immediately report it to Radiology management and Imaging support staff!"
I +MIXEDUP=5 D Q
. N T S X=$P(MIXEDUP,U,2) S:X="" X="Missing"
. S T=$P(MIXEDUP,U,3) S:T="" T="Missing"
. S X=" ("_X_" and "_T_") "
. S REPLY="This exam has problems in the Radiology files, with two different Case Numbers referenced"_X_". This is a potentially serious problem--immediately report it to Radiology management and Imaging support staff!"
Q
;
ERR ;
S @MAGRPTY@(0)="0^ERROR "_$$EC^%ZOSV
D @^%ZOSF("ERRTN")
Q:$Q 1 Q
END ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGJRPT 12691 printed Dec 13, 2024@02:06:54 Page 2
MAGJRPT ;WIRMFO/JHC - Display Rad reports ; 10/17/2022
+1 ;;3.0;IMAGING;**18,101,120,133,341**;Dec 21, 2022;Build 28
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 ; Reference to EN2^RAUTL20 in ICR #3270
+18 ; Reference to EN3^RAO7PC3 #2877
+19 ; Reference to ^RAORD5 #3513
+20 ; Reference to SVTCOM^RAUTL11 in ICR #3508
+21 ; Reference to PHARM^RARTUTL in ICR #5946
+22 ; Reference to RDIO^RARTUTL in ICR #5946
+23 ;; ISI IMAGING;**99,104,102**
+24 ; Subroutines for fetching Exam Info for VistaRad Workstation
+25 ; RADRPT: Display Radiology Report -- RPC Call: MAGJ EXAM REPORT
+26 ; ORD: Display Radiology Requisition -- RPC Call: MAGJ RADORDERDISP
+27 ;
+28 QUIT
ORD(MAGRPTY,DATA) ; Radiology Order Display
+1 ; RPC Call: MAGJ RADORDERDISP
+2 ; MAGRPTY holds indirect reference to returned data
+3 ;
+4 SET MAGRPTY=$NAME(^TMP($JOB,"WSDAT"))
KILL @MAGRPTY
+5 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^MAGJRPT"
+6 NEW RARPT,RADFN,RADTI,RACNI,RAPGE,RAX,RAOIFN
+7 NEW REPLY,POP,DFN,COMPLIC,XX,HDR,MAGRET,REQONLY,TMPDATA
+8 NEW MEDS,RDIOPHARM
+9 SET REPLY="0^4~Attempting to display order info"
+10 DO OPENDEV
+11 IF POP
SET REPLY="0^4~Unable to open device 'IMAGING WORKSTATION'"
GOTO ORDZ
+12 SET RADFN=$PIECE(DATA,U)
SET RADTI=$PIECE(DATA,U,2)
SET RACNI=$PIECE(DATA,U,3)
+13 SET RARPT=+$PIECE(DATA,U,4)
SET REQONLY=+$PIECE(DATA,U,5)
+14 IF RADFN
IF RADTI
IF RACNI
+15 IF '$TEST
SET REPLY="0^4~Request Contains Invalid Case Pointer ("_RADFN_" "_RADTI_" "_RACNI_" "_RARPT_")."
GOTO ORDZ
+16 SET RAOIFN=$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,11)
+17 IF RAOIFN
IF $DATA(^RAO(75.1,RAOIFN,0))
+18 IF '$TEST
SET REPLY="0^2~Order Information is NOT Available for this exam."
GOTO ORDZ
+19 ; Check for Database integrity problems ONLY if Req was explicitly
+20 ; requested (No check for Auto_Display of Req, cuz Exam Open does ck)
+21 DO GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.MAGRET)
+22 SET RADATA=$GET(^TMP($JOB,"MAGRAEX",1,1))
SET XX=$GET(^(2))
SET HDR=""
+23 ; Complications text
SET COMPLIC=$PIECE(XX,U,4)
+24 ; Medications & RadioPharm indicators
SET MEDS=$PIECE(XX,U,14)
SET RDIOPHARM=$PIECE(XX,U,15)
+25 ; PtName, Case #, Procedure
FOR I=4,12,9
SET HDR=HDR_$PIECE(RADATA,U,I)_" "
+26 ; ISI Modifier
SET T=$PIECE(XX,U,8)
IF T]""
SET HDR=HDR_" ("_T_")"
+27 ; Database integrity problems
IF REQONLY
DO CKINTEG(.REPLY,RADFN,RADTI,RACNI,RARPT,RADATA)
IF REPLY]""
SET REPLY="0^7~"_REPLY
GOTO ORDZ
+28 SET TMPDATA=MAGRPTY_"~"_RADTI_"~"_RACNI
+29 SET RAX=""
SET RAPGE=0
DO ^RAORD5
+30 SET MAGRPTY=$PIECE(TMPDATA,"~")
SET RADTI=$PIECE(TMPDATA,"~",2)
SET RACNI=$PIECE(TMPDATA,"~",3)
+31 if IO'=IO(0)
DO ^%ZISC
+32 SET @MAGRPTY@(1)="REQ: "_HDR
+33 ; ISI
DO CLEANUP(MAGRPTY)
+34 DO COMMENTS(RADFN,RADTI,RACNI,MAGRPTY,2,COMPLIC,MEDS,RDIOPHARM)
+35 ; append TIU note to reply at node 10000
DO TIUNOTE(RARPT,MAGRPTY,10000)
+36 SET REPLY="1^OK"
+37 ; ISI
KILL ^TMP($JOB,"MAGRAEX"),^("RAE2")
ORDZ SET @MAGRPTY@(0)=REPLY
+1 QUIT
+2 ;
CLEANUP(MAGRPTY) ; strip extraneous lines of dashes ; ISI new subrtn
+1 NEW HIT,I,X
SET HIT=0
+2 SET I=20
FOR
SET I=$ORDER(@MAGRPTY@(I))
if 'I
QUIT
SET X=^(I)
Begin DoDot:1
+3 IF $LENGTH(X,"-")>20
SET HIT=HIT+1
if (HIT>1)
KILL @MAGRPTY@(I)
+4 IF '$TEST
SET HIT=0
End DoDot:1
+5 QUIT
+6 ;
+1 ; Add Medications and Radiopharmaceuticals information to output
+2 ; RADFN, RADTI, & RACNI identify exam
+3 ; MAGRPTY is indirect reference wher output lines are to be stored
+4 ; DNODE holds reference for starting node for lines of output
+5 ; COMPLIC passes in complications data reference
+6 ; MEDS passes in Medications indicator
+7 ; RDIOPHARM passes in Radiopharmaceuticals reference
+8 ;
+9 ; ISI begin
NEW QTMP,CT,XX,NOTES,NOTESTAT,T
SET CT=0
+10 DO STATUS^ISIJNOTE(.NOTESTAT,RADFN,RADTI,RACNI)
+11 SET T=+$PIECE(NOTESTAT,U,2)
IF T
Begin DoDot:1
+12 SET @MAGRPTY@(DNODE)=" "
SET CT=CT+.01
SET @MAGRPTY@(DNODE+CT)=" * See "_T_" NOTE"_$SELECT(T-1:"S",1:"")_" at end of report."
+13 SET @MAGRPTY@(DNODE)=" "
SET CT=CT+.01
SET @MAGRPTY@(DNODE+CT)=" "
+14 DO NOTE^ISIJNOTE(.NOTES,1_U_RADFN_U_RADTI_U_RACNI_U_RARPT)
+15 DO NOTEDISP(.NOTES,MAGRPTY,5000)
+16 ; ISI end
KILL @NOTES
End DoDot:1
+17 ; Radiologist ; ISI--for RadTech Tool use
IF +$GET(MAGJOB("USER",1))
+18 ; Rad Tech
IF '$TEST
IF $DATA(^VA(200,"ARC","T",+DUZ))
+19 ; Don't display for any other user type
IF '$TEST
QUIT
+20 SET @MAGRPTY@(DNODE)=" "
SET CT=CT+.01
SET @MAGRPTY@(DNODE+CT)="Complications: "_$SELECT(COMPLIC:$PIECE($GET(^RA(78.1,+COMPLIC,0)),U),1:"")
+21 SET X=$PIECE(COMPLIC,"~",2)
+22 IF X
SET CT=CT+.01
SET @MAGRPTY@(DNODE+CT)=" "_$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"COMP")),U)
+23 KILL ^TMP($JOB,"RAE2")
DO SVTCOM^RAUTL11(RADFN,RADTI,RACNI)
+24 SET QTMP="^TMP($J,""RAE2"")"
+25 FOR
SET QTMP=$QUERY(@QTMP)
if QTMP=""
QUIT
if QTMP'["RAE2"
QUIT
IF QTMP["TCOM"
Begin DoDot:1
+26 SET XX=@(QTMP)
NEW HI,TXT,LINE1
SET LINE1=0
+27 FOR
if XX=""
QUIT
SET HI=$LENGTH(XX)
if HI>63
SET HI=63
FOR I=HI:-1:0
if 'I
SET XX=""
IF HI<63!($EXTRACT(XX,I)=" ")
Begin DoDot:2
+28 SET TXT=$SELECT('LINE1:"Tech Comments: ",1:" ")_$EXTRACT(XX,1,I)
SET XX=$EXTRACT(XX,I+1,999)
SET LINE1=1
+29 IF XX]""
FOR I=1:1:999
IF $EXTRACT(XX,I)'=" "
SET XX=$EXTRACT(XX,I,999)
QUIT
+30 SET CT=CT+.01
SET @MAGRPTY@(DNODE+CT)=TXT
End DoDot:2
QUIT
End DoDot:1
+31 KILL ^TMP($JOB,"RAE2")
+32 IF +$GET(MEDS)
Begin DoDot:1
+33 NEW REF,RAUTOE,RAACNT
+34 KILL ^TMP($JOB,"RA AUTOE")
+35 SET REF=RACNI_","_RADTI_","_RADFN_","
+36 ; if defined, directs output to ^TMP
SET RAUTOE=""
+37 ; init counter for output to ^TMP
SET RAACNT=1000
+38 ; get Medications data
DO PHARM^RARTUTL(REF)
+39 DO PHARMAS("Medications",1001)
End DoDot:1
+40 IF +$GET(RDIOPHARM)
Begin DoDot:1
+41 NEW RAUTOE,RAACNT
+42 KILL ^TMP($JOB,"RA AUTOE")
+43 ; if defined, directs output to ^TMP
SET RAUTOE=""
+44 ; init counter for output to ^TMP
SET RAACNT=1000
+45 ; get Radiopharm data
DO RDIO^RARTUTL(RDIOPHARM)
+46 DO PHARMAS("Radiopharmaceuticals",1001)
End DoDot:1
+47 IF +$GET(MEDS)!+$GET(RDIOPHARM)
Begin DoDot:1
+48 SET CT=CT+.001
SET @MAGRPTY@(DNODE+CT)=" "_$TRANSLATE($JUSTIFY(" ",66)," ","_")
+49 SET CT=CT+.001
SET @MAGRPTY@(DNODE+CT)=" "
End DoDot:1
+50 KILL ^TMP($JOB,"RA AUTOE")
+51 QUIT
+52 ;
PHARMAS(TITLE,NODE) ; output lines of pharma data
+1 NEW LINE
+2 IF $DATA(^TMP($JOB,"RA AUTOE",NODE))
Begin DoDot:1
+3 SET CT=CT+.001
SET @MAGRPTY@(DNODE+CT)=" "
+4 SET CT=CT+.001
SET @MAGRPTY@(DNODE+CT)=" ------------ "_TITLE_" ------------"
+5 SET CT=CT+.001
SET @MAGRPTY@(DNODE+CT)=" "
+6 FOR
SET LINE=^TMP($JOB,"RA AUTOE",NODE)
Begin DoDot:2
+7 SET CT=CT+.001
SET @MAGRPTY@(DNODE+CT)=LINE
End DoDot:2
SET NODE=$ORDER(^TMP($JOB,"RA AUTOE",NODE))
if 'NODE
QUIT
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
NOTEDISP(NOTES,MAGRPTY,DNODE) ; output notes ; ISI new subrtn
+1 NEW IP,NOTE,X
SET NOTE=0
+2 SET DNODE=DNODE+1
SET @MAGRPTY@(DNODE)=" "
+3 SET DNODE=DNODE+1
SET @MAGRPTY@(DNODE)="================================== NOTES =================================="
+4 SET DNODE=DNODE+1
SET @MAGRPTY@(DNODE)=" "
+5 SET IP=""
FOR
SET IP=$ORDER(@NOTES@(IP))
if IP=""
QUIT
SET X=(@NOTES@(IP))
Begin DoDot:1
+6 IF X="*NOTES"
SET NOTE=1
QUIT
+7 IF NOTE
Begin DoDot:2
+8 IF X="*NOTES_END"
SET NOTE=0
QUIT
+9 SET DNODE=DNODE+1
SET @MAGRPTY@(DNODE)=X
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
TIUNOTE(RARPT,MAGRPTY,DNODE) ; FUT-70/IHS append Rad TIU Notes to report
+1 ; 1/2011--only works at IHS where TIU notes may exist for Radiology exams
+2 ; test for this by presence of DOCTEXT^BEHOTIU
+3 ; RARPT--exam pointer
+4 ; MAGRPTY--indirect reference to output file
+5 ; DNODE--starting node for lines of output
+6 ;
+7 NEW CT,QTMP,TEXT,XX
+8 IF RARPT
IF $LENGTH(MAGRPTY)
IF DNODE
IF $LENGTH($TEXT(DOCTEXT^BEHOTIU))
Begin DoDot:1
+9 DO DOCTEXT^BEHOTIU("TEXT",RARPT_";RARPT(")
+10 IF $DATA(TEXT)
Begin DoDot:2
+11 SET CT=0
SET QTMP="TEXT"
+12 SET @MAGRPTY@(DNODE)=" "
+13 FOR
SET QTMP=$QUERY(@QTMP)
if QTMP=""
QUIT
SET XX=@(QTMP)
SET CT=CT+.01
SET @MAGRPTY@(DNODE+CT)=XX
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
OPENDEV ;
+1 NEW IOP,%ZIS
+2 SET IOP="IMAGING WORKSTATION"
SET %ZIS=0
DO ^%ZIS
+3 IF POP
+4 IF '$TEST
USE IO
+5 QUIT
+6 ;
RADRPT(MAGRPTY,DATA) ; Display rad report; 1st must pass integrity checks
+1 ; Note: adds an additional line of output for the Report Window header
+2 ; RPC is MAGJ EXAM REPORT
+3 ;
+4 ; MAGRPTY holds $NA reference to return message; references to it use subscript indirection
+5 ;
+6 SET MAGRPTY=$NAME(^TMP($JOB,"MAGJRADRPT"))
KILL @MAGRPTY
+7 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^MAGJRPT"
+8 NEW RARPT,RADATA,MAGDFN,MAGDTI,MAGCNI,X,MAGRET,HDR,REPLY,MAGPRC,COMPLIC,DNODE
+9 NEW MEDS,RDIOPHARM
+10 SET MAGDFN=$PIECE(DATA,U)
SET MAGDTI=$PIECE(DATA,U,2)
SET MAGCNI=$PIECE(DATA,U,3)
SET RARPT=+$PIECE(DATA,U,4)
+11 IF '(MAGDFN&MAGDTI&MAGCNI)
Begin DoDot:1
+12 SET REPLY="0^4~Request Contains Invalid Case Pointer ("_MAGDFN_" "_MAGDTI_" "_MAGCNI_")."
End DoDot:1
GOTO RPTZ
+13 DO GETEXAM2^MAGJUTL1(MAGDFN,MAGDTI,MAGCNI,"",.MAGRET)
+14 SET RADATA=$GET(^TMP($JOB,"MAGRAEX",1,1))
SET XX=$GET(^(2))
SET HDR=""
+15 ; Complications text
SET COMPLIC=$PIECE(XX,U,4)
+16 ; Medications & RadioPharm indicators
SET MEDS=$PIECE(XX,U,14)
SET RDIOPHARM=$PIECE(XX,U,15)
+17 FOR I=4,12,9
SET HDR=HDR_$PIECE(RADATA,U,I)_" "
+18 ; ISI Modifier
SET T=$PIECE(XX,U,8)
IF T]""
SET HDR=HDR_" ("_T_")"
+19 DO CKINTEG(.REPLY,MAGDFN,MAGDTI,MAGCNI,RARPT,RADATA)
+20 ; DB integ problem
IF REPLY]""
SET REPLY="0^7~"_REPLY
GOTO RPTZ
+21 DO EN3^RAO7PC3(MAGDFN_"^"_MAGDTI_"^"_MAGCNI)
+22 IF '$DATA(^TMP($JOB,"RAE3"))
SET REPLY="0^4~No report on file."
GOTO RPTZ
+23 DO COMMENTS(MAGDFN,MAGDTI,MAGCNI,MAGRPTY,2,COMPLIC,MEDS,RDIOPHARM)
+24 SET MAGPRC=$ORDER(^TMP($JOB,"RAE3",MAGDFN,MAGCNI,""))
SET I=0
SET DNODE=2
+25 FOR
SET I=$ORDER(^TMP($JOB,"RAE3",MAGDFN,MAGCNI,MAGPRC,I))
if 'I
QUIT
Begin DoDot:1
+26 SET DNODE=DNODE+1
+27 SET @MAGRPTY@(DNODE)=$GET(^TMP($JOB,"RAE3",MAGDFN,MAGCNI,MAGPRC,I))
End DoDot:1
+28 ; ISI
SET DNODE=DNODE+1
SET @MAGRPTY@(DNODE)=" "
+29 ; ISI
SET DNODE=DNODE+1
SET @MAGRPTY@(DNODE)="** END REPORT "_$$FMTE^XLFDT($$NOW^XLFDT,"1P")_" **"
+30 ; append TIU note to reply at node 10000
DO TIUNOTE(RARPT,MAGRPTY,10000)
+31 SET REPLY="1^1~Radiology Report"
RPTZ SET @MAGRPTY@(0)=REPLY
+1 ; if a report exists, add header line to output
IF +$GET(@MAGRPTY@(0))
SET @MAGRPTY@(1)="RPT: "_HDR
+2 KILL ^TMP($JOB,"MAGRAEX"),^("RAE3")
+3 QUIT
+4 ;
CKINTEG(REPLY,RADFN,RADTI,RACNI,RARPT,RADATA) ; check integrity between Exam, Report, and Image Group Headers
+1 ; This subroutine is used by other vrad programs
+2 ;
+3 NEW IEN,MAGIEN,MIXEDUP,X,CKDFN,CKACN
+4 SET MIXEDUP=0
SET REPLY=""
+5 IF RARPT
Begin DoDot:1
+6 SET X=$GET(^RARPT(RARPT,0))
SET CKDFN=$PIECE(X,U,2)
SET CKACN=$PIECE(X,U,4)
+7 IF CKDFN'=RADFN
SET MIXEDUP=1_U_+CKDFN
QUIT
+8 IF $GET(RADATA)]""
Begin DoDot:2
+9 IF $PIECE(RADATA,U,8)'=CKACN
Begin DoDot:3
+10 NEW MAGPSET,RAPRTSET,ACN,OK
SET OK=0
+11 SET RAPRTSET=0
DO EN2^RAUTL20(.MAGPSET)
IF RAPRTSET
Begin DoDot:4
+12 ; P133 mod for MAGPSET Data ex.--Old= 256^154^190^4 SSAN= 660-080504-256^154^190^4
NEW I,T
+13 SET I=0
FOR
SET I=$ORDER(MAGPSET(I))
if 'I
QUIT
SET T=$PIECE(MAGPSET(I),U)
IF $PIECE(T,"-",$LENGTH(T,"-"))=CKACN
SET OK=1
QUIT
End DoDot:4
+14 IF 'OK
SET MIXEDUP=5_U_CKACN_U_$PIECE(RADATA,U,8)
End DoDot:3
End DoDot:2
End DoDot:1
if MIXEDUP
GOTO CK2
+15 IF $DATA(^RARPT(+RARPT,2005))
SET IEN=0
Begin DoDot:1
+16 FOR
SET IEN=$ORDER(^RARPT(RARPT,2005,IEN))
if 'IEN
QUIT
SET MAGIEN=+$GET(^(IEN,0))
Begin DoDot:2
+17 SET X=$PIECE($GET(^MAG(2005,MAGIEN,0)),U,7)
IF X'=RADFN
SET MIXEDUP=2_U_+X
QUIT
+18 SET X=$PIECE($GET(^MAG(2005,MAGIEN,2)),U,7)
IF X'=RARPT
SET MIXEDUP=3_U_+X
QUIT
End DoDot:2
if MIXEDUP
QUIT
End DoDot:1
if MIXEDUP
GOTO CK2
CK2 ; no problems detected
IF 'MIXEDUP
QUIT
+1 IF +MIXEDUP=1!(+MIXEDUP=2)
Begin DoDot:1
+2 SET X=$$PNAM^MAGJEX1($PIECE(MIXEDUP,U,2))
+3 IF +MIXEDUP=1
SET REPLY="The Exam file for this exam has patient "_$$PNAM^MAGJEX1(RADFN)_"; the corresponding Report file has patient "_X_". This is a serious problem--immediately report it to Radiology management and Imaging support!"
+4 IF +MIXEDUP=2
SET REPLY="This exam is registered for "_$$PNAM^MAGJEX1(RADFN)_"; however, it is linked to images for patient "_X_". This is a serious problem--immediately report it to Radiology management and Imaging support staff!"
End DoDot:1
QUIT
+5 IF +MIXEDUP=3
Begin DoDot:1
+6 NEW T
SET T=$PIECE(MIXEDUP,U,2)
if 'T
SET T="Missing Link"
+7 SET REPLY="This exam is linked to Report entry #"_RARPT_", but some of its images may be linked to Report entry #"_T_". This is a potentially serious problem--immediately report it to Radiology management and Imaging support staff!"
End DoDot:1
QUIT
+8 IF +MIXEDUP=4
Begin DoDot:1
+9 NEW T
SET T=$PIECE(MIXEDUP,U,2)
if 'T
SET T="Missing Reference"
+10 SET X=" ("_RARPT_" and "_T_" )"
+11 SET REPLY="This exam has problems in the Radiology Report file, with two different report entries referenced"_X_". This is a potentially serious problem--immediately report it to Radiology management and Imaging support staff!"
End DoDot:1
QUIT
+12 IF +MIXEDUP=5
Begin DoDot:1
+13 NEW T
SET X=$PIECE(MIXEDUP,U,2)
if X=""
SET X="Missing"
+14 SET T=$PIECE(MIXEDUP,U,3)
if T=""
SET T="Missing"
+15 SET X=" ("_X_" and "_T_") "
+16 SET REPLY="This exam has problems in the Radiology files, with two different Case Numbers referenced"_X_". This is a potentially serious problem--immediately report it to Radiology management and Imaging support staff!"
End DoDot:1
QUIT
+17 QUIT
+18 ;
ERR ;
+1 SET @MAGRPTY@(0)="0^ERROR "_$$EC^%ZOSV
+2 DO @^%ZOSF("ERRTN")
+3 if $QUIT
QUIT 1
QUIT
END ;
