MAGNVQ01 ;VA/WOIFO/NST - Retrieve study ; 19 Oct 2020 3:59 PM
;;3.0;IMAGING;**185,301**;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
;
GSTUDY(MAGOUT,REFTYPE,REFIEN,CONTEXT,IMGLESS) ; Get Study by Reference and type
; MAGOUT - Output array where the images will be added
; REFTYPE - "RAD" or "TIU"
; REFIEN - Radiology Report IEN or TIU Note IEN
; CONTEXT - Context ID
; IMGLESS - 0|1 Include images
N STUDYUID
;
S STUDYUID=$$STUDYUID(REFTYPE,REFIEN,CONTEXT) ; get Study UID
I STUDYUID="" Q ; No study found for the reference
D IMGBYSTD(MAGOUT,STUDYUID,REFTYPE,REFIEN,CONTEXT,IMGLESS)
Q
;
IMGBYSTD(MAGOUT,STUDYUID,REFTYPE,REFIEN,CONTEXT,IMGLESS) ; Get a Study images
N IARRAY,IMAGE,STYIX,SERIX,SOPIX,PROCIX,PATIX,PAT,PAT0,PATDTA
;
S PAT=""
S STYIX=""
F S STYIX=$O(^MAGV(2005.62,"B",STUDYUID,STYIX)) Q:'STYIX D Q:PAT<0
. S PROCIX=$P($G(^MAGV(2005.62,STYIX,6)),"^",1) Q:'PROCIX
. S PATIX=$P($G(^MAGV(2005.61,PROCIX,6)),"^",1) Q:'PATIX
. S PATDTA=$G(^MAGV(2005.6,PATIX,0)) Q:PATDTA=""
. S PAT0=$P(PATDTA,"^",1) S:PAT="" PAT=PAT0
. I ($P(PATDTA,"^",3)'="D")!(PAT'=PAT0) S PAT=-1 Q
. ; process study for valid pt
. S SERIX=""
. F S SERIX=$O(^MAGV(2005.63,"C",STYIX,SERIX)) Q:'SERIX D
. . N ACTVIMG
. . S ACTVIMG=0
. . S SOPIX=""
. . F S SOPIX=$O(^MAGV(2005.64,"C",SERIX,SOPIX)) Q:'SOPIX D Q:IMGLESS&ACTVIMG
. . . S IMAGE=""
. . . F S IMAGE=$O(^MAGV(2005.65,"C",SOPIX,IMAGE)) Q:'IMAGE D
. . . . I $P($G(^MAGV(2005.65,IMAGE,1)),"^",5)'="I" D
. . . . . S IARRAY(STYIX,SERIX,SOPIX,IMAGE)="",ACTVIMG=1
. . . . Q
. . . Q
. . Q
. Q
I PAT<0 S @MAGOUT@(0)="0^Duplicate Study UID" Q
;
D GETSTUDY(MAGOUT,.IARRAY,REFTYPE,REFIEN,CONTEXT) ; Get Study by graph ien
Q
;
GETSTUDY(MAGOUT,IARRAY,REFTYPE,REFIEN,CONTEXT) ; Get Study by graph ien
N I,MAGNCNT,STYIX,SERIX,SOPIX,IMAGE
;
I '$D(IARRAY) Q
;
K ^TMP("MAGNVQ01",$J)
S ^TMP("MAGNVQ01",$J)=0
;
S STYIX=""
F S STYIX=$O(IARRAY(STYIX)) Q:'STYIX D
. D ASTUDY(STYIX,REFTYPE,REFIEN,CONTEXT)
. S SERIX=""
. F S SERIX=$O(IARRAY(STYIX,SERIX)) Q:'SERIX D
. . D ASERIES(SERIX)
. . S SOPIX=""
. . F S SOPIX=$O(IARRAY(STYIX,SERIX,SOPIX)) Q:'SOPIX D
. . . S IMAGE=$O(IARRAY(STYIX,SERIX,SOPIX,"")) ; First image instance in SOP
. . . D ASOP(SOPIX,IMAGE)
. . . S IMAGE=""
. . . F S IMAGE=$O(IARRAY(STYIX,SERIX,SOPIX,IMAGE)) Q:'IMAGE D
. . . . D AIMAGE(SOPIX,IMAGE)
. . . . Q
. . . Q
. . Q
. Q
;
; Append it to end result
S I=0
S MAGNCNT=$O(@MAGOUT@(""),-1)
F S I=$O(^TMP("MAGNVQ01",$J,I)) Q:'I D
. S MAGNCNT=MAGNCNT+1
. S @MAGOUT@(MAGNCNT)=^TMP("MAGNVQ01",$J,I)
. Q
I MAGNCNT S @MAGOUT@(0)=1
Q
;
STUDYUID(REFTYPE,REFIEN,CONTEXT) ; Get Study UID by readiology report or TIU note
N ACN,STDIEN
;
I REFTYPE="RAD" S ACN=$$ACNRAD^MAGNU003(REFIEN,CONTEXT)
I REFTYPE="TIU" S ACN=$$ACNTIU^MAGNU003(REFIEN)
I ACN="" Q ""
;
S STDIEN=$O(^MAGV(2005.62,"D",ACN,"")) ; Get study UID IEN
Q $$GET1^DIQ(2005.62,STDIEN,".01") ; Return study UID
;
WRTOUT(S) ; Write a new line
N CNT
S CNT=^TMP("MAGNVQ01",$J)+1
S ^TMP("MAGNVQ01",$J)=CNT
S ^TMP("MAGNVQ01",$J,CNT)=S
Q
;
ASTUDY(STYIX,REFTYPE,REFIEN,CONTEXT) ; Append Study section
N FILESTD,IENSSTD,MAGDFN,MAGOUTST,MAGOUTPR,MAGERR,UID,INFO,PROCIX
;
S FILESTD=2005.62
S IENSSTD=STYIX_","
D GETS^DIQ(FILESTD,STYIX,"**","RIE","MAGOUTST","MAGERR")
I REFIEN="" D
. N ACNUMB
. S ACNUMB=MAGOUTST(FILESTD,IENSSTD,"ACCESSION NUMBER","I")
. D REFBYACN^MAGNU003(.REFTYPE,.REFIEN,ACNUMB) ; Set Reference type by Accession Number
. S CONTEXT=$$CPRSCTX^MAGNU003(REFTYPE,REFIEN)
. Q
;
S UID=MAGOUTST(FILESTD,IENSSTD,"STUDY INSTANCE UID","I")
D WRTOUT("NEXT_STUDY|"_UID_"|NEW")
D WRTOUT("STUDY_UID|"_UID)
D WRTOUT("STUDY_IEN|"_$$STUDYIEN(.MAGOUTST,IENSSTD))
D WRTOUT("STUDY_INFO|"_$$STDINFO(.MAGOUTST,IENSSTD)_"|"_REFTYPE_"-"_REFIEN_"|"_CONTEXT)
;
S MAGDFN=MAGOUTST(FILESTD,IENSSTD,"PATIENT REFERENCE","E")
D WRTOUT("STUDY_PAT|"_MAGDFN_"|"_$S($T(GETICN^MPIF001)'="":$$GETICN^MPIF001(MAGDFN),1:"-1^NO MPI")_"|"_$P($G(^DPT(MAGDFN,0)),"^",1))
;
D WRTOUT("STUDY_MODALITY|"_MAGOUTST(FILESTD,IENSSTD,"MODALITIES IN STUDY","E"))
Q
;
STUDYIEN(MAGOUTST,IENSSTD) ; Return study IEN section
N INFO,FILESTD
S FILESTD=2005.62
S $P(INFO,"|",1)=+IENSSTD
S $P(INFO,"|",2)=$G(MAGOUTST(FILESTD,IENSSTD,"NUMBER OF SOP INSTANCES","I"))
Q INFO
;
STDINFO(MAGOUTST,IENSSTD) ; Return study info section
N INFO,FILEPRC,PROCIX,IENSPRC,FILESTD,MAGOUTPR,MAGERR
;
S FILESTD=2005.62
S FILEPRC=2005.61
S PROCIX=MAGOUTST(FILESTD,IENSSTD,"PROCEDURE REFERENCE","I")
S IENSPRC=PROCIX_","
D GETS^DIQ(FILEPRC,PROCIX,"**","RIE","MAGOUTPR","MAGERR")
;
S $P(INFO,U,4)=$$DTE^MAGSIXG3($G(MAGOUTPR(FILEPRC,IENSPRC,"PROCEDURE DATE/TIME","I")))
S $P(INFO,U,6)=$G(MAGOUTST(FILESTD,IENSSTD,"DESCRIPTION","I")) ; description
S $P(INFO,U,8)=$G(MAGOUTPR(FILEPRC,IENSPRC,"PACKAGE INDEX","I"))
S $P(INFO,U,13)=$G(MAGOUTST(FILESTD,IENSSTD,"ORIGIN INDEX","E"))
S $P(INFO,U,14)=$$DTE^MAGSIXG3($G(MAGOUTST(FILESTD,IENSSTD,"STUDY DATE/TIME","I"))) ; study date
S $P(INFO,U,20)=$G(MAGOUTST(FILESTD,IENSSTD,"ACCESSION NUMBER","I")) ; Accession number
Q INFO
;
ASERIES(SERIX) ; Append Series section
N FILESER,IENSSER,MAGOUTSR,MAGERR
S FILESER=2005.63
S IENSSER=SERIX_","
D GETS^DIQ(FILESER,SERIX,"**","RIE","MAGOUTSR","MAGERR")
;
D WRTOUT("NEXT_SERIES")
D WRTOUT("SERIES_UID|"_$G(MAGOUTSR(FILESER,IENSSER,"SERIES INSTANCE UID","I")))
D WRTOUT("SERIES_IEN|"_SERIX)
D WRTOUT("SERIES_MODALITY|"_$G(MAGOUTSR(FILESER,IENSSER,"MODALITY","E")))
D WRTOUT("SERIES_NUMBER|"_$G(MAGOUTSR(FILESER,IENSSER,"SERIES NUMBER","I")))
D WRTOUT("SERIES_CLASS_INDEX|"_$G(MAGOUTSR(FILESER,IENSSER,"CLASS INDEX","I")))
D WRTOUT("SERIES_PROC/EVENT_INDEX|"_$G(MAGOUTSR(FILESER,IENSSER,"PROC/EVENT INDEX","I")))
D WRTOUT("SERIES_SPEC/SUBSPEC_INDEX|"_$G(MAGOUTSR(FILESER,IENSSER,"SPEC/SUBSPEC INDEX","I")))
Q
;
ASOP(SOPIX,FIMAGE) ; Append SOP section
N FILEIMG,I,IENSIMG,FILESOP,IENSSOP,MAGOUTIM,MAGOUTSO,MAGERR
S FILESOP=2005.64
S IENSSOP=SOPIX_","
D GETS^DIQ(FILESOP,SOPIX,"**","RIE","MAGOUTSO","MAGERR")
D WRTOUT("NEXT_IMAGE")
D WRTOUT("IMAGE_IEN|"_SOPIX)
D WRTOUT("IMAGE_UID|"_$G(MAGOUTSO(FILESOP,IENSSOP,"SOP INSTANCE UID","E")))
D WRTOUT("IMAGE_NUMBER|"_$G(MAGOUTSO(FILESOP,IENSSOP,"INSTANCE NUMBER","E")))
D WRTOUT("IMAGE_INFO|"_$$IMGINFO(.MAGOUTSO,IENSSOP,FIMAGE))
D WRTOUT("IMAGE_SOP_CLASS_UID|"_$G(MAGOUTSO(FILESOP,IENSSOP,"SOP CLASS UID","E")))
Q
;
AIMAGE(SOPIX,IMAGE) ; Append Image section
N FILEIMG,IENSIMG,MAGOUTIM,MAGERR
;
S FILEIMG=2005.65
S IENSIMG=IMAGE_","
D GETS^DIQ(FILEIMG,IMAGE,"**","RIE","MAGOUTIM","MAGERR")
;
D AINST(MAGOUTIM(FILEIMG,IENSIMG,"ARTIFACT TOKEN","E")) ; Add Artifact Instance
Q
;
IMGINFO(MAGOUTSO,IENSSOP,FIMAGE) ;Get Image Info
N INFO,FILESOP
S FILESOP=2005.64
;
S $P(INFO,U,1)=+IENSSOP ; Image IEN
S $P(INFO,U,2)="" ;fullFilename
S $P(INFO,U,3)="" ;absFilename
S $P(INFO,U,4)="" ;description
S $P(INFO,U,5)=""
S $P(INFO,U,6)=$G(MAGOUTSO(FILESOP,IENSSOP,"TYPE INDEX","E")) ; Image type
S $P(INFO,U,7)="" ;procedure
S $P(INFO,U,8)="" ;procedureDate
S $P(INFO,U,9)=""
S $P(INFO,U,10)="" ;absLocation
S $P(INFO,U,11)="" ;fullLocation
S $P(INFO,U,12)="" ;dicomSequenceNumberForDisplay
S $P(INFO,U,13)="" ;dicomImageNumberForDisplay
S $P(INFO,U,14)=""
S $P(INFO,U,15)=""
S $P(INFO,U,16)="" ;siteAbbr
S $P(INFO,U,17)="" ;qaMessage
S $P(INFO,U,18)="" ;bigFilename
S $P(INFO,U,19)="" ;patientDFN
S $P(INFO,U,20)="" ;patientName
S $P(INFO,U,21)="" ;imageClass
S $P(INFO,U,22)=$$DTE($G(MAGOUTSO(FILESOP,IENSSOP,"ACQUISITION DATE/TIME","I"))) ; 09/12/2017 16:29:32 ;captureDate
S $P(INFO,U,23)="" ;documentDate
S $P(INFO,U,24)="" ;is the IEN of the group for the image
S $P(INFO,U,25)="" ;is the IEN of the first image in a group
S $P(INFO,U,26)="" ;is the Image type of the first image in the group
S $P(INFO,U,27)=""
S $P(INFO,U,28)=$$GET1^DIQ(2005.65,FIMAGE,"18","I") ; CONFIDENTIAL /Sensitive Image
S $P(INFO,U,29)="" ;viewStatusValue
S $P(INFO,U,30)="" ;statusValue
S $P(INFO,U,31)="" ;imageHasAnnotationsValue
S $P(INFO,U,32)="" ;associatedNoteResulted
S $P(INFO,U,33)="" ;imageAnnotationStatusValue
S $P(INFO,U,34)="" ;imageAnnotationStatusDescription
S $P(INFO,U,35)="" ;imagePackage
Q INFO
;
AINST(TOKEN) ; Add Artifact Instance
N KEY,VALUE,LINE,IEN,I,RES,TMPARR,QT
D GETAIENT^MAGVAG02(.RES,TOKEN,"") ; Get not deleted Artifact IEN by Token
I '$$ISOK^MAGVAF02(RES) Q
S IEN=$$GETVAL^MAGVAF02(RES)
D GETAINST^MAGVAG04(.TMPARR,IEN)
I '$$ISOK^MAGVAF02(TMPARR(0)) Q
S QT=$C(34)
S I=1
F S I=$O(TMPARR(I)) Q:'I S LINE=TMPARR(I) Q:LINE["</ARTIFACTINSTANCES" D
. I LINE["<ARTIFACTINSTANCE" D WRTOUT("NEXT_ARTIFACTINSTANCE") Q
. I LINE["</ARTIFACTINSTANCE" Q
. S KEY=$P(TMPARR(I),"=",1)
. S VALUE=$TR($P(TMPARR(I),"=",2),QT,"")
. S VALUE=$P(VALUE," >") ; special handling because of XML result set
. D WRTOUT("ARTIFACTINSTANCE_"_KEY_"|"_VALUE)
. I KEY="DISKVOLUME" D ; Add Phisical address
. . N LOCATION
. . S LOCATION=$$GET1^DIQ(2005.2,VALUE,"1")
. . D WRTOUT("ARTIFACTINSTANCE_PHYSICALREFERENCE|"_LOCATION)
. . Q
. I KEY="STORAGEPROVIDER" D ; Add Storage provider name
. . D WRTOUT("ARTIFACTINSTANCE_STORAGEPROVIDERTYPE|"_$$GET1^DIQ(2006.917,VALUE,"2"))
. . Q
. I KEY="ARTIFACT" D ; Add ARTIFACT FORMAT
. . D WRTOUT("ARTIFACTINSTANCE_ARTIFACTFORMAT|"_$$GET1^DIQ(2006.916,VALUE,"2:3"))
. . Q
. Q
Q
;
;+++++ PERFORMS SPECIAL CONVERSION OF THE DATE/TIME
DTE(DTI) ;
Q $TR($$FMTE^XLFDT(DTI,"5Z"),"@"," ")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGNVQ01 10729 printed Apr 09, 2024@21:08:46 Page 2
MAGNVQ01 ;VA/WOIFO/NST - Retrieve study ; 19 Oct 2020 3:59 PM
+1 ;;3.0;IMAGING;**185,301**;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 ;
GSTUDY(MAGOUT,REFTYPE,REFIEN,CONTEXT,IMGLESS) ; Get Study by Reference and type
+1 ; MAGOUT - Output array where the images will be added
+2 ; REFTYPE - "RAD" or "TIU"
+3 ; REFIEN - Radiology Report IEN or TIU Note IEN
+4 ; CONTEXT - Context ID
+5 ; IMGLESS - 0|1 Include images
+6 NEW STUDYUID
+7 ;
+8 ; get Study UID
SET STUDYUID=$$STUDYUID(REFTYPE,REFIEN,CONTEXT)
+9 ; No study found for the reference
IF STUDYUID=""
QUIT
+10 DO IMGBYSTD(MAGOUT,STUDYUID,REFTYPE,REFIEN,CONTEXT,IMGLESS)
+11 QUIT
+12 ;
IMGBYSTD(MAGOUT,STUDYUID,REFTYPE,REFIEN,CONTEXT,IMGLESS) ; Get a Study images
+1 NEW IARRAY,IMAGE,STYIX,SERIX,SOPIX,PROCIX,PATIX,PAT,PAT0,PATDTA
+2 ;
+3 SET PAT=""
+4 SET STYIX=""
+5 FOR
SET STYIX=$ORDER(^MAGV(2005.62,"B",STUDYUID,STYIX))
if 'STYIX
QUIT
Begin DoDot:1
+6 SET PROCIX=$PIECE($GET(^MAGV(2005.62,STYIX,6)),"^",1)
if 'PROCIX
QUIT
+7 SET PATIX=$PIECE($GET(^MAGV(2005.61,PROCIX,6)),"^",1)
if 'PATIX
QUIT
+8 SET PATDTA=$GET(^MAGV(2005.6,PATIX,0))
if PATDTA=""
QUIT
+9 SET PAT0=$PIECE(PATDTA,"^",1)
if PAT=""
SET PAT=PAT0
+10 IF ($PIECE(PATDTA,"^",3)'="D")!(PAT'=PAT0)
SET PAT=-1
QUIT
+11 ; process study for valid pt
+12 SET SERIX=""
+13 FOR
SET SERIX=$ORDER(^MAGV(2005.63,"C",STYIX,SERIX))
if 'SERIX
QUIT
Begin DoDot:2
+14 NEW ACTVIMG
+15 SET ACTVIMG=0
+16 SET SOPIX=""
+17 FOR
SET SOPIX=$ORDER(^MAGV(2005.64,"C",SERIX,SOPIX))
if 'SOPIX
QUIT
Begin DoDot:3
+18 SET IMAGE=""
+19 FOR
SET IMAGE=$ORDER(^MAGV(2005.65,"C",SOPIX,IMAGE))
if 'IMAGE
QUIT
Begin DoDot:4
+20 IF $PIECE($GET(^MAGV(2005.65,IMAGE,1)),"^",5)'="I"
Begin DoDot:5
+21 SET IARRAY(STYIX,SERIX,SOPIX,IMAGE)=""
SET ACTVIMG=1
End DoDot:5
+22 QUIT
End DoDot:4
+23 QUIT
End DoDot:3
if IMGLESS&ACTVIMG
QUIT
+24 QUIT
End DoDot:2
+25 QUIT
End DoDot:1
if PAT<0
QUIT
+26 IF PAT<0
SET @MAGOUT@(0)="0^Duplicate Study UID"
QUIT
+27 ;
+28 ; Get Study by graph ien
DO GETSTUDY(MAGOUT,.IARRAY,REFTYPE,REFIEN,CONTEXT)
+29 QUIT
+30 ;
GETSTUDY(MAGOUT,IARRAY,REFTYPE,REFIEN,CONTEXT) ; Get Study by graph ien
+1 NEW I,MAGNCNT,STYIX,SERIX,SOPIX,IMAGE
+2 ;
+3 IF '$DATA(IARRAY)
QUIT
+4 ;
+5 KILL ^TMP("MAGNVQ01",$JOB)
+6 SET ^TMP("MAGNVQ01",$JOB)=0
+7 ;
+8 SET STYIX=""
+9 FOR
SET STYIX=$ORDER(IARRAY(STYIX))
if 'STYIX
QUIT
Begin DoDot:1
+10 DO ASTUDY(STYIX,REFTYPE,REFIEN,CONTEXT)
+11 SET SERIX=""
+12 FOR
SET SERIX=$ORDER(IARRAY(STYIX,SERIX))
if 'SERIX
QUIT
Begin DoDot:2
+13 DO ASERIES(SERIX)
+14 SET SOPIX=""
+15 FOR
SET SOPIX=$ORDER(IARRAY(STYIX,SERIX,SOPIX))
if 'SOPIX
QUIT
Begin DoDot:3
+16 ; First image instance in SOP
SET IMAGE=$ORDER(IARRAY(STYIX,SERIX,SOPIX,""))
+17 DO ASOP(SOPIX,IMAGE)
+18 SET IMAGE=""
+19 FOR
SET IMAGE=$ORDER(IARRAY(STYIX,SERIX,SOPIX,IMAGE))
if 'IMAGE
QUIT
Begin DoDot:4
+20 DO AIMAGE(SOPIX,IMAGE)
+21 QUIT
End DoDot:4
+22 QUIT
End DoDot:3
+23 QUIT
End DoDot:2
+24 QUIT
End DoDot:1
+25 ;
+26 ; Append it to end result
+27 SET I=0
+28 SET MAGNCNT=$ORDER(@MAGOUT@(""),-1)
+29 FOR
SET I=$ORDER(^TMP("MAGNVQ01",$JOB,I))
if 'I
QUIT
Begin DoDot:1
+30 SET MAGNCNT=MAGNCNT+1
+31 SET @MAGOUT@(MAGNCNT)=^TMP("MAGNVQ01",$JOB,I)
+32 QUIT
End DoDot:1
+33 IF MAGNCNT
SET @MAGOUT@(0)=1
+34 QUIT
+35 ;
STUDYUID(REFTYPE,REFIEN,CONTEXT) ; Get Study UID by readiology report or TIU note
+1 NEW ACN,STDIEN
+2 ;
+3 IF REFTYPE="RAD"
SET ACN=$$ACNRAD^MAGNU003(REFIEN,CONTEXT)
+4 IF REFTYPE="TIU"
SET ACN=$$ACNTIU^MAGNU003(REFIEN)
+5 IF ACN=""
QUIT ""
+6 ;
+7 ; Get study UID IEN
SET STDIEN=$ORDER(^MAGV(2005.62,"D",ACN,""))
+8 ; Return study UID
QUIT $$GET1^DIQ(2005.62,STDIEN,".01")
+9 ;
WRTOUT(S) ; Write a new line
+1 NEW CNT
+2 SET CNT=^TMP("MAGNVQ01",$JOB)+1
+3 SET ^TMP("MAGNVQ01",$JOB)=CNT
+4 SET ^TMP("MAGNVQ01",$JOB,CNT)=S
+5 QUIT
+6 ;
ASTUDY(STYIX,REFTYPE,REFIEN,CONTEXT) ; Append Study section
+1 NEW FILESTD,IENSSTD,MAGDFN,MAGOUTST,MAGOUTPR,MAGERR,UID,INFO,PROCIX
+2 ;
+3 SET FILESTD=2005.62
+4 SET IENSSTD=STYIX_","
+5 DO GETS^DIQ(FILESTD,STYIX,"**","RIE","MAGOUTST","MAGERR")
+6 IF REFIEN=""
Begin DoDot:1
+7 NEW ACNUMB
+8 SET ACNUMB=MAGOUTST(FILESTD,IENSSTD,"ACCESSION NUMBER","I")
+9 ; Set Reference type by Accession Number
DO REFBYACN^MAGNU003(.REFTYPE,.REFIEN,ACNUMB)
+10 SET CONTEXT=$$CPRSCTX^MAGNU003(REFTYPE,REFIEN)
+11 QUIT
End DoDot:1
+12 ;
+13 SET UID=MAGOUTST(FILESTD,IENSSTD,"STUDY INSTANCE UID","I")
+14 DO WRTOUT("NEXT_STUDY|"_UID_"|NEW")
+15 DO WRTOUT("STUDY_UID|"_UID)
+16 DO WRTOUT("STUDY_IEN|"_$$STUDYIEN(.MAGOUTST,IENSSTD))
+17 DO WRTOUT("STUDY_INFO|"_$$STDINFO(.MAGOUTST,IENSSTD)_"|"_REFTYPE_"-"_REFIEN_"|"_CONTEXT)
+18 ;
+19 SET MAGDFN=MAGOUTST(FILESTD,IENSSTD,"PATIENT REFERENCE","E")
+20 DO WRTOUT("STUDY_PAT|"_MAGDFN_"|"_$SELECT($TEXT(GETICN^MPIF001)'="":$$GETICN^MPIF001(MAGDFN),1:"-1^NO MPI")_"|"_$PIECE($GET(^DPT(MAGDFN,0)),"^",1))
+21 ;
+22 DO WRTOUT("STUDY_MODALITY|"_MAGOUTST(FILESTD,IENSSTD,"MODALITIES IN STUDY","E"))
+23 QUIT
+24 ;
STUDYIEN(MAGOUTST,IENSSTD) ; Return study IEN section
+1 NEW INFO,FILESTD
+2 SET FILESTD=2005.62
+3 SET $PIECE(INFO,"|",1)=+IENSSTD
+4 SET $PIECE(INFO,"|",2)=$GET(MAGOUTST(FILESTD,IENSSTD,"NUMBER OF SOP INSTANCES","I"))
+5 QUIT INFO
+6 ;
STDINFO(MAGOUTST,IENSSTD) ; Return study info section
+1 NEW INFO,FILEPRC,PROCIX,IENSPRC,FILESTD,MAGOUTPR,MAGERR
+2 ;
+3 SET FILESTD=2005.62
+4 SET FILEPRC=2005.61
+5 SET PROCIX=MAGOUTST(FILESTD,IENSSTD,"PROCEDURE REFERENCE","I")
+6 SET IENSPRC=PROCIX_","
+7 DO GETS^DIQ(FILEPRC,PROCIX,"**","RIE","MAGOUTPR","MAGERR")
+8 ;
+9 SET $PIECE(INFO,U,4)=$$DTE^MAGSIXG3($GET(MAGOUTPR(FILEPRC,IENSPRC,"PROCEDURE DATE/TIME","I")))
+10 ; description
SET $PIECE(INFO,U,6)=$GET(MAGOUTST(FILESTD,IENSSTD,"DESCRIPTION","I"))
+11 SET $PIECE(INFO,U,8)=$GET(MAGOUTPR(FILEPRC,IENSPRC,"PACKAGE INDEX","I"))
+12 SET $PIECE(INFO,U,13)=$GET(MAGOUTST(FILESTD,IENSSTD,"ORIGIN INDEX","E"))
+13 ; study date
SET $PIECE(INFO,U,14)=$$DTE^MAGSIXG3($GET(MAGOUTST(FILESTD,IENSSTD,"STUDY DATE/TIME","I")))
+14 ; Accession number
SET $PIECE(INFO,U,20)=$GET(MAGOUTST(FILESTD,IENSSTD,"ACCESSION NUMBER","I"))
+15 QUIT INFO
+16 ;
ASERIES(SERIX) ; Append Series section
+1 NEW FILESER,IENSSER,MAGOUTSR,MAGERR
+2 SET FILESER=2005.63
+3 SET IENSSER=SERIX_","
+4 DO GETS^DIQ(FILESER,SERIX,"**","RIE","MAGOUTSR","MAGERR")
+5 ;
+6 DO WRTOUT("NEXT_SERIES")
+7 DO WRTOUT("SERIES_UID|"_$GET(MAGOUTSR(FILESER,IENSSER,"SERIES INSTANCE UID","I")))
+8 DO WRTOUT("SERIES_IEN|"_SERIX)
+9 DO WRTOUT("SERIES_MODALITY|"_$GET(MAGOUTSR(FILESER,IENSSER,"MODALITY","E")))
+10 DO WRTOUT("SERIES_NUMBER|"_$GET(MAGOUTSR(FILESER,IENSSER,"SERIES NUMBER","I")))
+11 DO WRTOUT("SERIES_CLASS_INDEX|"_$GET(MAGOUTSR(FILESER,IENSSER,"CLASS INDEX","I")))
+12 DO WRTOUT("SERIES_PROC/EVENT_INDEX|"_$GET(MAGOUTSR(FILESER,IENSSER,"PROC/EVENT INDEX","I")))
+13 DO WRTOUT("SERIES_SPEC/SUBSPEC_INDEX|"_$GET(MAGOUTSR(FILESER,IENSSER,"SPEC/SUBSPEC INDEX","I")))
+14 QUIT
+15 ;
ASOP(SOPIX,FIMAGE) ; Append SOP section
+1 NEW FILEIMG,I,IENSIMG,FILESOP,IENSSOP,MAGOUTIM,MAGOUTSO,MAGERR
+2 SET FILESOP=2005.64
+3 SET IENSSOP=SOPIX_","
+4 DO GETS^DIQ(FILESOP,SOPIX,"**","RIE","MAGOUTSO","MAGERR")
+5 DO WRTOUT("NEXT_IMAGE")
+6 DO WRTOUT("IMAGE_IEN|"_SOPIX)
+7 DO WRTOUT("IMAGE_UID|"_$GET(MAGOUTSO(FILESOP,IENSSOP,"SOP INSTANCE UID","E")))
+8 DO WRTOUT("IMAGE_NUMBER|"_$GET(MAGOUTSO(FILESOP,IENSSOP,"INSTANCE NUMBER","E")))
+9 DO WRTOUT("IMAGE_INFO|"_$$IMGINFO(.MAGOUTSO,IENSSOP,FIMAGE))
+10 DO WRTOUT("IMAGE_SOP_CLASS_UID|"_$GET(MAGOUTSO(FILESOP,IENSSOP,"SOP CLASS UID","E")))
+11 QUIT
+12 ;
AIMAGE(SOPIX,IMAGE) ; Append Image section
+1 NEW FILEIMG,IENSIMG,MAGOUTIM,MAGERR
+2 ;
+3 SET FILEIMG=2005.65
+4 SET IENSIMG=IMAGE_","
+5 DO GETS^DIQ(FILEIMG,IMAGE,"**","RIE","MAGOUTIM","MAGERR")
+6 ;
+7 ; Add Artifact Instance
DO AINST(MAGOUTIM(FILEIMG,IENSIMG,"ARTIFACT TOKEN","E"))
+8 QUIT
+9 ;
IMGINFO(MAGOUTSO,IENSSOP,FIMAGE) ;Get Image Info
+1 NEW INFO,FILESOP
+2 SET FILESOP=2005.64
+3 ;
+4 ; Image IEN
SET $PIECE(INFO,U,1)=+IENSSOP
+5 ;fullFilename
SET $PIECE(INFO,U,2)=""
+6 ;absFilename
SET $PIECE(INFO,U,3)=""
+7 ;description
SET $PIECE(INFO,U,4)=""
+8 SET $PIECE(INFO,U,5)=""
+9 ; Image type
SET $PIECE(INFO,U,6)=$GET(MAGOUTSO(FILESOP,IENSSOP,"TYPE INDEX","E"))
+10 ;procedure
SET $PIECE(INFO,U,7)=""
+11 ;procedureDate
SET $PIECE(INFO,U,8)=""
+12 SET $PIECE(INFO,U,9)=""
+13 ;absLocation
SET $PIECE(INFO,U,10)=""
+14 ;fullLocation
SET $PIECE(INFO,U,11)=""
+15 ;dicomSequenceNumberForDisplay
SET $PIECE(INFO,U,12)=""
+16 ;dicomImageNumberForDisplay
SET $PIECE(INFO,U,13)=""
+17 SET $PIECE(INFO,U,14)=""
+18 SET $PIECE(INFO,U,15)=""
+19 ;siteAbbr
SET $PIECE(INFO,U,16)=""
+20 ;qaMessage
SET $PIECE(INFO,U,17)=""
+21 ;bigFilename
SET $PIECE(INFO,U,18)=""
+22 ;patientDFN
SET $PIECE(INFO,U,19)=""
+23 ;patientName
SET $PIECE(INFO,U,20)=""
+24 ;imageClass
SET $PIECE(INFO,U,21)=""
+25 ; 09/12/2017 16:29:32 ;captureDate
SET $PIECE(INFO,U,22)=$$DTE($GET(MAGOUTSO(FILESOP,IENSSOP,"ACQUISITION DATE/TIME","I")))
+26 ;documentDate
SET $PIECE(INFO,U,23)=""
+27 ;is the IEN of the group for the image
SET $PIECE(INFO,U,24)=""
+28 ;is the IEN of the first image in a group
SET $PIECE(INFO,U,25)=""
+29 ;is the Image type of the first image in the group
SET $PIECE(INFO,U,26)=""
+30 SET $PIECE(INFO,U,27)=""
+31 ; CONFIDENTIAL /Sensitive Image
SET $PIECE(INFO,U,28)=$$GET1^DIQ(2005.65,FIMAGE,"18","I")
+32 ;viewStatusValue
SET $PIECE(INFO,U,29)=""
+33 ;statusValue
SET $PIECE(INFO,U,30)=""
+34 ;imageHasAnnotationsValue
SET $PIECE(INFO,U,31)=""
+35 ;associatedNoteResulted
SET $PIECE(INFO,U,32)=""
+36 ;imageAnnotationStatusValue
SET $PIECE(INFO,U,33)=""
+37 ;imageAnnotationStatusDescription
SET $PIECE(INFO,U,34)=""
+38 ;imagePackage
SET $PIECE(INFO,U,35)=""
+39 QUIT INFO
+40 ;
AINST(TOKEN) ; Add Artifact Instance
+1 NEW KEY,VALUE,LINE,IEN,I,RES,TMPARR,QT
+2 ; Get not deleted Artifact IEN by Token
DO GETAIENT^MAGVAG02(.RES,TOKEN,"")
+3 IF '$$ISOK^MAGVAF02(RES)
QUIT
+4 SET IEN=$$GETVAL^MAGVAF02(RES)
+5 DO GETAINST^MAGVAG04(.TMPARR,IEN)
+6 IF '$$ISOK^MAGVAF02(TMPARR(0))
QUIT
+7 SET QT=$CHAR(34)
+8 SET I=1
+9 FOR
SET I=$ORDER(TMPARR(I))
if 'I
QUIT
SET LINE=TMPARR(I)
if LINE["</ARTIFACTINSTANCES"
QUIT
Begin DoDot:1
+10 IF LINE["<ARTIFACTINSTANCE"
DO WRTOUT("NEXT_ARTIFACTINSTANCE")
QUIT
+11 IF LINE["</ARTIFACTINSTANCE"
QUIT
+12 SET KEY=$PIECE(TMPARR(I),"=",1)
+13 SET VALUE=$TRANSLATE($PIECE(TMPARR(I),"=",2),QT,"")
+14 ; special handling because of XML result set
SET VALUE=$PIECE(VALUE," >")
+15 DO WRTOUT("ARTIFACTINSTANCE_"_KEY_"|"_VALUE)
+16 ; Add Phisical address
IF KEY="DISKVOLUME"
Begin DoDot:2
+17 NEW LOCATION
+18 SET LOCATION=$$GET1^DIQ(2005.2,VALUE,"1")
+19 DO WRTOUT("ARTIFACTINSTANCE_PHYSICALREFERENCE|"_LOCATION)
+20 QUIT
End DoDot:2
+21 ; Add Storage provider name
IF KEY="STORAGEPROVIDER"
Begin DoDot:2
+22 DO WRTOUT("ARTIFACTINSTANCE_STORAGEPROVIDERTYPE|"_$$GET1^DIQ(2006.917,VALUE,"2"))
+23 QUIT
End DoDot:2
+24 ; Add ARTIFACT FORMAT
IF KEY="ARTIFACT"
Begin DoDot:2
+25 DO WRTOUT("ARTIFACTINSTANCE_ARTIFACTFORMAT|"_$$GET1^DIQ(2006.916,VALUE,"2:3"))
+26 QUIT
End DoDot:2
+27 QUIT
End DoDot:1
+28 QUIT
+29 ;
+30 ;+++++ PERFORMS SPECIAL CONVERSION OF THE DATE/TIME
DTE(DTI) ;
+1 QUIT $TRANSLATE($$FMTE^XLFDT(DTI,"5Z"),"@"," ")
