MAGDSTA9 ;WOIFO/PMK - Q/R Retrieve of DICOM images from PACS to VistA ; Aug 12, 2025@09:44:38
;;3.0;IMAGING;**231,306,333**;Mar 19, 2002;Build 2
;; Per VA Directive 6402, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | |
;; | 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 #10103 reference $$FMTE^XLFDT function call
;
Q
;
VERIFY ; get the parameters for this run
N PROMPT,X
W !!!?10,"F i n a l P a r a m e t e r C h e c k l i s t"
W !?10,"------------------------------------------------"
D DISPLAY
I ^TMP("MAG",$J,"BATCH Q/R","OPTION")="RETRIEVE MISSING IMAGES" D
. S PROMPT="Ready to retrieve missing DICOM images?"
. Q
E S PROMPT="Ready to compare image counts?"
I $$YESNO^MAGDSTQ(PROMPT,"y",.X)<0 S QUIT=1 Q
I X="YES" S QUIT=0
E W " -- ",^TMP("MAG",$J,"BATCH Q/R","OPTION")," not started" S QUIT=-1
Q
;
DISPLAY ; get and display the parameters
N BATCHSIZE,BEGDATE,CONSULTSERVICES,DFN,DILOCKTM,DISYS,DOB,ENDDATE,HOURS
N IMAGINGSERVICE,NAME,OPTION,QRSCP,SCANMODE,SERVICE,SORTORDER,SSN
;
N ACNUMB,STATUS,STUDYDATE,STUDYIEN ; not set
;
S IMAGINGSERVICE=^TMP("MAG",$J,"BATCH Q/R","IMAGING SERVICE")
M CONSULTSERVICES=^TMP("MAG",$J,"BATCH Q/R","CONSULT SERVICES") ; P333 PMK 08/12/2025
S QRSCP=^TMP("MAG",$J,"BATCH Q/R","PACS Q/R RETRIEVE SCP")
S OPTION=^TMP("MAG",$J,"BATCH Q/R","OPTION")
S SORTORDER=$G(^TMP("MAG",$J,"BATCH Q/R","SORT ORDER")) ; P333 PMK 08/12/2025
S BEGDATE=$G(^TMP("MAG",$J,"BATCH Q/R","BEGIN DATE"))
S ENDDATE=$G(^TMP("MAG",$J,"BATCH Q/R","END DATE"))
S BATCHSIZE=$G(^TMP("MAG",$J,"BATCH Q/R","BATCH SIZE"))
S HOURS=^TMP("MAG",$J,"BATCH Q/R","HOURS OF OPERATION")
S SCANMODE=^TMP("MAG",$J,"Q/R PARAM","SCAN MODE")
D DISPLAY1
Q
;
DISPLAY1 ; just display the parameters - called by ^MAGDSTA1
N I,J,LIST
N VA,VADM,VAERR,VAICN,VAIN,VAINFO,VAPA,X
W !,$$J("Imaging Service")
I IMAGINGSERVICE="CONSULTS" D ; display consult/procedure services
. S (I,J)=0
. F S I=$O(CONSULTSERVICES(I)) Q:I="" D
. . S J=J+1,LIST(J)=CONSULTSERVICES(I)
. . Q
. I J D
. . F I=1:1:J D
. . . S X=LIST(I)
. . . I ($L(X)+2)+$X>IOM W ",",!,?27 ; need new line
. . . E W:I>1 ", "
. . . W X
. . . Q
. . Q
. E W " -- *** Error: No Services Selected! ***"
. Q
E W IMAGINGSERVICE
W !,$$J("Query Retrieve Mode"),OPTION
W !,$$J("Scan Mode"),SCANMODE
W !,$$J("Query/Retrieve Provider"),QRSCP
W !,$$J("Study scanning order"),SORTORDER
I SCANMODE="NUMBER" D ; internal entry number order
. S IEN=$G(^TMP("MAG",$J,"BATCH Q/R","REPORT/STUDY IEN"))
. I IMAGINGSERVICE="RADIOLOGY" D
. . W !,$$J("Starting with report"),IEN
. . Q
. E D ; consults and procedures
. . W !,$$J("Starting with consult"),IEN
. . Q
. W !,$$J("Number of studies to retrieve"),BATCHSIZE
. Q
E I SCANMODE="PATIENT" D ; patient scan
. N I ; killed in DEM^VADPT
. S DFN=$G(^TMP("MAG",$J,"BATCH Q/R","PATIENT DFN"))
. D DEM^VADPT
. S NAME=VADM(1),DOB=$P(VADM(3),"^",2),SSN=$P(VADM(2),"^",2)
. W !,$$J("Patient Name"),NAME
. W !,$$J("Social Security Number"),SSN
. W !,$$J("Date of Birth"),DOB
. I SORTORDER="ASCENDING" D
. . W !,$$J("Earliest date for study"),$$FMTE^XLFDT(BEGDATE,1)
. . W !,$$J("Latest date for study"),$$FMTE^XLFDT(ENDDATE,1)
. . Q
. E D ; DESCENDING
. . W !,$$J("Latest date for study"),$$FMTE^XLFDT(ENDDATE,1)
. . W !,$$J("Earliest date for study"),$$FMTE^XLFDT(BEGDATE,1)
. . Q
. Q
E D ; date scan order
. I SORTORDER="ASCENDING" D
. . W !,$$J("Earliest date for study"),$$FMTE^XLFDT(BEGDATE,1)
. . W !,$$J("Latest date for study"),$$FMTE^XLFDT(ENDDATE,1)
. . Q
. E D ; DESCENDING
. . W !,$$J("Latest date for study"),$$FMTE^XLFDT(ENDDATE,1)
. . W !,$$J("Earliest date for study"),$$FMTE^XLFDT(BEGDATE,1)
. . Q
. Q
. Q
W !,$$J("Active hours of operation"),"M12345678901N12345678901 (M=midnight, N=noon)"
W !?27,HOURS
I $D(STATUS) D
. W !!,$$J("Status of Previous Run"),STATUS
. Q
I $D(STUDYDATE) D
. W !,$$J("Last Study Date"),$$FMTE^XLFDT(STUDYDATE)
. Q
I $D(ACNUMB) D
. W !,$$J("Accession Number"),ACNUMB
. Q
I $D(STUDYIEN) D
. W !,$$J("Last Report Number"),STUDYIEN
. Q
I $D(OUTPUTREPORT) D ; P333 PMK 11/03/2022
. W !,$$J("Report Date"),$P(OUTPUTREPORT,"^",1)
. W !,$$J("Report #"),$P(OUTPUTREPORT,"^",2)
. Q
Q
;
J(X) ; right justify field name and add colon & space
Q $J(X,25)_": "
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDSTA9 5150 printed Mar 25, 2026@15:26:21 Page 2
MAGDSTA9 ;WOIFO/PMK - Q/R Retrieve of DICOM images from PACS to VistA ; Aug 12, 2025@09:44:38
+1 ;;3.0;IMAGING;**231,306,333**;Mar 19, 2002;Build 2
+2 ;; Per VA Directive 6402, 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 ;; | |
+7 ;; | The Food and Drug Administration classifies this software as |
+8 ;; | a medical device. As such, it may not be changed in any way. |
+9 ;; | Modifications to this software may result in an adulterated |
+10 ;; | medical device under 21CFR820, the use of which is considered |
+11 ;; | to be a violation of US Federal Statutes. |
+12 ;; +---------------------------------------------------------------+
+13 ;;
+14 ;
+15 ; Supported IA #10061 reference DEM^VADPT subroutine call
+16 ; Supported IA #10103 reference $$FMTE^XLFDT function call
+17 ;
+18 QUIT
+19 ;
VERIFY ; get the parameters for this run
+1 NEW PROMPT,X
+2 WRITE !!!?10,"F i n a l P a r a m e t e r C h e c k l i s t"
+3 WRITE !?10,"------------------------------------------------"
+4 DO DISPLAY
+5 IF ^TMP("MAG",$JOB,"BATCH Q/R","OPTION")="RETRIEVE MISSING IMAGES"
Begin DoDot:1
+6 SET PROMPT="Ready to retrieve missing DICOM images?"
+7 QUIT
End DoDot:1
+8 IF '$TEST
SET PROMPT="Ready to compare image counts?"
+9 IF $$YESNO^MAGDSTQ(PROMPT,"y",.X)<0
SET QUIT=1
QUIT
+10 IF X="YES"
SET QUIT=0
+11 IF '$TEST
WRITE " -- ",^TMP("MAG",$JOB,"BATCH Q/R","OPTION")," not started"
SET QUIT=-1
+12 QUIT
+13 ;
DISPLAY ; get and display the parameters
+1 NEW BATCHSIZE,BEGDATE,CONSULTSERVICES,DFN,DILOCKTM,DISYS,DOB,ENDDATE,HOURS
+2 NEW IMAGINGSERVICE,NAME,OPTION,QRSCP,SCANMODE,SERVICE,SORTORDER,SSN
+3 ;
+4 ; not set
NEW ACNUMB,STATUS,STUDYDATE,STUDYIEN
+5 ;
+6 SET IMAGINGSERVICE=^TMP("MAG",$JOB,"BATCH Q/R","IMAGING SERVICE")
+7 ; P333 PMK 08/12/2025
MERGE CONSULTSERVICES=^TMP("MAG",$JOB,"BATCH Q/R","CONSULT SERVICES")
+8 SET QRSCP=^TMP("MAG",$JOB,"BATCH Q/R","PACS Q/R RETRIEVE SCP")
+9 SET OPTION=^TMP("MAG",$JOB,"BATCH Q/R","OPTION")
+10 ; P333 PMK 08/12/2025
SET SORTORDER=$GET(^TMP("MAG",$JOB,"BATCH Q/R","SORT ORDER"))
+11 SET BEGDATE=$GET(^TMP("MAG",$JOB,"BATCH Q/R","BEGIN DATE"))
+12 SET ENDDATE=$GET(^TMP("MAG",$JOB,"BATCH Q/R","END DATE"))
+13 SET BATCHSIZE=$GET(^TMP("MAG",$JOB,"BATCH Q/R","BATCH SIZE"))
+14 SET HOURS=^TMP("MAG",$JOB,"BATCH Q/R","HOURS OF OPERATION")
+15 SET SCANMODE=^TMP("MAG",$JOB,"Q/R PARAM","SCAN MODE")
+16 DO DISPLAY1
+17 QUIT
+18 ;
DISPLAY1 ; just display the parameters - called by ^MAGDSTA1
+1 NEW I,J,LIST
+2 NEW VA,VADM,VAERR,VAICN,VAIN,VAINFO,VAPA,X
+3 WRITE !,$$J("Imaging Service")
+4 ; display consult/procedure services
IF IMAGINGSERVICE="CONSULTS"
Begin DoDot:1
+5 SET (I,J)=0
+6 FOR
SET I=$ORDER(CONSULTSERVICES(I))
if I=""
QUIT
Begin DoDot:2
+7 SET J=J+1
SET LIST(J)=CONSULTSERVICES(I)
+8 QUIT
End DoDot:2
+9 IF J
Begin DoDot:2
+10 FOR I=1:1:J
Begin DoDot:3
+11 SET X=LIST(I)
+12 ; need new line
IF ($LENGTH(X)+2)+$X>IOM
WRITE ",",!,?27
+13 IF '$TEST
if I>1
WRITE ", "
+14 WRITE X
+15 QUIT
End DoDot:3
+16 QUIT
End DoDot:2
+17 IF '$TEST
WRITE " -- *** Error: No Services Selected! ***"
+18 QUIT
End DoDot:1
+19 IF '$TEST
WRITE IMAGINGSERVICE
+20 WRITE !,$$J("Query Retrieve Mode"),OPTION
+21 WRITE !,$$J("Scan Mode"),SCANMODE
+22 WRITE !,$$J("Query/Retrieve Provider"),QRSCP
+23 WRITE !,$$J("Study scanning order"),SORTORDER
+24 ; internal entry number order
IF SCANMODE="NUMBER"
Begin DoDot:1
+25 SET IEN=$GET(^TMP("MAG",$JOB,"BATCH Q/R","REPORT/STUDY IEN"))
+26 IF IMAGINGSERVICE="RADIOLOGY"
Begin DoDot:2
+27 WRITE !,$$J("Starting with report"),IEN
+28 QUIT
End DoDot:2
+29 ; consults and procedures
IF '$TEST
Begin DoDot:2
+30 WRITE !,$$J("Starting with consult"),IEN
+31 QUIT
End DoDot:2
+32 WRITE !,$$J("Number of studies to retrieve"),BATCHSIZE
+33 QUIT
End DoDot:1
+34 ; patient scan
IF '$TEST
IF SCANMODE="PATIENT"
Begin DoDot:1
+35 ; killed in DEM^VADPT
NEW I
+36 SET DFN=$GET(^TMP("MAG",$JOB,"BATCH Q/R","PATIENT DFN"))
+37 DO DEM^VADPT
+38 SET NAME=VADM(1)
SET DOB=$PIECE(VADM(3),"^",2)
SET SSN=$PIECE(VADM(2),"^",2)
+39 WRITE !,$$J("Patient Name"),NAME
+40 WRITE !,$$J("Social Security Number"),SSN
+41 WRITE !,$$J("Date of Birth"),DOB
+42 IF SORTORDER="ASCENDING"
Begin DoDot:2
+43 WRITE !,$$J("Earliest date for study"),$$FMTE^XLFDT(BEGDATE,1)
+44 WRITE !,$$J("Latest date for study"),$$FMTE^XLFDT(ENDDATE,1)
+45 QUIT
End DoDot:2
+46 ; DESCENDING
IF '$TEST
Begin DoDot:2
+47 WRITE !,$$J("Latest date for study"),$$FMTE^XLFDT(ENDDATE,1)
+48 WRITE !,$$J("Earliest date for study"),$$FMTE^XLFDT(BEGDATE,1)
+49 QUIT
End DoDot:2
+50 QUIT
End DoDot:1
+51 ; date scan order
IF '$TEST
Begin DoDot:1
+52 IF SORTORDER="ASCENDING"
Begin DoDot:2
+53 WRITE !,$$J("Earliest date for study"),$$FMTE^XLFDT(BEGDATE,1)
+54 WRITE !,$$J("Latest date for study"),$$FMTE^XLFDT(ENDDATE,1)
+55 QUIT
End DoDot:2
+56 ; DESCENDING
IF '$TEST
Begin DoDot:2
+57 WRITE !,$$J("Latest date for study"),$$FMTE^XLFDT(ENDDATE,1)
+58 WRITE !,$$J("Earliest date for study"),$$FMTE^XLFDT(BEGDATE,1)
+59 QUIT
End DoDot:2
+60 QUIT
+61 QUIT
End DoDot:1
+62 WRITE !,$$J("Active hours of operation"),"M12345678901N12345678901 (M=midnight, N=noon)"
+63 WRITE !?27,HOURS
+64 IF $DATA(STATUS)
Begin DoDot:1
+65 WRITE !!,$$J("Status of Previous Run"),STATUS
+66 QUIT
End DoDot:1
+67 IF $DATA(STUDYDATE)
Begin DoDot:1
+68 WRITE !,$$J("Last Study Date"),$$FMTE^XLFDT(STUDYDATE)
+69 QUIT
End DoDot:1
+70 IF $DATA(ACNUMB)
Begin DoDot:1
+71 WRITE !,$$J("Accession Number"),ACNUMB
+72 QUIT
End DoDot:1
+73 IF $DATA(STUDYIEN)
Begin DoDot:1
+74 WRITE !,$$J("Last Report Number"),STUDYIEN
+75 QUIT
End DoDot:1
+76 ; P333 PMK 11/03/2022
IF $DATA(OUTPUTREPORT)
Begin DoDot:1
+77 WRITE !,$$J("Report Date"),$PIECE(OUTPUTREPORT,"^",1)
+78 WRITE !,$$J("Report #"),$PIECE(OUTPUTREPORT,"^",2)
+79 QUIT
End DoDot:1
+80 QUIT
+81 ;
J(X) ; right justify field name and add colon & space
+1 QUIT $JUSTIFY(X,25)_": "
