MAGDSTA0 ;WOIFO/PMK - Study Tracker - Automatic CMP/RET ; Nov 08, 2022@14:32:16
;;3.0;IMAGING;**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 #10103 reference $$NOW^XLFDT function call
; Supported IA #10103 reference $$FMADD^XLFDT function call
;
Q
;
INITXTMP(OUTPUTEXCEL) ; initialize ^XTMP for Study Tracker's automatic CMP/RET
; This is different from INITXTMP^MAGDSTQ0
N NOW,PURGE,TITLE,TODAY
S TITLE="MAG Study Tracker"
L +^XTMP(TITLE):3 E W !!,"Can't lock ^XTMP(",TITLE,") - No Excel file" Q
S NOW=$$NOW^XLFDT(),TODAY=NOW\1
D KILL(TITLE,TODAY)
S PURGE=$$FMADD^XLFDT(TODAY,14) ; keep two week's worth of reports
S OUTPUTEXCEL=TITLE_" "_NOW
S ^XTMP(OUTPUTEXCEL,0)=PURGE_"^"_TODAY_"^"_TITLE
M ^XTMP(OUTPUTEXCEL,"INFO")=^TMP("MAG",$J)
S ^XTMP(OUTPUTEXCEL,"DUZ")=DUZ
S ^XTMP(OUTPUTEXCEL,"REPORT",0)=1,^(1)=""
L -^XTMP(TITLE)
Q
;
SAVE(OUTPUTEXCEL,OUTPUT,CONCATENATE) ; save output to ^XTMP
N SS4
S CONCATENATE=$G(CONCATENATE,0)
S MAGSTXTMP=$P(OUTPUTEXCEL,"^",1),XTMPSS=$P(OUTPUTEXCEL,"^",2)
S SS4=^XTMP(OUTPUTEXCEL,"REPORT",0)
I CONCATENATE S ^(SS4)=^XTMP(OUTPUTEXCEL,"REPORT",SS4)_OUTPUT
E D
. S SS4=SS4+1
. S ^XTMP(OUTPUTEXCEL,"REPORT",0)=SS4,^(SS4)=OUTPUT
. Q
Q
;
KILL(TITLE,TODAY) ; remove old ^XTMP files
N OUTPUTEXCEL,X
S OUTPUTEXCEL=TITLE
F S OUTPUTEXCEL=$O(^XTMP(OUTPUTEXCEL)) Q:OUTPUTEXCEL'?1"MAG".E D
. ; check purge date against today's - keep two week's worth of reports
. S X=$G(^XTMP(OUTPUTEXCEL,0)) I $P(X,"^",1)<TODAY K ^XTMP(OUTPUTEXCEL)
. Q
Q
;
LIST(MYSERVICE,LIST) ; get list of ^XTMP("MAG Study Tracker *" entries for service
N I,OUTPUTEXCEL,TITLE
K LIST
S (I,LIST(0))=0
S TITLE="MAG Study Tracker"
S OUTPUTEXCEL="MAG Study Tracker"
F S OUTPUTEXCEL=$O(^XTMP(OUTPUTEXCEL)) Q:OUTPUTEXCEL="" Q:OUTPUTEXCEL'?1"MAG Study Tracker".E D
. I $G(^XTMP(OUTPUTEXCEL,"INFO","BATCH Q/R","IMAGING SERVICE"))=MYSERVICE D
. . S I=LIST(0)+1,LIST(0)=I,LIST(I)=OUTPUTEXCEL
. . Q
. Q
Q I
;
;
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=$$DIRECTION(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
;
DIRECTION(SORTORDER) ; return the direction for $order
; 1 = normal order
; -1 = reverse order
Q $S(SORTORDER="ASCENDING":1,SORTORDER="DESCENDING":-1)
;
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[HMAGDSTA0 4771 printed Mar 25, 2026@15:26:13 Page 2
MAGDSTA0 ;WOIFO/PMK - Study Tracker - Automatic CMP/RET ; Nov 08, 2022@14:32:16
+1 ;;3.0;IMAGING;**333**;Mar 19, 2002;Build 2
+2 ;; Per VA Directive 6402, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | |
+7 ;; | The Food and Drug Administration classifies this software as |
+8 ;; | a medical device. As such, it may not be changed in any way. |
+9 ;; | Modifications to this software may result in an adulterated |
+10 ;; | medical device under 21CFR820, the use of which is considered |
+11 ;; | to be a violation of US Federal Statutes. |
+12 ;; +---------------------------------------------------------------+
+13 ;;
+14 ;
+15 ; Supported IA #10103 reference $$NOW^XLFDT function call
+16 ; Supported IA #10103 reference $$FMADD^XLFDT function call
+17 ;
+18 QUIT
+19 ;
INITXTMP(OUTPUTEXCEL) ; initialize ^XTMP for Study Tracker's automatic CMP/RET
+1 ; This is different from INITXTMP^MAGDSTQ0
+2 NEW NOW,PURGE,TITLE,TODAY
+3 SET TITLE="MAG Study Tracker"
+4 LOCK +^XTMP(TITLE):3
IF '$TEST
WRITE !!,"Can't lock ^XTMP(",TITLE,") - No Excel file"
QUIT
+5 SET NOW=$$NOW^XLFDT()
SET TODAY=NOW\1
+6 DO KILL(TITLE,TODAY)
+7 ; keep two week's worth of reports
SET PURGE=$$FMADD^XLFDT(TODAY,14)
+8 SET OUTPUTEXCEL=TITLE_" "_NOW
+9 SET ^XTMP(OUTPUTEXCEL,0)=PURGE_"^"_TODAY_"^"_TITLE
+10 MERGE ^XTMP(OUTPUTEXCEL,"INFO")=^TMP("MAG",$JOB)
+11 SET ^XTMP(OUTPUTEXCEL,"DUZ")=DUZ
+12 SET ^XTMP(OUTPUTEXCEL,"REPORT",0)=1
SET ^(1)=""
+13 LOCK -^XTMP(TITLE)
+14 QUIT
+15 ;
SAVE(OUTPUTEXCEL,OUTPUT,CONCATENATE) ; save output to ^XTMP
+1 NEW SS4
+2 SET CONCATENATE=$GET(CONCATENATE,0)
+3 SET MAGSTXTMP=$PIECE(OUTPUTEXCEL,"^",1)
SET XTMPSS=$PIECE(OUTPUTEXCEL,"^",2)
+4 SET SS4=^XTMP(OUTPUTEXCEL,"REPORT",0)
+5 IF CONCATENATE
SET ^(SS4)=^XTMP(OUTPUTEXCEL,"REPORT",SS4)_OUTPUT
+6 IF '$TEST
Begin DoDot:1
+7 SET SS4=SS4+1
+8 SET ^XTMP(OUTPUTEXCEL,"REPORT",0)=SS4
SET ^(SS4)=OUTPUT
+9 QUIT
End DoDot:1
+10 QUIT
+11 ;
KILL(TITLE,TODAY) ; remove old ^XTMP files
+1 NEW OUTPUTEXCEL,X
+2 SET OUTPUTEXCEL=TITLE
+3 FOR
SET OUTPUTEXCEL=$ORDER(^XTMP(OUTPUTEXCEL))
if OUTPUTEXCEL'?1"MAG".E
QUIT
Begin DoDot:1
+4 ; check purge date against today's - keep two week's worth of reports
+5 SET X=$GET(^XTMP(OUTPUTEXCEL,0))
IF $PIECE(X,"^",1)<TODAY
KILL ^XTMP(OUTPUTEXCEL)
+6 QUIT
End DoDot:1
+7 QUIT
+8 ;
LIST(MYSERVICE,LIST) ; get list of ^XTMP("MAG Study Tracker *" entries for service
+1 NEW I,OUTPUTEXCEL,TITLE
+2 KILL LIST
+3 SET (I,LIST(0))=0
+4 SET TITLE="MAG Study Tracker"
+5 SET OUTPUTEXCEL="MAG Study Tracker"
+6 FOR
SET OUTPUTEXCEL=$ORDER(^XTMP(OUTPUTEXCEL))
if OUTPUTEXCEL=""
QUIT
if OUTPUTEXCEL'?1"MAG Study Tracker".E
QUIT
Begin DoDot:1
+7 IF $GET(^XTMP(OUTPUTEXCEL,"INFO","BATCH Q/R","IMAGING SERVICE"))=MYSERVICE
Begin DoDot:2
+8 SET I=LIST(0)+1
SET LIST(0)=I
SET LIST(I)=OUTPUTEXCEL
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 QUIT I
+12 ;
+13 ;
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=$$DIRECTION(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 ;
DIRECTION(SORTORDER) ; return the direction for $order
+1 ; 1 = normal order
+2 ; -1 = reverse order
+3 QUIT $SELECT(SORTORDER="ASCENDING":1,SORTORDER="DESCENDING":-1)
+4 ;
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
