MAGDSTA1 ;WOIFO/PMK - Q/R Retrieve of DICOM images from PACS to VistA ; Mar 08, 2022@07:55:07
;;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 #2056 reference $$GET1^DIQ function call
; Supported IA #10103 reference $$FMTE^XLFDT function call
; Supported IA #10103 reference $$FMADD^XLFDT function call
; Supported IA #10103 reference $$NOW^XLFDT function call
; Supported IA #1519 reference EN^XUTMDEVQ subroutine call
; Supported IA #10097 reference $$EC^%ZOSV
; Supported IA #1621 reference UNWIND^%ZTER
; Supported IA #10035 to read PATIENT file (#2)
;
Q
;
ENTRY(MENUOPTION) ; Entry point from main menu
N ACNUMB,BATCHSIZE,BEGDATE,DFN,ENDDATE,HOSTNAME,HOURS,IMAGINGSERVICE,OPTION,QRSCP,QRSTACK
N MAGIOM,MAGXTMP,RUNTIME,SCANMODE,SORTORDER,STARTIEN,STARTTIME,STATUS,STUDYDATE,STUDYIEN
N CONSULTSERVICES,DEFAULT,DIVISION,DONE,ERROR,I,LASTRUN,OK,QUESTION,QUIT,SERVICES,X,ZTDESC
;
N $ETRAP,$ESTACK S $ETRAP="D ERROR^MAGDSTA"
;
; application-wide variables
S OPTION=$G(^TMP("MAG",$J,"BATCH Q/R","OPTION"))
S IMAGINGSERVICE=$G(^TMP("MAG",$J,"BATCH Q/R","IMAGING SERVICE"))
S QRSTACK="AUTOMATIC"
S HOSTNAME=$$HOSTNAME^MAGDFCNV
I $$CHECKDIV^MAGDSTAB()="" D Q
. W !!,"*** Use the PARM option to set Check Study Division switch ***"
. D CONTINUE^MAGDSTQ
. Q
S DIVISION=$G(DUZ(2),0) ; user's logon division
I $$CHECKDIV^MAGDSTAB()="Y",'DIVISION D Q
. W !!,"*** User's Division is not defined ***"
. D CONTINUE^MAGDSTQ
. Q
;
S MAGXTMP=$$INITXTMP^MAGDSTQ0
;
S DEFAULT=$G(^TMP("MAG",$J,"Q/R PARAM","SCAN MODE"),"DATE")
W ! S OK=0 F D Q:OK
. I IMAGINGSERVICE="RADIOLOGY" D
. . W !!,"Scan by Date, Report Number, Patient, or Accession (D, N, P, or A): "
. . Q
. E D
. . W !!,"Scan by Date, Consult Number, Patient, or Accession (D, N, P, or A): "
. . Q
. I $L(DEFAULT) W DEFAULT,"// "
. R X:DTIME E S OK=-1 Q
. I X="",$L(DEFAULT) S X=DEFAULT W X
. I X="" S OK=-1 Q
. I X["^" S OK=-1 Q
. I "Dd"[$E(X) S SCANMODE="DATE",OK=1 Q
. I "Nn"[$E(X) S SCANMODE="NUMBER",OK=1 Q
. I "Pp"[$E(X) S SCANMODE="PATIENT",OK=1 Q
. I "Aa"[$E(X) S SCANMODE="ACCESSION",OK=1 Q
. W " ???",!,"Please enter ""D"", ""N"", ""P"", or ""A""."
. Q
Q:OK'=1 ; didn't enter a choice
S ^TMP("MAG",$J,"Q/R PARAM","SCAN MODE")=SCANMODE
;
; get parameters of last run
S LASTRUN=$O(^MAGDSTT(2006.543,"C",MENUOPTION,$E(SCANMODE,1),""),-1)
I LASTRUN D
. S X="Parameters of the Previous "_SCANMODE_" Run"
. W !!?10,X,!?10 F I=1:1:$L(X) W "-"
. D LASTRUN^MAGDSTAS(LASTRUN)
. D DISPLAY1^MAGDSTA9
. I STATUS="COMPLETED" D
. . W !!,"The last ",SCANMODE," scan run completed on ",$$FMTE^XLFDT(RUNTIME)
. . S ERROR=$$YESNO^MAGDSTQ("Start this "_SCANMODE_" scan where the last run ended?","y",.X)
. . I ERROR<0 W " YESNO ERROR" Q
. . I X="YES" D
. . . D COPYPARM(1)
. . . Q
. . E D
. . . K ^TMP("MAG",$J,"BATCH Q/R","PATIENT DFN")
. . . K PICK ; consult service list
. . . Q
. . Q
. E I STATUS="RUNNING" D
. . W !!,"THE LAST ",SCANMODE," SCAN RUN HAS NOT YET COMPLETED. The last action was on ",$$FMTE^XLFDT(RUNTIME)
. . S ERROR=$$YESNO^MAGDSTQ("Start this "_SCANMODE_" scan where the last run is expected to end?",,.X) ; no default
. . I ERROR<0 W " YESNO ERROR" Q
. . I X="YES" D
. . . D COPYPARM(1)
. . . Q
. . E D
. . . K ^TMP("MAG",$J,"BATCH Q/R","PATIENT DFN")
. . . Q
. . Q
. E I STATUS="STARTED" D
. . W !!,"THE LAST ",SCANMODE," SCAN RUN HAS NOT YET BEGUN. The last action was on ",$$FMTE^XLFDT(RUNTIME)
. . S ERROR=$$YESNO^MAGDSTQ("Start this "_SCANMODE_" scan where the last run is expected to end?",,.X) ; no default
. . I ERROR<0 W " YESNO ERROR" Q
. . I X="YES" D
. . . D COPYPARM(1)
. . . Q
. . E D
. . . K ^TMP("MAG",$J,"BATCH Q/R","PATIENT DFN")
. . . Q
. . Q
. E D
. . W !!,"THE LAST ",SCANMODE," SCAN RUN ABNORMALLY TERMINATED: ",STATUS
. . W !,"The last action was on ",$$FMTE^XLFDT(RUNTIME)
. . S ERROR=$$YESNO^MAGDSTQ("Start this "_SCANMODE_" scan where the last run abnormally ended?",,.X) ; no default
. . I ERROR<0 W " YESNO ERROR" Q
. . I X="YES" D
. . . D COPYPARM(0)
. . . Q
. . E D
. . . K ^TMP("MAG",$J,"BATCH Q/R","PATIENT DFN")
. . . Q
. . Q
. . Q
. Q
;
I '$D(^TMP("MAG",$J,"BATCH Q/R","HOURS OF OPERATION")) D
. S ^TMP("MAG",$J,"BATCH Q/R","HOURS OF OPERATION")="YYYYYYYYYYYYYYYYYYYYYYYY"
. Q
;
D QRSCP^MAGDSTA2 ; get query/retrieve scp for radiology & consults
I $G(^TMP("MAG",$J,"BATCH Q/R","PACS Q/R RETRIEVE SCP"))="" W " -- Exiting" Q
;
I SCANMODE="ACCESSION" D Q ; single accession number compare/retrieve
. D ACNUM^MAGDSTA2
. Q
;
S X=0
I IMAGINGSERVICE="CONSULTS" D
. S X=$$SERVICES^MAGDSTA8(.CONSULTSERVICES,"YES")
. K ^TMP("MAG",$J,"BATCH Q/R","CONSULT SERVICES") ; remove old ones
. M ^TMP("MAG",$J,"BATCH Q/R","CONSULT SERVICES")=CONSULTSERVICES
. Q
I X<0 W !,"Exiting" Q
;
I SCANMODE="NUMBER" D
. S QUESTION="SORTORDR^MAGDSTA2"
. I IMAGINGSERVICE="RADIOLOGY" D
. . S QUESTION=QUESTION_" RARPT1^MAGDSTA4"
. . Q
. E D ; consults
. . S QUESTION=QUESTION_" STUDY1^MAGDSTA6"
. . Q
. S QUESTION=QUESTION_" BATCHSIZ^MAGDSTA2 HOURS^MAGDSTA2 VERIFY^MAGDSTA9"
. S QUESTION("ASCENDING")=QUESTION
. S QUESTION("DESCENDING")=QUESTION
. Q
E I SCANMODE="DATE" D
. S QUESTION="SORTORDR^MAGDSTA2"
. S QUESTION("ASCENDING")=QUESTION_" BEGDATE^MAGDSTA2 ENDDATE^MAGDSTA2 HOURS^MAGDSTA2 VERIFY^MAGDSTA9"
. S QUESTION("DESCENDING")=QUESTION_" ENDDATE^MAGDSTA2 BEGDATE^MAGDSTA2 HOURS^MAGDSTA2 VERIFY^MAGDSTA9"
. Q
E I SCANMODE="PATIENT" D
. S QUESTION="PATIENTA^MAGDSTQA SORTORDR^MAGDSTA2"
. S QUESTION("ASCENDING")=QUESTION_" BEGDATE^MAGDSTA2 ENDDATE^MAGDSTA2 HOURS^MAGDSTA2 VERIFY^MAGDSTA9"
. S QUESTION("DESCENDING")=QUESTION_" ENDDATE^MAGDSTA2 BEGDATE^MAGDSTA2 HOURS^MAGDSTA2 VERIFY^MAGDSTA9"
. Q
;
S QUESTION("NONE")=QUESTION("ASCENDING") ; initial default is ASCENDING
;
S SORTORDER="NONE" ; value will change when SORTORDER^MAGDSTA2 is invoked
F I=1:1:$L(QUESTION(SORTORDER)," ") D I I<0 S QUIT=-1 Q
. S QUIT=0
. D @$P(QUESTION(SORTORDER)," ",I)
. I QUIT>0 S I=I-2
. E I QUIT<0 S I=-1
. Q
I QUIT<0 Q
;
D TASKINIT
;
; Setup for tasking the compare image counts/retrieve job
;
; ZTDESC is set above
;
N %ZIS,ZTSAVE
S ZTSAVE("HOSTNAME")=""
S ZTSAVE("MAGIOM")=""
S ZTSAVE("MAGXTMP")=""
S ZTSAVE("MENUOPTION")=""
S ZTSAVE("^TMP(""MAG"",$J,""BATCH Q/R"",")=""
S ZTSAVE("^TMP(""MAG"",$J,""Q/R PARAM"",")=""
S ZTSAVE("QRSTACK")=""
S ZTSAVE("CONSULTSERVICES(")=""
D EN^XUTMDEVQ("TASK^"_$T(+0),ZTDESC,.ZTSAVE,.%ZIS)
Q
;
TASKINIT ; initialize MAGIOM and ZTDESC
I ^TMP("MAG",$J,"BATCH Q/R","OPTION")="RETRIEVE MISSING IMAGES" D
. W !!,"Recommend report output of 132 columns",!!
. S MAGIOM=132 ; retrieve requires 132 columns
. S ZTDESC="Retrieve Missing Images" ; for tasking
. Q
E D ; compare image counts
. S MAGIOM=80 ; comparing image counts requires only 80 columns
. S ZTDESC="Compare Image Counts" ; for tasking
. Q
S ZTDESC=ZTDESC_" for "_IMAGINGSERVICE
Q
;
TASK ; entry point for a tasked job
N $ETRAP,$ESTACK S $ETRAP="D ERROR^MAGDSTA"
N I
F I=1:1:$L(ZTDESC) W $E(ZTDESC,I)," "
W !,"-" F I=2:1:$L(ZTDESC) W "--"
W !,"Started on ",$$FMTE^XLFDT($$NOW^XLFDT,1)
W " by ",$$GET1^DIQ(200,DUZ,.01,"E")," (DUZ: ",DUZ,")"
W " Job Number: ",$J
D DISPLAY^MAGDSTA9
W !!
;
BEGIN ; entry point for running the image compare or retrieve process
N ACNUMB,BATCHSIZE,BEGDATE,DFN,ENDDATE,HOURS,IMAGINGSERVICE,OPTION,QRSCP,RUNTIME
N SCANMODE,SORTORDER,STARTIEN,STARTTIME,STATUS,STUDYDATE,STUDYIEN
N DIRECTION,I,J,K,L,RUNNUMBER,STOP
;
S X=MAGIOM X ^%ZOSF("RM") ; set right margin to 80 or 132
;
S OPTION=$G(^TMP("MAG",$J,"BATCH Q/R","OPTION"))
S IMAGINGSERVICE=$G(^TMP("MAG",$J,"BATCH Q/R","IMAGING SERVICE"))
S SCANMODE=$G(^TMP("MAG",$J,"Q/R PARAM","SCAN MODE"))
S SORTORDER=$G(^TMP("MAG",$J,"BATCH Q/R","SORT ORDER"))
S BATCHSIZE=$G(^TMP("MAG",$J,"BATCH Q/R","BATCH SIZE"))
S STARTIEN=$G(^TMP("MAG",$J,"BATCH Q/R","REPORT/STUDY IEN"))
S BEGDATE=$G(^TMP("MAG",$J,"BATCH Q/R","BEGIN DATE"))
S ENDDATE=$G(^TMP("MAG",$J,"BATCH Q/R","END DATE"))
S SORTORDER=$G(^TMP("MAG",$J,"BATCH Q/R","SORT ORDER"))
S HOURS=^TMP("MAG",$J,"BATCH Q/R","HOURS OF OPERATION")
S QRSCP=$G(^TMP("MAG",$J,"BATCH Q/R","PACS Q/R RETRIEVE SCP"))
S DFN=$G(^TMP("MAG",$J,"BATCH Q/R","PATIENT DFN"))
;
L +^MAGDSTT(2006.543,0):30 E D Q
. W !!,"Cannot obtain LOCK on Q/R RETRIEVE DICOM RUN STATISTICS Table.",!!
. Q
S X=$G(^MAGDSTT(2006.543,0))
S $P(X,"^",1,2)="DICOM BATCH Q/R RUN STATISTICS^2006.543"
S (RUNNUMBER,$P(X,"^",3))=$O(^MAGDSTT(2006.543," "),-1)+1 ; get next IEN
S $P(X,"^",4)=$P(X,"^",4)+1 ; increment total count
S ^MAGDSTT(2006.543,0)=X
;
S (RUNTIME,STARTTIME)=$$NOW^XLFDT(),X=""
S $P(X,"^",1)=STARTTIME
S $P(X,"^",2)=$E(IMAGINGSERVICE,1) ; R or C
S $P(X,"^",3)=RUNTIME ; updated during the run
S $P(X,"^",4)=$E(OPTION,1) ; C or R
S $P(X,"^",5)="STARTED" ; will be updated during the run
S $P(X,"^",6)=$E(SCANMODE,1) ; D, N, or P
S $P(X,"^",7)=QRSCP
S $P(X,"^",9)=BEGDATE
S $P(X,"^",10)=ENDDATE
S $P(X,"^",11)=STARTIEN
S $P(X,"^",12)=BATCHSIZE
S $P(X,"^",13)=$E(SORTORDER,1) ; A or D
S $P(X,"^",14)=HOURS
S $P(X,"^",15)=DFN
;
; piece 8 will be set in ^MAGDSTV1
; pieces 15-18 will be set in ^MAGDSTAA
;
S $P(X,"^",19)=DUZ
S $P(X,"^",20)=MENUOPTION
S ^MAGDSTT(2006.543,RUNNUMBER,0)=X
I IMAGINGSERVICE="CONSULTS" D ; add the consult request services, if applicable
. S (I,J)=0
. F S I=$O(CONSULTSERVICES(I)) Q:'I D
. . S J=J+1
. . S ^MAGDSTT(2006.543,RUNNUMBER,1,J,0)=I
. . S ^MAGDSTT(2006.543,RUNNUMBER,1,"B",I,J)=""
. . Q
. S ^MAGDSTT(2006.543,RUNNUMBER,1,0)="^2006.5431P^"_J_"^"_J
. Q
S ^MAGDSTT(2006.543,"B",STARTTIME,RUNNUMBER)=""
S ^MAGDSTT(2006.543,"C",MENUOPTION,$E(SCANMODE,1),RUNNUMBER)=""
L -^MAGDSTT(2006.543,0)
;
D INITSTT^MAGDSTA(RUNNUMBER) ; initialize the statistics
;
S ^TMP("MAG",$J,"BATCH Q/R","RUN NUMBER")=RUNNUMBER
;
S DIRECTION=$$DIRECTON(SORTORDER)
;
S ^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,$J,"STATUS")="RUN",^("IMAGING SERVICE")=IMAGINGSERVICE
S ^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,$J,"SCAN MODE")=SCANMODE,^("OPTION")=OPTION
S ^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,$J,"START TIME")=$$NOW^XLFDT
;
I IMAGINGSERVICE="RADIOLOGY" D
. S STOP=$$MAIN^MAGDSTA5()
. Q
E D ; consults and procedures
. S STOP=$$MAIN^MAGDSTA7()
. Q
;
;
; STOP: -1=error, 0=run completed, 1=run stopped
S RUNTIME=$$NOW^XLFDT()
S $P(^MAGDSTT(2006.543,RUNNUMBER,0),"^",3)=RUNTIME ; final time updated
S X=$S(STOP<0:"Stopped due to Error",STOP>0:"Stopped by User",1:"COMPLETED")
S $P(^MAGDSTT(2006.543,RUNNUMBER,0),"^",5)=X
W !!,"RUN ",X
W " at ",$$FMTE^XLFDT($$NOW^XLFDT,1)
K ^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,$J)
K ^TMP("MAG",$J,"BATCH Q/R")
D CONTINUE^MAGDSTQ
Q
;
DIRECTON(SORTORDER) ; return the direction for $order
; 1 = normal order
; -1 = reverse order
Q $S(SORTORDER="ASCENDING":1,SORTORDER="DESCENDING":-1)
;
COPYPARM(NORMALRUN) ; copy last run's parameters for the next run
N I,DIRECTION
S ^TMP("MAG",$J,"BATCH Q/R","PACS Q/R RETRIEVE SCP")=QRSCP
S ^TMP("MAG",$J,"Q/R PARAM","SCAN MODE")=SCANMODE
S ^TMP("MAG",$J,"BATCH Q/R","SORT ORDER")=SORTORDER
S ^TMP("MAG",$J,"BATCH Q/R","HOURS OF OPERATION")=HOURS
;
S ^TMP("MAG",$J,"Q/R PARAM","QUERY USER APPLICATION")=QRSCP ; needed for QRSCP^MAGDSTA2
;
S DIRECTION=$$DIRECTON(SORTORDER)
;
; get scan mode specific parameters
I SCANMODE="PATIENT" D
. ; user may want to change patient
. S ^TMP("MAG",$J,"BATCH Q/R","PATIENT DFN")=DFN
. Q
I (SCANMODE="DATE")!(SCANMODE="PATIENT") D ; user may want to change date range
. I SORTORDER="ASCENDING" D ; set BEGIN DATE to the last date of the previous run
. . I NORMALRUN S ^TMP("MAG",$J,"BATCH Q/R","BEGIN DATE")=$$NEXTDATE(ENDDATE,DIRECTION)
. . E S ^TMP("MAG",$J,"BATCH Q/R","BEGIN DATE")=STUDYDATE\1
. . S ^TMP("MAG",$J,"BATCH Q/R","END DATE")=""
. . Q
. E D ; DESCENDING -- set END DATE to the last date of the previous run
. . I NORMALRUN S ^TMP("MAG",$J,"BATCH Q/R","END DATE")=$$NEXTDATE(BEGDATE,DIRECTION)
. . E S ^TMP("MAG",$J,"BATCH Q/R","END DATE")=STUDYDATE\1
. . S ^TMP("MAG",$J,"BATCH Q/R","BEGIN DATE")=""
. . Q
. Q
E I SCANMODE="NUMBER" D
. ; set REPORT/STUDY IEN to the last IEN of the previous run
. S ^TMP("MAG",$J,"BATCH Q/R","REPORT/STUDY IEN")=(STUDYIEN+DIRECTION)
. S ^TMP("MAG",$J,"BATCH Q/R","BATCH SIZE")=BATCHSIZE
. Q
;
; get consult services
M ^TMP("MAG",$J,"BATCH Q/R","CONSULT SERVICES")=CONSULTSERVICES
Q
;
NEXTDATE(DATE,DIRECTION) ; get the next date, but not in the future
N NEXTDATE,NOW
S NOW=$$NOW^XLFDT\1
S NEXTDATE=$$FMADD^XLFDT(DATE\1,DIRECTION)
I NEXTDATE>NOW S NEXTDATE=NOW ; no future dates
Q NEXTDATE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDSTA1 14011 printed Sep 23, 2025@19:37:49 Page 2
MAGDSTA1 ;WOIFO/PMK - Q/R Retrieve of DICOM images from PACS to VistA ; Mar 08, 2022@07:55:07
+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 ; Supported IA #2056 reference $$GET1^DIQ function call
+18 ; Supported IA #10103 reference $$FMTE^XLFDT function call
+19 ; Supported IA #10103 reference $$FMADD^XLFDT function call
+20 ; Supported IA #10103 reference $$NOW^XLFDT function call
+21 ; Supported IA #1519 reference EN^XUTMDEVQ subroutine call
+22 ; Supported IA #10097 reference $$EC^%ZOSV
+23 ; Supported IA #1621 reference UNWIND^%ZTER
+24 ; Supported IA #10035 to read PATIENT file (#2)
+25 ;
+26 QUIT
+27 ;
ENTRY(MENUOPTION) ; Entry point from main menu
+1 NEW ACNUMB,BATCHSIZE,BEGDATE,DFN,ENDDATE,HOSTNAME,HOURS,IMAGINGSERVICE,OPTION,QRSCP,QRSTACK
+2 NEW MAGIOM,MAGXTMP,RUNTIME,SCANMODE,SORTORDER,STARTIEN,STARTTIME,STATUS,STUDYDATE,STUDYIEN
+3 NEW CONSULTSERVICES,DEFAULT,DIVISION,DONE,ERROR,I,LASTRUN,OK,QUESTION,QUIT,SERVICES,X,ZTDESC
+4 ;
+5 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERROR^MAGDSTA"
+6 ;
+7 ; application-wide variables
+8 SET OPTION=$GET(^TMP("MAG",$JOB,"BATCH Q/R","OPTION"))
+9 SET IMAGINGSERVICE=$GET(^TMP("MAG",$JOB,"BATCH Q/R","IMAGING SERVICE"))
+10 SET QRSTACK="AUTOMATIC"
+11 SET HOSTNAME=$$HOSTNAME^MAGDFCNV
+12 IF $$CHECKDIV^MAGDSTAB()=""
Begin DoDot:1
+13 WRITE !!,"*** Use the PARM option to set Check Study Division switch ***"
+14 DO CONTINUE^MAGDSTQ
+15 QUIT
End DoDot:1
QUIT
+16 ; user's logon division
SET DIVISION=$GET(DUZ(2),0)
+17 IF $$CHECKDIV^MAGDSTAB()="Y"
IF 'DIVISION
Begin DoDot:1
+18 WRITE !!,"*** User's Division is not defined ***"
+19 DO CONTINUE^MAGDSTQ
+20 QUIT
End DoDot:1
QUIT
+21 ;
+22 SET MAGXTMP=$$INITXTMP^MAGDSTQ0
+23 ;
+24 SET DEFAULT=$GET(^TMP("MAG",$JOB,"Q/R PARAM","SCAN MODE"),"DATE")
+25 WRITE !
SET OK=0
FOR
Begin DoDot:1
+26 IF IMAGINGSERVICE="RADIOLOGY"
Begin DoDot:2
+27 WRITE !!,"Scan by Date, Report Number, Patient, or Accession (D, N, P, or A): "
+28 QUIT
End DoDot:2
+29 IF '$TEST
Begin DoDot:2
+30 WRITE !!,"Scan by Date, Consult Number, Patient, or Accession (D, N, P, or A): "
+31 QUIT
End DoDot:2
+32 IF $LENGTH(DEFAULT)
WRITE DEFAULT,"// "
+33 READ X:DTIME
IF '$TEST
SET OK=-1
QUIT
+34 IF X=""
IF $LENGTH(DEFAULT)
SET X=DEFAULT
WRITE X
+35 IF X=""
SET OK=-1
QUIT
+36 IF X["^"
SET OK=-1
QUIT
+37 IF "Dd"[$EXTRACT(X)
SET SCANMODE="DATE"
SET OK=1
QUIT
+38 IF "Nn"[$EXTRACT(X)
SET SCANMODE="NUMBER"
SET OK=1
QUIT
+39 IF "Pp"[$EXTRACT(X)
SET SCANMODE="PATIENT"
SET OK=1
QUIT
+40 IF "Aa"[$EXTRACT(X)
SET SCANMODE="ACCESSION"
SET OK=1
QUIT
+41 WRITE " ???",!,"Please enter ""D"", ""N"", ""P"", or ""A""."
+42 QUIT
End DoDot:1
if OK
QUIT
+43 ; didn't enter a choice
if OK'=1
QUIT
+44 SET ^TMP("MAG",$JOB,"Q/R PARAM","SCAN MODE")=SCANMODE
+45 ;
+46 ; get parameters of last run
+47 SET LASTRUN=$ORDER(^MAGDSTT(2006.543,"C",MENUOPTION,$EXTRACT(SCANMODE,1),""),-1)
+48 IF LASTRUN
Begin DoDot:1
+49 SET X="Parameters of the Previous "_SCANMODE_" Run"
+50 WRITE !!?10,X,!?10
FOR I=1:1:$LENGTH(X)
WRITE "-"
+51 DO LASTRUN^MAGDSTAS(LASTRUN)
+52 DO DISPLAY1^MAGDSTA9
+53 IF STATUS="COMPLETED"
Begin DoDot:2
+54 WRITE !!,"The last ",SCANMODE," scan run completed on ",$$FMTE^XLFDT(RUNTIME)
+55 SET ERROR=$$YESNO^MAGDSTQ("Start this "_SCANMODE_" scan where the last run ended?","y",.X)
+56 IF ERROR<0
WRITE " YESNO ERROR"
QUIT
+57 IF X="YES"
Begin DoDot:3
+58 DO COPYPARM(1)
+59 QUIT
End DoDot:3
+60 IF '$TEST
Begin DoDot:3
+61 KILL ^TMP("MAG",$JOB,"BATCH Q/R","PATIENT DFN")
+62 ; consult service list
KILL PICK
+63 QUIT
End DoDot:3
+64 QUIT
End DoDot:2
+65 IF '$TEST
IF STATUS="RUNNING"
Begin DoDot:2
+66 WRITE !!,"THE LAST ",SCANMODE," SCAN RUN HAS NOT YET COMPLETED. The last action was on ",$$FMTE^XLFDT(RUNTIME)
+67 ; no default
SET ERROR=$$YESNO^MAGDSTQ("Start this "_SCANMODE_" scan where the last run is expected to end?",,.X)
+68 IF ERROR<0
WRITE " YESNO ERROR"
QUIT
+69 IF X="YES"
Begin DoDot:3
+70 DO COPYPARM(1)
+71 QUIT
End DoDot:3
+72 IF '$TEST
Begin DoDot:3
+73 KILL ^TMP("MAG",$JOB,"BATCH Q/R","PATIENT DFN")
+74 QUIT
End DoDot:3
+75 QUIT
End DoDot:2
+76 IF '$TEST
IF STATUS="STARTED"
Begin DoDot:2
+77 WRITE !!,"THE LAST ",SCANMODE," SCAN RUN HAS NOT YET BEGUN. The last action was on ",$$FMTE^XLFDT(RUNTIME)
+78 ; no default
SET ERROR=$$YESNO^MAGDSTQ("Start this "_SCANMODE_" scan where the last run is expected to end?",,.X)
+79 IF ERROR<0
WRITE " YESNO ERROR"
QUIT
+80 IF X="YES"
Begin DoDot:3
+81 DO COPYPARM(1)
+82 QUIT
End DoDot:3
+83 IF '$TEST
Begin DoDot:3
+84 KILL ^TMP("MAG",$JOB,"BATCH Q/R","PATIENT DFN")
+85 QUIT
End DoDot:3
+86 QUIT
End DoDot:2
+87 IF '$TEST
Begin DoDot:2
+88 WRITE !!,"THE LAST ",SCANMODE," SCAN RUN ABNORMALLY TERMINATED: ",STATUS
+89 WRITE !,"The last action was on ",$$FMTE^XLFDT(RUNTIME)
+90 ; no default
SET ERROR=$$YESNO^MAGDSTQ("Start this "_SCANMODE_" scan where the last run abnormally ended?",,.X)
+91 IF ERROR<0
WRITE " YESNO ERROR"
QUIT
+92 IF X="YES"
Begin DoDot:3
+93 DO COPYPARM(0)
+94 QUIT
End DoDot:3
+95 IF '$TEST
Begin DoDot:3
+96 KILL ^TMP("MAG",$JOB,"BATCH Q/R","PATIENT DFN")
+97 QUIT
End DoDot:3
+98 QUIT
+99 QUIT
End DoDot:2
+100 QUIT
End DoDot:1
+101 ;
+102 IF '$DATA(^TMP("MAG",$JOB,"BATCH Q/R","HOURS OF OPERATION"))
Begin DoDot:1
+103 SET ^TMP("MAG",$JOB,"BATCH Q/R","HOURS OF OPERATION")="YYYYYYYYYYYYYYYYYYYYYYYY"
+104 QUIT
End DoDot:1
+105 ;
+106 ; get query/retrieve scp for radiology & consults
DO QRSCP^MAGDSTA2
+107 IF $GET(^TMP("MAG",$JOB,"BATCH Q/R","PACS Q/R RETRIEVE SCP"))=""
WRITE " -- Exiting"
QUIT
+108 ;
+109 ; single accession number compare/retrieve
IF SCANMODE="ACCESSION"
Begin DoDot:1
+110 DO ACNUM^MAGDSTA2
+111 QUIT
End DoDot:1
QUIT
+112 ;
+113 SET X=0
+114 IF IMAGINGSERVICE="CONSULTS"
Begin DoDot:1
+115 SET X=$$SERVICES^MAGDSTA8(.CONSULTSERVICES,"YES")
+116 ; remove old ones
KILL ^TMP("MAG",$JOB,"BATCH Q/R","CONSULT SERVICES")
+117 MERGE ^TMP("MAG",$JOB,"BATCH Q/R","CONSULT SERVICES")=CONSULTSERVICES
+118 QUIT
End DoDot:1
+119 IF X<0
WRITE !,"Exiting"
QUIT
+120 ;
+121 IF SCANMODE="NUMBER"
Begin DoDot:1
+122 SET QUESTION="SORTORDR^MAGDSTA2"
+123 IF IMAGINGSERVICE="RADIOLOGY"
Begin DoDot:2
+124 SET QUESTION=QUESTION_" RARPT1^MAGDSTA4"
+125 QUIT
End DoDot:2
+126 ; consults
IF '$TEST
Begin DoDot:2
+127 SET QUESTION=QUESTION_" STUDY1^MAGDSTA6"
+128 QUIT
End DoDot:2
+129 SET QUESTION=QUESTION_" BATCHSIZ^MAGDSTA2 HOURS^MAGDSTA2 VERIFY^MAGDSTA9"
+130 SET QUESTION("ASCENDING")=QUESTION
+131 SET QUESTION("DESCENDING")=QUESTION
+132 QUIT
End DoDot:1
+133 IF '$TEST
IF SCANMODE="DATE"
Begin DoDot:1
+134 SET QUESTION="SORTORDR^MAGDSTA2"
+135 SET QUESTION("ASCENDING")=QUESTION_" BEGDATE^MAGDSTA2 ENDDATE^MAGDSTA2 HOURS^MAGDSTA2 VERIFY^MAGDSTA9"
+136 SET QUESTION("DESCENDING")=QUESTION_" ENDDATE^MAGDSTA2 BEGDATE^MAGDSTA2 HOURS^MAGDSTA2 VERIFY^MAGDSTA9"
+137 QUIT
End DoDot:1
+138 IF '$TEST
IF SCANMODE="PATIENT"
Begin DoDot:1
+139 SET QUESTION="PATIENTA^MAGDSTQA SORTORDR^MAGDSTA2"
+140 SET QUESTION("ASCENDING")=QUESTION_" BEGDATE^MAGDSTA2 ENDDATE^MAGDSTA2 HOURS^MAGDSTA2 VERIFY^MAGDSTA9"
+141 SET QUESTION("DESCENDING")=QUESTION_" ENDDATE^MAGDSTA2 BEGDATE^MAGDSTA2 HOURS^MAGDSTA2 VERIFY^MAGDSTA9"
+142 QUIT
End DoDot:1
+143 ;
+144 ; initial default is ASCENDING
SET QUESTION("NONE")=QUESTION("ASCENDING")
+145 ;
+146 ; value will change when SORTORDER^MAGDSTA2 is invoked
SET SORTORDER="NONE"
+147 FOR I=1:1:$LENGTH(QUESTION(SORTORDER)," ")
Begin DoDot:1
+148 SET QUIT=0
+149 DO @$PIECE(QUESTION(SORTORDER)," ",I)
+150 IF QUIT>0
SET I=I-2
+151 IF '$TEST
IF QUIT<0
SET I=-1
+152 QUIT
End DoDot:1
IF I<0
SET QUIT=-1
QUIT
+153 IF QUIT<0
QUIT
+154 ;
+155 DO TASKINIT
+156 ;
+157 ; Setup for tasking the compare image counts/retrieve job
+158 ;
+159 ; ZTDESC is set above
+160 ;
+161 NEW %ZIS,ZTSAVE
+162 SET ZTSAVE("HOSTNAME")=""
+163 SET ZTSAVE("MAGIOM")=""
+164 SET ZTSAVE("MAGXTMP")=""
+165 SET ZTSAVE("MENUOPTION")=""
+166 SET ZTSAVE("^TMP(""MAG"",$J,""BATCH Q/R"",")=""
+167 SET ZTSAVE("^TMP(""MAG"",$J,""Q/R PARAM"",")=""
+168 SET ZTSAVE("QRSTACK")=""
+169 SET ZTSAVE("CONSULTSERVICES(")=""
+170 DO EN^XUTMDEVQ("TASK^"_$TEXT(+0),ZTDESC,.ZTSAVE,.%ZIS)
+171 QUIT
+172 ;
TASKINIT ; initialize MAGIOM and ZTDESC
+1 IF ^TMP("MAG",$JOB,"BATCH Q/R","OPTION")="RETRIEVE MISSING IMAGES"
Begin DoDot:1
+2 WRITE !!,"Recommend report output of 132 columns",!!
+3 ; retrieve requires 132 columns
SET MAGIOM=132
+4 ; for tasking
SET ZTDESC="Retrieve Missing Images"
+5 QUIT
End DoDot:1
+6 ; compare image counts
IF '$TEST
Begin DoDot:1
+7 ; comparing image counts requires only 80 columns
SET MAGIOM=80
+8 ; for tasking
SET ZTDESC="Compare Image Counts"
+9 QUIT
End DoDot:1
+10 SET ZTDESC=ZTDESC_" for "_IMAGINGSERVICE
+11 QUIT
+12 ;
TASK ; entry point for a tasked job
+1 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERROR^MAGDSTA"
+2 NEW I
+3 FOR I=1:1:$LENGTH(ZTDESC)
WRITE $EXTRACT(ZTDESC,I)," "
+4 WRITE !,"-"
FOR I=2:1:$LENGTH(ZTDESC)
WRITE "--"
+5 WRITE !,"Started on ",$$FMTE^XLFDT($$NOW^XLFDT,1)
+6 WRITE " by ",$$GET1^DIQ(200,DUZ,.01,"E")," (DUZ: ",DUZ,")"
+7 WRITE " Job Number: ",$JOB
+8 DO DISPLAY^MAGDSTA9
+9 WRITE !!
+10 ;
BEGIN ; entry point for running the image compare or retrieve process
+1 NEW ACNUMB,BATCHSIZE,BEGDATE,DFN,ENDDATE,HOURS,IMAGINGSERVICE,OPTION,QRSCP,RUNTIME
+2 NEW SCANMODE,SORTORDER,STARTIEN,STARTTIME,STATUS,STUDYDATE,STUDYIEN
+3 NEW DIRECTION,I,J,K,L,RUNNUMBER,STOP
+4 ;
+5 ; set right margin to 80 or 132
SET X=MAGIOM
XECUTE ^%ZOSF("RM")
+6 ;
+7 SET OPTION=$GET(^TMP("MAG",$JOB,"BATCH Q/R","OPTION"))
+8 SET IMAGINGSERVICE=$GET(^TMP("MAG",$JOB,"BATCH Q/R","IMAGING SERVICE"))
+9 SET SCANMODE=$GET(^TMP("MAG",$JOB,"Q/R PARAM","SCAN MODE"))
+10 SET SORTORDER=$GET(^TMP("MAG",$JOB,"BATCH Q/R","SORT ORDER"))
+11 SET BATCHSIZE=$GET(^TMP("MAG",$JOB,"BATCH Q/R","BATCH SIZE"))
+12 SET STARTIEN=$GET(^TMP("MAG",$JOB,"BATCH Q/R","REPORT/STUDY IEN"))
+13 SET BEGDATE=$GET(^TMP("MAG",$JOB,"BATCH Q/R","BEGIN DATE"))
+14 SET ENDDATE=$GET(^TMP("MAG",$JOB,"BATCH Q/R","END DATE"))
+15 SET SORTORDER=$GET(^TMP("MAG",$JOB,"BATCH Q/R","SORT ORDER"))
+16 SET HOURS=^TMP("MAG",$JOB,"BATCH Q/R","HOURS OF OPERATION")
+17 SET QRSCP=$GET(^TMP("MAG",$JOB,"BATCH Q/R","PACS Q/R RETRIEVE SCP"))
+18 SET DFN=$GET(^TMP("MAG",$JOB,"BATCH Q/R","PATIENT DFN"))
+19 ;
+20 LOCK +^MAGDSTT(2006.543,0):30
IF '$TEST
Begin DoDot:1
+21 WRITE !!,"Cannot obtain LOCK on Q/R RETRIEVE DICOM RUN STATISTICS Table.",!!
+22 QUIT
End DoDot:1
QUIT
+23 SET X=$GET(^MAGDSTT(2006.543,0))
+24 SET $PIECE(X,"^",1,2)="DICOM BATCH Q/R RUN STATISTICS^2006.543"
+25 ; get next IEN
SET (RUNNUMBER,$PIECE(X,"^",3))=$ORDER(^MAGDSTT(2006.543," "),-1)+1
+26 ; increment total count
SET $PIECE(X,"^",4)=$PIECE(X,"^",4)+1
+27 SET ^MAGDSTT(2006.543,0)=X
+28 ;
+29 SET (RUNTIME,STARTTIME)=$$NOW^XLFDT()
SET X=""
+30 SET $PIECE(X,"^",1)=STARTTIME
+31 ; R or C
SET $PIECE(X,"^",2)=$EXTRACT(IMAGINGSERVICE,1)
+32 ; updated during the run
SET $PIECE(X,"^",3)=RUNTIME
+33 ; C or R
SET $PIECE(X,"^",4)=$EXTRACT(OPTION,1)
+34 ; will be updated during the run
SET $PIECE(X,"^",5)="STARTED"
+35 ; D, N, or P
SET $PIECE(X,"^",6)=$EXTRACT(SCANMODE,1)
+36 SET $PIECE(X,"^",7)=QRSCP
+37 SET $PIECE(X,"^",9)=BEGDATE
+38 SET $PIECE(X,"^",10)=ENDDATE
+39 SET $PIECE(X,"^",11)=STARTIEN
+40 SET $PIECE(X,"^",12)=BATCHSIZE
+41 ; A or D
SET $PIECE(X,"^",13)=$EXTRACT(SORTORDER,1)
+42 SET $PIECE(X,"^",14)=HOURS
+43 SET $PIECE(X,"^",15)=DFN
+44 ;
+45 ; piece 8 will be set in ^MAGDSTV1
+46 ; pieces 15-18 will be set in ^MAGDSTAA
+47 ;
+48 SET $PIECE(X,"^",19)=DUZ
+49 SET $PIECE(X,"^",20)=MENUOPTION
+50 SET ^MAGDSTT(2006.543,RUNNUMBER,0)=X
+51 ; add the consult request services, if applicable
IF IMAGINGSERVICE="CONSULTS"
Begin DoDot:1
+52 SET (I,J)=0
+53 FOR
SET I=$ORDER(CONSULTSERVICES(I))
if 'I
QUIT
Begin DoDot:2
+54 SET J=J+1
+55 SET ^MAGDSTT(2006.543,RUNNUMBER,1,J,0)=I
+56 SET ^MAGDSTT(2006.543,RUNNUMBER,1,"B",I,J)=""
+57 QUIT
End DoDot:2
+58 SET ^MAGDSTT(2006.543,RUNNUMBER,1,0)="^2006.5431P^"_J_"^"_J
+59 QUIT
End DoDot:1
+60 SET ^MAGDSTT(2006.543,"B",STARTTIME,RUNNUMBER)=""
+61 SET ^MAGDSTT(2006.543,"C",MENUOPTION,$EXTRACT(SCANMODE,1),RUNNUMBER)=""
+62 LOCK -^MAGDSTT(2006.543,0)
+63 ;
+64 ; initialize the statistics
DO INITSTT^MAGDSTA(RUNNUMBER)
+65 ;
+66 SET ^TMP("MAG",$JOB,"BATCH Q/R","RUN NUMBER")=RUNNUMBER
+67 ;
+68 SET DIRECTION=$$DIRECTON(SORTORDER)
+69 ;
+70 SET ^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,$JOB,"STATUS")="RUN"
SET ^("IMAGING SERVICE")=IMAGINGSERVICE
+71 SET ^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,$JOB,"SCAN MODE")=SCANMODE
SET ^("OPTION")=OPTION
+72 SET ^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,$JOB,"START TIME")=$$NOW^XLFDT
+73 ;
+74 IF IMAGINGSERVICE="RADIOLOGY"
Begin DoDot:1
+75 SET STOP=$$MAIN^MAGDSTA5()
+76 QUIT
End DoDot:1
+77 ; consults and procedures
IF '$TEST
Begin DoDot:1
+78 SET STOP=$$MAIN^MAGDSTA7()
+79 QUIT
End DoDot:1
+80 ;
+81 ;
+82 ; STOP: -1=error, 0=run completed, 1=run stopped
+83 SET RUNTIME=$$NOW^XLFDT()
+84 ; final time updated
SET $PIECE(^MAGDSTT(2006.543,RUNNUMBER,0),"^",3)=RUNTIME
+85 SET X=$SELECT(STOP<0:"Stopped due to Error",STOP>0:"Stopped by User",1:"COMPLETED")
+86 SET $PIECE(^MAGDSTT(2006.543,RUNNUMBER,0),"^",5)=X
+87 WRITE !!,"RUN ",X
+88 WRITE " at ",$$FMTE^XLFDT($$NOW^XLFDT,1)
+89 KILL ^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,$JOB)
+90 KILL ^TMP("MAG",$JOB,"BATCH Q/R")
+91 DO CONTINUE^MAGDSTQ
+92 QUIT
+93 ;
DIRECTON(SORTORDER) ; return the direction for $order
+1 ; 1 = normal order
+2 ; -1 = reverse order
+3 QUIT $SELECT(SORTORDER="ASCENDING":1,SORTORDER="DESCENDING":-1)
+4 ;
COPYPARM(NORMALRUN) ; copy last run's parameters for the next run
+1 NEW I,DIRECTION
+2 SET ^TMP("MAG",$JOB,"BATCH Q/R","PACS Q/R RETRIEVE SCP")=QRSCP
+3 SET ^TMP("MAG",$JOB,"Q/R PARAM","SCAN MODE")=SCANMODE
+4 SET ^TMP("MAG",$JOB,"BATCH Q/R","SORT ORDER")=SORTORDER
+5 SET ^TMP("MAG",$JOB,"BATCH Q/R","HOURS OF OPERATION")=HOURS
+6 ;
+7 ; needed for QRSCP^MAGDSTA2
SET ^TMP("MAG",$JOB,"Q/R PARAM","QUERY USER APPLICATION")=QRSCP
+8 ;
+9 SET DIRECTION=$$DIRECTON(SORTORDER)
+10 ;
+11 ; get scan mode specific parameters
+12 IF SCANMODE="PATIENT"
Begin DoDot:1
+13 ; user may want to change patient
+14 SET ^TMP("MAG",$JOB,"BATCH Q/R","PATIENT DFN")=DFN
+15 QUIT
End DoDot:1
+16 ; user may want to change date range
IF (SCANMODE="DATE")!(SCANMODE="PATIENT")
Begin DoDot:1
+17 ; set BEGIN DATE to the last date of the previous run
IF SORTORDER="ASCENDING"
Begin DoDot:2
+18 IF NORMALRUN
SET ^TMP("MAG",$JOB,"BATCH Q/R","BEGIN DATE")=$$NEXTDATE(ENDDATE,DIRECTION)
+19 IF '$TEST
SET ^TMP("MAG",$JOB,"BATCH Q/R","BEGIN DATE")=STUDYDATE\1
+20 SET ^TMP("MAG",$JOB,"BATCH Q/R","END DATE")=""
+21 QUIT
End DoDot:2
+22 ; DESCENDING -- set END DATE to the last date of the previous run
IF '$TEST
Begin DoDot:2
+23 IF NORMALRUN
SET ^TMP("MAG",$JOB,"BATCH Q/R","END DATE")=$$NEXTDATE(BEGDATE,DIRECTION)
+24 IF '$TEST
SET ^TMP("MAG",$JOB,"BATCH Q/R","END DATE")=STUDYDATE\1
+25 SET ^TMP("MAG",$JOB,"BATCH Q/R","BEGIN DATE")=""
+26 QUIT
End DoDot:2
+27 QUIT
End DoDot:1
+28 IF '$TEST
IF SCANMODE="NUMBER"
Begin DoDot:1
+29 ; set REPORT/STUDY IEN to the last IEN of the previous run
+30 SET ^TMP("MAG",$JOB,"BATCH Q/R","REPORT/STUDY IEN")=(STUDYIEN+DIRECTION)
+31 SET ^TMP("MAG",$JOB,"BATCH Q/R","BATCH SIZE")=BATCHSIZE
+32 QUIT
End DoDot:1
+33 ;
+34 ; get consult services
+35 MERGE ^TMP("MAG",$JOB,"BATCH Q/R","CONSULT SERVICES")=CONSULTSERVICES
+36 QUIT
+37 ;
NEXTDATE(DATE,DIRECTION) ; get the next date, but not in the future
+1 NEW NEXTDATE,NOW
+2 SET NOW=$$NOW^XLFDT\1
+3 SET NEXTDATE=$$FMADD^XLFDT(DATE\1,DIRECTION)
+4 ; no future dates
IF NEXTDATE>NOW
SET NEXTDATE=NOW
+5 QUIT NEXTDATE
