MAGNTRAI ;WOIFO/NST - List images for Reports ; 16 Jan 2018 3:59 PM
;;3.0;IMAGING;**170,185**;Mar 19, 2002;Build 4525;May 01, 2013
;; 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
;
;***** List Images for Rad Exams or TIU Notes by CPRS context
;
; RPC: MAGN CPRS IMAGE LIST
;
; Input Parameters
; ================
;
; DATA - Array holds Windows message received from CPRS in format
; e.g. 'RPT^CPRS^29027^RA^79029185.9998-1'
; or
; RPT^CPRS^4658^TIU^2243408^^^^^^^^1
; [IMGLESS] flag to speed up queries: if=1 (true), just get study-level data
;
; Return Values
; =============
;
; if error MAGRY(0) = 0 ^Error message^
; if success MAGRY(0) = 1
; MAGRY(1..n) = CONTEXTID | 0 or 1 | images in format defined in
; RPC [MAGG CPRS RAD EXAM] or [MAG3 CPRS TIU NOTE]
;
IMAGEL(MAGRY,DATA,IMGLESS) ;RPC [MAGN CPRS IMAGE LIST]
S IMGLESS=$S($D(IMGLESS):+IMGLESS,1:1) ; Defualt is IMAGELESS
;
N MAGVER,MAGNII
S MAGVER=""
S MAGNII=""
; Check version of the RPC we need to call
F S MAGNII=$O(DATA(MAGNII)) Q:(MAGVER'="")!(MAGNII="") D
. S MAGVER=$P(DATA(MAGNII),"~",2)
. Q
I MAGVER=2 D IMAGEL^MAGNVQ06(.MAGRY,.DATA,IMGLESS) Q
;
N MAGNCXT,MAGNI,MAGNCNT,MAGNX,MAGNTIU,RARPT
N MAGZRY
N $ETRAP,$ESTACK S $ETRAP="D AERRA^MAGGTERR"
S IMGLESS=$S($D(IMGLESS):+IMGLESS,1:1) ; Defualt is IMAGELESS
S MAGRY=$NA(^TMP("MAGNTRAI",$J))
K @MAGRY
S @MAGRY@(0)=0
S MAGNCNT=0
S MAGNI=""
F S MAGNI=$O(DATA(MAGNI)) Q:MAGNI="" D
. S MAGNCXT=DATA(MAGNI) ; CPRS contextID
. S MAGNX=$P(MAGNCXT,"^",4)
. I MAGNX="RA" D Q
. . D IMAGEC(.MAGZRY,MAGNCXT,IMGLESS,.RARPT) ; get image list for a single contextID
. . D APPENDRA(MAGRY,.MAGNCNT,MAGNCXT,MAGZRY,RARPT) ; Append individual contextID image list to final list
. . Q
. I MAGNX="TIU" D Q
. . S MAGNTIU=$P(MAGNCXT,"^",5)
. . K MAGZRY
. . D IMAGES^MAGGNTI(.MAGZRY,MAGNTIU)
. . D APPEND2(MAGRY,.MAGNCNT,MAGNCXT,.MAGZRY,MAGNTIU) ; Append individual contextID image list to final list
. . Q
. S MAGNCNT=MAGNCNT+1
. S @MAGRY@(MAGNCNT)="NEXT_CONTEXTID|"_MAGNCXT_"|0|"_"Invalid ContextId Type"
. Q
S @MAGRY@(0)=1
Q
;
IMAGEC(MAGZRY,DATA,IMGLESS,RARPT) ;A copy from MAGGTRAI
; 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,ENT,INVDTTM,INVDT,INVTM
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
S RARPT=0
I '$D(^RADPT(DFN,"DT",INVDTTM,"P",ENT,0)) S @MAGZRY@(0)="0^INVALID Data : Attempt to access Exam failed." Q
S RARPT=$P(^RADPT(DFN,"DT",INVDTTM,"P",ENT,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 GETSTUDY(.MAGZRY,RARPT,IMGLESS) ; Pass input parameters
Q
;
GETSTUDY(MAGZRY,RARPT,IMGLESS) ; Private call. From other points in this routine, when RARPT is defined
; RARPT -- Radiology report IEN
; 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.
;
N GROUPS,OUT,REQDFN
;
N CT,OI,IGCT,MAGIEN1,MAGQI,MAGX
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) S GROUPS(OI)=MAGIEN1
. Q
;
S REQDFN=$P($G(^RARPT(RARPT,0)),U,2)
D STUDY2^MAGDQR21(.OUT,.GROUPS,REQDFN,IMGLESS) ; MAG DOD GET STUDIES IEN
;
S MAGZRY=OUT
S @MAGZRY@(0)=1
;
Q
;
APPENDRA(OUT,MAGNCNT,MAGNCXT,MAGZRY,RARPT) ;
; Append individual contextID image list to final list
; and add more data
; OUT - destination image list array
; .MAGNCNT -- Start position in the array
; MAGNCXT -- context ID
; MAGZRY -- Image list to be appended - reference to a global
;
N I,IMGIEN,MAGNCNTN,MAGSTUDY
S @MAGZRY@(0)=$G(@MAGZRY@(0))
I '@MAGZRY@(0) D Q
. S MAGNCNT=MAGNCNT+1
. S @OUT@(MAGNCNT)="NEXT_CONTEXTID|"_MAGNCXT_"|0|"_$P(@MAGZRY@(0),"^",2)
. Q
;
S MAGNCNTN=MAGNCNT
S MAGNCNT=MAGNCNT+1
;
S I=1 ; start from line number 2. Line number 1 is a records count
F S I=$O(@MAGZRY@(I)) Q:'I D
. S MAGNCNT=MAGNCNT+1
. S @OUT@(MAGNCNT)=@MAGZRY@(I)
. I $P(@MAGZRY@(I),"|")="STUDY_IEN" D ; Add STUDY_INFO. Better place will be MAGDQR21
. . S MAGNCNT=MAGNCNT+1
. . S IMGIEN=$P(@MAGZRY@(I),"|",2) ; IEN of the group
. . S @OUT@(MAGNCNT)="STUDY_INFO|"_$$STDINFO(IMGIEN)_"|RA-"_RARPT
. . S MAGSTUDY=@MAGZRY@(I)
. . Q
. I IMGLESS,($P(@MAGZRY@(I),"|")="STUDY_PAT") D INSFIMG(MAGSTUDY,.MAGNCNT,OUT) ; Append First Image Info
. Q
S @OUT@(MAGNCNTN+1)="NEXT_CONTEXTID|"_MAGNCXT_"|1|"_(MAGNCNT-MAGNCNTN) ; @MAGZRY@(1) is a result lines count
Q
;
INSFIMG(DATA,MAGNCNT,OUT) ; Append First Image Info I
N IMGGRP,IMGIEN
S IMGGRP=$P(DATA,"|",2)
S IMGIEN=$P(DATA,"|",4)
S MAGNCNT=MAGNCNT+1,@OUT@(MAGNCNT)="NEXT_SERIES"
S MAGNCNT=MAGNCNT+1,@OUT@(MAGNCNT)="SERIES_IEN|"_IMGGRP
S MAGNCNT=MAGNCNT+1,@OUT@(MAGNCNT)="SERIES_NUMBER|1"
S MAGNCNT=MAGNCNT+1,@OUT@(MAGNCNT)="NEXT_IMAGE"
S MAGNCNT=MAGNCNT+1,@OUT@(MAGNCNT)="IMAGE_IEN|"_IMGIEN
S MAGNCNT=MAGNCNT+1,@OUT@(MAGNCNT)="GROUP_IEN|"_IMGGRP
S MAGNCNT=MAGNCNT+1,@OUT@(MAGNCNT)="IMAGE_INFO|"_"^"_$$INFO^MAGGAII(IMGIEN,"E")
Q
;
APPEND2(OUT,MAGNCNT,MAGNCXT,MAGZRY,MAGNTIU) ;
; Append individual contextID image list to final list
; and add more data
; OUT - destination image list array
; .MAGNCNT -- Start position in the array
; MAGNCXT -- context ID
; .MAGZRY -- Image list to be appended
;
N I,IMGIEN,STDINFO
S MAGZRY(0)=$G(MAGZRY(0))
I 'MAGZRY(0) D Q
. S MAGNCNT=MAGNCNT+1
. S @OUT@(MAGNCNT)="NEXT_CONTEXTID|"_MAGNCXT_"|0|"_$P(MAGZRY(0),"^",2)
. Q
;
S MAGNCNT=MAGNCNT+1
S @OUT@(MAGNCNT)="NEXT_CONTEXTID|"_MAGNCXT_"|1|"_MAGZRY(0)
S I=0
F S I=$O(MAGZRY(I)) Q:'I D
. S IMGIEN=$P(MAGZRY(I),"^",25) ; IEN of the group
. S:'IMGIEN IMGIEN=$P(MAGZRY(I),"^",2) ; Ien of the image
. S MAGNCNT=MAGNCNT+1
. S STDINFO=$$STDINFO(IMGIEN)
. S $P(STDINFO,"^",6)=$P(MAGZRY(I),"^",15) ; Group image count per VIX request
. S @OUT@(MAGNCNT)=STDINFO_"|"_$P(MAGZRY(I),"^",2,9999)_"|TIU-"_MAGNTIU
. Q
Q
;
STDINFO(IMGIEN) ; Get study info
; IMGIEN -- Image IEN
;
; Return Study( Image ) info. The code is a copy from MAGSIXG3
N X0,X2,X40
N PKG,TYPE,EVT,SPEC,ORIG,ORIG,CAPTAPP,CLASS
N IMGNODE,FLTX
;
S IMGNODE=$$NODE^MAGGI11(IMGIEN) Q:IMGNODE="" 0
;
S X0=$G(@IMGNODE@(0))
S X2=$G(@IMGNODE@(2))
S X40=$G(@IMGNODE@(40))
;
S PKG=$P(X40,U) ; PACKAGE INDEX (40)
S TYPE=$P(X40,U,3) ; TYPE INDEX (42)
S EVT=$P(X40,U,4) ; PROC/EVENT INDEX (43)
S SPEC=$P(X40,U,5) ; SPEC/SUBSPEC INDEX (44)
S ORIG=$P(X40,U,6) ; ORIGIN INDEX (45)
S:ORIG="" ORIG="V" ; Show VA by default
S CAPTAPP=$P(X2,U,12) ; CAPTURE APPLICATION (8.1)
;
S CLASS=$S(TYPE:$P($G(^MAG(2005.83,+TYPE,0)),U,2),1:"")
;
S FLTX=""
S $P(FLTX,U,3)=$$RPTITLE^MAGSIXG3($P(X2,U,6),$P(X2,U,7)) ; Report title
S $P(FLTX,U,4)=$$DTE^MAGSIXG3($P(X2,U,5)) ; Procedure date
S $P(FLTX,U,5)=$P(X0,U,8) ; Procedure
S $P(FLTX,U,7)=$P(X2,U,4) ; Short descr.
S $P(FLTX,U,8)=PKG ; Package
S $P(FLTX,U,9)=$P($G(^MAG(2005.82,+CLASS,0)),U) ; Class
S $P(FLTX,U,10)=$P($G(^MAG(2005.83,+TYPE,0)),U) ; Type
S $P(FLTX,U,11)=$P($G(^MAG(2005.84,+SPEC,0)),U) ; (Sub)Specialty
S $P(FLTX,U,12)=$P($G(^MAG(2005.85,+EVT,0)),U) ; Proc/Event
S $P(FLTX,U,13)=$$EXTERNAL^DILFD(2005,45,,ORIG) ; Origin
S $P(FLTX,U,14)=$$DTE^MAGSIXG3($P(X2,U)) ; Capture date
S $P(FLTX,U,15)=$$GET1^DIQ(200,+$P(X2,U,2)_",",.01) ; Captured by
S $P(FLTX,U,16)=IMGIEN ; Image IEN
Q FLTX
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGNTRAI 10335 printed Sep 23, 2025@19:43:43 Page 2
MAGNTRAI ;WOIFO/NST - List images for Reports ; 16 Jan 2018 3:59 PM
+1 ;;3.0;IMAGING;**170,185**;Mar 19, 2002;Build 4525;May 01, 2013
+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 QUIT
+18 ;
+19 ;***** List Images for Rad Exams or TIU Notes by CPRS context
+20 ;
+21 ; RPC: MAGN CPRS IMAGE LIST
+22 ;
+23 ; Input Parameters
+24 ; ================
+25 ;
+26 ; DATA - Array holds Windows message received from CPRS in format
+27 ; e.g. 'RPT^CPRS^29027^RA^79029185.9998-1'
+28 ; or
+29 ; RPT^CPRS^4658^TIU^2243408^^^^^^^^1
+30 ; [IMGLESS] flag to speed up queries: if=1 (true), just get study-level data
+31 ;
+32 ; Return Values
+33 ; =============
+34 ;
+35 ; if error MAGRY(0) = 0 ^Error message^
+36 ; if success MAGRY(0) = 1
+37 ; MAGRY(1..n) = CONTEXTID | 0 or 1 | images in format defined in
+38 ; RPC [MAGG CPRS RAD EXAM] or [MAG3 CPRS TIU NOTE]
+39 ;
IMAGEL(MAGRY,DATA,IMGLESS) ;RPC [MAGN CPRS IMAGE LIST]
+1 ; Defualt is IMAGELESS
SET IMGLESS=$SELECT($DATA(IMGLESS):+IMGLESS,1:1)
+2 ;
+3 NEW MAGVER,MAGNII
+4 SET MAGVER=""
+5 SET MAGNII=""
+6 ; Check version of the RPC we need to call
+7 FOR
SET MAGNII=$ORDER(DATA(MAGNII))
if (MAGVER'="")!(MAGNII="")
QUIT
Begin DoDot:1
+8 SET MAGVER=$PIECE(DATA(MAGNII),"~",2)
+9 QUIT
End DoDot:1
+10 IF MAGVER=2
DO IMAGEL^MAGNVQ06(.MAGRY,.DATA,IMGLESS)
QUIT
+11 ;
+12 NEW MAGNCXT,MAGNI,MAGNCNT,MAGNX,MAGNTIU,RARPT
+13 NEW MAGZRY
+14 NEW $ETRAP,$ESTACK
SET $ETRAP="D AERRA^MAGGTERR"
+15 ; Defualt is IMAGELESS
SET IMGLESS=$SELECT($DATA(IMGLESS):+IMGLESS,1:1)
+16 SET MAGRY=$NAME(^TMP("MAGNTRAI",$JOB))
+17 KILL @MAGRY
+18 SET @MAGRY@(0)=0
+19 SET MAGNCNT=0
+20 SET MAGNI=""
+21 FOR
SET MAGNI=$ORDER(DATA(MAGNI))
if MAGNI=""
QUIT
Begin DoDot:1
+22 ; CPRS contextID
SET MAGNCXT=DATA(MAGNI)
+23 SET MAGNX=$PIECE(MAGNCXT,"^",4)
+24 IF MAGNX="RA"
Begin DoDot:2
+25 ; get image list for a single contextID
DO IMAGEC(.MAGZRY,MAGNCXT,IMGLESS,.RARPT)
+26 ; Append individual contextID image list to final list
DO APPENDRA(MAGRY,.MAGNCNT,MAGNCXT,MAGZRY,RARPT)
+27 QUIT
End DoDot:2
QUIT
+28 IF MAGNX="TIU"
Begin DoDot:2
+29 SET MAGNTIU=$PIECE(MAGNCXT,"^",5)
+30 KILL MAGZRY
+31 DO IMAGES^MAGGNTI(.MAGZRY,MAGNTIU)
+32 ; Append individual contextID image list to final list
DO APPEND2(MAGRY,.MAGNCNT,MAGNCXT,.MAGZRY,MAGNTIU)
+33 QUIT
End DoDot:2
QUIT
+34 SET MAGNCNT=MAGNCNT+1
+35 SET @MAGRY@(MAGNCNT)="NEXT_CONTEXTID|"_MAGNCXT_"|0|"_"Invalid ContextId Type"
+36 QUIT
End DoDot:1
+37 SET @MAGRY@(0)=1
+38 QUIT
+39 ;
IMAGEC(MAGZRY,DATA,IMGLESS,RARPT) ;A copy from MAGGTRAI
+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,ENT,INVDTTM,INVDT,INVTM
+6 SET MAGZRY=$NAME(^TMP("MAGGTRAI",$JOB))
+7 KILL @MAGZRY
+8 SET DFN=+$PIECE(DATA,U,3)
+9 SET ENT=+$PIECE($PIECE(DATA,U,5),"-",2)
+10 SET INVDTTM=$PIECE($PIECE(DATA,U,5),"-",1)
+11 SET INVDT=$PIECE(INVDTTM,".",1)
+12 SET INVTM=$PIECE(INVDTTM,".",2)
+13 FOR
if ($LENGTH(INVDT)<8)
QUIT
SET INVDT=$EXTRACT(INVDT,2,$LENGTH(INVDT))
+14 SET INVDTTM=INVDT_"."_INVTM
+15 SET RARPT=0
+16 IF '$DATA(^RADPT(DFN,"DT",INVDTTM,"P",ENT,0))
SET @MAGZRY@(0)="0^INVALID Data : Attempt to access Exam failed."
QUIT
+17 SET RARPT=$PIECE(^RADPT(DFN,"DT",INVDTTM,"P",ENT,0),U,17)
+18 IF 'RARPT
SET @MAGZRY@(0)="0^No Report for selected Exam"
QUIT
+19 ; MAGQI 8/22/01
+20 IF $PIECE($GET(^RARPT(RARPT,0)),U,2)'=DFN
SET @MAGZRY@(0)="-2^Patient Mismatch. Radiology File"
QUIT
+21 ; Pass input parameters
DO GETSTUDY(.MAGZRY,RARPT,IMGLESS)
+22 QUIT
+23 ;
GETSTUDY(MAGZRY,RARPT,IMGLESS) ; Private call. From other points in this routine, when RARPT is defined
+1 ; RARPT -- Radiology report IEN
+2 ; and returns a list in MAGZRY(1..n).
+3 ; We'll make a tmp list of just the image IEN's
+4 ; splitting groups into individual image entries.
+5 ; If more than 1 Image group points to this report, we
+6 ; will prefix the Image Description with (G1), (G2) etc
+7 ; We call GROUP^MAGGTIG to get the images for the group, this call
+8 ; sorts the images in Dicom Series, Dicom Image number order.
+9 ;
+10 NEW GROUPS,OUT,REQDFN
+11 ;
+12 NEW CT,OI,IGCT,MAGIEN1,MAGQI,MAGX
+13 SET IGCT=+$PIECE($GET(^RARPT(RARPT,2005,0)),U,4)
+14 ; Quit if no images for RARPT
+15 IF IGCT=0
SET @MAGZRY@(0)="0^0 Images for Radiology Report."
QUIT
+16 ;
+17 ; Check all Image entries in RARPT 2005 NODE. for Patient match Pointer match, from both
+18 ; RARPT end, and Imaging end.
+19 SET MAGQI=1
+20 SET OI=0
SET CT=1
FOR
SET OI=$ORDER(^RARPT(RARPT,2005,OI))
if 'OI
QUIT
Begin DoDot:1
+21 SET MAGIEN1=$PIECE(^RARPT(RARPT,2005,OI,0),U)
+22 ; Assure magdfn = rarpt dfn
+23 IF $PIECE($GET(^RARPT(RARPT,0)),U,2)'=$PIECE($GET(^MAG(2005,MAGIEN1,0)),U,7)
SET MAGQI="-2^Patient Mismatch. Radiology Report"
QUIT
+24 ; Assure magien1 is pointing to this rarpt
+25 IF $PIECE($GET(^MAG(2005,MAGIEN1,2)),U,7)'=RARPT
SET MAGQI="-2^Pointer Mismatch. Radiology Report"
QUIT
+26 ; Now run the Imaging integrity check
+27 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
+28 ;
+29 IF MAGQI<1
SET @MAGZRY@(0)=MAGQI
QUIT
+30 SET CT=0
+31 ;
+32 SET OI=0
SET CT=1
FOR
SET OI=$ORDER(^RARPT(RARPT,2005,OI))
if 'OI
QUIT
Begin DoDot:1
+33 SET MAGIEN1=$PIECE(^RARPT(RARPT,2005,OI,0),U)
SET GROUPS(OI)=MAGIEN1
+34 QUIT
End DoDot:1
+35 ;
+36 SET REQDFN=$PIECE($GET(^RARPT(RARPT,0)),U,2)
+37 ; MAG DOD GET STUDIES IEN
DO STUDY2^MAGDQR21(.OUT,.GROUPS,REQDFN,IMGLESS)
+38 ;
+39 SET MAGZRY=OUT
+40 SET @MAGZRY@(0)=1
+41 ;
+42 QUIT
+43 ;
APPENDRA(OUT,MAGNCNT,MAGNCXT,MAGZRY,RARPT) ;
+1 ; Append individual contextID image list to final list
+2 ; and add more data
+3 ; OUT - destination image list array
+4 ; .MAGNCNT -- Start position in the array
+5 ; MAGNCXT -- context ID
+6 ; MAGZRY -- Image list to be appended - reference to a global
+7 ;
+8 NEW I,IMGIEN,MAGNCNTN,MAGSTUDY
+9 SET @MAGZRY@(0)=$GET(@MAGZRY@(0))
+10 IF '@MAGZRY@(0)
Begin DoDot:1
+11 SET MAGNCNT=MAGNCNT+1
+12 SET @OUT@(MAGNCNT)="NEXT_CONTEXTID|"_MAGNCXT_"|0|"_$PIECE(@MAGZRY@(0),"^",2)
+13 QUIT
End DoDot:1
QUIT
+14 ;
+15 SET MAGNCNTN=MAGNCNT
+16 SET MAGNCNT=MAGNCNT+1
+17 ;
+18 ; start from line number 2. Line number 1 is a records count
SET I=1
+19 FOR
SET I=$ORDER(@MAGZRY@(I))
if 'I
QUIT
Begin DoDot:1
+20 SET MAGNCNT=MAGNCNT+1
+21 SET @OUT@(MAGNCNT)=@MAGZRY@(I)
+22 ; Add STUDY_INFO. Better place will be MAGDQR21
IF $PIECE(@MAGZRY@(I),"|")="STUDY_IEN"
Begin DoDot:2
+23 SET MAGNCNT=MAGNCNT+1
+24 ; IEN of the group
SET IMGIEN=$PIECE(@MAGZRY@(I),"|",2)
+25 SET @OUT@(MAGNCNT)="STUDY_INFO|"_$$STDINFO(IMGIEN)_"|RA-"_RARPT
+26 SET MAGSTUDY=@MAGZRY@(I)
+27 QUIT
End DoDot:2
+28 ; Append First Image Info
IF IMGLESS
IF ($PIECE(@MAGZRY@(I),"|")="STUDY_PAT")
DO INSFIMG(MAGSTUDY,.MAGNCNT,OUT)
+29 QUIT
End DoDot:1
+30 ; @MAGZRY@(1) is a result lines count
SET @OUT@(MAGNCNTN+1)="NEXT_CONTEXTID|"_MAGNCXT_"|1|"_(MAGNCNT-MAGNCNTN)
+31 QUIT
+32 ;
INSFIMG(DATA,MAGNCNT,OUT) ; Append First Image Info I
+1 NEW IMGGRP,IMGIEN
+2 SET IMGGRP=$PIECE(DATA,"|",2)
+3 SET IMGIEN=$PIECE(DATA,"|",4)
+4 SET MAGNCNT=MAGNCNT+1
SET @OUT@(MAGNCNT)="NEXT_SERIES"
+5 SET MAGNCNT=MAGNCNT+1
SET @OUT@(MAGNCNT)="SERIES_IEN|"_IMGGRP
+6 SET MAGNCNT=MAGNCNT+1
SET @OUT@(MAGNCNT)="SERIES_NUMBER|1"
+7 SET MAGNCNT=MAGNCNT+1
SET @OUT@(MAGNCNT)="NEXT_IMAGE"
+8 SET MAGNCNT=MAGNCNT+1
SET @OUT@(MAGNCNT)="IMAGE_IEN|"_IMGIEN
+9 SET MAGNCNT=MAGNCNT+1
SET @OUT@(MAGNCNT)="GROUP_IEN|"_IMGGRP
+10 SET MAGNCNT=MAGNCNT+1
SET @OUT@(MAGNCNT)="IMAGE_INFO|"_"^"_$$INFO^MAGGAII(IMGIEN,"E")
+11 QUIT
+12 ;
APPEND2(OUT,MAGNCNT,MAGNCXT,MAGZRY,MAGNTIU) ;
+1 ; Append individual contextID image list to final list
+2 ; and add more data
+3 ; OUT - destination image list array
+4 ; .MAGNCNT -- Start position in the array
+5 ; MAGNCXT -- context ID
+6 ; .MAGZRY -- Image list to be appended
+7 ;
+8 NEW I,IMGIEN,STDINFO
+9 SET MAGZRY(0)=$GET(MAGZRY(0))
+10 IF 'MAGZRY(0)
Begin DoDot:1
+11 SET MAGNCNT=MAGNCNT+1
+12 SET @OUT@(MAGNCNT)="NEXT_CONTEXTID|"_MAGNCXT_"|0|"_$PIECE(MAGZRY(0),"^",2)
+13 QUIT
End DoDot:1
QUIT
+14 ;
+15 SET MAGNCNT=MAGNCNT+1
+16 SET @OUT@(MAGNCNT)="NEXT_CONTEXTID|"_MAGNCXT_"|1|"_MAGZRY(0)
+17 SET I=0
+18 FOR
SET I=$ORDER(MAGZRY(I))
if 'I
QUIT
Begin DoDot:1
+19 ; IEN of the group
SET IMGIEN=$PIECE(MAGZRY(I),"^",25)
+20 ; Ien of the image
if 'IMGIEN
SET IMGIEN=$PIECE(MAGZRY(I),"^",2)
+21 SET MAGNCNT=MAGNCNT+1
+22 SET STDINFO=$$STDINFO(IMGIEN)
+23 ; Group image count per VIX request
SET $PIECE(STDINFO,"^",6)=$PIECE(MAGZRY(I),"^",15)
+24 SET @OUT@(MAGNCNT)=STDINFO_"|"_$PIECE(MAGZRY(I),"^",2,9999)_"|TIU-"_MAGNTIU
+25 QUIT
End DoDot:1
+26 QUIT
+27 ;
STDINFO(IMGIEN) ; Get study info
+1 ; IMGIEN -- Image IEN
+2 ;
+3 ; Return Study( Image ) info. The code is a copy from MAGSIXG3
+4 NEW X0,X2,X40
+5 NEW PKG,TYPE,EVT,SPEC,ORIG,ORIG,CAPTAPP,CLASS
+6 NEW IMGNODE,FLTX
+7 ;
+8 SET IMGNODE=$$NODE^MAGGI11(IMGIEN)
if IMGNODE=""
QUIT 0
+9 ;
+10 SET X0=$GET(@IMGNODE@(0))
+11 SET X2=$GET(@IMGNODE@(2))
+12 SET X40=$GET(@IMGNODE@(40))
+13 ;
+14 ; PACKAGE INDEX (40)
SET PKG=$PIECE(X40,U)
+15 ; TYPE INDEX (42)
SET TYPE=$PIECE(X40,U,3)
+16 ; PROC/EVENT INDEX (43)
SET EVT=$PIECE(X40,U,4)
+17 ; SPEC/SUBSPEC INDEX (44)
SET SPEC=$PIECE(X40,U,5)
+18 ; ORIGIN INDEX (45)
SET ORIG=$PIECE(X40,U,6)
+19 ; Show VA by default
if ORIG=""
SET ORIG="V"
+20 ; CAPTURE APPLICATION (8.1)
SET CAPTAPP=$PIECE(X2,U,12)
+21 ;
+22 SET CLASS=$SELECT(TYPE:$PIECE($GET(^MAG(2005.83,+TYPE,0)),U,2),1:"")
+23 ;
+24 SET FLTX=""
+25 ; Report title
SET $PIECE(FLTX,U,3)=$$RPTITLE^MAGSIXG3($PIECE(X2,U,6),$PIECE(X2,U,7))
+26 ; Procedure date
SET $PIECE(FLTX,U,4)=$$DTE^MAGSIXG3($PIECE(X2,U,5))
+27 ; Procedure
SET $PIECE(FLTX,U,5)=$PIECE(X0,U,8)
+28 ; Short descr.
SET $PIECE(FLTX,U,7)=$PIECE(X2,U,4)
+29 ; Package
SET $PIECE(FLTX,U,8)=PKG
+30 ; Class
SET $PIECE(FLTX,U,9)=$PIECE($GET(^MAG(2005.82,+CLASS,0)),U)
+31 ; Type
SET $PIECE(FLTX,U,10)=$PIECE($GET(^MAG(2005.83,+TYPE,0)),U)
+32 ; (Sub)Specialty
SET $PIECE(FLTX,U,11)=$PIECE($GET(^MAG(2005.84,+SPEC,0)),U)
+33 ; Proc/Event
SET $PIECE(FLTX,U,12)=$PIECE($GET(^MAG(2005.85,+EVT,0)),U)
+34 ; Origin
SET $PIECE(FLTX,U,13)=$$EXTERNAL^DILFD(2005,45,,ORIG)
+35 ; Capture date
SET $PIECE(FLTX,U,14)=$$DTE^MAGSIXG3($PIECE(X2,U))
+36 ; Captured by
SET $PIECE(FLTX,U,15)=$$GET1^DIQ(200,+$PIECE(X2,U,2)_",",.01)
+37 ; Image IEN
SET $PIECE(FLTX,U,16)=IMGIEN
+38 QUIT FLTX
