- 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 Feb 18, 2025@23:28:15 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 ;