MAGDSTAA ;WOIFO/PMK - Q/R Retrieve of DICOM images from PACS to VistA ; Feb 15, 2022@10:50:34
;;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 #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
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=0,IMAGES="NONE"
W !,$J(STUDYIEN,8),?11,ACNUMB,?30,$P($$FMTE^XLFDT(STUDYDATE,"2Z"),"@",1)
; 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
. W:I>1 ! W ?40,$J(MAGIEN,8)
. D LEGACY^MAGDSTA8(MAGIEN,.SERIESCOUNT,.IMAGECOUNT) ; count images in all groups
. I SERIESCOUNT W ?52,$J(SERIESCOUNT,5)
. E D
. . I IMAGECOUNT W ?52,$J("",5) ; same as previous series, don't show count
. . E D
. . . W ?55,"non-DICOM" ; not DICOM, maybe TGA, JPEG, PDF, etc.
. . . S NONDICOM=1
. . . Q
. . Q
. I IMAGECOUNT W ?59,$J(IMAGECOUNT,5)
. 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
. W:$D(MAGIENLIST) ! W ?41,"NEW SOP",?52,$J(SERIESCOUNT,5),?59,$J(IMAGECOUNT,5)
. 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 W ?46,"--",?55,"--",?62,"--"
. 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 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 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 CONTINUE D CONTINUE^MAGDSTQ(0)
I CLEARSCREEN W @IOF
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
;
QRSTATUS(TEXT) ; output query/retrieve status text
I $Y>(IOSL-4) D HEADER(1)
W:$X>82 ! W ?82,TEXT
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 11155 printed Apr 09, 2024@21:01:46 Page 2
MAGDSTAA ;WOIFO/PMK - Q/R Retrieve of DICOM images from PACS to VistA ; Feb 15, 2022@10:50:34
+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 #10063 reference $$S^%ZTLOAD function call
+19 ; Supported IA #10103 reference $$FMTE^XLFDT function call
+20 ; Supported IA #10103 reference $$NOW^XLFDT function call
+21 ; Supported IA #2056 reference $$GET1^DIQ function call
+22 ; Supported IA #10035 to read PATIENT file (#2)
+23 ;
+24 QUIT
+25 ;
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
+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=0
SET IMAGES="NONE"
+23 WRITE !,$JUSTIFY(STUDYIEN,8),?11,ACNUMB,?30,$PIECE($$FMTE^XLFDT(STUDYDATE,"2Z"),"@",1)
+24 ; lookup legacy 2005 image group pointers
+25 ; remove the list of UIDs for the VistA study
KILL ^TMP("MAG",$JOB,"UIDS")
+26 SET MAGIEN=""
+27 FOR I=1:1
SET MAGIEN=$ORDER(MAGIENLIST(MAGIEN))
if MAGIEN=""
QUIT
Begin DoDot:1
+28 if I>1
WRITE !
WRITE ?40,$JUSTIFY(MAGIEN,8)
+29 ; count images in all groups
DO LEGACY^MAGDSTA8(MAGIEN,.SERIESCOUNT,.IMAGECOUNT)
+30 IF SERIESCOUNT
WRITE ?52,$JUSTIFY(SERIESCOUNT,5)
+31 IF '$TEST
Begin DoDot:2
+32 ; same as previous series, don't show count
IF IMAGECOUNT
WRITE ?52,$JUSTIFY("",5)
+33 IF '$TEST
Begin DoDot:3
+34 ; not DICOM, maybe TGA, JPEG, PDF, etc.
WRITE ?55,"non-DICOM"
+35 SET NONDICOM=1
+36 QUIT
End DoDot:3
+37 QUIT
End DoDot:2
+38 IF IMAGECOUNT
WRITE ?59,$JUSTIFY(IMAGECOUNT,5)
+39 DO STTINC("LEGACY STUDIES PROCESSED",1)
+40 DO STTINC("LEGACY SERIES COUNT",SERIESCOUNT)
+41 DO STTINC("LEGACY IMAGE COUNT",IMAGECOUNT)
+42 ;
+43 ; save VistA counts for later steps
+44 ; Note: These counts may be for multiple study instance UIDs
+45 SET VISTA("SERIES COUNT")=$GET(VISTA("SERIES COUNT"),0)+$GET(SERIESCOUNT,0)
+46 SET VISTA("IMAGE COUNT")=$GET(VISTA("IMAGE COUNT"),0)+$GET(IMAGECOUNT,0)
+47 QUIT
End DoDot:1
+48 ;
+49 ; look up in new sop class database (P34)
+50 DO NEWSOPDB^MAGDSTA8(ACNUMB,.SERIESCOUNT,.IMAGECOUNT)
+51 IF IMAGECOUNT>0
Begin DoDot:1
+52 if $DATA(MAGIENLIST)
WRITE !
WRITE ?41,"NEW SOP",?52,$JUSTIFY(SERIESCOUNT,5),?59,$JUSTIFY(IMAGECOUNT,5)
+53 DO STTINC("NEW SOP CLASS STUDIES PROCESSED",1)
+54 DO STTINC("NEW SOP CLASS SERIES COUNT",SERIESCOUNT)
+55 DO STTINC("NEW SOP CLASS IMAGE COUNT",IMAGECOUNT)
+56 QUIT
End DoDot:1
+57 ;
+58 ; update legacy and new database VistA counts for later steps
+59 SET VISTA("SERIES COUNT")=$GET(VISTA("SERIES COUNT"),0)+$GET(SERIESCOUNT,0)
+60 SET VISTA("IMAGE COUNT")=$GET(VISTA("IMAGE COUNT"),0)+$GET(IMAGECOUNT,0)
+61 ;
+62 KILL PACSSTUDYUID
+63 SET VISTAUIDFLAG=0
+64 ; perform Accession Number query to obtain the Study Instance UID & counts from PACS
+65 ; P306 PMK 06/11/2021 use last 4 of SSN to make query unique
SET SSN=$$GET1^DIQ(2,DFN,.09,"E")
+66 SET ERROR=$$FINDSUID^MAGDSTAB(ACNUMB,SSN,.PACSSTUDYUID,.SERIESCOUNT,.IMAGECOUNT)
+67 ;
+68 ; no DICOM images on file in VistA
IF VISTA("IMAGE COUNT")=0
Begin DoDot:1
+69 IF NONDICOM=0
WRITE ?46,"--",?55,"--",?62,"--"
+70 DO STTINC("VISTA STUDIES WITHOUT DICOM IMAGES",1)
+71 QUIT
End DoDot:1
+72 IF '$TEST
IF '$DATA(PACSSTUDYUID)
Begin DoDot:1
+73 ; perform queries using the VistA Study Instance UID to get the image and series counts
+74 ; build array of VistA Study Instance UIDs for the query
SET (I,VISTASTUDYUID)=0
+75 FOR
SET VISTASTUDYUID=$ORDER(^TMP("MAG",$JOB,"UIDS","VISTA",VISTASTUDYUID))
if VISTASTUDYUID=""
QUIT
Begin DoDot:2
+76 SET I=I+1
SET PACSSTUDYUID(I)=VISTASTUDYUID
+77 QUIT
End DoDot:2
+78 SET ERROR=$$QUERY^MAGDSTAC(.PACSSTUDYUID,.SERIESCOUNT,.IMAGECOUNT)
+79 IF $DATA(PACSSTUDYUID(1))
SET VISTAUIDFLAG=1
+80 QUIT
End DoDot:1
+81 ;
+82 ; Note: These counts may be for multiple study instance UIDs
+83 SET PACS("SERIES COUNT")=SERIESCOUNT
SET PACS("IMAGE COUNT")=IMAGECOUNT
+84 IF SERIESCOUNT
Begin DoDot:1
+85 WRITE ?67,$JUSTIFY(SERIESCOUNT,5),?74,$JUSTIFY(IMAGECOUNT,5)
+86 DO STTINC("PACS STUDIES PROCESSED",1)
+87 DO STTINC("PACS SERIES COUNT",SERIESCOUNT)
+88 DO STTINC("PACS IMAGE COUNT",IMAGECOUNT)
+89 IF VISTAUIDFLAG
Begin DoDot:2
+90 WRITE !," (Query with Accession Number failed, but worked with VistA Study Instance UID)"
+91 QUIT
End DoDot:2
+92 QUIT
End DoDot:1
+93 IF '$TEST
Begin DoDot:1
+94 WRITE ?70,"--",?77,"--"
+95 DO STTINC("PACS STUDIES WITHOUT IMAGES",1)
+96 QUIT
End DoDot:1
+97 ;
+98 IF ^TMP("MAG",$JOB,"BATCH Q/R","OPTION")="RETRIEVE MISSING IMAGES"
Begin DoDot:1
+99 SET ERROR=$$RETRIEVE^MAGDSTAC(.PACSSTUDYUID)
+100 QUIT
End DoDot:1
+101 ;
+102 ;
+103 ; cleanup
+104 KILL ^TMP("MAG",$JOB,"DICOM"),^("Q/R QUERY"),^("UIDS")
+105 QUIT 0
+106 ;
+107 ;
+1 SET CONTINUE=$GET(CONTINUE,1)
+2 SET CLEARSCREEN=$GET(CLEARSCREEN,1)
+3 IF CONTINUE
DO CONTINUE^MAGDSTQ(0)
+4 IF CLEARSCREEN
WRITE @IOF
+5 IF '$TEST
WRITE !!
SET $Y=0
+6 WRITE $$FMTE^XLFDT($$NOW^XLFDT,1),?55,"VistA",?71,"PACS"
+7 WRITE !,"Report #",?11,"Accession Number",?32,"Date",?40,"Group #",?51,"Series Images",?66,"Series Images"
+8 IF ^TMP("MAG",$JOB,"BATCH Q/R","OPTION")="RETRIEVE MISSING IMAGES"
Begin DoDot:1
+9 WRITE ?82,"Retrieve Status"
+10 QUIT
End DoDot:1
+11 WRITE !,"--------",?11,"----------------",?30,"--------",?40,"--------",?51,"------ ------",?66,"------ ------"
+12 IF ^TMP("MAG",$JOB,"BATCH Q/R","OPTION")="RETRIEVE MISSING IMAGES"
Begin DoDot:1
+13 WRITE ?82,"-------- ------"
+14 QUIT
End DoDot:1
+15 QUIT
+16 ;
QRSTATUS(TEXT) ; output query/retrieve status text
+1 IF $Y>(IOSL-4)
DO HEADER(1)
+2 if $X>82
WRITE !
WRITE ?82,TEXT
+3 QUIT
+4 ;
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
