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