Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGDQR20

MAGDQR20.m

Go to the documentation of this file. 
  1. 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
  1.  ;; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1.  Q
  1.  ;
  1.  ;*zeb *348 pass on INCSERD to code that would actually include the series description
  1.  ;This procedure called by STUDY^MAGDQR21 to generate IMAGE INFO lines
  1. WRTIMG(SERIESARRAY,D0,REQDFN,STUMO,INCDEL,INCSERD) ; Retrieve Image info and output to IMAGE INFO line
  1.  N I
  1.  N SERID  ;SERID(UID _ DCOM SERIES NUM, UID)
  1.  N SERIES ;SERIES(UID _ DCOM SERIES NUM, DCOM IMAGE NUM, OBJECT GROUP)=""
  1.  N SNUM,TMP
  1.  S INCSERD=$G(INCSERD)
  1.  K ^TMP("MAG",$J,"S") ;Images info by IEN
  1.  K ^TMP("MAG",$J,"M") ;RAD Procedure by IEN (1,IEN) and by SERIESUID (2,SERIESUID,Procedure)
  1.  ;
  1.  D RTRVIMG^MAGDQR20(.TMP,D0,REQDFN,INCDEL) ;retrieve images info for D0 and saved to TMP
  1.  D:$E($G(TMP),1,5)="^TMP(" WRTMAGM^MAGDQR20(.TMP,.STUMO) ;Save images and procedures, return STUMO (procedures)
  1.  ;
  1.  D GETSER^MAGDQR20(D0,.SERIES,.SERID,INCDEL) ;Get SERIESUID info, store in SERIES and SERID
  1.  S SNUM="" F  S SNUM=$O(SERIES(SNUM)) Q:SNUM=""  D WRTSER^MAGDQR20(D0,.SERIESARRAY,.SERIES,SNUM,.SERID,REQDFN,INCSERD)
  1.  ;
  1.  S I="" F  S I=$O(^TMP("MAG",$J,"S",I)) Q:I=""  D WRTOUT^MAGDQR21("UNUSED_GROUP_INFO|"_^TMP("MAG",$J,"S",I))
  1.  ;
  1.  K ^TMP("MAG",$J,"S")
  1.  K ^TMP("MAG",$J,"M")
  1.  Q
  1.  ;
  1. RTRVIMG(TMP,D0,REQDFN,INCDEL) ; Retrieve info for either single or group image
  1.  N MAGFIL,X
  1.  S MAGFIL=$$FILE^MAGGI11(D0)
  1.  ;
  1.  I MAGFIL,$D(^MAG(MAGFIL,D0,1)) D  Q  ; images and/or deleted images group
  1.  . ; allow return of info if DFN defined
  1.  . D GROUP^MAGGTIG(.TMP,D0,REQDFN)
  1.  . D:INCDEL RTRVDIMG^MAGDQR20(.TMP,D0) ;include deleted images of the active group
  1.  . Q
  1.  ;
  1.  ; DEFAULT - image is a single
  1.  D IMAGEINF^MAGGTU3(.X,D0,REQDFN)
  1.  I INCDEL,$$ISDEL^MAGGI11(D0) D DIMGINF^MAGDQR20(.X,D0)
  1.  S TMP=$NA(^TMP("MAGGTIG",$J))
  1.  K @TMP S @TMP@(0)="1^1",@TMP@(1)=X(0)
  1.  Q
  1.  ;
  1. RTRVDIMG(MAGRY,MAGIEN) ; Get Deleted images and output the info
  1.  N MAGCHILD,MAGCT,MAGFILE,X
  1.  ;
  1.  I $G(MAGRY)="" D
  1.  . ;  we'll use @ notation, this'll work if an Array or a Global Array is being returned
  1.  . S X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1) ;must call this, setting up Internal Variables
  1.  . S MAGRY=$NA(^TMP("MAGGTIG",$J))
  1.  . K @MAGRY
  1.  . Q
  1.  ;
  1.  S MAGCT=$O(@MAGRY@(""),-1)
  1.  S MAGCHILD=""
  1.  ;
  1.  F  S MAGCHILD=$O(^MAG(2005.1,"AGP",MAGIEN,MAGCHILD)) Q:'MAGCHILD  D
  1.  . S MAGCT=MAGCT+1
  1.  . S MAGFILE=$$INFO^MAGGAII(MAGCHILD,"D")
  1.  . S @MAGRY@(MAGCT)="B2^"_MAGFILE
  1.  . Q
  1.  S @MAGRY@(0)="1^"_MAGCT
  1.  Q
  1.  ;
  1. DIMGINF(MAGRY,IEN) ; Retrieve Deleted images
  1.  N MAGINFO,Z,EXIST
  1.  ;
  1.  S MAGINFO=$$INFO^MAGGAII(IEN,"E")
  1.  S EXIST=$D(^MAG(2005.1,IEN,0))
  1.  I 'EXIST S Z="1^Missing Record"
  1.  I EXIST D
  1.  . S Z=$P(^MAG(2005.1,IEN,0),U,7)
  1.  . I '$D(^DPT(Z)) S Z="1^Invalid patient pointer"
  1.  . E  S Z=Z_U_$P(^DPT(Z,0),U)
  1.  S MAGRY(0)="1^"_MAGINFO
  1.  S MAGRY(1)=Z ; dfn^name
  1.  Q
  1.  ;
  1. WRTMAGM(TMP,STUMO) ; Save series to TMP
  1.  N D,G,M,P,X,I
  1.  N MAGFILD,MAGFILG
  1.  K @TMP@(0)
  1.  S I=""
  1.  ;
  1.  F  S I=$O(@TMP@(I)) Q:I=""  D
  1.  . S X=$G(@TMP@(I))
  1.  . S D=$P(X,"^",2) ;IEN containing the images' info
  1.  . Q:'D
  1.  . S ^TMP("MAG",$J,"S",D)=X
  1.  . S MAGFILD=$$FILE^MAGGI11(D)
  1.  . S X=$S(MAGFILD:$G(^MAG(MAGFILD,D,0)),1:"")
  1.  . S G=+$P(X,"^",10) ;Group IEN
  1.  . S M=$P(X,"^",8)   ;Procedure
  1.  . S:$E(M,1,4)="RAD " M=$E(M,5,$L(M))
  1.  . Q:M=""
  1.  . S MAGFILG=$$FILE^MAGGI11(G)
  1.  . S G=$S(MAGFILG:$P($G(^MAG(MAGFILG,G,2)),"^",6),1:"") ;Parent Data File# for Group IEN
  1.  . S P=$S(MAGFILD:$P($G(^MAG(MAGFILD,D,2)),"^",6),1:"") ;Parent Data File# for IEN
  1.  . I P'=74,G'=74 Q  ;quit if not RAD/NUC MED REPORTS file (#74)
  1.  . S ^TMP("MAG",$J,"M",1,D)=M
  1.  . S STUMO(M)=""
  1.  . S G=$S(MAGFILD:$G(^MAG(MAGFILD,D,"SERIESUID")),1:"")
  1.  . S:G'="" ^TMP("MAG",$J,"M",2,G,M)=""
  1.  . Q
  1.  Q
  1.  ;
  1. GETSER(D0,SERIES,SERID,INCDEL) ; Populate SERIES array for File 2005 and 2005.1
  1.  N MAGFIL,U1
  1.  ; 
  1.  ; group IEN 
  1.  I $D(^MAG(2005,D0,1)) D GETRSER^MAGDQR20(D0,.SERIES,.SERID)
  1.  ; include deleted images 
  1.  I INCDEL D GETDSER^MAGDQR20(D0,.SERIES,.SERID)
  1.  ;
  1.  D:'$D(SERIES)
  1.  . S U1=""
  1.  . S MAGFIL=$$FILE^MAGGI11(D0)
  1.  . S:MAGFIL U1=$G(^MAG(MAGFIL,D0,"SERIESUID"))
  1.  . S:U1="" U1="?"
  1.  . S SERIES(U1_"_1",1,D0)="",SERID(U1_"_1",U1)=""
  1.  . Q
  1.  Q
  1.  ;
  1. GETRSER(D0,SERIES,SERID) ; Populate SERIES array for File 2005
  1.  N ANY,D1,X
  1.  N SNUM ;DCOM SERIES NUM
  1.  N INUM ;DCOM IMAGE NUM
  1.  N U1   ;UID
  1.  N I0   ;object for a GROUP
  1.  S (ANY,D1)=0
  1.  ;
  1.  F  S D1=$O(^MAG(2005,D0,1,D1)) Q:'D1  D
  1.  . S X=$G(^MAG(2005,D0,1,D1,0)),I0=+X Q:'I0
  1.  . S ANY=1,I0=+X,SNUM=$P(X,"^",2),INUM=$P(X,"^",3)
  1.  . S U1=$G(^MAG(2005,I0,"SERIESUID"))
  1.  . S:SNUM="" SNUM="?" S:INUM="" INUM="?" S:U1="" U1="?"
  1.  . S SERIES(U1_"_"_SNUM,INUM,I0)="",SERID(U1_"_"_SNUM,U1)=""
  1.  . Q
  1.  Q
  1.  ;
  1. GETDSER(D0,SERIES,SERID) ; Populate SERIES array for File 2005.1
  1.  N SNUM ;DCOM SERIES NUM
  1.  N INUM ;DCOM IMAGE NUM
  1.  N U1   ;UID
  1.  N I0   ;object for a GROUP (Child IEN)
  1.  S I0=""
  1.  ;
  1.  F  S I0=$O(^MAG(2005.1,"AGP",D0,I0)) Q:I0=""  D
  1.  . D GETDINUM^MAGDQR20(D0,I0,.SNUM,.INUM)
  1.  . S U1=$G(^MAG(2005.1,I0,"SERIESUID"))
  1.  . S:U1="" U1="?"
  1.  . S SERIES(U1_"_"_SNUM,INUM,I0)="",SERID(U1_"_"_SNUM,U1)=""
  1.  . Q
  1.  Q
  1.  ;
  1. GETDINUM(GRPIEN,CHLDIEN,SNUM,INUM) ; Get DICOM Serial Number and Image Number for Child IEN from Audit Image 
  1.  N X,D1,I0
  1.  S SNUM="",INUM=""
  1.  S D1=0
  1.  ;
  1.  F  S D1=$O(^MAG(2005.1,GRPIEN,1,D1)) Q:'D1  D  Q:SNUM'=""!(INUM'="")
  1.  . S X=$G(^MAG(2005.1,GRPIEN,1,D1,0)),I0=+X Q:'I0
  1.  . S:I0=CHLDIEN SNUM=$P(X,"^",2),INUM=$P(X,"^",3)
  1.  . Q
  1.  ;
  1.  S:SNUM="" SNUM="?"
  1.  S:INUM="" INUM="?"
  1.  Q
  1.  ;
  1.  ;*zeb *348 add Series Description as optional return
  1. WRTSER(D0,SERIESARRAY,SERIES,SNUM,SERID,REQDFN,INCSERD) ; Output to TMP based on SERIES array
  1.  ; refresh temp image index
  1.  ; SERIES(UID _ DCOM SERIES NUM, DCOM IMAGE NUM, OBJECT GROUP)=""
  1.  N MAGTI
  1.  N INUM ;IMAGE NUMBER
  1.  N I0   ;OBJECT GROUP
  1.  N UID  ;SERIES UID
  1.  S MAGTI=0 ; temp image index
  1.  S INCSERD=$G(INCSERD)
  1.  K ^TMP("MAG",$J,"TI") ;temp for sorting
  1.  ;
  1.  ; seek qualifying images (no QI or matching known DFN)
  1.  S INUM=""
  1.  F  S INUM=$O(SERIES(SNUM,INUM)) Q:INUM=""  D
  1.  . S I0=""
  1.  . ;sort into ^TMP(,,"TI",)
  1.  . F  S I0=$O(SERIES(SNUM,INUM,I0)) Q:I0=""  D SRTMAGTI^MAGDQR20(INUM,I0,REQDFN)
  1.  . Q
  1.  ;
  1.  ;quit if qualifying images were not found
  1.  Q:'$D(^TMP("MAG",$J,"TI"))
  1.  ;
  1.  S UID="" F  S UID=$O(SERID(SNUM,UID)) Q:UID=""  D WRSERUID^MAGDQR20(UID,D0,INCSERD)
  1.  ;
  1.  D:SNUM'="?" WASGNSER^MAGDQR20(SNUM,.SERIESARRAY)  ; assign the series number
  1.  S MAGTI="" F  S MAGTI=$O(^TMP("MAG",$J,"TI",MAGTI)) Q:'MAGTI  D WRTOUT^MAGDQR21(^TMP("MAG",$J,"TI",MAGTI))
  1.  ;
  1.  K ^TMP("MAG",$J,"TI")
  1.  Q
  1.  ;
  1. SRTMAGTI(INUM,I0,REQDFN) ; Save IMAGE_IEN and GROUP_IEN lines
  1.  ; if dup study instance UID, purge image info and bail out
  1.  ; unless pt is specified and this image is for that pt
  1.  N MAGFIL,MAGR0,X
  1.  N UID ;PACS UID
  1.  N MAGTI ;Line counter
  1.  N GRPIEN ;Group IEN
  1.  N IMGINFO
  1.  ;
  1.  S MAGR0=""
  1.  S MAGFIL=$$FILE^MAGGI11(I0)
  1.  S:MAGFIL MAGR0=$G(^MAG(MAGFIL,I0,0))
  1.  I REQDFN,$P(MAGR0,"^",7)'=REQDFN K ^TMP("MAG",$J,"S",I0) Q  ;patient must be the REQDFN
  1.  ;
  1.  S UID=$P($G(^MAG(MAGFIL,I0,"PACS")),"^",1)
  1.  S MAGTI=$O(^TMP("MAG",$J,"TI",""),-1)+1
  1.  S MAGTI=MAGTI+1,^TMP("MAG",$J,"TI",MAGTI)="NEXT_IMAGE"
  1.  S:UID'="" MAGTI=MAGTI+1,^TMP("MAG",$J,"TI",MAGTI)="IMAGE_UID|"_UID
  1.  S MAGTI=MAGTI+1,^TMP("MAG",$J,"TI",MAGTI)="IMAGE_IEN|"_I0
  1.  S GRPIEN=$P(MAGR0,"^",10)
  1.  S:GRPIEN MAGTI=MAGTI+1,^TMP("MAG",$J,"TI",MAGTI)="GROUP_IEN|"_GRPIEN
  1.  ;
  1.  ; QI check - override only if DFN specified in call
  1.  ; (VA internal only!)
  1.  D CHK^MAGGSQI(.X,I0) ;Check the integrity of I0
  1.  I '$G(X(0)) D  Q:'REQDFN
  1.  . S MAGTI=MAGTI+1,^TMP("MAG",$J,"TI",MAGTI)="IMAGE_ERR|"_$P($G(X(0)),"^",2)
  1.  . Q
  1.  ;
  1.  S:INUM'="?" MAGTI=MAGTI+1,^TMP("MAG",$J,"TI",MAGTI)="IMAGE_NUMBER|"_INUM
  1.  S IMGINFO=$G(^TMP("MAG",$J,"S",I0)) K ^TMP("MAG",$J,"S",I0)
  1.  ; Get Site image parameters IEN from 16^ piece of IMGINFO
  1.  S:IMGINFO'="" MAGTI=MAGTI+1,^TMP("MAG",$J,"TI",MAGTI)="IMAGE_INFO|"_IMGINFO_"|"_$$GETSNUM^MAGDQR21($P(IMGINFO,"^",16))
  1.  ;
  1.  S MAGTI=MAGTI+1,^TMP("MAG",$J,"TI",MAGTI)="IMAGE_SOP_CLASS_UID|"_$$GET1^DIQ(2005,I0,251)
  1.  ;
  1.  Q
  1.  ;
  1.  ;*zeb *348 add Series Description as optional return
  1. WRSERUID(UID,D0,INCSERD) ; Output SERIES_IEN line
  1.  N M,X
  1.  S INCSERD=$G(INCSERD)
  1.  ;
  1.  D WRTOUT^MAGDQR21("NEXT_SERIES")
  1.  D:UID'="?" WRTOUT^MAGDQR21("SERIES_UID|"_UID)
  1.  D WRTOUT^MAGDQR21("SERIES_IEN|"_D0)
  1.  ; Officially, there can be only one modality per series,
  1.  ; so stop when the first modality is found...
  1.  S X="",M=""
  1.  F  S M=$O(^TMP("MAG",$J,"M",2,UID,M)) Q:M=""  D  Q:X'=""
  1.  . S X=$S(X'="":"\",1:"")_M
  1.  . Q
  1.  D:X'="" WRTOUT^MAGDQR21("SERIES_MODALITY|"_X)
  1.  D:INCSERD
  1.  . S X=$$GET1^DIQ(2005,D0,10)
  1.  . D:X'="" WRTOUT^MAGDQR21("SERIES_DESCRIPTION|"_X)
  1.  Q
  1.  ;
  1. WASGNSER(SNUM,SERIESARRAY) ; Output SERIES_NUMBER line
  1.  N SERIESNUM
  1.  ; - get series no from study itself if possible, else generate
  1.  D TSTSER^MAGDQR20(SNUM,.SERIESARRAY,.SERIESNUM)
  1.  D:'$D(SERIESNUM)  ; still need to generate
  1.  . F SERIESNUM=1:1 Q:'$D(SERIESARRAY(SERIESNUM))
  1.  . Q
  1.  ;
  1.  D WRTOUT^MAGDQR21("SERIES_NUMBER|"_SERIESNUM)
  1.  S SERIESARRAY(SERIESNUM)=""
  1.  Q
  1.  ;
  1. TSTSER(SNUM,SERIESARRAY,SERIESNUM) ; Validate SERIES NUMBER
  1.  N SERIESTEST,SGN
  1.  S SERIESTEST=$P(SNUM,"_",2)
  1.  Q:"+-1234567890"'[$E(SERIESTEST,1)  ; invalid number
  1.  S:"+-"[$E(SERIESTEST,1) SGN=$E(SERIESTEST,1)
  1.  S:$D(SGN) SERIESTEST=$E(SERIESTEST,2,$L(SERIESTEST))
  1.  Q:SERIESTEST'?1.12N
  1.  S SERIESTEST=$G(SGN)_SERIESTEST
  1.  Q:$D(SERIESARRAY(SERIESTEST))
  1.  S SERIESNUM=SERIESTEST
  1.  Q