MAGGTRAI ;WOIFO/GEK - list images for Radiology report ; [ 11/08/2001 17:18 ]
;;3.0;IMAGING;**8,93**;Dec 02, 2009;Build 163
;; 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. |
;; +---------------------------------------------------------------+
;;
Q
IMAGE(MAGZRY,DATA) ;RPC [MAGGRADIMAGE]
; Call from selected entry in Rad Exam list.
; INPUT is DATA, which is just what we sent in the list of Rad
; Exams for the patient.
;DATA is the Radiology values stored in ^TMP($J,"RAEX",x)
; that the radiology procedure RAPTLU sets during the search
; for patient exams. (see routine RAPTLU )
; ^TMP($J,"RAEX",RACNT)=
; RADFN_"^"_RADTI_"^"_RACNI_"^"_RANME_"^"_RASSN_"^"
; _RADATE_"^"_RADTE_"^"_RACN_"^"_RAPRC_"^"_RARPT_"^"_RAST
;
S MAGZRY=$NA(^TMP("MAGGTRAI",$J))
K @MAGZRY
IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
E S X="ERRA^MAGGTERR",@^%ZOSF("TRAP")
N I,Y,CT,MAGIEN
;
S DATA=$P(DATA,"^",7,99)
S CT=0
F I="RADFN","RADTI","RACNI","RANME","RASSN","RADATE","RADTE","RACN","RAPRC","RARPT","RAST" S CT=CT+1,@I=$P(DATA,"^",CT)
; Patch 2.0.5 next few lines for Patient Safety
I RARPT["PMRAD" S @MAGZRY@(0)="-2^Patient Mismatch. Radiology Files" Q
I 'RARPT S @MAGZRY@(0)="0^No Report for selected exam." Q
I '$O(^RARPT(RARPT,2005,0)) S @MAGZRY@(0)="0^No Images for selected exam." Q
I $P($G(^RARPT(RARPT,0)),U,2)'=RADFN S @MAGZRY@(0)="-2^Patient Mismatch. Radiology Files" Q
D GETLIST
Q
IMAGEC(MAGZRY,DATA) ;RPC [MAGG CPRS RAD EXAM]
; Call to list Images for a Rad Exam that was selected from CPRS
; and Imaging Window was notified via windows messaging
; INPUT : DATA is in format of Windows message received from CPRS
; example 'RPT^CPRS^29027^RA^i79029185.9998-1'
N DFN,RARPT,ENT,INVDTTM,INVDT,INVTM
S X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1)
S MAGZRY=$NA(^TMP("MAGGTRAI",$J))
K @MAGZRY
S DFN=$P(DATA,U,3)
S ENT=$P($P(DATA,U,5),"-",2)
S INVDTTM=$P($P(DATA,U,5),"-",1)
S INVDT=$P(INVDTTM,".",1)
S INVTM=$P(INVDTTM,".",2)
F Q:($L(INVDT)<8) S INVDT=$E(INVDT,2,$L(INVDT))
S INVDTTM=INVDT_"."_INVTM
I '$D(^RADPT(DFN,"DT",INVDTTM,"P",ENT,0)) S @MAGZRY@(0)="0^INVALID Data : Attempt to access Exam failed." Q
; Get out the Naked reference .
S RARPT=$P(^RADPT(DFN,"DT",INVDTTM,"P",ENT,0),U,17)
;S RARPT=$P(^(0),U,17)
I 'RARPT S @MAGZRY@(0)="0^No Report for selected Exam" Q
; MAGQI 8/22/01
I $P($G(^RARPT(RARPT,0)),U,2)'=DFN S @MAGZRY@(0)="-2^Patient Mismatch. Radiology File" Q
D GETLIST
N XINFO
S XINFO=$P(^RARPT(RARPT,0),U,1)
S X=$P(^RADPT(DFN,"DT",INVDTTM,"P",ENT,0),U,2)
S XINFO=XINFO_" "_$P(^RAMIS(71,X,0),U)
S X=$P(^RARPT(RARPT,0),U,3)
S XINFO=XINFO_" "_X
S $P(@MAGZRY@(0),U,3)=RARPT
S $P(@MAGZRY@(0),U,4)=XINFO
Q
GETLIST ; Private call. From other points in this routine, when RARPT is defined
; and returns a list in MAGZRY(1..n).
; We'll make a tmp list of just the image IEN's
; splitting groups into individual image entries.
; If more than 1 Image group points to this report, we
; will prefix the Image Description with (G1), (G2) etc
; We call GROUP^MAGGTIG to get the images for the group, this call
; sorts the images in Dicom Series, Dicom Image number order.
;
K ^TMP("MAGGX",$J)
N OI,IGCT,MAGIEN1,ORDCT,GCT,MAGQI,MAGX,SINGCT
S (ORDCT,GCT,SINGCT)=0
S IGCT=+$P($G(^RARPT(RARPT,2005,0)),U,4)
; Quit if no images for RARPT
I IGCT=0 S @MAGZRY@(0)="0^0 Images for Radiology Report." Q
;
; Check all Image entries in RARPT 2005 NODE. for Patient match Pointer match, from both
; RARPT end, and Imaging end.
S MAGQI=1
S OI=0,CT=1 F S OI=$O(^RARPT(RARPT,2005,OI)) Q:'OI D Q:(MAGQI<1)
. S MAGIEN1=$P(^RARPT(RARPT,2005,OI,0),U)
. ; Assure magdfn = rarpt dfn
. I $P($G(^RARPT(RARPT,0)),U,2)'=$P($G(^MAG(2005,MAGIEN1,0)),U,7) S MAGQI="-2^Patient Mismatch. Radiology Report" Q
. ; Assure magien1 is pointing to this rarpt
. I $P($G(^MAG(2005,MAGIEN1,2)),U,7)'=RARPT S MAGQI="-2^Pointer Mismatch. Radiology Report" Q
. ; Now run the Imaging integrity check
. D CHK^MAGGSQI(.MAGX,MAGIEN1) I 'MAGX(0) S MAGQI="-2^"_$P(MAGX(0),U,2,99) Q
;
I MAGQI<1 S @MAGZRY@(0)=MAGQI Q
S CT=0
;
S OI=0,CT=1 F S OI=$O(^RARPT(RARPT,2005,OI)) Q:'OI D
. S MAGIEN1=$P(^RARPT(RARPT,2005,OI,0),U) D ONELIST
;
; Now get the list from the TMP LIST and return it.
I '$D(^TMP("MAGGX",$J)) S @MAGZRY@(0)="0^Report "_RARPT_": has INVALID Image Pointers" Q
S CT=0
S MAGQUIET=1
S I="",J="",K=""
F S I=$O(^TMP("MAGGX",$J,I)) Q:I="" D
. S J=""
. F S J=$O(^TMP("MAGGX",$J,I,J)) Q:J="" D
. . S K=""
. . F S K=$O(^TMP("MAGGX",$J,I,J,K)) Q:K="" D
. . . S CT=CT+1
. . . S X="["_J_"]"_$P(^TMP("MAGGX",$J,I,J,K),U,8)
. . . S $P(^TMP("MAGGX",$J,I,J,K),U,8)=X
. . . S @MAGZRY@(CT)=^TMP("MAGGX",$J,I,J,K)
K MAGQUIET
S @MAGZRY@(0)=CT_"^Images for the selected Radiology Exam"
; Redesign needed for Multiple Image Groups pointing to an exam or note.
; we now put all images from all groups in one list.
S $P(@MAGZRY@(0),U,5)=$G(MAGIEN1) ; this was last ien from multiple Image Groups.
;
Q
ONELIST ; Private Call from other parts of this routine.
N MAGTMP
Q:'$D(^MAG(2005,MAGIEN1,0))
; if a single image just get record for that IEN
I '$O(^MAG(2005,MAGIEN1,1,0)) D Q
. ;S MAGXX=MAGIEN1 D INFO^MAGGTII
. S MAGFILE=$$INFO^MAGGAII(MAGIEN1,"E")
. S ORDCT=ORDCT+1,SINGCT=SINGCT+1
. S ^TMP("MAGGX",$J,ORDCT,"S",SINGCT)="B2^"_MAGFILE
D GROUP^MAGGTIG(.MAGTMP,MAGIEN1) I $P(@MAGTMP@(0),U,2)>0 D
. S ORDCT=ORDCT+1,GCT=GCT+1,X="G"_GCT
. K @MAGTMP@(0)
. M ^TMP("MAGGX",$J,ORDCT,X)=@MAGTMP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGTRAI 6603 printed Dec 13, 2024@02:03:11 Page 2
MAGGTRAI ;WOIFO/GEK - list images for Radiology report ; [ 11/08/2001 17:18 ]
+1 ;;3.0;IMAGING;**8,93**;Dec 02, 2009;Build 163
+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 ;; | |
+11 ;; | The Food and Drug Administration classifies this software as |
+12 ;; | a medical device. As such, it may not be changed in any way. |
+13 ;; | Modifications to this software may result in an adulterated |
+14 ;; | medical device under 21CFR820, the use of which is considered |
+15 ;; | to be a violation of US Federal Statutes. |
+16 ;; +---------------------------------------------------------------+
+17 ;;
+18 QUIT
IMAGE(MAGZRY,DATA) ;RPC [MAGGRADIMAGE]
+1 ; Call from selected entry in Rad Exam list.
+2 ; INPUT is DATA, which is just what we sent in the list of Rad
+3 ; Exams for the patient.
+4 ;DATA is the Radiology values stored in ^TMP($J,"RAEX",x)
+5 ; that the radiology procedure RAPTLU sets during the search
+6 ; for patient exams. (see routine RAPTLU )
+7 ; ^TMP($J,"RAEX",RACNT)=
+8 ; RADFN_"^"_RADTI_"^"_RACNI_"^"_RANME_"^"_RASSN_"^"
+9 ; _RADATE_"^"_RADTE_"^"_RACN_"^"_RAPRC_"^"_RARPT_"^"_RAST
+10 ;
+11 SET MAGZRY=$NAME(^TMP("MAGGTRAI",$JOB))
+12 KILL @MAGZRY
+13 IF $$NEWERR^%ZTER
NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGGTERR"
+14 IF '$TEST
SET X="ERRA^MAGGTERR"
SET @^%ZOSF("TRAP")
+15 NEW I,Y,CT,MAGIEN
+16 ;
+17 SET DATA=$PIECE(DATA,"^",7,99)
+18 SET CT=0
+19 FOR I="RADFN","RADTI","RACNI","RANME","RASSN","RADATE","RADTE","RACN","RAPRC","RARPT","RAST"
SET CT=CT+1
SET @I=$PIECE(DATA,"^",CT)
+20 ; Patch 2.0.5 next few lines for Patient Safety
+21 IF RARPT["PMRAD"
SET @MAGZRY@(0)="-2^Patient Mismatch. Radiology Files"
QUIT
+22 IF 'RARPT
SET @MAGZRY@(0)="0^No Report for selected exam."
QUIT
+23 IF '$ORDER(^RARPT(RARPT,2005,0))
SET @MAGZRY@(0)="0^No Images for selected exam."
QUIT
+24 IF $PIECE($GET(^RARPT(RARPT,0)),U,2)'=RADFN
SET @MAGZRY@(0)="-2^Patient Mismatch. Radiology Files"
QUIT
+25 DO GETLIST
+26 QUIT
IMAGEC(MAGZRY,DATA) ;RPC [MAGG CPRS RAD EXAM]
+1 ; Call to list Images for a Rad Exam that was selected from CPRS
+2 ; and Imaging Window was notified via windows messaging
+3 ; INPUT : DATA is in format of Windows message received from CPRS
+4 ; example 'RPT^CPRS^29027^RA^i79029185.9998-1'
+5 NEW DFN,RARPT,ENT,INVDTTM,INVDT,INVTM
+6 SET X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1)
+7 SET MAGZRY=$NAME(^TMP("MAGGTRAI",$JOB))
+8 KILL @MAGZRY
+9 SET DFN=$PIECE(DATA,U,3)
+10 SET ENT=$PIECE($PIECE(DATA,U,5),"-",2)
+11 SET INVDTTM=$PIECE($PIECE(DATA,U,5),"-",1)
+12 SET INVDT=$PIECE(INVDTTM,".",1)
+13 SET INVTM=$PIECE(INVDTTM,".",2)
+14 FOR
if ($LENGTH(INVDT)<8)
QUIT
SET INVDT=$EXTRACT(INVDT,2,$LENGTH(INVDT))
+15 SET INVDTTM=INVDT_"."_INVTM
+16 IF '$DATA(^RADPT(DFN,"DT",INVDTTM,"P",ENT,0))
SET @MAGZRY@(0)="0^INVALID Data : Attempt to access Exam failed."
QUIT
+17 ; Get out the Naked reference .
+18 SET RARPT=$PIECE(^RADPT(DFN,"DT",INVDTTM,"P",ENT,0),U,17)
+19 ;S RARPT=$P(^(0),U,17)
+20 IF 'RARPT
SET @MAGZRY@(0)="0^No Report for selected Exam"
QUIT
+21 ; MAGQI 8/22/01
+22 IF $PIECE($GET(^RARPT(RARPT,0)),U,2)'=DFN
SET @MAGZRY@(0)="-2^Patient Mismatch. Radiology File"
QUIT
+23 DO GETLIST
+24 NEW XINFO
+25 SET XINFO=$PIECE(^RARPT(RARPT,0),U,1)
+26 SET X=$PIECE(^RADPT(DFN,"DT",INVDTTM,"P",ENT,0),U,2)
+27 SET XINFO=XINFO_" "_$PIECE(^RAMIS(71,X,0),U)
+28 SET X=$PIECE(^RARPT(RARPT,0),U,3)
+29 SET XINFO=XINFO_" "_X
+30 SET $PIECE(@MAGZRY@(0),U,3)=RARPT
+31 SET $PIECE(@MAGZRY@(0),U,4)=XINFO
+32 QUIT
GETLIST ; Private call. From other points in this routine, when RARPT is defined
+1 ; and returns a list in MAGZRY(1..n).
+2 ; We'll make a tmp list of just the image IEN's
+3 ; splitting groups into individual image entries.
+4 ; If more than 1 Image group points to this report, we
+5 ; will prefix the Image Description with (G1), (G2) etc
+6 ; We call GROUP^MAGGTIG to get the images for the group, this call
+7 ; sorts the images in Dicom Series, Dicom Image number order.
+8 ;
+9 KILL ^TMP("MAGGX",$JOB)
+10 NEW OI,IGCT,MAGIEN1,ORDCT,GCT,MAGQI,MAGX,SINGCT
+11 SET (ORDCT,GCT,SINGCT)=0
+12 SET IGCT=+$PIECE($GET(^RARPT(RARPT,2005,0)),U,4)
+13 ; Quit if no images for RARPT
+14 IF IGCT=0
SET @MAGZRY@(0)="0^0 Images for Radiology Report."
QUIT
+15 ;
+16 ; Check all Image entries in RARPT 2005 NODE. for Patient match Pointer match, from both
+17 ; RARPT end, and Imaging end.
+18 SET MAGQI=1
+19 SET OI=0
SET CT=1
FOR
SET OI=$ORDER(^RARPT(RARPT,2005,OI))
if 'OI
QUIT
Begin DoDot:1
+20 SET MAGIEN1=$PIECE(^RARPT(RARPT,2005,OI,0),U)
+21 ; Assure magdfn = rarpt dfn
+22 IF $PIECE($GET(^RARPT(RARPT,0)),U,2)'=$PIECE($GET(^MAG(2005,MAGIEN1,0)),U,7)
SET MAGQI="-2^Patient Mismatch. Radiology Report"
QUIT
+23 ; Assure magien1 is pointing to this rarpt
+24 IF $PIECE($GET(^MAG(2005,MAGIEN1,2)),U,7)'=RARPT
SET MAGQI="-2^Pointer Mismatch. Radiology Report"
QUIT
+25 ; Now run the Imaging integrity check
+26 DO CHK^MAGGSQI(.MAGX,MAGIEN1)
IF 'MAGX(0)
SET MAGQI="-2^"_$PIECE(MAGX(0),U,2,99)
QUIT
End DoDot:1
if (MAGQI<1)
QUIT
+27 ;
+28 IF MAGQI<1
SET @MAGZRY@(0)=MAGQI
QUIT
+29 SET CT=0
+30 ;
+31 SET OI=0
SET CT=1
FOR
SET OI=$ORDER(^RARPT(RARPT,2005,OI))
if 'OI
QUIT
Begin DoDot:1
+32 SET MAGIEN1=$PIECE(^RARPT(RARPT,2005,OI,0),U)
DO ONELIST
End DoDot:1
+33 ;
+34 ; Now get the list from the TMP LIST and return it.
+35 IF '$DATA(^TMP("MAGGX",$JOB))
SET @MAGZRY@(0)="0^Report "_RARPT_": has INVALID Image Pointers"
QUIT
+36 SET CT=0
+37 SET MAGQUIET=1
+38 SET I=""
SET J=""
SET K=""
+39 FOR
SET I=$ORDER(^TMP("MAGGX",$JOB,I))
if I=""
QUIT
Begin DoDot:1
+40 SET J=""
+41 FOR
SET J=$ORDER(^TMP("MAGGX",$JOB,I,J))
if J=""
QUIT
Begin DoDot:2
+42 SET K=""
+43 FOR
SET K=$ORDER(^TMP("MAGGX",$JOB,I,J,K))
if K=""
QUIT
Begin DoDot:3
+44 SET CT=CT+1
+45 SET X="["_J_"]"_$PIECE(^TMP("MAGGX",$JOB,I,J,K),U,8)
+46 SET $PIECE(^TMP("MAGGX",$JOB,I,J,K),U,8)=X
+47 SET @MAGZRY@(CT)=^TMP("MAGGX",$JOB,I,J,K)
End DoDot:3
End DoDot:2
End DoDot:1
+48 KILL MAGQUIET
+49 SET @MAGZRY@(0)=CT_"^Images for the selected Radiology Exam"
+50 ; Redesign needed for Multiple Image Groups pointing to an exam or note.
+51 ; we now put all images from all groups in one list.
+52 ; this was last ien from multiple Image Groups.
SET $PIECE(@MAGZRY@(0),U,5)=$GET(MAGIEN1)
+53 ;
+54 QUIT
ONELIST ; Private Call from other parts of this routine.
+1 NEW MAGTMP
+2 if '$DATA(^MAG(2005,MAGIEN1,0))
QUIT
+3 ; if a single image just get record for that IEN
+4 IF '$ORDER(^MAG(2005,MAGIEN1,1,0))
Begin DoDot:1
+5 ;S MAGXX=MAGIEN1 D INFO^MAGGTII
+6 SET MAGFILE=$$INFO^MAGGAII(MAGIEN1,"E")
+7 SET ORDCT=ORDCT+1
SET SINGCT=SINGCT+1
+8 SET ^TMP("MAGGX",$JOB,ORDCT,"S",SINGCT)="B2^"_MAGFILE
End DoDot:1
QUIT
+9 DO GROUP^MAGGTIG(.MAGTMP,MAGIEN1)
IF $PIECE(@MAGTMP@(0),U,2)>0
Begin DoDot:1
+10 SET ORDCT=ORDCT+1
SET GCT=GCT+1
SET X="G"_GCT
+11 KILL @MAGTMP@(0)
+12 MERGE ^TMP("MAGGX",$JOB,ORDCT,X)=@MAGTMP
End DoDot:1
+13 QUIT
