MAGDSTAA ;WOIFO/PMK - Q/R Retrieve of DICOM images from PACS to VistA ; Aug 14, 2025@09:05:58
;;3.0;IMAGING;**231,306,305,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 #10063 reference $$S^%ZTLOAD function call
; Supported IA #10103 reference $$FMTE^XLFDT function call
; Supported IA #10103 reference $$NOW^XLFDT function call
; Supported IA #2056 reference $$GET1^DIQ function call
; Supported IA #10035 to read PATIENT file (#2)
;
Q
;
LOOKUP(DFN,STUDYDATE,STUDYIEN,ACNUMB,MAGIENLIST) ; called by MAGDSTA5 and MAGDSTA7
; STUDYDATE ---- date of study
; STUDYIEN ----- RARPT1 or GMRCIEN
; ACNUMB ------- accession number
; MAGIENLIST --- array of MAGIEN pointers
; VISTAUIDFLAG - flag to indicate that an acn query failed
;
N ERROR,EXAMDATE,I,IMAGECOUNT,MAGGLIST,MAGIEN,NONDICOM,SSN,TEXTCNT
N PACS,RUNTIME,SERIESCOUNT,PACSSTUDYUID,VISTASTUDYUID,VISTA,X
;
D STTINC("VISTA STUDIES PROCESSED",1)
S RUNTIME=$$NOW^XLFDT()
S $P(^MAGDSTT(2006.543,RUNNUMBER,0),"^",3)=RUNTIME ; updated during the run
S $P(^MAGDSTT(2006.543,RUNNUMBER,0),"^",5)="RUNNING"
S $P(^MAGDSTT(2006.543,RUNNUMBER,0),"^",15)=DFN
S $P(^MAGDSTT(2006.543,RUNNUMBER,0),"^",16)=STUDYDATE
S $P(^MAGDSTT(2006.543,RUNNUMBER,0),"^",17)=STUDYIEN
S $P(^MAGDSTT(2006.543,RUNNUMBER,0),"^",18)=ACNUMB
;
I $$SUSPEND(HOURS) Q 1 ; stop
I $Y>(IOSL-6) W !! D HEADER(1)
;
S (NONDICOM,TEXTCNT)=0,IMAGES="NONE"
W !,$J(STUDYIEN,8),?11,ACNUMB,?30,$P($$FMTE^XLFDT(STUDYDATE,"2Z"),"@",1)
D CSVNEWLINE
; lookup legacy 2005 image group pointers
K ^TMP("MAG",$J,"UIDS") ; remove the list of UIDs for the VistA study
S MAGIEN=""
F I=1:1 S MAGIEN=$O(MAGIENLIST(MAGIEN)) Q:MAGIEN="" D
. I I>1 W ! D CSVSAVE(0,0),CSVNEWLINE
. W ?40,$J(MAGIEN,8) D CSVSAVE(MAGIEN)
. D LEGACY^MAGDSTA8(MAGIEN,.SERIESCOUNT,.IMAGECOUNT) ; count images in all groups
. I SERIESCOUNT D
. . W ?52,$J(SERIESCOUNT,5) D CSVSAVE(SERIESCOUNT)
. . Q
. E D
. . I IMAGECOUNT D
. . . W ?52,$J("",5) ; same as previous series, don't show count
. . . D CSVSAVE(0)
. . . Q
. . E D
. . . W ?55,"non-DICOM" ; not DICOM, maybe TGA, JPEG, PDF, etc.
. . . D CSVSAVE("non-DICOM","non-DICOM")
. . . S NONDICOM=1
. . . Q
. . Q
. I IMAGECOUNT D
. . W ?59,$J(IMAGECOUNT,5) D CSVSAVE(IMAGECOUNT)
. . Q
. D STTINC("LEGACY STUDIES PROCESSED",1)
. D STTINC("LEGACY SERIES COUNT",SERIESCOUNT)
. D STTINC("LEGACY IMAGE COUNT",IMAGECOUNT)
. ;
. ; save VistA counts for later steps
. ; Note: These counts may be for multiple study instance UIDs
. S VISTA("SERIES COUNT")=$G(VISTA("SERIES COUNT"),0)+$G(SERIESCOUNT,0)
. S VISTA("IMAGE COUNT")=$G(VISTA("IMAGE COUNT"),0)+$G(IMAGECOUNT,0)
. Q
;
; look up in new sop class database (P34)
D NEWSOPDB^MAGDSTA8(ACNUMB,.SERIESCOUNT,.IMAGECOUNT)
I IMAGECOUNT>0 D
. I $D(MAGIENLIST) D
. . W ! D CSVNEWLINE ; P333 PMK 08/04/2025
. . Q
. W ?41,"NEW SOP",?52,$J(SERIESCOUNT,5),?59,$J(IMAGECOUNT,5)
. D CSVSAVE("NEW SOP",SERIESCOUNT,IMAGECOUNT)
. D STTINC("NEW SOP CLASS STUDIES PROCESSED",1)
. D STTINC("NEW SOP CLASS SERIES COUNT",SERIESCOUNT)
. D STTINC("NEW SOP CLASS IMAGE COUNT",IMAGECOUNT)
. Q
;
; update legacy and new database VistA counts for later steps
S VISTA("SERIES COUNT")=$G(VISTA("SERIES COUNT"),0)+$G(SERIESCOUNT,0)
S VISTA("IMAGE COUNT")=$G(VISTA("IMAGE COUNT"),0)+$G(IMAGECOUNT,0)
;
K PACSSTUDYUID
S VISTAUIDFLAG=0
; perform Accession Number query to obtain the Study Instance UID & counts from PACS
S SSN=$$GET1^DIQ(2,DFN,.09,"E") ; P306 PMK 06/11/2021 use last 4 of SSN to make query unique
S ERROR=$$FINDSUID^MAGDSTAB(ACNUMB,SSN,.PACSSTUDYUID,.SERIESCOUNT,.IMAGECOUNT)
;
I VISTA("IMAGE COUNT")=0 D ; no DICOM images on file in VistA
. I NONDICOM=0 D
. . W ?46,"--",?55,"--",?62,"--" D CSVSAVE(0,0,0)
. . Q
. D STTINC("VISTA STUDIES WITHOUT DICOM IMAGES",1)
. Q
E I '$D(PACSSTUDYUID) D
. ; perform queries using the VistA Study Instance UID to get the image and series counts
. S (I,VISTASTUDYUID)=0 ; build array of VistA Study Instance UIDs for the query
. F S VISTASTUDYUID=$O(^TMP("MAG",$J,"UIDS","VISTA",VISTASTUDYUID)) Q:VISTASTUDYUID="" D
. . S I=I+1,PACSSTUDYUID(I)=VISTASTUDYUID
. . Q
. S ERROR=$$QUERY^MAGDSTAC(.PACSSTUDYUID,.SERIESCOUNT,.IMAGECOUNT)
. I $D(PACSSTUDYUID(1)) S VISTAUIDFLAG=1
. Q
;
; Note: These counts may be for multiple study instance UIDs
S PACS("SERIES COUNT")=SERIESCOUNT,PACS("IMAGE COUNT")=IMAGECOUNT
I SERIESCOUNT D
. W ?67,$J(SERIESCOUNT,5),?74,$J(IMAGECOUNT,5)
. D CSVSAVE(SERIESCOUNT,IMAGECOUNT)
. D STTINC("PACS STUDIES PROCESSED",1)
. D STTINC("PACS SERIES COUNT",SERIESCOUNT)
. D STTINC("PACS IMAGE COUNT",IMAGECOUNT)
. I VISTAUIDFLAG D
. . W !," (Query with Accession Number failed, but worked with VistA Study Instance UID)"
. . Q
. Q
E D
. W ?70,"--",?77,"--" D CSVSAVE(0,0)
. D STTINC("PACS STUDIES WITHOUT IMAGES",1)
. Q
;
I ^TMP("MAG",$J,"BATCH Q/R","OPTION")="RETRIEVE MISSING IMAGES" D
. S ERROR=$$RETRIEVE^MAGDSTAC(.PACSSTUDYUID)
. Q
;
;
; cleanup
K ^TMP("MAG",$J,"DICOM"),^("Q/R QUERY"),^("UIDS")
Q 0
;
;
S CONTINUE=$G(CONTINUE,1)
S CLEARSCREEN=$G(CLEARSCREEN,1)
I $G(AUTOSCROLL)'="YES" D
. I CONTINUE D CONTINUE^MAGDSTQ(0)
. I CLEARSCREEN W @IOF
. E W !! S $Y=0
. Q
E W !! S $Y=0
W $$FMTE^XLFDT($$NOW^XLFDT,1),?55,"VistA",?71,"PACS"
W !,"Report #",?11,"Accession Number",?32,"Date",?40,"Group #",?51,"Series Images",?66,"Series Images"
I ^TMP("MAG",$J,"BATCH Q/R","OPTION")="RETRIEVE MISSING IMAGES" D
. W ?82,"Retrieve Status"
. Q
W !,"--------",?11,"----------------",?30,"--------",?40,"--------",?51,"------ ------",?66,"------ ------"
I ^TMP("MAG",$J,"BATCH Q/R","OPTION")="RETRIEVE MISSING IMAGES" D
. W ?82,"-------- ------"
. Q
Q
;
CSVNEWLINE ; output the beginning of the new line for the CSV Excel file
D CSVSAVE("") ; start the next record
D CSVSAVE(STUDYIEN,ACNUMB)
D CSVSAVE($P($$FMTE^XLFDT(STUDYDATE,"2Z"),"@",1))
Q
;
CSVSAVE(D0,D1,D2,D3,D4,D6,D7,D8,D9) ; save values in CSV format
N DATA,I,VAR
I OUTPUTEXCEL="" Q ; no CSV file to be generated
F I=0:1:9 S VAR="D"_I I $D(@VAR) S DATA=@VAR D
. I DATA="" D
. . D SAVE^MAGDSTA0(OUTPUTEXCEL,"") ; start the next record
. . Q
. E D
. . I DATA["," S DATA=""""_DATA_""""
. . D SAVE^MAGDSTA0(OUTPUTEXCEL,DATA_DEL,1) ; concatenate
. . Q
. Q
Q
;
QRSTATUS(TEXT) ; output query/retrieve status text
I $Y>(IOSL-4) D HEADER(1)
I $X>82 W !
W ?82,TEXT I OUTPUTEXCEL'="" D
. S TEXTCNT=TEXTCNT+1 I TEXTCNT>1 D SAVE^MAGDSTA0(OUTPUTEXCEL,"; ",1)
. I TEXT["," D SAVE^MAGDSTA0(OUTPUTEXCEL,""""_TEXT_"""",1)
. E D SAVE^MAGDSTA0(OUTPUTEXCEL,TEXT,1)
Q
;
SUSPEND(HOURS) ; check date/time & request to stop
; HOURS is a 24 character string of Y's and N's indicating active times
; Assume that Saturday and Sunday are 24 hours
N DONE,FIRSTTIME,TICKER,X
;
I SCANMODE="ACCESSION" Q 0 ; don't check for accession number scans
;
S (DONE,TICKER)=0,FIRSTTIME=1
I "23"[($H#7) S HOURS=$TR($J("",24)," ","Y") ; Saturday and Sunday
F D Q:DONE
. I $G(^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,$J,"STATUS"))'="RUN" D Q ; menu stop
. . S DONE=-1 ; indicates user stop task
. . W !!,"User requested VistA Automatic Q/R Processing to stop at ",$$FMTE^XLFDT($$NOW^XLFDT,1)
. . Q
. I $$S^%ZTLOAD("Stopping "_ZTDESC) D Q ; user has asked task to stop
. . S DONE=-1 ; indicates user stop task
. . S ZTSTOP=1 ; notify submanager of response to user's STOP request
. . W !!,"User requested task to stop at ",$$FMTE^XLFDT($$NOW^XLFDT,1)
. . Q
. S X=$E(HOURS,$P($H,",",2)\3600+1)
. I X="Y" S DONE=1
. E D ; suspend run
. . I FIRSTTIME W !!,"Waiting for time to start " S FIRSTTIME=0
. . ; Show "idle" marker
. . S TICKER=TICKER+1 S:TICKER<1 TICKER=1 S:TICKER>4 TICKER=1
. . I $E(IOST,1,2)="C-" W $E("-\|/",TICKER),$C(8)
. . H 1
. . Q
. Q
Q $S(DONE=1:0,1:DONE)
;
STOP ; stop job
N COUNT,DONE,LIST,X
S COUNT=$$STOP1(.LIST)
I 'COUNT D
. W !!,"No VistA Automatic Q/R Processes appear to be running."
. Q
E D
. D STOP2(.LIST,COUNT)
. I COUNT=1 D
. . S ERROR=$$YESNO^MAGDSTQ("Stop this process?","y",.X)
. . I ERROR<0 W " YESNO ERROR" Q
. . I X="YES" D
. . . D STOP3(.LIST,1)
. . . Q
. . Q
. E D
. . S DONE=0 F D Q:DONE
. . . W !!,"Enter 1-",COUNT," to stop a procss: "
. . . R X:DTIME E S X="^"
. . . I X="" W " -- nothing selected" Q
. . . I X["^" S DONE=-11 Q
. . . I X?1N.N,X,X'>COUNT D
. . . . D STOP3(.LIST,X)
. . . . S DONE=1
. . . . Q
. . . E D
. . . . W " ???"
. . . . Q
. . . Q
. . Q
. Q
D CONTINUE^MAGDSTQ
Q
;
STOP1(LIST) ; get list of running VistA Automatic Q/R Processes
N COUNT,HOSTNAME,I,JOB,MAGXTMP
S COUNT=0
S MAGXTMP="MAG Q/R Client"
F S MAGXTMP=$O(^XTMP(MAGXTMP)) Q:MAGXTMP'?1"MAG Q/R Client".E D
. S HOSTNAME=""
. F S HOSTNAME=$O(^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME)) Q:HOSTNAME="" D
. . S JOB=0
. . F S JOB=$O(^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,JOB)) Q:'JOB D
. . . S COUNT=COUNT+1
. . . S LIST(COUNT)=MAGXTMP_"^"_HOSTNAME_"^"_JOB
. . . Q
. . Q
. Q
Q COUNT
;
STOP2(LIST,COUNT) ; display the jobs
N HOSTNAME,I,JOB,MAGXTMP
F I=1:1:COUNT D
. S MAGXTMP=$P(LIST(I),"^",1),HOSTNAME=$P(LIST(I),"^",2),JOB=$P(LIST(I),"^",3)
. W ! W:COUNT>1 $J(I,2),")"
. W ?4,^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,JOB,"IMAGING SERVICE")
. W ?20,^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,JOB,"OPTION")
. W ?50,"Started: ",$$FMTE^XLFDT(^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,JOB,"START TIME"),"2MP")
. Q
Q
;
STOP3(LIST,I) ; signal the process to stop by killing the "STATUS" node
N HOSTNAME,JOB,MAGXTMP
S MAGXTMP=$P(LIST(I),"^",1),HOSTNAME=$P(LIST(I),"^",2),JOB=$P(LIST(I),"^",3)
K ^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,JOB)
W !!,"VistA Automatic Q/R Processing will stop soon."
Q
;
STTWRITE(NAME,VALUE) ; write statistics for the run
N IEN
S VALUE=$G(VALUE)
S IEN=$$STTNAME(NAME) Q:IEN<0
I IEN>0 D STTUPDT(NAME,VALUE) Q ; use update instead
S IEN=$O(^MAGDSTT(2006.543,RUNNUMBER,2,"B"),-1)+1
S ^MAGDSTT(2006.543,RUNNUMBER,2,IEN,0)=NAME_"^"_VALUE
S ^MAGDSTT(2006.543,RUNNUMBER,2,"B",NAME,IEN)=""
S ^MAGDSTT(2006.543,RUNNUMBER,2,0)="^2006.5432^"_IEN_"^"_IEN
Q
;
STTREAD(NAME) ; read a statistics parameter
N IEN
S IEN=$$STTNAME(NAME) Q:IEN<0
I IEN="" D Q ""
. W !,"*** ERROR in STTREAD^",$T(+0)," ***"
. W !,"NAME """,NAME,""" is not defined in"
. W " ^MAGDSTT(2006.543,",RUNNUMBER,")."
. Q
Q $P(^MAGDSTT(2006.543,RUNNUMBER,2,IEN,0),"^",2)
;
STTUPDT(NAME,VALUE) ; update a statistics parameter
N IEN
S VALUE=$G(VALUE)
S IEN=$$STTNAME(NAME) Q:IEN<0
I IEN="" D STTWRITE(NAME,VALUE) Q
S $P(^MAGDSTT(2006.543,RUNNUMBER,2,IEN,0),"^",2)=VALUE
Q
;
STTINC(NAME,VALUE) ; increment a statistics parameter
N IEN
S VALUE=+$G(VALUE)
S IEN=$$STTNAME(NAME) Q:IEN<0
I IEN="" D STTWRITE(NAME,VALUE) Q
S $P(^(0),"^",2)=$P(^MAGDSTT(2006.543,RUNNUMBER,2,IEN,0),"^",2)+VALUE
Q
;
STTNAME(NAME) ; get IEN for NAME
; return: -1 for an error, "" for no NAME, IEN otherwise
N IEN
S NAME=$G(NAME)
I NAME="" D Q -1
. W !,"*** ERROR in STTNAME^",$T(+0)
. W " NAME is null or undefined ***"
. Q
; check for existence of the statistical parameter
S IEN=$O(^MAGDSTT(2006.543,RUNNUMBER,2,"B",NAME,""))
Q IEN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDSTAA 12235 printed Mar 25, 2026@15:26:22 Page 2
MAGDSTAA ;WOIFO/PMK - Q/R Retrieve of DICOM images from PACS to VistA ; Aug 14, 2025@09:05:58
+1 ;;3.0;IMAGING;**231,306,305,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 #10063 reference $$S^%ZTLOAD function call
+16 ; Supported IA #10103 reference $$FMTE^XLFDT function call
+17 ; Supported IA #10103 reference $$NOW^XLFDT function call
+18 ; Supported IA #2056 reference $$GET1^DIQ function call
+19 ; Supported IA #10035 to read PATIENT file (#2)
+20 ;
+21 QUIT
+22 ;
LOOKUP(DFN,STUDYDATE,STUDYIEN,ACNUMB,MAGIENLIST) ; called by MAGDSTA5 and MAGDSTA7
+1 ; STUDYDATE ---- date of study
+2 ; STUDYIEN ----- RARPT1 or GMRCIEN
+3 ; ACNUMB ------- accession number
+4 ; MAGIENLIST --- array of MAGIEN pointers
+5 ; VISTAUIDFLAG - flag to indicate that an acn query failed
+6 ;
+7 NEW ERROR,EXAMDATE,I,IMAGECOUNT,MAGGLIST,MAGIEN,NONDICOM,SSN,TEXTCNT
+8 NEW PACS,RUNTIME,SERIESCOUNT,PACSSTUDYUID,VISTASTUDYUID,VISTA,X
+9 ;
+10 DO STTINC("VISTA STUDIES PROCESSED",1)
+11 SET RUNTIME=$$NOW^XLFDT()
+12 ; updated during the run
SET $PIECE(^MAGDSTT(2006.543,RUNNUMBER,0),"^",3)=RUNTIME
+13 SET $PIECE(^MAGDSTT(2006.543,RUNNUMBER,0),"^",5)="RUNNING"
+14 SET $PIECE(^MAGDSTT(2006.543,RUNNUMBER,0),"^",15)=DFN
+15 SET $PIECE(^MAGDSTT(2006.543,RUNNUMBER,0),"^",16)=STUDYDATE
+16 SET $PIECE(^MAGDSTT(2006.543,RUNNUMBER,0),"^",17)=STUDYIEN
+17 SET $PIECE(^MAGDSTT(2006.543,RUNNUMBER,0),"^",18)=ACNUMB
+18 ;
+19 ; stop
IF $$SUSPEND(HOURS)
QUIT 1
+20 IF $Y>(IOSL-6)
WRITE !!
DO HEADER(1)
+21 ;
+22 SET (NONDICOM,TEXTCNT)=0
SET IMAGES="NONE"
+23 WRITE !,$JUSTIFY(STUDYIEN,8),?11,ACNUMB,?30,$PIECE($$FMTE^XLFDT(STUDYDATE,"2Z"),"@",1)
+24 DO CSVNEWLINE
+25 ; lookup legacy 2005 image group pointers
+26 ; remove the list of UIDs for the VistA study
KILL ^TMP("MAG",$JOB,"UIDS")
+27 SET MAGIEN=""
+28 FOR I=1:1
SET MAGIEN=$ORDER(MAGIENLIST(MAGIEN))
if MAGIEN=""
QUIT
Begin DoDot:1
+29 IF I>1
WRITE !
DO CSVSAVE(0,0)
DO CSVNEWLINE
+30 WRITE ?40,$JUSTIFY(MAGIEN,8)
DO CSVSAVE(MAGIEN)
+31 ; count images in all groups
DO LEGACY^MAGDSTA8(MAGIEN,.SERIESCOUNT,.IMAGECOUNT)
+32 IF SERIESCOUNT
Begin DoDot:2
+33 WRITE ?52,$JUSTIFY(SERIESCOUNT,5)
DO CSVSAVE(SERIESCOUNT)
+34 QUIT
End DoDot:2
+35 IF '$TEST
Begin DoDot:2
+36 IF IMAGECOUNT
Begin DoDot:3
+37 ; same as previous series, don't show count
WRITE ?52,$JUSTIFY("",5)
+38 DO CSVSAVE(0)
+39 QUIT
End DoDot:3
+40 IF '$TEST
Begin DoDot:3
+41 ; not DICOM, maybe TGA, JPEG, PDF, etc.
WRITE ?55,"non-DICOM"
+42 DO CSVSAVE("non-DICOM","non-DICOM")
+43 SET NONDICOM=1
+44 QUIT
End DoDot:3
+45 QUIT
End DoDot:2
+46 IF IMAGECOUNT
Begin DoDot:2
+47 WRITE ?59,$JUSTIFY(IMAGECOUNT,5)
DO CSVSAVE(IMAGECOUNT)
+48 QUIT
End DoDot:2
+49 DO STTINC("LEGACY STUDIES PROCESSED",1)
+50 DO STTINC("LEGACY SERIES COUNT",SERIESCOUNT)
+51 DO STTINC("LEGACY IMAGE COUNT",IMAGECOUNT)
+52 ;
+53 ; save VistA counts for later steps
+54 ; Note: These counts may be for multiple study instance UIDs
+55 SET VISTA("SERIES COUNT")=$GET(VISTA("SERIES COUNT"),0)+$GET(SERIESCOUNT,0)
+56 SET VISTA("IMAGE COUNT")=$GET(VISTA("IMAGE COUNT"),0)+$GET(IMAGECOUNT,0)
+57 QUIT
End DoDot:1
+58 ;
+59 ; look up in new sop class database (P34)
+60 DO NEWSOPDB^MAGDSTA8(ACNUMB,.SERIESCOUNT,.IMAGECOUNT)
+61 IF IMAGECOUNT>0
Begin DoDot:1
+62 IF $DATA(MAGIENLIST)
Begin DoDot:2
+63 ; P333 PMK 08/04/2025
WRITE !
DO CSVNEWLINE
+64 QUIT
End DoDot:2
+65 WRITE ?41,"NEW SOP",?52,$JUSTIFY(SERIESCOUNT,5),?59,$JUSTIFY(IMAGECOUNT,5)
+66 DO CSVSAVE("NEW SOP",SERIESCOUNT,IMAGECOUNT)
+67 DO STTINC("NEW SOP CLASS STUDIES PROCESSED",1)
+68 DO STTINC("NEW SOP CLASS SERIES COUNT",SERIESCOUNT)
+69 DO STTINC("NEW SOP CLASS IMAGE COUNT",IMAGECOUNT)
+70 QUIT
End DoDot:1
+71 ;
+72 ; update legacy and new database VistA counts for later steps
+73 SET VISTA("SERIES COUNT")=$GET(VISTA("SERIES COUNT"),0)+$GET(SERIESCOUNT,0)
+74 SET VISTA("IMAGE COUNT")=$GET(VISTA("IMAGE COUNT"),0)+$GET(IMAGECOUNT,0)
+75 ;
+76 KILL PACSSTUDYUID
+77 SET VISTAUIDFLAG=0
+78 ; perform Accession Number query to obtain the Study Instance UID & counts from PACS
+79 ; P306 PMK 06/11/2021 use last 4 of SSN to make query unique
SET SSN=$$GET1^DIQ(2,DFN,.09,"E")
+80 SET ERROR=$$FINDSUID^MAGDSTAB(ACNUMB,SSN,.PACSSTUDYUID,.SERIESCOUNT,.IMAGECOUNT)
+81 ;
+82 ; no DICOM images on file in VistA
IF VISTA("IMAGE COUNT")=0
Begin DoDot:1
+83 IF NONDICOM=0
Begin DoDot:2
+84 WRITE ?46,"--",?55,"--",?62,"--"
DO CSVSAVE(0,0,0)
+85 QUIT
End DoDot:2
+86 DO STTINC("VISTA STUDIES WITHOUT DICOM IMAGES",1)
+87 QUIT
End DoDot:1
+88 IF '$TEST
IF '$DATA(PACSSTUDYUID)
Begin DoDot:1
+89 ; perform queries using the VistA Study Instance UID to get the image and series counts
+90 ; build array of VistA Study Instance UIDs for the query
SET (I,VISTASTUDYUID)=0
+91 FOR
SET VISTASTUDYUID=$ORDER(^TMP("MAG",$JOB,"UIDS","VISTA",VISTASTUDYUID))
if VISTASTUDYUID=""
QUIT
Begin DoDot:2
+92 SET I=I+1
SET PACSSTUDYUID(I)=VISTASTUDYUID
+93 QUIT
End DoDot:2
+94 SET ERROR=$$QUERY^MAGDSTAC(.PACSSTUDYUID,.SERIESCOUNT,.IMAGECOUNT)
+95 IF $DATA(PACSSTUDYUID(1))
SET VISTAUIDFLAG=1
+96 QUIT
End DoDot:1
+97 ;
+98 ; Note: These counts may be for multiple study instance UIDs
+99 SET PACS("SERIES COUNT")=SERIESCOUNT
SET PACS("IMAGE COUNT")=IMAGECOUNT
+100 IF SERIESCOUNT
Begin DoDot:1
+101 WRITE ?67,$JUSTIFY(SERIESCOUNT,5),?74,$JUSTIFY(IMAGECOUNT,5)
+102 DO CSVSAVE(SERIESCOUNT,IMAGECOUNT)
+103 DO STTINC("PACS STUDIES PROCESSED",1)
+104 DO STTINC("PACS SERIES COUNT",SERIESCOUNT)
+105 DO STTINC("PACS IMAGE COUNT",IMAGECOUNT)
+106 IF VISTAUIDFLAG
Begin DoDot:2
+107 WRITE !," (Query with Accession Number failed, but worked with VistA Study Instance UID)"
+108 QUIT
End DoDot:2
+109 QUIT
End DoDot:1
+110 IF '$TEST
Begin DoDot:1
+111 WRITE ?70,"--",?77,"--"
DO CSVSAVE(0,0)
+112 DO STTINC("PACS STUDIES WITHOUT IMAGES",1)
+113 QUIT
End DoDot:1
+114 ;
+115 IF ^TMP("MAG",$JOB,"BATCH Q/R","OPTION")="RETRIEVE MISSING IMAGES"
Begin DoDot:1
+116 SET ERROR=$$RETRIEVE^MAGDSTAC(.PACSSTUDYUID)
+117 QUIT
End DoDot:1
+118 ;
+119 ;
+120 ; cleanup
+121 KILL ^TMP("MAG",$JOB,"DICOM"),^("Q/R QUERY"),^("UIDS")
+122 QUIT 0
+123 ;
+124 ;
+1 SET CONTINUE=$GET(CONTINUE,1)
+2 SET CLEARSCREEN=$GET(CLEARSCREEN,1)
+3 IF $GET(AUTOSCROLL)'="YES"
Begin DoDot:1
+4 IF CONTINUE
DO CONTINUE^MAGDSTQ(0)
+5 IF CLEARSCREEN
WRITE @IOF
+6 IF '$TEST
WRITE !!
SET $Y=0
+7 QUIT
End DoDot:1
+8 IF '$TEST
WRITE !!
SET $Y=0
+9 WRITE $$FMTE^XLFDT($$NOW^XLFDT,1),?55,"VistA",?71,"PACS"
+10 WRITE !,"Report #",?11,"Accession Number",?32,"Date",?40,"Group #",?51,"Series Images",?66,"Series Images"
+11 IF ^TMP("MAG",$JOB,"BATCH Q/R","OPTION")="RETRIEVE MISSING IMAGES"
Begin DoDot:1
+12 WRITE ?82,"Retrieve Status"
+13 QUIT
End DoDot:1
+14 WRITE !,"--------",?11,"----------------",?30,"--------",?40,"--------",?51,"------ ------",?66,"------ ------"
+15 IF ^TMP("MAG",$JOB,"BATCH Q/R","OPTION")="RETRIEVE MISSING IMAGES"
Begin DoDot:1
+16 WRITE ?82,"-------- ------"
+17 QUIT
End DoDot:1
+18 QUIT
+19 ;
CSVNEWLINE ; output the beginning of the new line for the CSV Excel file
+1 ; start the next record
DO CSVSAVE("")
+2 DO CSVSAVE(STUDYIEN,ACNUMB)
+3 DO CSVSAVE($PIECE($$FMTE^XLFDT(STUDYDATE,"2Z"),"@",1))
+4 QUIT
+5 ;
CSVSAVE(D0,D1,D2,D3,D4,D6,D7,D8,D9) ; save values in CSV format
+1 NEW DATA,I,VAR
+2 ; no CSV file to be generated
IF OUTPUTEXCEL=""
QUIT
+3 FOR I=0:1:9
SET VAR="D"_I
IF $DATA(@VAR)
SET DATA=@VAR
Begin DoDot:1
+4 IF DATA=""
Begin DoDot:2
+5 ; start the next record
DO SAVE^MAGDSTA0(OUTPUTEXCEL,"")
+6 QUIT
End DoDot:2
+7 IF '$TEST
Begin DoDot:2
+8 IF DATA[","
SET DATA=""""_DATA_""""
+9 ; concatenate
DO SAVE^MAGDSTA0(OUTPUTEXCEL,DATA_DEL,1)
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 QUIT
+13 ;
QRSTATUS(TEXT) ; output query/retrieve status text
+1 IF $Y>(IOSL-4)
DO HEADER(1)
+2 IF $X>82
WRITE !
+3 WRITE ?82,TEXT
IF OUTPUTEXCEL'=""
Begin DoDot:1
+4 SET TEXTCNT=TEXTCNT+1
IF TEXTCNT>1
DO SAVE^MAGDSTA0(OUTPUTEXCEL,"; ",1)
+5 IF TEXT[","
DO SAVE^MAGDSTA0(OUTPUTEXCEL,""""_TEXT_"""",1)
+6 IF '$TEST
DO SAVE^MAGDSTA0(OUTPUTEXCEL,TEXT,1)
End DoDot:1
+7 QUIT
+8 ;
SUSPEND(HOURS) ; check date/time & request to stop
+1 ; HOURS is a 24 character string of Y's and N's indicating active times
+2 ; Assume that Saturday and Sunday are 24 hours
+3 NEW DONE,FIRSTTIME,TICKER,X
+4 ;
+5 ; don't check for accession number scans
IF SCANMODE="ACCESSION"
QUIT 0
+6 ;
+7 SET (DONE,TICKER)=0
SET FIRSTTIME=1
+8 ; Saturday and Sunday
IF "23"[($HOROLOG#7)
SET HOURS=$TRANSLATE($JUSTIFY("",24)," ","Y")
+9 FOR
Begin DoDot:1
+10 ; menu stop
IF $GET(^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,$JOB,"STATUS"))'="RUN"
Begin DoDot:2
+11 ; indicates user stop task
SET DONE=-1
+12 WRITE !!,"User requested VistA Automatic Q/R Processing to stop at ",$$FMTE^XLFDT($$NOW^XLFDT,1)
+13 QUIT
End DoDot:2
QUIT
+14 ; user has asked task to stop
IF $$S^%ZTLOAD("Stopping "_ZTDESC)
Begin DoDot:2
+15 ; indicates user stop task
SET DONE=-1
+16 ; notify submanager of response to user's STOP request
SET ZTSTOP=1
+17 WRITE !!,"User requested task to stop at ",$$FMTE^XLFDT($$NOW^XLFDT,1)
+18 QUIT
End DoDot:2
QUIT
+19 SET X=$EXTRACT(HOURS,$PIECE($HOROLOG,",",2)\3600+1)
+20 IF X="Y"
SET DONE=1
+21 ; suspend run
IF '$TEST
Begin DoDot:2
+22 IF FIRSTTIME
WRITE !!,"Waiting for time to start "
SET FIRSTTIME=0
+23 ; Show "idle" marker
+24 SET TICKER=TICKER+1
if TICKER<1
SET TICKER=1
if TICKER>4
SET TICKER=1
+25 IF $EXTRACT(IOST,1,2)="C-"
WRITE $EXTRACT("-\|/",TICKER),$CHAR(8)
+26 HANG 1
+27 QUIT
End DoDot:2
+28 QUIT
End DoDot:1
if DONE
QUIT
+29 QUIT $SELECT(DONE=1:0,1:DONE)
+30 ;
STOP ; stop job
+1 NEW COUNT,DONE,LIST,X
+2 SET COUNT=$$STOP1(.LIST)
+3 IF 'COUNT
Begin DoDot:1
+4 WRITE !!,"No VistA Automatic Q/R Processes appear to be running."
+5 QUIT
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 DO STOP2(.LIST,COUNT)
+8 IF COUNT=1
Begin DoDot:2
+9 SET ERROR=$$YESNO^MAGDSTQ("Stop this process?","y",.X)
+10 IF ERROR<0
WRITE " YESNO ERROR"
QUIT
+11 IF X="YES"
Begin DoDot:3
+12 DO STOP3(.LIST,1)
+13 QUIT
End DoDot:3
+14 QUIT
End DoDot:2
+15 IF '$TEST
Begin DoDot:2
+16 SET DONE=0
FOR
Begin DoDot:3
+17 WRITE !!,"Enter 1-",COUNT," to stop a procss: "
+18 READ X:DTIME
IF '$TEST
SET X="^"
+19 IF X=""
WRITE " -- nothing selected"
QUIT
+20 IF X["^"
SET DONE=-11
QUIT
+21 IF X?1N.N
IF X
IF X'>COUNT
Begin DoDot:4
+22 DO STOP3(.LIST,X)
+23 SET DONE=1
+24 QUIT
End DoDot:4
+25 IF '$TEST
Begin DoDot:4
+26 WRITE " ???"
+27 QUIT
End DoDot:4
+28 QUIT
End DoDot:3
if DONE
QUIT
+29 QUIT
End DoDot:2
+30 QUIT
End DoDot:1
+31 DO CONTINUE^MAGDSTQ
+32 QUIT
+33 ;
STOP1(LIST) ; get list of running VistA Automatic Q/R Processes
+1 NEW COUNT,HOSTNAME,I,JOB,MAGXTMP
+2 SET COUNT=0
+3 SET MAGXTMP="MAG Q/R Client"
+4 FOR
SET MAGXTMP=$ORDER(^XTMP(MAGXTMP))
if MAGXTMP'?1"MAG Q/R Client".E
QUIT
Begin DoDot:1
+5 SET HOSTNAME=""
+6 FOR
SET HOSTNAME=$ORDER(^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME))
if HOSTNAME=""
QUIT
Begin DoDot:2
+7 SET JOB=0
+8 FOR
SET JOB=$ORDER(^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,JOB))
if 'JOB
QUIT
Begin DoDot:3
+9 SET COUNT=COUNT+1
+10 SET LIST(COUNT)=MAGXTMP_"^"_HOSTNAME_"^"_JOB
+11 QUIT
End DoDot:3
+12 QUIT
End DoDot:2
+13 QUIT
End DoDot:1
+14 QUIT COUNT
+15 ;
STOP2(LIST,COUNT) ; display the jobs
+1 NEW HOSTNAME,I,JOB,MAGXTMP
+2 FOR I=1:1:COUNT
Begin DoDot:1
+3 SET MAGXTMP=$PIECE(LIST(I),"^",1)
SET HOSTNAME=$PIECE(LIST(I),"^",2)
SET JOB=$PIECE(LIST(I),"^",3)
+4 WRITE !
if COUNT>1
WRITE $JUSTIFY(I,2),")"
+5 WRITE ?4,^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,JOB,"IMAGING SERVICE")
+6 WRITE ?20,^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,JOB,"OPTION")
+7 WRITE ?50,"Started: ",$$FMTE^XLFDT(^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,JOB,"START TIME"),"2MP")
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
STOP3(LIST,I) ; signal the process to stop by killing the "STATUS" node
+1 NEW HOSTNAME,JOB,MAGXTMP
+2 SET MAGXTMP=$PIECE(LIST(I),"^",1)
SET HOSTNAME=$PIECE(LIST(I),"^",2)
SET JOB=$PIECE(LIST(I),"^",3)
+3 KILL ^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,JOB)
+4 WRITE !!,"VistA Automatic Q/R Processing will stop soon."
+5 QUIT
+6 ;
STTWRITE(NAME,VALUE) ; write statistics for the run
+1 NEW IEN
+2 SET VALUE=$GET(VALUE)
+3 SET IEN=$$STTNAME(NAME)
if IEN<0
QUIT
+4 ; use update instead
IF IEN>0
DO STTUPDT(NAME,VALUE)
QUIT
+5 SET IEN=$ORDER(^MAGDSTT(2006.543,RUNNUMBER,2,"B"),-1)+1
+6 SET ^MAGDSTT(2006.543,RUNNUMBER,2,IEN,0)=NAME_"^"_VALUE
+7 SET ^MAGDSTT(2006.543,RUNNUMBER,2,"B",NAME,IEN)=""
+8 SET ^MAGDSTT(2006.543,RUNNUMBER,2,0)="^2006.5432^"_IEN_"^"_IEN
+9 QUIT
+10 ;
STTREAD(NAME) ; read a statistics parameter
+1 NEW IEN
+2 SET IEN=$$STTNAME(NAME)
if IEN<0
QUIT
+3 IF IEN=""
Begin DoDot:1
+4 WRITE !,"*** ERROR in STTREAD^",$TEXT(+0)," ***"
+5 WRITE !,"NAME """,NAME,""" is not defined in"
+6 WRITE " ^MAGDSTT(2006.543,",RUNNUMBER,")."
+7 QUIT
End DoDot:1
QUIT ""
+8 QUIT $PIECE(^MAGDSTT(2006.543,RUNNUMBER,2,IEN,0),"^",2)
+9 ;
STTUPDT(NAME,VALUE) ; update a statistics parameter
+1 NEW IEN
+2 SET VALUE=$GET(VALUE)
+3 SET IEN=$$STTNAME(NAME)
if IEN<0
QUIT
+4 IF IEN=""
DO STTWRITE(NAME,VALUE)
QUIT
+5 SET $PIECE(^MAGDSTT(2006.543,RUNNUMBER,2,IEN,0),"^",2)=VALUE
+6 QUIT
+7 ;
STTINC(NAME,VALUE) ; increment a statistics parameter
+1 NEW IEN
+2 SET VALUE=+$GET(VALUE)
+3 SET IEN=$$STTNAME(NAME)
if IEN<0
QUIT
+4 IF IEN=""
DO STTWRITE(NAME,VALUE)
QUIT
+5 SET $PIECE(^(0),"^",2)=$PIECE(^MAGDSTT(2006.543,RUNNUMBER,2,IEN,0),"^",2)+VALUE
+6 QUIT
+7 ;
STTNAME(NAME) ; get IEN for NAME
+1 ; return: -1 for an error, "" for no NAME, IEN otherwise
+2 NEW IEN
+3 SET NAME=$GET(NAME)
+4 IF NAME=""
Begin DoDot:1
+5 WRITE !,"*** ERROR in STTNAME^",$TEXT(+0)
+6 WRITE " NAME is null or undefined ***"
+7 QUIT
End DoDot:1
QUIT -1
+8 ; check for existence of the statistical parameter
+9 SET IEN=$ORDER(^MAGDSTT(2006.543,RUNNUMBER,2,"B",NAME,""))
+10 QUIT IEN
