MAGDSTAS ;WOIFO/PMK - Q/R Retrieve of DICOM images from PACS to VistA ; Feb 15, 2022@10:52: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. |
;; +---------------------------------------------------------------+
;;
Q
;
; Supported IA #2056 reference $$GET1^DIQ function call
; Supported IA #10103 reference $$FMTE^XLFDT function call
; Supported IA #10103 reference $$HTE^XLFDT function call
; Supported IA #10103 reference $$FMTH^XLFDT function call
; Supported IA #10075 reference to read the OPTION file (#19)
; Supported IA #2051 reference $$FIND1^DIC function call
;
CON ; entry point to output consult statistics
N PATTERN S PATTERN="1"_"""MAGD CON"""_".E"
N MYSERVICE S MYSERVICE="CONSULTS"
N $ETRAP,$ESTACK S $ETRAP="D ERROR^MAGDSTA"
D START(PATTERN)
Q
;
RAD ; entry point to output radiology statistics
N PATTERN S PATTERN="1"_"""MAGD RAD"""_".E"
N MYSERVICE S MYSERVICE="RADIOLOGY"
N $ETRAP,$ESTACK S $ETRAP="D ERROR^MAGDSTA"
D START(PATTERN)
Q
;
START(PATTERN) ; Entry point to output statistics
N ACNUMB,BATCHSIZE,BEGDATE,CMOVEAET,DFN,ENDDATE,HOURS,IMAGINGSERVICE,OPTION,QRSCP
N RUNTIME,SCANMODE,SORTORDER,STARTIEN,STARTTIME,STATUS,STUDYDATE,STUDYIEN
N MENUOPTION,S2,X
;
I $$YESNO^MAGDSTQ("Display statistics for individual "_MYSERVICE_" runs?","y",.X)<0 Q
I X="YES" D Q
. D ONERUN(MYSERVICE)
. Q
;
I $$YESNO^MAGDSTQ("Display cumulative statistics for all "_MYSERVICE_" runs?","y",.X)<0 Q
I X="NO" D Q
. D CONTINUE^MAGDSTQ
. Q
;
K ^TMP("MAG",$J,"BATCH Q/R","DATE"),^("NUMBER")
S MENUOPTION=""
F S MENUOPTION=$O(^MAGDSTT(2006.543,"C",MENUOPTION)) Q:MENUOPTION="" D
. I MENUOPTION'?@PATTERN Q
. S S2=""
. F S S2=$O(^MAGDSTT(2006.543,"C",MENUOPTION,S2)) Q:S2="" D
. . D OPTION(MENUOPTION,S2)
. . Q
. Q
I $D(S2) D
. W !,"The above statistics are only an estimate. If the same scans are run"
. W !,"multiple times, that scan's numbers will be counted more than once."
. Q
E D
. W !!,"There are no statistics for ",MYSERVICE,"."
. Q
D CONTINUE^MAGDSTQ
K ^TMP("MAG",$J,"BATCH Q/R","DATE"),^("NUMBER")
Q
;
OPTION(MENUOPTION,S2) ; output statistics for all runs for one option/scan mode
N HDATE1,HDATE2,I,MAXLENGTH,OPTIONIEN,OPTIONNAME,RUNNUMBER,STATS
;
S SCANMODE=$S(S2="D":"DATE",S2="N":"NUMBER",S2="P":"PATIENT")
;
I SCANMODE="DATE" D ; build list of $H dates
. S HDATE1=+$$FMTH^XLFDT(2900000) ; $H format of FM date Jan 1, 1990
. S HDATE2=+$H ; today
. F I=HDATE1:1:HDATE2 S ^TMP("MAG",$J,"BATCH Q/R","DATE",I)=""
. Q
E I SCANMODE="NUMBER" D
. ;
. Q
;
S OPTIONIEN=$$FIND1^DIC(19,"","B",MENUOPTION)
S OPTIONNAME=$$GET1^DIQ(19,OPTIONIEN,1,"E")
W @IOF,OPTIONNAME," -- ",SCANMODE," scan"
;
; collect statistics
;
S (MAXLENGTH,RUNNUMBER,STATS)=0
F S RUNNUMBER=$O(^MAGDSTT(2006.543,"C",MENUOPTION,S2,RUNNUMBER)) Q:RUNNUMBER="" D
. D GETDATA(RUNNUMBER,.STATS)
. Q
;
; display statistics
;
D DISPLAY(.STATS)
;
I SCANMODE="DATE" D
. I '$D(^TMP("MAG",$J,"BATCH Q/R","DATE")) D
. . W !,"The DATE scan has been run for the entire date interval from ",$$HTE^XLFDT(HDATE1)," to today."
. . Q
. E D
. . W !,"The process has not been run for the following date intervals:"
. . S HDATE1="" F D Q:HDATE1=""
. . . S HDATE1=$O(^TMP("MAG",$J,"BATCH Q/R","DATE",HDATE1))
. . . I HDATE1="" Q ; no more date intervals
. . . F HDATE2=HDATE1:1 Q:'$D(^TMP("MAG",$J,"BATCH Q/R","DATE",HDATE2))
. . . W ! I $Y>(IOSL-4) D CONTINUE^MAGDSTQ(1)
. . . W ?15,$$HTE^XLFDT(HDATE1)," -- ",$$HTE^XLFDT(HDATE2)
. . . S HDATE1=HDATE2
. . . Q
. . Q
. Q
E I SCANMODE="NUMBER" D
. W !,"The NUMBER scan has not been run for the following IEN intervals:"
. S (ZEROIEN1,ZEROIEN2)=0
. S MOD100="" ; first node may be 0
. F MOD100=0:1:10 D
. . I '$D(^TMP("MAG",$J,"BATCH Q/R","NUMBER",MOD100)) D Q
. . . I ZEROIEN1=0 S ZEROIEN1=MOD100*100 I ZEROIEN1=0 S ZEROIEN1=1
. . . S ZEROIEN2=(MOD100+1)*100
. . . Q
. . S X=^TMP("MAG",$J,"BATCH Q/R","NUMBER",MOD100)
. . F I=1:1:100 D
. . . I $E(X,I)="0" D ; "0"
. . . . I ZEROIEN1=0 S ZEROIEN1=(MOD100*100)+I-1
. . . . S ZEROIEN2=(MOD100*100)+I-1
. . . . Q
. . . E D ; "1"
. . . . I ZEROIEN1,ZEROIEN2=0 S ZEROIEN2=(MOD100*100)+I-2
. . . . I ZEROIEN1=0 Q
. . . . D ZEROES(ZEROIEN1,ZEROIEN2)
. . . . S ZEROIEN1=0
. . . . Q
. . . Q
. . Q
. I ZEROIEN1 D ZEROES(ZEROIEN1,ZEROIEN2)
. Q
W ! D CONTINUE^MAGDSTQ(1)
Q
ZEROES(ZEROIEN1,ZEROIEN2) ; output an IEN range
W ! I $Y>(IOSL-4) D CONTINUE^MAGDSTQ(1)
W ?15,ZEROIEN1," to ",ZEROIEN2
Q
;
GETDATA(RUNNUMBER,STATS) ; accumulate the data for one run
D NODE0(RUNNUMBER)
I SCANMODE="DATE" D ; remove dates that have been processed
. N HDATE1,HDATE2,I
. S HDATE1=$$FMTH^XLFDT(BEGDATE)
. S HDATE2=$$FMTH^XLFDT(ENDDATE)
. F I=HDATE1:1:HDATE2 K ^TMP("MAG",$J,"BATCH Q/R","DATE",I)
. Q
E I SCANMODE="NUMBER" D
. D SETONES(+STARTIEN,+STUDYIEN)
. Q
D STATS(RUNNUMBER,.STATS)
Q
;
SETONES(IEN1,IEN2) ; set 1's for scanned ien ranges
N I,IEN,MOD100,REMAINDER,ZEROS
S ZEROS=$TR($J("",100)," ","0")
F IEN=IEN1:1:IEN2 D
. S MOD100=(IEN\100)
. I '$D(^TMP("MAG",$J,"BATCH Q/R","NUMBER",MOD100)) S ^(MOD100)=ZEROS
. S REMAINDER=IEN-(MOD100*100)
. S $E(^TMP("MAG",$J,"BATCH Q/R","NUMBER",MOD100),REMAINDER+1)="1"
. ; set the first zero to one, for completeness
. I MOD100=0 S $E(^TMP("MAG",$J,"BATCH Q/R","NUMBER",MOD100),1)="1"
. Q
Q
;
STATS(I,STATS) ; collect statistics info
N ISTATS,J,NAME,VALUE,X
S J=0
F S J=$O(^MAGDSTT(2006.543,I,2,J)) Q:'J D
. S X=^MAGDSTT(2006.543,I,2,J,0)
. S NAME=$P(X,"^",1),VALUE=$P(X,"^",2)
. S ISTATS=$G(STATS("XREF",NAME))
. I 'ISTATS D
. . S (ISTATS,STATS)=STATS+1
. . S STATS("XREF",NAME)=ISTATS
. . Q
. S STATS(ISTATS,"NAME")=NAME_"_____________________________"
. S STATS(ISTATS,"VALUE")=$G(STATS(ISTATS,"VALUE"))+VALUE
. Q
Q
;
DISPLAY(STATS) ; output the statistics
N I
W !
F I=1:1:STATS D
. W !?10,$E(STATS(I,"NAME"),1,35),?45,$TR($J(STATS(I,"VALUE"),10)," ","_")
. I $Y>(IOSL-4) D
. . D CONTINUE^MAGDSTQ
. . W @IOF
. . Q
. Q
W !
Q
;
;
;
ONERUN(MYSERVICE) ; display the statistics for individual runs
N COUNT,LIST,MAXLENGTH,RUNNUMBER,SELECT,STATS
;
; get statistics for this imaging service
D MAKELIST(MYSERVICE,.LIST,.COUNT)
;
I COUNT=0 W !!,"No run statistics on file for ",MYSERVICE Q
;
I COUNT=1 D
. W !!,"Just a single run for ",MYSERVICE
. S SELECT=1
. D ONERUN1(.LIST,1)
. Q
E D ; select the run number from the list
. N DONE1,FIRSTTIME
. S DONE1=0,FIRSTTIME=1
. F D Q:DONE1
. . S SELECT=$$ONERUN2(.COUNT,.LIST)
. . I SELECT'>0 D Q
. . . I FIRSTTIME W !!,"No run was selected"
. . . S DONE1=1
. . . Q
. . S FIRSTTIME=0
. . D ONERUN1(.LIST,SELECT)
. . Q
. Q
Q
;
ONERUN1(LIST,SELECT) ; display statics for a single run
N STATS
S RUNNUMBER=LIST(SELECT)
D NODE0(RUNNUMBER)
W @IOF,"Entry #",SELECT
W ?14,"Started: ",$$FMTE^XLFDT(STARTTIME)
W ?50,"Ended: ",$$FMTE^XLFDT(RUNTIME)
W !,MYSERVICE,?14,OPTION," by ",SCANMODE
I STATUS'?1"ERROR: ".E W ?50,"Status: ",STATUS
E D ; special processing for an error
. W ?50,"*** ERROR ***"
. W !?14,"<< ",STATUS," >>"
. Q
W !,"PACS: ",QRSCP
I CMOVEAET'="" W " Move Destination: ",CMOVEAET
I SCANMODE="DATE" D
. W !,"Beginning Date: ",$$FMTE^XLFDT(BEGDATE)
. W " Ending Date: ",$$FMTE^XLFDT(ENDDATE,"D")
. Q
E I SCANMODE="PATIENT" D
. W !,"DFN: ",DFN
. W ?14,"Beginning Date: ",$$FMTE^XLFDT(BEGDATE)
. W ?50,"Ending Date: ",$$FMTE^XLFDT(ENDDATE,"D")
. Q
E I SCANMODE="NUMBER" D
. W !,"Starting Report Number: ",STARTIEN," Batch Size: ",BATCHSIZE
. Q
W !,"Sort Order: ",SORTORDER,?43,"Hours: ",HOURS
W !,"Last Accession #: ",ACNUMB,?50,"M12345678901N12345678901"
W !,"Last Study Date: ",$$FMTE^XLFDT(STUDYDATE,"D")
W ?35,"Last DFN: ",DFN,?55,"Last Report #: ",STUDYIEN
I IMAGINGSERVICE="CONSULTS" D ; display consult/procedure services
. S I=0
. W !,"Services: "
. F S I=$O(^MAGDSTT(2006.543,RUNNUMBER,1,I)) Q:'I D
. . S SERVICE=^MAGDSTT(2006.543,RUNNUMBER,1,I,0)
. . S SERVICENAME=$$GET1^DIQ(123.5,SERVICE,.01,"E")
. . I ($L(SERVICENAME)+2)+$X>IOM W ",",!?10 ; need new line
. . E W:I>1 ", "
. . W SERVICENAME
. . Q
. Q
S (MAXLENGTH,STATS)=0
D STATS(RUNNUMBER,.STATS)
D DISPLAY(.STATS)
D CONTINUE^MAGDSTQ
Q
;
ONERUN2(COUNT,LIST) ; present run selection screen(s)
N DONE2,IBEGIN,IEND,INCREMENT,ISCREEN,NSCREENS,SELECT
S INCREMENT=IOSL-7,DONE2=0
S NSCREENS=((COUNT-1)\INCREMENT)+1
F D Q:DONE2
. F ISCREEN=1:1:NSCREENS D Q:DONE2
. . S IBEGIN=1+((ISCREEN-1)*INCREMENT)
. . S IEND=INCREMENT*ISCREEN
. . S IEND=$S(IEND>COUNT:COUNT,1:IEND)
. . W !,ISCREEN
. . S SELECT=$$ONERUN3(IBEGIN,IEND,.LIST,.DONE2)
. . Q
. Q
Q SELECT
;
ONERUN3(IBEGIN,IEND,LIST,DONE2) ; select the run number from a screen full
N DONE3,I,RETURN,RUNNUMBER,X
S (DONE3,RETURN)=0
F D Q:DONE2 Q:DONE3
. W @IOF,"Select the number of the run"
. W !,"----------------------------",!
. F I=IBEGIN:1:IEND D
. . S RUNNUMBER=LIST(I) D NODE0(RUNNUMBER)
. . W !,$J(I,3),") ",$$FMTE^XLFDT(STARTTIME,"2MPZ")
. . W ?24,OPTION," by ",SCANMODE
. . W ?60,$S(STATUS?1"ERROR: ".E:"*** ERROR ***",1:STATUS)
. . Q
. ;
. ; process user selection(s)
. W !!,"Please enter 1-",IEND," to select the run, ""^"" to exit: "
. R X:DTIME E S X="^"
. I $E(X)="^" S RETURN=-1,DONE2=1
. E I X?1N.N,X>0,X'>IEND D
. . S RETURN=X
. . S DONE2=1
. . Q
. E I X="" S DONE3=1
. E D
. . I $E(X)'="?" W " ???"
. . W !,"Please enter the number of the run to display the statistics"
. . D CONTINUE^MAGDSTQ
. . Q
. Q
Q RETURN
;
MAKELIST(MYSERVICE,LIST,COUNT) ; make a list of the service's runs
N ACNUMB,BATCHSIZE,BEGDATE,CMOVEAET,DFN,ENDDATE,HOURS,IMAGINGSERVICE
N MENUOPTION,OPTION,RUNNUMBER,RUNTIME,QRSCP,SCANMODE,SORTORDER,STARTIEN
N STARTTIME,STATUS,STUDYDATE,STUDYIEN
; get statistics for this imaging service
S (COUNT,RUNNUMBER)=0
F S RUNNUMBER=$O(^MAGDSTT(2006.543,RUNNUMBER)) Q:'RUNNUMBER D
. D NODE0(RUNNUMBER) I MYSERVICE'=IMAGINGSERVICE Q
. S COUNT=COUNT+1,LIST(COUNT)=RUNNUMBER
. Q
Q
;
;
;
LASTRUN(I) ; entry point from ^MAGDSTA1 to get last parameters of the last run
D NODE0(I)
D SERVICES(I)
Q
;
NODE0(I) ; get parameters from the zero-node for one run
N X
S X=$G(^MAGDSTT(2006.543,I,0))
S STARTTIME=$P(X,"^",1)
S IMAGINGSERVICE=$$GET1^DIQ(2006.543,I,2,"E")
S RUNTIME=$P(X,"^",3)
S OPTION=$$GET1^DIQ(2006.543,I,4,"E")
S STATUS=$P(X,"^",5)
S SCANMODE=$$GET1^DIQ(2006.543,I,6,"E")
S QRSCP=$P(X,"^",7)
S CMOVEAET=$P(X,"^",8)
S BEGDATE=$P(X,"^",9)
S ENDDATE=$P(X,"^",10)
S STARTIEN=$P(X,"^",11)
S BATCHSIZE=$P(X,"^",12)
S SORTORDER=$$GET1^DIQ(2006.543,I,13,"E")
S HOURS=$P(X,"^",14)
S DFN=$P(X,"^",15)
S STUDYDATE=$P(X,"^",16)
S STUDYIEN=$P(X,"^",17)
S ACNUMB=$P(X,"^",18)
S USERDUZ=$P(X,"^",19)
S MENUOPTION=$P(X,"^",20)
;
S ^TMP("MAG",$J,"BATCH Q/R","PATIENT DFN")=DFN
Q
;
SERVICES(I) ; get the services for a consult run
N IEN,J
S J=0
F S J=$O(^MAGDSTT(2006.543,I,1,J)) Q:'J D
. S IEN=^MAGDSTT(2006.543,I,1,J,0)
. S CONSULTSERVICES(IEN)=$$GET1^DIQ(123.5,IEN,.01,"E")
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDSTAS 12320 printed Nov 22, 2024@17:12 Page 2
MAGDSTAS ;WOIFO/PMK - Q/R Retrieve of DICOM images from PACS to VistA ; Feb 15, 2022@10:52: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 QUIT
+18 ;
+19 ; Supported IA #2056 reference $$GET1^DIQ function call
+20 ; Supported IA #10103 reference $$FMTE^XLFDT function call
+21 ; Supported IA #10103 reference $$HTE^XLFDT function call
+22 ; Supported IA #10103 reference $$FMTH^XLFDT function call
+23 ; Supported IA #10075 reference to read the OPTION file (#19)
+24 ; Supported IA #2051 reference $$FIND1^DIC function call
+25 ;
CON ; entry point to output consult statistics
+1 NEW PATTERN
SET PATTERN="1"_"""MAGD CON"""_".E"
+2 NEW MYSERVICE
SET MYSERVICE="CONSULTS"
+3 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERROR^MAGDSTA"
+4 DO START(PATTERN)
+5 QUIT
+6 ;
RAD ; entry point to output radiology statistics
+1 NEW PATTERN
SET PATTERN="1"_"""MAGD RAD"""_".E"
+2 NEW MYSERVICE
SET MYSERVICE="RADIOLOGY"
+3 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERROR^MAGDSTA"
+4 DO START(PATTERN)
+5 QUIT
+6 ;
START(PATTERN) ; Entry point to output statistics
+1 NEW ACNUMB,BATCHSIZE,BEGDATE,CMOVEAET,DFN,ENDDATE,HOURS,IMAGINGSERVICE,OPTION,QRSCP
+2 NEW RUNTIME,SCANMODE,SORTORDER,STARTIEN,STARTTIME,STATUS,STUDYDATE,STUDYIEN
+3 NEW MENUOPTION,S2,X
+4 ;
+5 IF $$YESNO^MAGDSTQ("Display statistics for individual "_MYSERVICE_" runs?","y",.X)<0
QUIT
+6 IF X="YES"
Begin DoDot:1
+7 DO ONERUN(MYSERVICE)
+8 QUIT
End DoDot:1
QUIT
+9 ;
+10 IF $$YESNO^MAGDSTQ("Display cumulative statistics for all "_MYSERVICE_" runs?","y",.X)<0
QUIT
+11 IF X="NO"
Begin DoDot:1
+12 DO CONTINUE^MAGDSTQ
+13 QUIT
End DoDot:1
QUIT
+14 ;
+15 KILL ^TMP("MAG",$JOB,"BATCH Q/R","DATE"),^("NUMBER")
+16 SET MENUOPTION=""
+17 FOR
SET MENUOPTION=$ORDER(^MAGDSTT(2006.543,"C",MENUOPTION))
if MENUOPTION=""
QUIT
Begin DoDot:1
+18 IF MENUOPTION'?@PATTERN
QUIT
+19 SET S2=""
+20 FOR
SET S2=$ORDER(^MAGDSTT(2006.543,"C",MENUOPTION,S2))
if S2=""
QUIT
Begin DoDot:2
+21 DO OPTION(MENUOPTION,S2)
+22 QUIT
End DoDot:2
+23 QUIT
End DoDot:1
+24 IF $DATA(S2)
Begin DoDot:1
+25 WRITE !,"The above statistics are only an estimate. If the same scans are run"
+26 WRITE !,"multiple times, that scan's numbers will be counted more than once."
+27 QUIT
End DoDot:1
+28 IF '$TEST
Begin DoDot:1
+29 WRITE !!,"There are no statistics for ",MYSERVICE,"."
+30 QUIT
End DoDot:1
+31 DO CONTINUE^MAGDSTQ
+32 KILL ^TMP("MAG",$JOB,"BATCH Q/R","DATE"),^("NUMBER")
+33 QUIT
+34 ;
OPTION(MENUOPTION,S2) ; output statistics for all runs for one option/scan mode
+1 NEW HDATE1,HDATE2,I,MAXLENGTH,OPTIONIEN,OPTIONNAME,RUNNUMBER,STATS
+2 ;
+3 SET SCANMODE=$SELECT(S2="D":"DATE",S2="N":"NUMBER",S2="P":"PATIENT")
+4 ;
+5 ; build list of $H dates
IF SCANMODE="DATE"
Begin DoDot:1
+6 ; $H format of FM date Jan 1, 1990
SET HDATE1=+$$FMTH^XLFDT(2900000)
+7 ; today
SET HDATE2=+$HOROLOG
+8 FOR I=HDATE1:1:HDATE2
SET ^TMP("MAG",$JOB,"BATCH Q/R","DATE",I)=""
+9 QUIT
End DoDot:1
+10 IF '$TEST
IF SCANMODE="NUMBER"
Begin DoDot:1
+11 ;
+12 QUIT
End DoDot:1
+13 ;
+14 SET OPTIONIEN=$$FIND1^DIC(19,"","B",MENUOPTION)
+15 SET OPTIONNAME=$$GET1^DIQ(19,OPTIONIEN,1,"E")
+16 WRITE @IOF,OPTIONNAME," -- ",SCANMODE," scan"
+17 ;
+18 ; collect statistics
+19 ;
+20 SET (MAXLENGTH,RUNNUMBER,STATS)=0
+21 FOR
SET RUNNUMBER=$ORDER(^MAGDSTT(2006.543,"C",MENUOPTION,S2,RUNNUMBER))
if RUNNUMBER=""
QUIT
Begin DoDot:1
+22 DO GETDATA(RUNNUMBER,.STATS)
+23 QUIT
End DoDot:1
+24 ;
+25 ; display statistics
+26 ;
+27 DO DISPLAY(.STATS)
+28 ;
+29 IF SCANMODE="DATE"
Begin DoDot:1
+30 IF '$DATA(^TMP("MAG",$JOB,"BATCH Q/R","DATE"))
Begin DoDot:2
+31 WRITE !,"The DATE scan has been run for the entire date interval from ",$$HTE^XLFDT(HDATE1)," to today."
+32 QUIT
End DoDot:2
+33 IF '$TEST
Begin DoDot:2
+34 WRITE !,"The process has not been run for the following date intervals:"
+35 SET HDATE1=""
FOR
Begin DoDot:3
+36 SET HDATE1=$ORDER(^TMP("MAG",$JOB,"BATCH Q/R","DATE",HDATE1))
+37 ; no more date intervals
IF HDATE1=""
QUIT
+38 FOR HDATE2=HDATE1:1
if '$DATA(^TMP("MAG",$JOB,"BATCH Q/R","DATE",HDATE2))
QUIT
+39 WRITE !
IF $Y>(IOSL-4)
DO CONTINUE^MAGDSTQ(1)
+40 WRITE ?15,$$HTE^XLFDT(HDATE1)," -- ",$$HTE^XLFDT(HDATE2)
+41 SET HDATE1=HDATE2
+42 QUIT
End DoDot:3
if HDATE1=""
QUIT
+43 QUIT
End DoDot:2
+44 QUIT
End DoDot:1
+45 IF '$TEST
IF SCANMODE="NUMBER"
Begin DoDot:1
+46 WRITE !,"The NUMBER scan has not been run for the following IEN intervals:"
+47 SET (ZEROIEN1,ZEROIEN2)=0
+48 ; first node may be 0
SET MOD100=""
+49 FOR MOD100=0:1:10
Begin DoDot:2
+50 IF '$DATA(^TMP("MAG",$JOB,"BATCH Q/R","NUMBER",MOD100))
Begin DoDot:3
+51 IF ZEROIEN1=0
SET ZEROIEN1=MOD100*100
IF ZEROIEN1=0
SET ZEROIEN1=1
+52 SET ZEROIEN2=(MOD100+1)*100
+53 QUIT
End DoDot:3
QUIT
+54 SET X=^TMP("MAG",$JOB,"BATCH Q/R","NUMBER",MOD100)
+55 FOR I=1:1:100
Begin DoDot:3
+56 ; "0"
IF $EXTRACT(X,I)="0"
Begin DoDot:4
+57 IF ZEROIEN1=0
SET ZEROIEN1=(MOD100*100)+I-1
+58 SET ZEROIEN2=(MOD100*100)+I-1
+59 QUIT
End DoDot:4
+60 ; "1"
IF '$TEST
Begin DoDot:4
+61 IF ZEROIEN1
IF ZEROIEN2=0
SET ZEROIEN2=(MOD100*100)+I-2
+62 IF ZEROIEN1=0
QUIT
+63 DO ZEROES(ZEROIEN1,ZEROIEN2)
+64 SET ZEROIEN1=0
+65 QUIT
End DoDot:4
+66 QUIT
End DoDot:3
+67 QUIT
End DoDot:2
+68 IF ZEROIEN1
DO ZEROES(ZEROIEN1,ZEROIEN2)
+69 QUIT
End DoDot:1
+70 WRITE !
DO CONTINUE^MAGDSTQ(1)
+71 QUIT
ZEROES(ZEROIEN1,ZEROIEN2) ; output an IEN range
+1 WRITE !
IF $Y>(IOSL-4)
DO CONTINUE^MAGDSTQ(1)
+2 WRITE ?15,ZEROIEN1," to ",ZEROIEN2
+3 QUIT
+4 ;
GETDATA(RUNNUMBER,STATS) ; accumulate the data for one run
+1 DO NODE0(RUNNUMBER)
+2 ; remove dates that have been processed
IF SCANMODE="DATE"
Begin DoDot:1
+3 NEW HDATE1,HDATE2,I
+4 SET HDATE1=$$FMTH^XLFDT(BEGDATE)
+5 SET HDATE2=$$FMTH^XLFDT(ENDDATE)
+6 FOR I=HDATE1:1:HDATE2
KILL ^TMP("MAG",$JOB,"BATCH Q/R","DATE",I)
+7 QUIT
End DoDot:1
+8 IF '$TEST
IF SCANMODE="NUMBER"
Begin DoDot:1
+9 DO SETONES(+STARTIEN,+STUDYIEN)
+10 QUIT
End DoDot:1
+11 DO STATS(RUNNUMBER,.STATS)
+12 QUIT
+13 ;
SETONES(IEN1,IEN2) ; set 1's for scanned ien ranges
+1 NEW I,IEN,MOD100,REMAINDER,ZEROS
+2 SET ZEROS=$TRANSLATE($JUSTIFY("",100)," ","0")
+3 FOR IEN=IEN1:1:IEN2
Begin DoDot:1
+4 SET MOD100=(IEN\100)
+5 IF '$DATA(^TMP("MAG",$JOB,"BATCH Q/R","NUMBER",MOD100))
SET ^(MOD100)=ZEROS
+6 SET REMAINDER=IEN-(MOD100*100)
+7 SET $EXTRACT(^TMP("MAG",$JOB,"BATCH Q/R","NUMBER",MOD100),REMAINDER+1)="1"
+8 ; set the first zero to one, for completeness
+9 IF MOD100=0
SET $EXTRACT(^TMP("MAG",$JOB,"BATCH Q/R","NUMBER",MOD100),1)="1"
+10 QUIT
End DoDot:1
+11 QUIT
+12 ;
STATS(I,STATS) ; collect statistics info
+1 NEW ISTATS,J,NAME,VALUE,X
+2 SET J=0
+3 FOR
SET J=$ORDER(^MAGDSTT(2006.543,I,2,J))
if 'J
QUIT
Begin DoDot:1
+4 SET X=^MAGDSTT(2006.543,I,2,J,0)
+5 SET NAME=$PIECE(X,"^",1)
SET VALUE=$PIECE(X,"^",2)
+6 SET ISTATS=$GET(STATS("XREF",NAME))
+7 IF 'ISTATS
Begin DoDot:2
+8 SET (ISTATS,STATS)=STATS+1
+9 SET STATS("XREF",NAME)=ISTATS
+10 QUIT
End DoDot:2
+11 SET STATS(ISTATS,"NAME")=NAME_"_____________________________"
+12 SET STATS(ISTATS,"VALUE")=$GET(STATS(ISTATS,"VALUE"))+VALUE
+13 QUIT
End DoDot:1
+14 QUIT
+15 ;
DISPLAY(STATS) ; output the statistics
+1 NEW I
+2 WRITE !
+3 FOR I=1:1:STATS
Begin DoDot:1
+4 WRITE !?10,$EXTRACT(STATS(I,"NAME"),1,35),?45,$TRANSLATE($JUSTIFY(STATS(I,"VALUE"),10)," ","_")
+5 IF $Y>(IOSL-4)
Begin DoDot:2
+6 DO CONTINUE^MAGDSTQ
+7 WRITE @IOF
+8 QUIT
End DoDot:2
+9 QUIT
End DoDot:1
+10 WRITE !
+11 QUIT
+12 ;
+13 ;
+14 ;
ONERUN(MYSERVICE) ; display the statistics for individual runs
+1 NEW COUNT,LIST,MAXLENGTH,RUNNUMBER,SELECT,STATS
+2 ;
+3 ; get statistics for this imaging service
+4 DO MAKELIST(MYSERVICE,.LIST,.COUNT)
+5 ;
+6 IF COUNT=0
WRITE !!,"No run statistics on file for ",MYSERVICE
QUIT
+7 ;
+8 IF COUNT=1
Begin DoDot:1
+9 WRITE !!,"Just a single run for ",MYSERVICE
+10 SET SELECT=1
+11 DO ONERUN1(.LIST,1)
+12 QUIT
End DoDot:1
+13 ; select the run number from the list
IF '$TEST
Begin DoDot:1
+14 NEW DONE1,FIRSTTIME
+15 SET DONE1=0
SET FIRSTTIME=1
+16 FOR
Begin DoDot:2
+17 SET SELECT=$$ONERUN2(.COUNT,.LIST)
+18 IF SELECT'>0
Begin DoDot:3
+19 IF FIRSTTIME
WRITE !!,"No run was selected"
+20 SET DONE1=1
+21 QUIT
End DoDot:3
QUIT
+22 SET FIRSTTIME=0
+23 DO ONERUN1(.LIST,SELECT)
+24 QUIT
End DoDot:2
if DONE1
QUIT
+25 QUIT
End DoDot:1
+26 QUIT
+27 ;
ONERUN1(LIST,SELECT) ; display statics for a single run
+1 NEW STATS
+2 SET RUNNUMBER=LIST(SELECT)
+3 DO NODE0(RUNNUMBER)
+4 WRITE @IOF,"Entry #",SELECT
+5 WRITE ?14,"Started: ",$$FMTE^XLFDT(STARTTIME)
+6 WRITE ?50,"Ended: ",$$FMTE^XLFDT(RUNTIME)
+7 WRITE !,MYSERVICE,?14,OPTION," by ",SCANMODE
+8 IF STATUS'?1"ERROR: ".E
WRITE ?50,"Status: ",STATUS
+9 ; special processing for an error
IF '$TEST
Begin DoDot:1
+10 WRITE ?50,"*** ERROR ***"
+11 WRITE !?14,"<< ",STATUS," >>"
+12 QUIT
End DoDot:1
+13 WRITE !,"PACS: ",QRSCP
+14 IF CMOVEAET'=""
WRITE " Move Destination: ",CMOVEAET
+15 IF SCANMODE="DATE"
Begin DoDot:1
+16 WRITE !,"Beginning Date: ",$$FMTE^XLFDT(BEGDATE)
+17 WRITE " Ending Date: ",$$FMTE^XLFDT(ENDDATE,"D")
+18 QUIT
End DoDot:1
+19 IF '$TEST
IF SCANMODE="PATIENT"
Begin DoDot:1
+20 WRITE !,"DFN: ",DFN
+21 WRITE ?14,"Beginning Date: ",$$FMTE^XLFDT(BEGDATE)
+22 WRITE ?50,"Ending Date: ",$$FMTE^XLFDT(ENDDATE,"D")
+23 QUIT
End DoDot:1
+24 IF '$TEST
IF SCANMODE="NUMBER"
Begin DoDot:1
+25 WRITE !,"Starting Report Number: ",STARTIEN," Batch Size: ",BATCHSIZE
+26 QUIT
End DoDot:1
+27 WRITE !,"Sort Order: ",SORTORDER,?43,"Hours: ",HOURS
+28 WRITE !,"Last Accession #: ",ACNUMB,?50,"M12345678901N12345678901"
+29 WRITE !,"Last Study Date: ",$$FMTE^XLFDT(STUDYDATE,"D")
+30 WRITE ?35,"Last DFN: ",DFN,?55,"Last Report #: ",STUDYIEN
+31 ; display consult/procedure services
IF IMAGINGSERVICE="CONSULTS"
Begin DoDot:1
+32 SET I=0
+33 WRITE !,"Services: "
+34 FOR
SET I=$ORDER(^MAGDSTT(2006.543,RUNNUMBER,1,I))
if 'I
QUIT
Begin DoDot:2
+35 SET SERVICE=^MAGDSTT(2006.543,RUNNUMBER,1,I,0)
+36 SET SERVICENAME=$$GET1^DIQ(123.5,SERVICE,.01,"E")
+37 ; need new line
IF ($LENGTH(SERVICENAME)+2)+$X>IOM
WRITE ",",!?10
+38 IF '$TEST
if I>1
WRITE ", "
+39 WRITE SERVICENAME
+40 QUIT
End DoDot:2
+41 QUIT
End DoDot:1
+42 SET (MAXLENGTH,STATS)=0
+43 DO STATS(RUNNUMBER,.STATS)
+44 DO DISPLAY(.STATS)
+45 DO CONTINUE^MAGDSTQ
+46 QUIT
+47 ;
ONERUN2(COUNT,LIST) ; present run selection screen(s)
+1 NEW DONE2,IBEGIN,IEND,INCREMENT,ISCREEN,NSCREENS,SELECT
+2 SET INCREMENT=IOSL-7
SET DONE2=0
+3 SET NSCREENS=((COUNT-1)\INCREMENT)+1
+4 FOR
Begin DoDot:1
+5 FOR ISCREEN=1:1:NSCREENS
Begin DoDot:2
+6 SET IBEGIN=1+((ISCREEN-1)*INCREMENT)
+7 SET IEND=INCREMENT*ISCREEN
+8 SET IEND=$SELECT(IEND>COUNT:COUNT,1:IEND)
+9 WRITE !,ISCREEN
+10 SET SELECT=$$ONERUN3(IBEGIN,IEND,.LIST,.DONE2)
+11 QUIT
End DoDot:2
if DONE2
QUIT
+12 QUIT
End DoDot:1
if DONE2
QUIT
+13 QUIT SELECT
+14 ;
ONERUN3(IBEGIN,IEND,LIST,DONE2) ; select the run number from a screen full
+1 NEW DONE3,I,RETURN,RUNNUMBER,X
+2 SET (DONE3,RETURN)=0
+3 FOR
Begin DoDot:1
+4 WRITE @IOF,"Select the number of the run"
+5 WRITE !,"----------------------------",!
+6 FOR I=IBEGIN:1:IEND
Begin DoDot:2
+7 SET RUNNUMBER=LIST(I)
DO NODE0(RUNNUMBER)
+8 WRITE !,$JUSTIFY(I,3),") ",$$FMTE^XLFDT(STARTTIME,"2MPZ")
+9 WRITE ?24,OPTION," by ",SCANMODE
+10 WRITE ?60,$SELECT(STATUS?1"ERROR: ".E:"*** ERROR ***",1:STATUS)
+11 QUIT
End DoDot:2
+12 ;
+13 ; process user selection(s)
+14 WRITE !!,"Please enter 1-",IEND," to select the run, ""^"" to exit: "
+15 READ X:DTIME
IF '$TEST
SET X="^"
+16 IF $EXTRACT(X)="^"
SET RETURN=-1
SET DONE2=1
+17 IF '$TEST
IF X?1N.N
IF X>0
IF X'>IEND
Begin DoDot:2
+18 SET RETURN=X
+19 SET DONE2=1
+20 QUIT
End DoDot:2
+21 IF '$TEST
IF X=""
SET DONE3=1
+22 IF '$TEST
Begin DoDot:2
+23 IF $EXTRACT(X)'="?"
WRITE " ???"
+24 WRITE !,"Please enter the number of the run to display the statistics"
+25 DO CONTINUE^MAGDSTQ
+26 QUIT
End DoDot:2
+27 QUIT
End DoDot:1
if DONE2
QUIT
if DONE3
QUIT
+28 QUIT RETURN
+29 ;
MAKELIST(MYSERVICE,LIST,COUNT) ; make a list of the service's runs
+1 NEW ACNUMB,BATCHSIZE,BEGDATE,CMOVEAET,DFN,ENDDATE,HOURS,IMAGINGSERVICE
+2 NEW MENUOPTION,OPTION,RUNNUMBER,RUNTIME,QRSCP,SCANMODE,SORTORDER,STARTIEN
+3 NEW STARTTIME,STATUS,STUDYDATE,STUDYIEN
+4 ; get statistics for this imaging service
+5 SET (COUNT,RUNNUMBER)=0
+6 FOR
SET RUNNUMBER=$ORDER(^MAGDSTT(2006.543,RUNNUMBER))
if 'RUNNUMBER
QUIT
Begin DoDot:1
+7 DO NODE0(RUNNUMBER)
IF MYSERVICE'=IMAGINGSERVICE
QUIT
+8 SET COUNT=COUNT+1
SET LIST(COUNT)=RUNNUMBER
+9 QUIT
End DoDot:1
+10 QUIT
+11 ;
+12 ;
+13 ;
LASTRUN(I) ; entry point from ^MAGDSTA1 to get last parameters of the last run
+1 DO NODE0(I)
+2 DO SERVICES(I)
+3 QUIT
+4 ;
NODE0(I) ; get parameters from the zero-node for one run
+1 NEW X
+2 SET X=$GET(^MAGDSTT(2006.543,I,0))
+3 SET STARTTIME=$PIECE(X,"^",1)
+4 SET IMAGINGSERVICE=$$GET1^DIQ(2006.543,I,2,"E")
+5 SET RUNTIME=$PIECE(X,"^",3)
+6 SET OPTION=$$GET1^DIQ(2006.543,I,4,"E")
+7 SET STATUS=$PIECE(X,"^",5)
+8 SET SCANMODE=$$GET1^DIQ(2006.543,I,6,"E")
+9 SET QRSCP=$PIECE(X,"^",7)
+10 SET CMOVEAET=$PIECE(X,"^",8)
+11 SET BEGDATE=$PIECE(X,"^",9)
+12 SET ENDDATE=$PIECE(X,"^",10)
+13 SET STARTIEN=$PIECE(X,"^",11)
+14 SET BATCHSIZE=$PIECE(X,"^",12)
+15 SET SORTORDER=$$GET1^DIQ(2006.543,I,13,"E")
+16 SET HOURS=$PIECE(X,"^",14)
+17 SET DFN=$PIECE(X,"^",15)
+18 SET STUDYDATE=$PIECE(X,"^",16)
+19 SET STUDYIEN=$PIECE(X,"^",17)
+20 SET ACNUMB=$PIECE(X,"^",18)
+21 SET USERDUZ=$PIECE(X,"^",19)
+22 SET MENUOPTION=$PIECE(X,"^",20)
+23 ;
+24 SET ^TMP("MAG",$JOB,"BATCH Q/R","PATIENT DFN")=DFN
+25 QUIT
+26 ;
SERVICES(I) ; get the services for a consult run
+1 NEW IEN,J
+2 SET J=0
+3 FOR
SET J=$ORDER(^MAGDSTT(2006.543,I,1,J))
if 'J
QUIT
Begin DoDot:1
+4 SET IEN=^MAGDSTT(2006.543,I,1,J,0)
+5 SET CONSULTSERVICES(IEN)=$$GET1^DIQ(123.5,IEN,.01,"E")
+6 QUIT
End DoDot:1
+7 QUIT
