MAGDQR20 ;WOIFO/EDM,NST,MLH,BT,JSL,ZEB - RPCs for Query/Retrieve SetUp ; 07 Dec 2023 1:21 PM
;;3.0;IMAGING;**119,301,348**;Mar 19, 2002;Build 6;Apr 19, 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
;
;*zeb *348 pass on INCSERD to code that would actually include the series description
;This procedure called by STUDY^MAGDQR21 to generate IMAGE INFO lines
WRTIMG(SERIESARRAY,D0,REQDFN,STUMO,INCDEL,INCSERD) ; Retrieve Image info and output to IMAGE INFO line
N I
N SERID ;SERID(UID _ DCOM SERIES NUM, UID)
N SERIES ;SERIES(UID _ DCOM SERIES NUM, DCOM IMAGE NUM, OBJECT GROUP)=""
N SNUM,TMP
S INCSERD=$G(INCSERD)
K ^TMP("MAG",$J,"S") ;Images info by IEN
K ^TMP("MAG",$J,"M") ;RAD Procedure by IEN (1,IEN) and by SERIESUID (2,SERIESUID,Procedure)
;
D RTRVIMG^MAGDQR20(.TMP,D0,REQDFN,INCDEL) ;retrieve images info for D0 and saved to TMP
D:$E($G(TMP),1,5)="^TMP(" WRTMAGM^MAGDQR20(.TMP,.STUMO) ;Save images and procedures, return STUMO (procedures)
;
D GETSER^MAGDQR20(D0,.SERIES,.SERID,INCDEL) ;Get SERIESUID info, store in SERIES and SERID
S SNUM="" F S SNUM=$O(SERIES(SNUM)) Q:SNUM="" D WRTSER^MAGDQR20(D0,.SERIESARRAY,.SERIES,SNUM,.SERID,REQDFN,INCSERD)
;
S I="" F S I=$O(^TMP("MAG",$J,"S",I)) Q:I="" D WRTOUT^MAGDQR21("UNUSED_GROUP_INFO|"_^TMP("MAG",$J,"S",I))
;
K ^TMP("MAG",$J,"S")
K ^TMP("MAG",$J,"M")
Q
;
RTRVIMG(TMP,D0,REQDFN,INCDEL) ; Retrieve info for either single or group image
N MAGFIL,X
S MAGFIL=$$FILE^MAGGI11(D0)
;
I MAGFIL,$D(^MAG(MAGFIL,D0,1)) D Q ; images and/or deleted images group
. ; allow return of info if DFN defined
. D GROUP^MAGGTIG(.TMP,D0,REQDFN)
. D:INCDEL RTRVDIMG^MAGDQR20(.TMP,D0) ;include deleted images of the active group
. Q
;
; DEFAULT - image is a single
D IMAGEINF^MAGGTU3(.X,D0,REQDFN)
I INCDEL,$$ISDEL^MAGGI11(D0) D DIMGINF^MAGDQR20(.X,D0)
S TMP=$NA(^TMP("MAGGTIG",$J))
K @TMP S @TMP@(0)="1^1",@TMP@(1)=X(0)
Q
;
RTRVDIMG(MAGRY,MAGIEN) ; Get Deleted images and output the info
N MAGCHILD,MAGCT,MAGFILE,X
;
I $G(MAGRY)="" D
. ; we'll use @ notation, this'll work if an Array or a Global Array is being returned
. S X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1) ;must call this, setting up Internal Variables
. S MAGRY=$NA(^TMP("MAGGTIG",$J))
. K @MAGRY
. Q
;
S MAGCT=$O(@MAGRY@(""),-1)
S MAGCHILD=""
;
F S MAGCHILD=$O(^MAG(2005.1,"AGP",MAGIEN,MAGCHILD)) Q:'MAGCHILD D
. S MAGCT=MAGCT+1
. S MAGFILE=$$INFO^MAGGAII(MAGCHILD,"D")
. S @MAGRY@(MAGCT)="B2^"_MAGFILE
. Q
S @MAGRY@(0)="1^"_MAGCT
Q
;
DIMGINF(MAGRY,IEN) ; Retrieve Deleted images
N MAGINFO,Z,EXIST
;
S MAGINFO=$$INFO^MAGGAII(IEN,"E")
S EXIST=$D(^MAG(2005.1,IEN,0))
I 'EXIST S Z="1^Missing Record"
I EXIST D
. S Z=$P(^MAG(2005.1,IEN,0),U,7)
. I '$D(^DPT(Z)) S Z="1^Invalid patient pointer"
. E S Z=Z_U_$P(^DPT(Z,0),U)
S MAGRY(0)="1^"_MAGINFO
S MAGRY(1)=Z ; dfn^name
Q
;
WRTMAGM(TMP,STUMO) ; Save series to TMP
N D,G,M,P,X,I
N MAGFILD,MAGFILG
K @TMP@(0)
S I=""
;
F S I=$O(@TMP@(I)) Q:I="" D
. S X=$G(@TMP@(I))
. S D=$P(X,"^",2) ;IEN containing the images' info
. Q:'D
. S ^TMP("MAG",$J,"S",D)=X
. S MAGFILD=$$FILE^MAGGI11(D)
. S X=$S(MAGFILD:$G(^MAG(MAGFILD,D,0)),1:"")
. S G=+$P(X,"^",10) ;Group IEN
. S M=$P(X,"^",8) ;Procedure
. S:$E(M,1,4)="RAD " M=$E(M,5,$L(M))
. Q:M=""
. S MAGFILG=$$FILE^MAGGI11(G)
. S G=$S(MAGFILG:$P($G(^MAG(MAGFILG,G,2)),"^",6),1:"") ;Parent Data File# for Group IEN
. S P=$S(MAGFILD:$P($G(^MAG(MAGFILD,D,2)),"^",6),1:"") ;Parent Data File# for IEN
. I P'=74,G'=74 Q ;quit if not RAD/NUC MED REPORTS file (#74)
. S ^TMP("MAG",$J,"M",1,D)=M
. S STUMO(M)=""
. S G=$S(MAGFILD:$G(^MAG(MAGFILD,D,"SERIESUID")),1:"")
. S:G'="" ^TMP("MAG",$J,"M",2,G,M)=""
. Q
Q
;
GETSER(D0,SERIES,SERID,INCDEL) ; Populate SERIES array for File 2005 and 2005.1
N MAGFIL,U1
;
; group IEN
I $D(^MAG(2005,D0,1)) D GETRSER^MAGDQR20(D0,.SERIES,.SERID)
; include deleted images
I INCDEL D GETDSER^MAGDQR20(D0,.SERIES,.SERID)
;
D:'$D(SERIES)
. S U1=""
. S MAGFIL=$$FILE^MAGGI11(D0)
. S:MAGFIL U1=$G(^MAG(MAGFIL,D0,"SERIESUID"))
. S:U1="" U1="?"
. S SERIES(U1_"_1",1,D0)="",SERID(U1_"_1",U1)=""
. Q
Q
;
GETRSER(D0,SERIES,SERID) ; Populate SERIES array for File 2005
N ANY,D1,X
N SNUM ;DCOM SERIES NUM
N INUM ;DCOM IMAGE NUM
N U1 ;UID
N I0 ;object for a GROUP
S (ANY,D1)=0
;
F S D1=$O(^MAG(2005,D0,1,D1)) Q:'D1 D
. S X=$G(^MAG(2005,D0,1,D1,0)),I0=+X Q:'I0
. S ANY=1,I0=+X,SNUM=$P(X,"^",2),INUM=$P(X,"^",3)
. S U1=$G(^MAG(2005,I0,"SERIESUID"))
. S:SNUM="" SNUM="?" S:INUM="" INUM="?" S:U1="" U1="?"
. S SERIES(U1_"_"_SNUM,INUM,I0)="",SERID(U1_"_"_SNUM,U1)=""
. Q
Q
;
GETDSER(D0,SERIES,SERID) ; Populate SERIES array for File 2005.1
N SNUM ;DCOM SERIES NUM
N INUM ;DCOM IMAGE NUM
N U1 ;UID
N I0 ;object for a GROUP (Child IEN)
S I0=""
;
F S I0=$O(^MAG(2005.1,"AGP",D0,I0)) Q:I0="" D
. D GETDINUM^MAGDQR20(D0,I0,.SNUM,.INUM)
. S U1=$G(^MAG(2005.1,I0,"SERIESUID"))
. S:U1="" U1="?"
. S SERIES(U1_"_"_SNUM,INUM,I0)="",SERID(U1_"_"_SNUM,U1)=""
. Q
Q
;
GETDINUM(GRPIEN,CHLDIEN,SNUM,INUM) ; Get DICOM Serial Number and Image Number for Child IEN from Audit Image
N X,D1,I0
S SNUM="",INUM=""
S D1=0
;
F S D1=$O(^MAG(2005.1,GRPIEN,1,D1)) Q:'D1 D Q:SNUM'=""!(INUM'="")
. S X=$G(^MAG(2005.1,GRPIEN,1,D1,0)),I0=+X Q:'I0
. S:I0=CHLDIEN SNUM=$P(X,"^",2),INUM=$P(X,"^",3)
. Q
;
S:SNUM="" SNUM="?"
S:INUM="" INUM="?"
Q
;
;*zeb *348 add Series Description as optional return
WRTSER(D0,SERIESARRAY,SERIES,SNUM,SERID,REQDFN,INCSERD) ; Output to TMP based on SERIES array
; refresh temp image index
; SERIES(UID _ DCOM SERIES NUM, DCOM IMAGE NUM, OBJECT GROUP)=""
N MAGTI
N INUM ;IMAGE NUMBER
N I0 ;OBJECT GROUP
N UID ;SERIES UID
S MAGTI=0 ; temp image index
S INCSERD=$G(INCSERD)
K ^TMP("MAG",$J,"TI") ;temp for sorting
;
; seek qualifying images (no QI or matching known DFN)
S INUM=""
F S INUM=$O(SERIES(SNUM,INUM)) Q:INUM="" D
. S I0=""
. ;sort into ^TMP(,,"TI",)
. F S I0=$O(SERIES(SNUM,INUM,I0)) Q:I0="" D SRTMAGTI^MAGDQR20(INUM,I0,REQDFN)
. Q
;
;quit if qualifying images were not found
Q:'$D(^TMP("MAG",$J,"TI"))
;
S UID="" F S UID=$O(SERID(SNUM,UID)) Q:UID="" D WRSERUID^MAGDQR20(UID,D0,INCSERD)
;
D:SNUM'="?" WASGNSER^MAGDQR20(SNUM,.SERIESARRAY) ; assign the series number
S MAGTI="" F S MAGTI=$O(^TMP("MAG",$J,"TI",MAGTI)) Q:'MAGTI D WRTOUT^MAGDQR21(^TMP("MAG",$J,"TI",MAGTI))
;
K ^TMP("MAG",$J,"TI")
Q
;
SRTMAGTI(INUM,I0,REQDFN) ; Save IMAGE_IEN and GROUP_IEN lines
; if dup study instance UID, purge image info and bail out
; unless pt is specified and this image is for that pt
N MAGFIL,MAGR0,X
N UID ;PACS UID
N MAGTI ;Line counter
N GRPIEN ;Group IEN
N IMGINFO
;
S MAGR0=""
S MAGFIL=$$FILE^MAGGI11(I0)
S:MAGFIL MAGR0=$G(^MAG(MAGFIL,I0,0))
I REQDFN,$P(MAGR0,"^",7)'=REQDFN K ^TMP("MAG",$J,"S",I0) Q ;patient must be the REQDFN
;
S UID=$P($G(^MAG(MAGFIL,I0,"PACS")),"^",1)
S MAGTI=$O(^TMP("MAG",$J,"TI",""),-1)+1
S MAGTI=MAGTI+1,^TMP("MAG",$J,"TI",MAGTI)="NEXT_IMAGE"
S:UID'="" MAGTI=MAGTI+1,^TMP("MAG",$J,"TI",MAGTI)="IMAGE_UID|"_UID
S MAGTI=MAGTI+1,^TMP("MAG",$J,"TI",MAGTI)="IMAGE_IEN|"_I0
S GRPIEN=$P(MAGR0,"^",10)
S:GRPIEN MAGTI=MAGTI+1,^TMP("MAG",$J,"TI",MAGTI)="GROUP_IEN|"_GRPIEN
;
; QI check - override only if DFN specified in call
; (VA internal only!)
D CHK^MAGGSQI(.X,I0) ;Check the integrity of I0
I '$G(X(0)) D Q:'REQDFN
. S MAGTI=MAGTI+1,^TMP("MAG",$J,"TI",MAGTI)="IMAGE_ERR|"_$P($G(X(0)),"^",2)
. Q
;
S:INUM'="?" MAGTI=MAGTI+1,^TMP("MAG",$J,"TI",MAGTI)="IMAGE_NUMBER|"_INUM
S IMGINFO=$G(^TMP("MAG",$J,"S",I0)) K ^TMP("MAG",$J,"S",I0)
; Get Site image parameters IEN from 16^ piece of IMGINFO
S:IMGINFO'="" MAGTI=MAGTI+1,^TMP("MAG",$J,"TI",MAGTI)="IMAGE_INFO|"_IMGINFO_"|"_$$GETSNUM^MAGDQR21($P(IMGINFO,"^",16))
;
S MAGTI=MAGTI+1,^TMP("MAG",$J,"TI",MAGTI)="IMAGE_SOP_CLASS_UID|"_$$GET1^DIQ(2005,I0,251)
;
Q
;
;*zeb *348 add Series Description as optional return
WRSERUID(UID,D0,INCSERD) ; Output SERIES_IEN line
N M,X
S INCSERD=$G(INCSERD)
;
D WRTOUT^MAGDQR21("NEXT_SERIES")
D:UID'="?" WRTOUT^MAGDQR21("SERIES_UID|"_UID)
D WRTOUT^MAGDQR21("SERIES_IEN|"_D0)
; Officially, there can be only one modality per series,
; so stop when the first modality is found...
S X="",M=""
F S M=$O(^TMP("MAG",$J,"M",2,UID,M)) Q:M="" D Q:X'=""
. S X=$S(X'="":"\",1:"")_M
. Q
D:X'="" WRTOUT^MAGDQR21("SERIES_MODALITY|"_X)
D:INCSERD
. S X=$$GET1^DIQ(2005,D0,10)
. D:X'="" WRTOUT^MAGDQR21("SERIES_DESCRIPTION|"_X)
Q
;
WASGNSER(SNUM,SERIESARRAY) ; Output SERIES_NUMBER line
N SERIESNUM
; - get series no from study itself if possible, else generate
D TSTSER^MAGDQR20(SNUM,.SERIESARRAY,.SERIESNUM)
D:'$D(SERIESNUM) ; still need to generate
. F SERIESNUM=1:1 Q:'$D(SERIESARRAY(SERIESNUM))
. Q
;
D WRTOUT^MAGDQR21("SERIES_NUMBER|"_SERIESNUM)
S SERIESARRAY(SERIESNUM)=""
Q
;
TSTSER(SNUM,SERIESARRAY,SERIESNUM) ; Validate SERIES NUMBER
N SERIESTEST,SGN
S SERIESTEST=$P(SNUM,"_",2)
Q:"+-1234567890"'[$E(SERIESTEST,1) ; invalid number
S:"+-"[$E(SERIESTEST,1) SGN=$E(SERIESTEST,1)
S:$D(SGN) SERIESTEST=$E(SERIESTEST,2,$L(SERIESTEST))
Q:SERIESTEST'?1.12N
S SERIESTEST=$G(SGN)_SERIESTEST
Q:$D(SERIESARRAY(SERIESTEST))
S SERIESNUM=SERIESTEST
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDQR20 10463 printed Dec 13, 2024@02:01:01 Page 2
MAGDQR20 ;WOIFO/EDM,NST,MLH,BT,JSL,ZEB - RPCs for Query/Retrieve SetUp ; 07 Dec 2023 1:21 PM
+1 ;;3.0;IMAGING;**119,301,348**;Mar 19, 2002;Build 6;Apr 19, 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 ;*zeb *348 pass on INCSERD to code that would actually include the series description
+20 ;This procedure called by STUDY^MAGDQR21 to generate IMAGE INFO lines
WRTIMG(SERIESARRAY,D0,REQDFN,STUMO,INCDEL,INCSERD) ; Retrieve Image info and output to IMAGE INFO line
+1 NEW I
+2 ;SERID(UID _ DCOM SERIES NUM, UID)
NEW SERID
+3 ;SERIES(UID _ DCOM SERIES NUM, DCOM IMAGE NUM, OBJECT GROUP)=""
NEW SERIES
+4 NEW SNUM,TMP
+5 SET INCSERD=$GET(INCSERD)
+6 ;Images info by IEN
KILL ^TMP("MAG",$JOB,"S")
+7 ;RAD Procedure by IEN (1,IEN) and by SERIESUID (2,SERIESUID,Procedure)
KILL ^TMP("MAG",$JOB,"M")
+8 ;
+9 ;retrieve images info for D0 and saved to TMP
DO RTRVIMG^MAGDQR20(.TMP,D0,REQDFN,INCDEL)
+10 ;Save images and procedures, return STUMO (procedures)
if $EXTRACT($GET(TMP),1,5)="^TMP("
DO WRTMAGM^MAGDQR20(.TMP,.STUMO)
+11 ;
+12 ;Get SERIESUID info, store in SERIES and SERID
DO GETSER^MAGDQR20(D0,.SERIES,.SERID,INCDEL)
+13 SET SNUM=""
FOR
SET SNUM=$ORDER(SERIES(SNUM))
if SNUM=""
QUIT
DO WRTSER^MAGDQR20(D0,.SERIESARRAY,.SERIES,SNUM,.SERID,REQDFN,INCSERD)
+14 ;
+15 SET I=""
FOR
SET I=$ORDER(^TMP("MAG",$JOB,"S",I))
if I=""
QUIT
DO WRTOUT^MAGDQR21("UNUSED_GROUP_INFO|"_^TMP("MAG",$JOB,"S",I))
+16 ;
+17 KILL ^TMP("MAG",$JOB,"S")
+18 KILL ^TMP("MAG",$JOB,"M")
+19 QUIT
+20 ;
RTRVIMG(TMP,D0,REQDFN,INCDEL) ; Retrieve info for either single or group image
+1 NEW MAGFIL,X
+2 SET MAGFIL=$$FILE^MAGGI11(D0)
+3 ;
+4 ; images and/or deleted images group
IF MAGFIL
IF $DATA(^MAG(MAGFIL,D0,1))
Begin DoDot:1
+5 ; allow return of info if DFN defined
+6 DO GROUP^MAGGTIG(.TMP,D0,REQDFN)
+7 ;include deleted images of the active group
if INCDEL
DO RTRVDIMG^MAGDQR20(.TMP,D0)
+8 QUIT
End DoDot:1
QUIT
+9 ;
+10 ; DEFAULT - image is a single
+11 DO IMAGEINF^MAGGTU3(.X,D0,REQDFN)
+12 IF INCDEL
IF $$ISDEL^MAGGI11(D0)
DO DIMGINF^MAGDQR20(.X,D0)
+13 SET TMP=$NAME(^TMP("MAGGTIG",$JOB))
+14 KILL @TMP
SET @TMP@(0)="1^1"
SET @TMP@(1)=X(0)
+15 QUIT
+16 ;
RTRVDIMG(MAGRY,MAGIEN) ; Get Deleted images and output the info
+1 NEW MAGCHILD,MAGCT,MAGFILE,X
+2 ;
+3 IF $GET(MAGRY)=""
Begin DoDot:1
+4 ; we'll use @ notation, this'll work if an Array or a Global Array is being returned
+5 ;must call this, setting up Internal Variables
SET X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1)
+6 SET MAGRY=$NAME(^TMP("MAGGTIG",$JOB))
+7 KILL @MAGRY
+8 QUIT
End DoDot:1
+9 ;
+10 SET MAGCT=$ORDER(@MAGRY@(""),-1)
+11 SET MAGCHILD=""
+12 ;
+13 FOR
SET MAGCHILD=$ORDER(^MAG(2005.1,"AGP",MAGIEN,MAGCHILD))
if 'MAGCHILD
QUIT
Begin DoDot:1
+14 SET MAGCT=MAGCT+1
+15 SET MAGFILE=$$INFO^MAGGAII(MAGCHILD,"D")
+16 SET @MAGRY@(MAGCT)="B2^"_MAGFILE
+17 QUIT
End DoDot:1
+18 SET @MAGRY@(0)="1^"_MAGCT
+19 QUIT
+20 ;
DIMGINF(MAGRY,IEN) ; Retrieve Deleted images
+1 NEW MAGINFO,Z,EXIST
+2 ;
+3 SET MAGINFO=$$INFO^MAGGAII(IEN,"E")
+4 SET EXIST=$DATA(^MAG(2005.1,IEN,0))
+5 IF 'EXIST
SET Z="1^Missing Record"
+6 IF EXIST
Begin DoDot:1
+7 SET Z=$PIECE(^MAG(2005.1,IEN,0),U,7)
+8 IF '$DATA(^DPT(Z))
SET Z="1^Invalid patient pointer"
+9 IF '$TEST
SET Z=Z_U_$PIECE(^DPT(Z,0),U)
End DoDot:1
+10 SET MAGRY(0)="1^"_MAGINFO
+11 ; dfn^name
SET MAGRY(1)=Z
+12 QUIT
+13 ;
WRTMAGM(TMP,STUMO) ; Save series to TMP
+1 NEW D,G,M,P,X,I
+2 NEW MAGFILD,MAGFILG
+3 KILL @TMP@(0)
+4 SET I=""
+5 ;
+6 FOR
SET I=$ORDER(@TMP@(I))
if I=""
QUIT
Begin DoDot:1
+7 SET X=$GET(@TMP@(I))
+8 ;IEN containing the images' info
SET D=$PIECE(X,"^",2)
+9 if 'D
QUIT
+10 SET ^TMP("MAG",$JOB,"S",D)=X
+11 SET MAGFILD=$$FILE^MAGGI11(D)
+12 SET X=$SELECT(MAGFILD:$GET(^MAG(MAGFILD,D,0)),1:"")
+13 ;Group IEN
SET G=+$PIECE(X,"^",10)
+14 ;Procedure
SET M=$PIECE(X,"^",8)
+15 if $EXTRACT(M,1,4)="RAD "
SET M=$EXTRACT(M,5,$LENGTH(M))
+16 if M=""
QUIT
+17 SET MAGFILG=$$FILE^MAGGI11(G)
+18 ;Parent Data File# for Group IEN
SET G=$SELECT(MAGFILG:$PIECE($GET(^MAG(MAGFILG,G,2)),"^",6),1:"")
+19 ;Parent Data File# for IEN
SET P=$SELECT(MAGFILD:$PIECE($GET(^MAG(MAGFILD,D,2)),"^",6),1:"")
+20 ;quit if not RAD/NUC MED REPORTS file (#74)
IF P'=74
IF G'=74
QUIT
+21 SET ^TMP("MAG",$JOB,"M",1,D)=M
+22 SET STUMO(M)=""
+23 SET G=$SELECT(MAGFILD:$GET(^MAG(MAGFILD,D,"SERIESUID")),1:"")
+24 if G'=""
SET ^TMP("MAG",$JOB,"M",2,G,M)=""
+25 QUIT
End DoDot:1
+26 QUIT
+27 ;
GETSER(D0,SERIES,SERID,INCDEL) ; Populate SERIES array for File 2005 and 2005.1
+1 NEW MAGFIL,U1
+2 ;
+3 ; group IEN
+4 IF $DATA(^MAG(2005,D0,1))
DO GETRSER^MAGDQR20(D0,.SERIES,.SERID)
+5 ; include deleted images
+6 IF INCDEL
DO GETDSER^MAGDQR20(D0,.SERIES,.SERID)
+7 ;
+8 if '$DATA(SERIES)
Begin DoDot:1
+9 SET U1=""
+10 SET MAGFIL=$$FILE^MAGGI11(D0)
+11 if MAGFIL
SET U1=$GET(^MAG(MAGFIL,D0,"SERIESUID"))
+12 if U1=""
SET U1="?"
+13 SET SERIES(U1_"_1",1,D0)=""
SET SERID(U1_"_1",U1)=""
+14 QUIT
End DoDot:1
+15 QUIT
+16 ;
GETRSER(D0,SERIES,SERID) ; Populate SERIES array for File 2005
+1 NEW ANY,D1,X
+2 ;DCOM SERIES NUM
NEW SNUM
+3 ;DCOM IMAGE NUM
NEW INUM
+4 ;UID
NEW U1
+5 ;object for a GROUP
NEW I0
+6 SET (ANY,D1)=0
+7 ;
+8 FOR
SET D1=$ORDER(^MAG(2005,D0,1,D1))
if 'D1
QUIT
Begin DoDot:1
+9 SET X=$GET(^MAG(2005,D0,1,D1,0))
SET I0=+X
if 'I0
QUIT
+10 SET ANY=1
SET I0=+X
SET SNUM=$PIECE(X,"^",2)
SET INUM=$PIECE(X,"^",3)
+11 SET U1=$GET(^MAG(2005,I0,"SERIESUID"))
+12 if SNUM=""
SET SNUM="?"
if INUM=""
SET INUM="?"
if U1=""
SET U1="?"
+13 SET SERIES(U1_"_"_SNUM,INUM,I0)=""
SET SERID(U1_"_"_SNUM,U1)=""
+14 QUIT
End DoDot:1
+15 QUIT
+16 ;
GETDSER(D0,SERIES,SERID) ; Populate SERIES array for File 2005.1
+1 ;DCOM SERIES NUM
NEW SNUM
+2 ;DCOM IMAGE NUM
NEW INUM
+3 ;UID
NEW U1
+4 ;object for a GROUP (Child IEN)
NEW I0
+5 SET I0=""
+6 ;
+7 FOR
SET I0=$ORDER(^MAG(2005.1,"AGP",D0,I0))
if I0=""
QUIT
Begin DoDot:1
+8 DO GETDINUM^MAGDQR20(D0,I0,.SNUM,.INUM)
+9 SET U1=$GET(^MAG(2005.1,I0,"SERIESUID"))
+10 if U1=""
SET U1="?"
+11 SET SERIES(U1_"_"_SNUM,INUM,I0)=""
SET SERID(U1_"_"_SNUM,U1)=""
+12 QUIT
End DoDot:1
+13 QUIT
+14 ;
GETDINUM(GRPIEN,CHLDIEN,SNUM,INUM) ; Get DICOM Serial Number and Image Number for Child IEN from Audit Image
+1 NEW X,D1,I0
+2 SET SNUM=""
SET INUM=""
+3 SET D1=0
+4 ;
+5 FOR
SET D1=$ORDER(^MAG(2005.1,GRPIEN,1,D1))
if 'D1
QUIT
Begin DoDot:1
+6 SET X=$GET(^MAG(2005.1,GRPIEN,1,D1,0))
SET I0=+X
if 'I0
QUIT
+7 if I0=CHLDIEN
SET SNUM=$PIECE(X,"^",2)
SET INUM=$PIECE(X,"^",3)
+8 QUIT
End DoDot:1
if SNUM'=""!(INUM'="")
QUIT
+9 ;
+10 if SNUM=""
SET SNUM="?"
+11 if INUM=""
SET INUM="?"
+12 QUIT
+13 ;
+14 ;*zeb *348 add Series Description as optional return
WRTSER(D0,SERIESARRAY,SERIES,SNUM,SERID,REQDFN,INCSERD) ; Output to TMP based on SERIES array
+1 ; refresh temp image index
+2 ; SERIES(UID _ DCOM SERIES NUM, DCOM IMAGE NUM, OBJECT GROUP)=""
+3 NEW MAGTI
+4 ;IMAGE NUMBER
NEW INUM
+5 ;OBJECT GROUP
NEW I0
+6 ;SERIES UID
NEW UID
+7 ; temp image index
SET MAGTI=0
+8 SET INCSERD=$GET(INCSERD)
+9 ;temp for sorting
KILL ^TMP("MAG",$JOB,"TI")
+10 ;
+11 ; seek qualifying images (no QI or matching known DFN)
+12 SET INUM=""
+13 FOR
SET INUM=$ORDER(SERIES(SNUM,INUM))
if INUM=""
QUIT
Begin DoDot:1
+14 SET I0=""
+15 ;sort into ^TMP(,,"TI",)
+16 FOR
SET I0=$ORDER(SERIES(SNUM,INUM,I0))
if I0=""
QUIT
DO SRTMAGTI^MAGDQR20(INUM,I0,REQDFN)
+17 QUIT
End DoDot:1
+18 ;
+19 ;quit if qualifying images were not found
+20 if '$DATA(^TMP("MAG",$JOB,"TI"))
QUIT
+21 ;
+22 SET UID=""
FOR
SET UID=$ORDER(SERID(SNUM,UID))
if UID=""
QUIT
DO WRSERUID^MAGDQR20(UID,D0,INCSERD)
+23 ;
+24 ; assign the series number
if SNUM'="?"
DO WASGNSER^MAGDQR20(SNUM,.SERIESARRAY)
+25 SET MAGTI=""
FOR
SET MAGTI=$ORDER(^TMP("MAG",$JOB,"TI",MAGTI))
if 'MAGTI
QUIT
DO WRTOUT^MAGDQR21(^TMP("MAG",$JOB,"TI",MAGTI))
+26 ;
+27 KILL ^TMP("MAG",$JOB,"TI")
+28 QUIT
+29 ;
SRTMAGTI(INUM,I0,REQDFN) ; Save IMAGE_IEN and GROUP_IEN lines
+1 ; if dup study instance UID, purge image info and bail out
+2 ; unless pt is specified and this image is for that pt
+3 NEW MAGFIL,MAGR0,X
+4 ;PACS UID
NEW UID
+5 ;Line counter
NEW MAGTI
+6 ;Group IEN
NEW GRPIEN
+7 NEW IMGINFO
+8 ;
+9 SET MAGR0=""
+10 SET MAGFIL=$$FILE^MAGGI11(I0)
+11 if MAGFIL
SET MAGR0=$GET(^MAG(MAGFIL,I0,0))
+12 ;patient must be the REQDFN
IF REQDFN
IF $PIECE(MAGR0,"^",7)'=REQDFN
KILL ^TMP("MAG",$JOB,"S",I0)
QUIT
+13 ;
+14 SET UID=$PIECE($GET(^MAG(MAGFIL,I0,"PACS")),"^",1)
+15 SET MAGTI=$ORDER(^TMP("MAG",$JOB,"TI",""),-1)+1
+16 SET MAGTI=MAGTI+1
SET ^TMP("MAG",$JOB,"TI",MAGTI)="NEXT_IMAGE"
+17 if UID'=""
SET MAGTI=MAGTI+1
SET ^TMP("MAG",$JOB,"TI",MAGTI)="IMAGE_UID|"_UID
+18 SET MAGTI=MAGTI+1
SET ^TMP("MAG",$JOB,"TI",MAGTI)="IMAGE_IEN|"_I0
+19 SET GRPIEN=$PIECE(MAGR0,"^",10)
+20 if GRPIEN
SET MAGTI=MAGTI+1
SET ^TMP("MAG",$JOB,"TI",MAGTI)="GROUP_IEN|"_GRPIEN
+21 ;
+22 ; QI check - override only if DFN specified in call
+23 ; (VA internal only!)
+24 ;Check the integrity of I0
DO CHK^MAGGSQI(.X,I0)
+25 IF '$GET(X(0))
Begin DoDot:1
+26 SET MAGTI=MAGTI+1
SET ^TMP("MAG",$JOB,"TI",MAGTI)="IMAGE_ERR|"_$PIECE($GET(X(0)),"^",2)
+27 QUIT
End DoDot:1
if 'REQDFN
QUIT
+28 ;
+29 if INUM'="?"
SET MAGTI=MAGTI+1
SET ^TMP("MAG",$JOB,"TI",MAGTI)="IMAGE_NUMBER|"_INUM
+30 SET IMGINFO=$GET(^TMP("MAG",$JOB,"S",I0))
KILL ^TMP("MAG",$JOB,"S",I0)
+31 ; Get Site image parameters IEN from 16^ piece of IMGINFO
+32 if IMGINFO'=""
SET MAGTI=MAGTI+1
SET ^TMP("MAG",$JOB,"TI",MAGTI)="IMAGE_INFO|"_IMGINFO_"|"_$$GETSNUM^MAGDQR21($PIECE(IMGINFO,"^",16))
+33 ;
+34 SET MAGTI=MAGTI+1
SET ^TMP("MAG",$JOB,"TI",MAGTI)="IMAGE_SOP_CLASS_UID|"_$$GET1^DIQ(2005,I0,251)
+35 ;
+36 QUIT
+37 ;
+38 ;*zeb *348 add Series Description as optional return
WRSERUID(UID,D0,INCSERD) ; Output SERIES_IEN line
+1 NEW M,X
+2 SET INCSERD=$GET(INCSERD)
+3 ;
+4 DO WRTOUT^MAGDQR21("NEXT_SERIES")
+5 if UID'="?"
DO WRTOUT^MAGDQR21("SERIES_UID|"_UID)
+6 DO WRTOUT^MAGDQR21("SERIES_IEN|"_D0)
+7 ; Officially, there can be only one modality per series,
+8 ; so stop when the first modality is found...
+9 SET X=""
SET M=""
+10 FOR
SET M=$ORDER(^TMP("MAG",$JOB,"M",2,UID,M))
if M=""
QUIT
Begin DoDot:1
+11 SET X=$SELECT(X'="":"\",1:"")_M
+12 QUIT
End DoDot:1
if X'=""
QUIT
+13 if X'=""
DO WRTOUT^MAGDQR21("SERIES_MODALITY|"_X)
+14 if INCSERD
Begin DoDot:1
+15 SET X=$$GET1^DIQ(2005,D0,10)
+16 if X'=""
DO WRTOUT^MAGDQR21("SERIES_DESCRIPTION|"_X)
End DoDot:1
+17 QUIT
+18 ;
WASGNSER(SNUM,SERIESARRAY) ; Output SERIES_NUMBER line
+1 NEW SERIESNUM
+2 ; - get series no from study itself if possible, else generate
+3 DO TSTSER^MAGDQR20(SNUM,.SERIESARRAY,.SERIESNUM)
+4 ; still need to generate
if '$DATA(SERIESNUM)
Begin DoDot:1
+5 FOR SERIESNUM=1:1
if '$DATA(SERIESARRAY(SERIESNUM))
QUIT
+6 QUIT
End DoDot:1
+7 ;
+8 DO WRTOUT^MAGDQR21("SERIES_NUMBER|"_SERIESNUM)
+9 SET SERIESARRAY(SERIESNUM)=""
+10 QUIT
+11 ;
TSTSER(SNUM,SERIESARRAY,SERIESNUM) ; Validate SERIES NUMBER
+1 NEW SERIESTEST,SGN
+2 SET SERIESTEST=$PIECE(SNUM,"_",2)
+3 ; invalid number
if "+-1234567890"'[$EXTRACT(SERIESTEST,1)
QUIT
+4 if "+-"[$EXTRACT(SERIESTEST,1)
SET SGN=$EXTRACT(SERIESTEST,1)
+5 if $DATA(SGN)
SET SERIESTEST=$EXTRACT(SERIESTEST,2,$LENGTH(SERIESTEST))
+6 if SERIESTEST'?1.12N
QUIT
+7 SET SERIESTEST=$GET(SGN)_SERIESTEST
+8 if $DATA(SERIESARRAY(SERIESTEST))
QUIT
+9 SET SERIESNUM=SERIESTEST
+10 QUIT
