Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGDSTAA

MAGDSTAA.m

Go to the documentation of this file. 
  1. 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
  1.  ;; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1.  ;
  1.  ; Supported IA #10063 reference $$S^%ZTLOAD function call
  1.  ; Supported IA #10103 reference $$FMTE^XLFDT function call
  1.  ; Supported IA #10103 reference $$NOW^XLFDT function call
  1.  ; Supported IA #2056 reference $$GET1^DIQ function call
  1.  ; Supported IA #10035 to read PATIENT file (#2)
  1.  ;
  1.  Q
  1.  ;
  1. LOOKUP(DFN,STUDYDATE,STUDYIEN,ACNUMB,MAGIENLIST) ; called by MAGDSTA5 and MAGDSTA7
  1.  ; STUDYDATE ---- date of study
  1.  ; STUDYIEN ----- RARPT1 or GMRCIEN
  1.  ; ACNUMB ------- accession number
  1.  ; MAGIENLIST --- array of MAGIEN pointers
  1.  ; VISTAUIDFLAG - flag to indicate that an acn query failed
  1.  ;
  1.  N ERROR,EXAMDATE,I,IMAGECOUNT,MAGGLIST,MAGIEN,NONDICOM,SSN
  1.  N PACS,RUNTIME,SERIESCOUNT,PACSSTUDYUID,VISTASTUDYUID,VISTA,X
  1.  ;
  1.  D STTINC("VISTA STUDIES PROCESSED",1)
  1.  S RUNTIME=$$NOW^XLFDT()
  1.  S $P(^MAGDSTT(2006.543,RUNNUMBER,0),"^",3)=RUNTIME ; updated during the run
  1.  S $P(^MAGDSTT(2006.543,RUNNUMBER,0),"^",5)="RUNNING"
  1.  S $P(^MAGDSTT(2006.543,RUNNUMBER,0),"^",15)=DFN
  1.  S $P(^MAGDSTT(2006.543,RUNNUMBER,0),"^",16)=STUDYDATE
  1.  S $P(^MAGDSTT(2006.543,RUNNUMBER,0),"^",17)=STUDYIEN
  1.  S $P(^MAGDSTT(2006.543,RUNNUMBER,0),"^",18)=ACNUMB
  1.  ;
  1.  I $$SUSPEND(HOURS) Q 1  ; stop
  1.  I $Y>(IOSL-6) W !! D HEADER(1)
  1.  ;
  1.  S NONDICOM=0,IMAGES="NONE"
  1.  W !,$J(STUDYIEN,8),?11,ACNUMB,?30,$P($$FMTE^XLFDT(STUDYDATE,"2Z"),"@",1)
  1.  ; lookup legacy 2005 image group pointers
  1.  K ^TMP("MAG",$J,"UIDS") ; remove the list of UIDs for the VistA study
  1.  S MAGIEN=""
  1.  F I=1:1 S MAGIEN=$O(MAGIENLIST(MAGIEN)) Q:MAGIEN=""  D
  1.  . W:I>1 ! W ?40,$J(MAGIEN,8)
  1.  . D LEGACY^MAGDSTA8(MAGIEN,.SERIESCOUNT,.IMAGECOUNT) ; count images in all groups
  1.  . I SERIESCOUNT W ?52,$J(SERIESCOUNT,5)
  1.  . E  D
  1.  . . I IMAGECOUNT W ?52,$J("",5) ; same as previous series, don't show count
  1.  . . E  D
  1.  . . . W ?55,"non-DICOM" ; not DICOM, maybe TGA, JPEG, PDF, etc.
  1.  . . . S NONDICOM=1
  1.  . . . Q
  1.  . . Q
  1.  . I IMAGECOUNT W ?59,$J(IMAGECOUNT,5)
  1.  . D STTINC("LEGACY STUDIES PROCESSED",1)
  1.  . D STTINC("LEGACY SERIES COUNT",SERIESCOUNT)
  1.  . D STTINC("LEGACY IMAGE COUNT",IMAGECOUNT)
  1.  . ;
  1.  . ; save VistA counts for later steps
  1.  . ; Note: These counts may be for multiple study instance UIDs
  1.  . S VISTA("SERIES COUNT")=$G(VISTA("SERIES COUNT"),0)+$G(SERIESCOUNT,0)
  1.  . S VISTA("IMAGE COUNT")=$G(VISTA("IMAGE COUNT"),0)+$G(IMAGECOUNT,0)
  1.  . Q
  1.  ;
  1.  ; look up in new sop class database (P34)
  1.  D NEWSOPDB^MAGDSTA8(ACNUMB,.SERIESCOUNT,.IMAGECOUNT)
  1.  I IMAGECOUNT>0 D
  1.  . W:$D(MAGIENLIST) ! W ?41,"NEW SOP",?52,$J(SERIESCOUNT,5),?59,$J(IMAGECOUNT,5)
  1.  . D STTINC("NEW SOP CLASS STUDIES PROCESSED",1)
  1.  . D STTINC("NEW SOP CLASS SERIES COUNT",SERIESCOUNT)
  1.  . D STTINC("NEW SOP CLASS IMAGE COUNT",IMAGECOUNT)
  1.  . Q
  1.  ;
  1.  ; update legacy and new database VistA counts for later steps
  1.  S VISTA("SERIES COUNT")=$G(VISTA("SERIES COUNT"),0)+$G(SERIESCOUNT,0)
  1.  S VISTA("IMAGE COUNT")=$G(VISTA("IMAGE COUNT"),0)+$G(IMAGECOUNT,0)
  1.  ;
  1.  K PACSSTUDYUID
  1.  S VISTAUIDFLAG=0
  1.  ; perform Accession Number query to obtain the Study Instance UID & counts from PACS
  1.  S SSN=$$GET1^DIQ(2,DFN,.09,"E") ; P306 PMK 06/11/2021 use last 4 of SSN to make query unique
  1.  S ERROR=$$FINDSUID^MAGDSTAB(ACNUMB,SSN,.PACSSTUDYUID,.SERIESCOUNT,.IMAGECOUNT)
  1.  ;
  1.  I VISTA("IMAGE COUNT")=0 D  ; no DICOM images on file in VistA
  1.  . I NONDICOM=0 W ?46,"--",?55,"--",?62,"--"
  1.  . D STTINC("VISTA STUDIES WITHOUT DICOM IMAGES",1)
  1.  . Q
  1.  E  I '$D(PACSSTUDYUID) D
  1.  . ; perform queries using the VistA Study Instance UID to get the image and series counts
  1.  . S (I,VISTASTUDYUID)=0 ; build array of VistA Study Instance UIDs for the query
  1.  . F  S VISTASTUDYUID=$O(^TMP("MAG",$J,"UIDS","VISTA",VISTASTUDYUID)) Q:VISTASTUDYUID=""  D
  1.  . . S I=I+1,PACSSTUDYUID(I)=VISTASTUDYUID
  1.  . . Q
  1.  . S ERROR=$$QUERY^MAGDSTAC(.PACSSTUDYUID,.SERIESCOUNT,.IMAGECOUNT)
  1.  . I $D(PACSSTUDYUID(1)) S VISTAUIDFLAG=1
  1.  . Q
  1.  ; 
  1.  ; Note: These counts may be for multiple study instance UIDs
  1.  S PACS("SERIES COUNT")=SERIESCOUNT,PACS("IMAGE COUNT")=IMAGECOUNT
  1.  I SERIESCOUNT D
  1.  . W ?67,$J(SERIESCOUNT,5),?74,$J(IMAGECOUNT,5)
  1.  . D STTINC("PACS STUDIES PROCESSED",1)
  1.  . D STTINC("PACS SERIES COUNT",SERIESCOUNT)
  1.  . D STTINC("PACS IMAGE COUNT",IMAGECOUNT)
  1.  . I VISTAUIDFLAG D
  1.  . . W !," (Query with Accession Number failed, but worked with VistA Study Instance UID)"
  1.  . . Q
  1.  . Q
  1.  E  D
  1.  . W ?70,"--",?77,"--"
  1.  . D STTINC("PACS STUDIES WITHOUT IMAGES",1)
  1.  . Q
  1.  ;
  1.  I ^TMP("MAG",$J,"BATCH Q/R","OPTION")="RETRIEVE MISSING IMAGES" D
  1.  . S ERROR=$$RETRIEVE^MAGDSTAC(.PACSSTUDYUID)
  1.  . Q
  1.  ;
  1.  ;
  1.  ; cleanup
  1.  K ^TMP("MAG",$J,"DICOM"),^("Q/R QUERY"),^("UIDS")
  1.  Q 0
  1.  ;
  1.  ;
  1.  S CONTINUE=$G(CONTINUE,1)
  1.  S CLEARSCREEN=$G(CLEARSCREEN,1)
  1.  I CONTINUE D CONTINUE^MAGDSTQ(0)
  1.  I CLEARSCREEN W @IOF
  1.  E  W !! S $Y=0
  1.  W $$FMTE^XLFDT($$NOW^XLFDT,1),?55,"VistA",?71,"PACS"
  1.  W !,"Report #",?11,"Accession Number",?32,"Date",?40,"Group #",?51,"Series Images",?66,"Series Images"
  1.  I ^TMP("MAG",$J,"BATCH Q/R","OPTION")="RETRIEVE MISSING IMAGES" D
  1.  . W ?82,"Retrieve Status"
  1.  . Q
  1.  W !,"--------",?11,"----------------",?30,"--------",?40,"--------",?51,"------ ------",?66,"------ ------"
  1.  I ^TMP("MAG",$J,"BATCH Q/R","OPTION")="RETRIEVE MISSING IMAGES" D
  1.  . W ?82,"-------- ------"
  1.  . Q
  1.  Q
  1.  ;
  1. QRSTATUS(TEXT) ; output query/retrieve status text
  1.  I $Y>(IOSL-4) D HEADER(1)
  1.  W:$X>82 ! W ?82,TEXT
  1.  Q
  1.  ;
  1. SUSPEND(HOURS) ; check date/time & request to stop
  1.  ; HOURS is a 24 character string of Y's and N's indicating active times
  1.  ; Assume that Saturday and Sunday are 24 hours
  1.  N DONE,FIRSTTIME,TICKER,X
  1.  ;
  1.  I SCANMODE="ACCESSION" Q 0  ; don't check for accession number scans
  1.  ;
  1.  S (DONE,TICKER)=0,FIRSTTIME=1
  1.  I "23"[($H#7) S HOURS=$TR($J("",24)," ","Y") ; Saturday and Sunday
  1.  F  D  Q:DONE
  1.  . I $G(^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,$J,"STATUS"))'="RUN" D  Q  ; menu stop
  1.  . . S DONE=-1 ; indicates user stop task
  1.  . . W !!,"User requested VistA Automatic Q/R Processing to stop at ",$$FMTE^XLFDT($$NOW^XLFDT,1)
  1.  . . Q
  1.  . I $$S^%ZTLOAD("Stopping "_ZTDESC)  D  Q  ; user has asked task to stop
  1.  . . S DONE=-1 ; indicates user stop task
  1.  . . S ZTSTOP=1 ; notify submanager of response to user's STOP request
  1.  . . W !!,"User requested task to stop at ",$$FMTE^XLFDT($$NOW^XLFDT,1)
  1.  . . Q
  1.  . S X=$E(HOURS,$P($H,",",2)\3600+1)
  1.  . I X="Y" S DONE=1
  1.  . E  D  ; suspend run  
  1.  . . I FIRSTTIME W !!,"Waiting for time to start " S FIRSTTIME=0
  1.  . . ; Show "idle" marker
  1.  . . S TICKER=TICKER+1 S:TICKER<1 TICKER=1 S:TICKER>4 TICKER=1
  1.  . . I $E(IOST,1,2)="C-" W $E("-\|/",TICKER),$C(8)
  1.  . . H 1
  1.  . . Q
  1.  . Q
  1.  Q $S(DONE=1:0,1:DONE)
  1.  ;
  1. STOP ; stop job
  1.  N COUNT,DONE,LIST,X
  1.  S COUNT=$$STOP1(.LIST)
  1.  I 'COUNT D
  1.  . W !!,"No VistA Automatic Q/R Processes appear to be running."
  1.  . Q
  1.  E  D
  1.  . D STOP2(.LIST,COUNT)
  1.  . I COUNT=1 D
  1.  . . S ERROR=$$YESNO^MAGDSTQ("Stop this process?","y",.X)
  1.  . . I ERROR<0 W " YESNO ERROR" Q
  1.  . . I X="YES" D
  1.  . . . D STOP3(.LIST,1)
  1.  . . . Q
  1.  . . Q
  1.  . E  D
  1.  . . S DONE=0 F  D  Q:DONE
  1.  . . . W !!,"Enter 1-",COUNT," to stop a procss: "
  1.  . . . R X:DTIME  E  S X="^"
  1.  . . . I X="" W " -- nothing selected" Q
  1.  . . . I X["^" S DONE=-11 Q
  1.  . . . I X?1N.N,X,X'>COUNT D
  1.  . . . . D STOP3(.LIST,X)
  1.  . . . . S DONE=1
  1.  . . . . Q
  1.  . . . E  D
  1.  . . . . W " ???"
  1.  . . . . Q
  1.  . . . Q
  1.  . . Q
  1.  . Q
  1.  D CONTINUE^MAGDSTQ
  1.  Q
  1.  ;
  1. STOP1(LIST) ; get list of running VistA Automatic Q/R Processes
  1.  N COUNT,HOSTNAME,I,JOB,MAGXTMP
  1.  S COUNT=0
  1.  S MAGXTMP="MAG Q/R Client"
  1.  F  S MAGXTMP=$O(^XTMP(MAGXTMP)) Q:MAGXTMP'?1"MAG Q/R Client".E  D
  1.  . S HOSTNAME=""
  1.  . F  S HOSTNAME=$O(^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME)) Q:HOSTNAME=""  D
  1.  . . S JOB=0
  1.  . . F  S JOB=$O(^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,JOB)) Q:'JOB  D
  1.  . . . S COUNT=COUNT+1
  1.  . . . S LIST(COUNT)=MAGXTMP_"^"_HOSTNAME_"^"_JOB
  1.  . . . Q
  1.  . . Q
  1.  . Q
  1.  Q COUNT
  1.  ;
  1. STOP2(LIST,COUNT) ; display the jobs
  1.  N HOSTNAME,I,JOB,MAGXTMP
  1.  F I=1:1:COUNT D
  1.  . S MAGXTMP=$P(LIST(I),"^",1),HOSTNAME=$P(LIST(I),"^",2),JOB=$P(LIST(I),"^",3)
  1.  . W ! W:COUNT>1 $J(I,2),")"
  1.  . W ?4,^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,JOB,"IMAGING SERVICE")
  1.  . W ?20,^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,JOB,"OPTION")
  1.  . W ?50,"Started: ",$$FMTE^XLFDT(^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,JOB,"START TIME"),"2MP")
  1.  . Q
  1.  Q
  1.  ;
  1. STOP3(LIST,I) ; signal the process to stop by killing the "STATUS" node
  1.  N HOSTNAME,JOB,MAGXTMP
  1.  S MAGXTMP=$P(LIST(I),"^",1),HOSTNAME=$P(LIST(I),"^",2),JOB=$P(LIST(I),"^",3)
  1.  K ^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,JOB)
  1.  W !!,"VistA Automatic Q/R Processing will stop soon."
  1.  Q
  1.  ;
  1. STTWRITE(NAME,VALUE) ; write statistics for the run
  1.  N IEN
  1.  S VALUE=$G(VALUE)
  1.  S IEN=$$STTNAME(NAME) Q:IEN<0
  1.  I IEN>0 D STTUPDT(NAME,VALUE) Q  ; use update instead
  1.  S IEN=$O(^MAGDSTT(2006.543,RUNNUMBER,2,"B"),-1)+1
  1.  S ^MAGDSTT(2006.543,RUNNUMBER,2,IEN,0)=NAME_"^"_VALUE
  1.  S ^MAGDSTT(2006.543,RUNNUMBER,2,"B",NAME,IEN)=""
  1.  S ^MAGDSTT(2006.543,RUNNUMBER,2,0)="^2006.5432^"_IEN_"^"_IEN
  1.  Q
  1.  ;
  1. STTREAD(NAME) ; read a statistics parameter
  1.  N IEN
  1.  S IEN=$$STTNAME(NAME) Q:IEN<0
  1.  I IEN="" D  Q ""
  1.  . W !,"*** ERROR in STTREAD^",$T(+0)," ***"
  1.  . W !,"NAME """,NAME,""" is not defined in"
  1.  . W " ^MAGDSTT(2006.543,",RUNNUMBER,")."
  1.  . Q 
  1.  Q $P(^MAGDSTT(2006.543,RUNNUMBER,2,IEN,0),"^",2)
  1.  ;
  1. STTUPDT(NAME,VALUE) ; update a statistics parameter
  1.  N IEN
  1.  S VALUE=$G(VALUE)
  1.  S IEN=$$STTNAME(NAME) Q:IEN<0
  1.  I IEN="" D STTWRITE(NAME,VALUE) Q
  1.  S $P(^MAGDSTT(2006.543,RUNNUMBER,2,IEN,0),"^",2)=VALUE
  1.  Q
  1.  ;
  1. STTINC(NAME,VALUE) ; increment a statistics parameter
  1.  N IEN
  1.  S VALUE=+$G(VALUE)
  1.  S IEN=$$STTNAME(NAME) Q:IEN<0
  1.  I IEN="" D STTWRITE(NAME,VALUE) Q
  1.  S $P(^(0),"^",2)=$P(^MAGDSTT(2006.543,RUNNUMBER,2,IEN,0),"^",2)+VALUE
  1.  Q
  1.  ;
  1. STTNAME(NAME) ; get IEN for NAME
  1.  ; return: -1 for an error, "" for no NAME, IEN otherwise
  1.  N IEN
  1.  S NAME=$G(NAME)
  1.  I NAME="" D  Q -1
  1.  . W !,"*** ERROR in STTNAME^",$T(+0)
  1.  . W " NAME is null or undefined ***"
  1.  . Q
  1.  ; check for existence of the statistical parameter
  1.  S IEN=$O(^MAGDSTT(2006.543,RUNNUMBER,2,"B",NAME,""))
  1.  Q IEN