MAGDSTAB ;WOIFO/PMK - Q/R Retrieve of DICOM images from PACS to VistA ; Mar 04, 2022@14:35:44
;;3.0;IMAGING;**231,306,305**;Mar 19, 2002;Build 3
;; 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. |
;; +---------------------------------------------------------------+
;;
;
; Supported IA #10061 reference DEM^VADPT subroutine call
; Supported IA #2541 reference $$KSP^XUPARAM function call
; Supported IA #2056 reference $$GET1^DIQ function call
;
Q
;
; QUERY and RETRIEVE are called by MAGDSTAA when
; there are no images for the study on VistA
;
; They is used to retrieve all the images for a study.
;
; There are two steps to the process.
; First, a query is performed to obtain the Study Instance UID
; Second, the retrieve is performed using the Study Instance UID
;
; If it is "query only mode" then, just the first step is done.
;
; Study Root Study Level query and retrieve are used,
; so ALL the images for the study are retrieved.
;
; Note: Patient identification information is not used
;
FINDSUID(ACNUMB,SSN,PACSSTUDYUID,SERIESCOUNT,IMAGECOUNT) ; get study instance uid
N I,L,RETURN
;
; check that accession number exists
I $G(ACNUMB)="" Q "-1,No Accession Number" ; nope
;
K ^TMP("MAG",$J,"Q/R QUERY")
I IMAGINGSERVICE="RADIOLOGY" D ; add accession number prefix to legacy radiology acn's
. S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"ACCESSION NUMBER")=$S($L(ACNUMB,"-")<3:$$ANPREFIX_ACNUMB,1:ACNUMB)
. Q
E S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"ACCESSION NUMBER")=ACNUMB
;
; P305 PMK 11/17/2021 - make last four digits optional
;
I $$ACNLAST4="Y" D ; default is NO
. ; P306 PMK 06/11/2021 - add last four digits of SSN (MRN) to PATIENT ID to make query unique
. ; when there are multiple studies with same accession because of PACS merges
. S L=$L(SSN) ; length of SSN=9; MRN may have a different length
. S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT ID")="*"_$E(SSN,L-3,L) ; * + last four digits
. Q
;
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"QUERY USER APPLICATION")=$$QRSCP^MAGDSTA8
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"QUERY LEVEL")="STUDY"
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"ROOT")="STUDY"
D SOPUIDQ^MAGDSTV1 ; C-FIND
;
; Note: There may be multiple study instance UIDs for a study
S (SERIESCOUNT,IMAGECOUNT)=0
F I=1:1 Q:'$D(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"STUDY",1,I)) D
. ; get PACS Study UIDs
. S PACSSTUDYUID(I)=$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"STUDY",1,I,"STUDYUID"))
. ; get number of study related series and study related sop instances
. S SERIESCOUNT=SERIESCOUNT+$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"STUDY",1,I,"NSTUDYRS"))
. S IMAGECOUNT=IMAGECOUNT+$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"STUDY",1,I,"NSTUDYRI"))
. Q
Q ""
;
;
MOVEALL() ; retrieve all the images for the study
N ERROR,I
;
S ERROR=""
; Note: There may be multiple study instance UIDs for a study
F I=1:1 Q:'$D(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"STUDY",1,I)) D Q:ERROR
. ; get the Study Instance UID needed to perform the retrieve
. S STUDYUID=$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"STUDY",1,I,"STUDYUID"))
. S ERROR=$$MOVEALL1(STUDYUID)
. I ERROR Q
. Q
Q ERROR
;
MOVEALL1(STUDYUID) ; retrieve all the images for the Study Instance UID
; retrieve the whole study
S STUDYUID=$G(STUDYUID)
I STUDYUID="" Q "-1,No Study UID"
;
K ^TMP("MAG",$J,"Q/R QUERY")
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"STUDY INSTANCE UID(0001)")=STUDYUID
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"QUERY USER APPLICATION")=$$QRSCP^MAGDSTA8
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"RETRIEVE LEVEL")="STUDY"
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"ROOT")="STUDY"
D SOPUIDR^MAGDSTV1 ; C-MOVE
Q ""
;
PARM ; set query/retrieve site parameters
N ANPREFIX,IEN,KSITEPAR
S KSITEPAR=$$KSP^XUPARAM("INST")
S IEN=$O(^MAG(2006.1,"B",KSITEPAR,""))
;
; get the accession number prefix, if there is one
S ANPREFIX=$$GETANPFX^MAGDSTQ1($$ANPREFIX)
S $P(^MAG(2006.1,IEN,7),"^",3)=ANPREFIX
;
; get the patient identifier dash or no dash
S DEFAULT=$$DASHES
I $$YESNO^MAGDSTQ("Include dashes in the DICOM Patient Identifier?",DEFAULT,.X)<0 Q
S $P(^MAG(2006.1,IEN,7),"^",4)=$E(X)
;
; get the patient identifier last 4 or no last 4
S DEFAULT=$$ACNLAST4
I $$YESNO^MAGDSTQ("Use LAST 4 in the PID with Accession Number in the automatic query?",DEFAULT,.X)<0 Q
S $P(^MAG(2006.1,IEN,7),"^",7)=$E(X)
;
; get the check study division switch
N HELP
S HELP(1)="If there are VistA Imaging file servers at other divisions, answer ""Y""."
S HELP(2)=" Then only studies for this division will be processed,"
S HELP(3)=" and those for the other divisions will be ignored."
S HELP(4)=""
S HELP(5)="If there is only one VistA Imaging file server for all divisions, answer ""N""."
S HELP(6)=" Then all the studies will be processed."
S DEFAULT=$$CHECKDIV
I $$YESNO^MAGDSTQ("Select only studies for the current division for auto compare/retrieve?",DEFAULT,.X,.HELP)<0 Q
S $P(^MAG(2006.1,IEN,8),"^",1)=$E(X)
;
D CONTINUE^MAGDSTQ
Q
;
ANPREFIX() ; Get the value of the accession number prefix
N IEN,KSITEPAR
S KSITEPAR=$$KSP^XUPARAM("INST")
S IEN=$O(^MAG(2006.1,"B",KSITEPAR,""))
Q $$GET1^DIQ(2006.1,IEN,206)
;
DASHES() ; Get the value of the patient identifier dashes
N IEN,KSITPAR
S KSITEPAR=$$KSP^XUPARAM("INST")
S IEN=$O(^MAG(2006.1,"B",KSITEPAR,""))
Q $$GET1^DIQ(2006.1,IEN,207,"I")
;
ACNLAST4() ; Get the value of the last 4 query key
N IEN,KSITEPAR
S KSITEPAR=$$KSP^XUPARAM("INST")
S IEN=$O(^MAG(2006.1,"B",KSITEPAR,""))
Q $$GET1^DIQ(2006.1,IEN,210,"I")
;
CHECKDIV() ; Get the value of the check study division switch
N IEN,KSITEPAR
S KSITEPAR=$$KSP^XUPARAM("INST")
S IEN=$O(^MAG(2006.1,"B",KSITEPAR,""))
Q $$GET1^DIQ(2006.1,IEN,211,"I")
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDSTAB 6726 printed Apr 09, 2024@21:06:45 Page 2
MAGDSTAB ;WOIFO/PMK - Q/R Retrieve of DICOM images from PACS to VistA ; Mar 04, 2022@14:35:44
+1 ;;3.0;IMAGING;**231,306,305**;Mar 19, 2002;Build 3
+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 ;
+18 ; Supported IA #10061 reference DEM^VADPT subroutine call
+19 ; Supported IA #2541 reference $$KSP^XUPARAM function call
+20 ; Supported IA #2056 reference $$GET1^DIQ function call
+21 ;
+22 QUIT
+23 ;
+24 ; QUERY and RETRIEVE are called by MAGDSTAA when
+25 ; there are no images for the study on VistA
+26 ;
+27 ; They is used to retrieve all the images for a study.
+28 ;
+29 ; There are two steps to the process.
+30 ; First, a query is performed to obtain the Study Instance UID
+31 ; Second, the retrieve is performed using the Study Instance UID
+32 ;
+33 ; If it is "query only mode" then, just the first step is done.
+34 ;
+35 ; Study Root Study Level query and retrieve are used,
+36 ; so ALL the images for the study are retrieved.
+37 ;
+38 ; Note: Patient identification information is not used
+39 ;
FINDSUID(ACNUMB,SSN,PACSSTUDYUID,SERIESCOUNT,IMAGECOUNT) ; get study instance uid
+1 NEW I,L,RETURN
+2 ;
+3 ; check that accession number exists
+4 ; nope
IF $GET(ACNUMB)=""
QUIT "-1,No Accession Number"
+5 ;
+6 KILL ^TMP("MAG",$JOB,"Q/R QUERY")
+7 ; add accession number prefix to legacy radiology acn's
IF IMAGINGSERVICE="RADIOLOGY"
Begin DoDot:1
+8 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"ACCESSION NUMBER")=$SELECT($LENGTH(ACNUMB,"-")<3:$$ANPREFIX_ACNUMB,1:ACNUMB)
+9 QUIT
End DoDot:1
+10 IF '$TEST
SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"ACCESSION NUMBER")=ACNUMB
+11 ;
+12 ; P305 PMK 11/17/2021 - make last four digits optional
+13 ;
+14 ; default is NO
IF $$ACNLAST4="Y"
Begin DoDot:1
+15 ; P306 PMK 06/11/2021 - add last four digits of SSN (MRN) to PATIENT ID to make query unique
+16 ; when there are multiple studies with same accession because of PACS merges
+17 ; length of SSN=9; MRN may have a different length
SET L=$LENGTH(SSN)
+18 ; * + last four digits
SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"PATIENT ID")="*"_$EXTRACT(SSN,L-3,L)
+19 QUIT
End DoDot:1
+20 ;
+21 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"QUERY USER APPLICATION")=$$QRSCP^MAGDSTA8
+22 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"QUERY LEVEL")="STUDY"
+23 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"ROOT")="STUDY"
+24 ; C-FIND
DO SOPUIDQ^MAGDSTV1
+25 ;
+26 ; Note: There may be multiple study instance UIDs for a study
+27 SET (SERIESCOUNT,IMAGECOUNT)=0
+28 FOR I=1:1
if '$DATA(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"STUDY",1,I))
QUIT
Begin DoDot:1
+29 ; get PACS Study UIDs
+30 SET PACSSTUDYUID(I)=$GET(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"STUDY",1,I,"STUDYUID"))
+31 ; get number of study related series and study related sop instances
+32 SET SERIESCOUNT=SERIESCOUNT+$GET(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"STUDY",1,I,"NSTUDYRS"))
+33 SET IMAGECOUNT=IMAGECOUNT+$GET(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"STUDY",1,I,"NSTUDYRI"))
+34 QUIT
End DoDot:1
+35 QUIT ""
+36 ;
+37 ;
MOVEALL() ; retrieve all the images for the study
+1 NEW ERROR,I
+2 ;
+3 SET ERROR=""
+4 ; Note: There may be multiple study instance UIDs for a study
+5 FOR I=1:1
if '$DATA(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"STUDY",1,I))
QUIT
Begin DoDot:1
+6 ; get the Study Instance UID needed to perform the retrieve
+7 SET STUDYUID=$GET(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"STUDY",1,I,"STUDYUID"))
+8 SET ERROR=$$MOVEALL1(STUDYUID)
+9 IF ERROR
QUIT
+10 QUIT
End DoDot:1
if ERROR
QUIT
+11 QUIT ERROR
+12 ;
MOVEALL1(STUDYUID) ; retrieve all the images for the Study Instance UID
+1 ; retrieve the whole study
+2 SET STUDYUID=$GET(STUDYUID)
+3 IF STUDYUID=""
QUIT "-1,No Study UID"
+4 ;
+5 KILL ^TMP("MAG",$JOB,"Q/R QUERY")
+6 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"STUDY INSTANCE UID(0001)")=STUDYUID
+7 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"QUERY USER APPLICATION")=$$QRSCP^MAGDSTA8
+8 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"RETRIEVE LEVEL")="STUDY"
+9 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"ROOT")="STUDY"
+10 ; C-MOVE
DO SOPUIDR^MAGDSTV1
+11 QUIT ""
+12 ;
PARM ; set query/retrieve site parameters
+1 NEW ANPREFIX,IEN,KSITEPAR
+2 SET KSITEPAR=$$KSP^XUPARAM("INST")
+3 SET IEN=$ORDER(^MAG(2006.1,"B",KSITEPAR,""))
+4 ;
+5 ; get the accession number prefix, if there is one
+6 SET ANPREFIX=$$GETANPFX^MAGDSTQ1($$ANPREFIX)
+7 SET $PIECE(^MAG(2006.1,IEN,7),"^",3)=ANPREFIX
+8 ;
+9 ; get the patient identifier dash or no dash
+10 SET DEFAULT=$$DASHES
+11 IF $$YESNO^MAGDSTQ("Include dashes in the DICOM Patient Identifier?",DEFAULT,.X)<0
QUIT
+12 SET $PIECE(^MAG(2006.1,IEN,7),"^",4)=$EXTRACT(X)
+13 ;
+14 ; get the patient identifier last 4 or no last 4
+15 SET DEFAULT=$$ACNLAST4
+16 IF $$YESNO^MAGDSTQ("Use LAST 4 in the PID with Accession Number in the automatic query?",DEFAULT,.X)<0
QUIT
+17 SET $PIECE(^MAG(2006.1,IEN,7),"^",7)=$EXTRACT(X)
+18 ;
+19 ; get the check study division switch
+20 NEW HELP
+21 SET HELP(1)="If there are VistA Imaging file servers at other divisions, answer ""Y""."
+22 SET HELP(2)=" Then only studies for this division will be processed,"
+23 SET HELP(3)=" and those for the other divisions will be ignored."
+24 SET HELP(4)=""
+25 SET HELP(5)="If there is only one VistA Imaging file server for all divisions, answer ""N""."
+26 SET HELP(6)=" Then all the studies will be processed."
+27 SET DEFAULT=$$CHECKDIV
+28 IF $$YESNO^MAGDSTQ("Select only studies for the current division for auto compare/retrieve?",DEFAULT,.X,.HELP)<0
QUIT
+29 SET $PIECE(^MAG(2006.1,IEN,8),"^",1)=$EXTRACT(X)
+30 ;
+31 DO CONTINUE^MAGDSTQ
+32 QUIT
+33 ;
ANPREFIX() ; Get the value of the accession number prefix
+1 NEW IEN,KSITEPAR
+2 SET KSITEPAR=$$KSP^XUPARAM("INST")
+3 SET IEN=$ORDER(^MAG(2006.1,"B",KSITEPAR,""))
+4 QUIT $$GET1^DIQ(2006.1,IEN,206)
+5 ;
DASHES() ; Get the value of the patient identifier dashes
+1 NEW IEN,KSITPAR
+2 SET KSITEPAR=$$KSP^XUPARAM("INST")
+3 SET IEN=$ORDER(^MAG(2006.1,"B",KSITEPAR,""))
+4 QUIT $$GET1^DIQ(2006.1,IEN,207,"I")
+5 ;
ACNLAST4() ; Get the value of the last 4 query key
+1 NEW IEN,KSITEPAR
+2 SET KSITEPAR=$$KSP^XUPARAM("INST")
+3 SET IEN=$ORDER(^MAG(2006.1,"B",KSITEPAR,""))
+4 QUIT $$GET1^DIQ(2006.1,IEN,210,"I")
+5 ;
CHECKDIV() ; Get the value of the check study division switch
+1 NEW IEN,KSITEPAR
+2 SET KSITEPAR=$$KSP^XUPARAM("INST")
+3 SET IEN=$ORDER(^MAG(2006.1,"B",KSITEPAR,""))
+4 QUIT $$GET1^DIQ(2006.1,IEN,211,"I")
+5 ;
