MAGDRTIM ;WOIFO/EdM - Routing Statistics ; 02/05/2004 08:45
;;3.0;IMAGING;**11**;14-April-2004
;; +---------------------------------------------------------------+
;; | 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
;
AVERAGE ;
N D0,D1
N DEST ;--- Destination where file is sent to
N PARENT ;- Parent Image
N PROC ;--- Procedure (closest to "Modality")
N SEC ;---- Stop time converted to seconds
N START ;-- Timestamp when transmission started
N STOP ;--- Timestamp when transmission completed
N TIME ;--- Duration of transmission
N TYP ;---- Type of tile (TXT, FULL, ABS, ...)
N X ;------ Scratch
;
K ^TMP("MAG",$J,"RTTIM")
S DEST="" F S DEST=$O(^MAG(2005,"ROUTE",DEST)) Q:DEST="" D
. S STOP="" F S STOP=$O(^MAG(2005,"ROUTE",DEST,STOP)) Q:STOP="" D
. . Q:'STOP
. . S SEC=$$SEC(STOP)
. . S D0="" F S D0=$O(^MAG(2005,"ROUTE",DEST,STOP,D0)) Q:D0="" D
. . . S X=$G(^MAG(2005,D0,0))
. . . S PROC=$P(X,"^",8) S:PROC="" PROC="?"
. . . S PARENT=$P(X,"^",10) S:'PARENT PARENT=D0
. . . S ^TMP("MAG",$J,"RTTIM",PROC,DEST,PARENT,2)=$G(^TMP("MAG",$J,"RTTIM",PROC,DEST,PARENT,2))+1
. . . S D1="" F S D1=$O(^MAG(2005,"ROUTE",DEST,STOP,D0,D1)) Q:D1="" D
. . . . S X=$G(^MAG(2005,D0,4,D1,0)) Q:X=""
. . . . S START=$P(X,"^",5) Q:'START
. . . . S TIME=SEC-$$SEC(START) S:TIME<0 TIME=TIME+86400
. . . . S ^TMP("MAG",$J,"RTTIM",PROC,DEST,PARENT,1)=$G(^TMP("MAG",$J,"RTTIM",PROC,DEST,PARENT,1))+TIME
. . . . Q
. . . Q
. . Q
. Q
S PROC="" F S PROC=$O(^TMP("MAG",$J,"RTTIM",PROC)) Q:PROC="" D
. S DEST="" F S DEST=$O(^TMP("MAG",$J,"RTTIM",PROC,DEST)) Q:DEST="" D
. . N IMAGE
. . S (TIME,IMAGE)=0
. . S D0="" F S D0=$O(^TMP("MAG",$J,"RTTIM",PROC,DEST,D0)) Q:D0="" D
. . . S X=$G(^TMP("MAG",$J,"RTTIM",PROC,DEST,D0,1)) Q:'X
. . . S TIME=TIME+X,IMAGE=IMAGE+^TMP("MAG",$J,"RTTIM",PROC,DEST,D0,2)
. . . Q
. . Q:'IMAGE
. . W !,"Sending ",IMAGE," ",PROC," image" W:IMAGE'=1 "s"
. . W " to ",$P($G(^MAG(2005.2,DEST,0),"#"_DEST),"^",1)," took "
. . S X=$$HMS(TIME)
. . W X,"."
. . W !?5,$$HMS(TIME*100\IMAGE)," per 100 images."
. . Q
. Q
K ^TMP("MAG",$J,"RTTIM")
Q
;
HMS(T) N H,M,S,X
S H=T\3600,M=T\60#60,S=T#60,X=""
I H S X=H_" hour" S:H'=1 X=X_"s"
I M S:X'="" X=X_"; |" S X=X_M_" minute" S:M'=1 X=X_"s"
I S S:X'="" X=$TR(X,";|",",")_" |" S X=X_S_" second" S:S'=1 X=X_"s"
S:X["|" X=$P($TR(X,";"),"|",1)_"and "_$P(X,"|",2)
Q X
;
SEC(DT) N R,X
S X=DT-(DT\1)*1000000,R=X\10000,R=R*60+(X\100#100),R=R*60+(X#100)
Q R
;
TRANSID(OUT,LOC) ; RPC = MAG DICOM ROUTE GET TRANS ID
N PLACE,SITE,X
S PLACE=$S($G(LOC):$O(^MAG(2006.1,"B",LOC,"")),1:0)
S:'PLACE PLACE=$O(^MAG(2006.1,0))
S X=$G(^MAG(2006.1,PLACE,0)),SITE=$P(X,"^",9)
S:SITE="" SITE=$P(X,"^",2)
S:SITE="" SITE="!"
;
L +^MAG(2006.1,PLACE,"TRANSACTION")
S OUT=$G(^MAG(2006.1,PLACE,"TRANSACTION"))+1
S ^MAG(2006.1,PLACE,"TRANSACTION")=OUT
L -^MAG(2006.1,PLACE,"TRANSACTION")
S OUT=SITE_$TR($J(OUT,12)," ",0)
Q
;
TRANSTS(OUT,TRANSID) ; RPC = MAG DICOM ROUTE TRANSACT STS
N CNT,D0,STS
I $G(TRANSID)="" S OUT="-1,No Transaction ID Specified" Q
I '$D(^MAGQUEUE(2006.035,"ID",TRANSID)) S OUT="-2,Invalid Transaction ID" Q
S D0="" F S D0=$O(^MAGQUEUE(2006.035,"ID",TRANSID,D0)) Q:D0="" D
. S STS=$P($G(^MAGQUEUE(2006.035,D0,1)),"^",1) S:STS="" STS="?"
. S CNT(STS)=$G(CNT(STS))+1
. Q
S OUT="" F STS="WAITING","SENDING","SENT","FAILED","?" D
. S OUT=OUT_$G(CNT(STS))_"="_STS_"^"
. Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDRTIM 4373 printed Apr 09, 2024@21:09:02 Page 2
MAGDRTIM ;WOIFO/EdM - Routing Statistics ; 02/05/2004 08:45
+1 ;;3.0;IMAGING;**11**;14-April-2004
+2 ;; +---------------------------------------------------------------+
+3 ;; | Property of the US Government. |
+4 ;; | No permission to copy or redistribute this software is given. |
+5 ;; | Use of unreleased versions of this software requires the user |
+6 ;; | to execute a written test agreement with the VistA Imaging |
+7 ;; | Development Office of the Department of Veterans Affairs, |
+8 ;; | telephone (301) 734-0100. |
+9 ;; | |
+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 ;
AVERAGE ;
+1 NEW D0,D1
+2 ;--- Destination where file is sent to
NEW DEST
+3 ;- Parent Image
NEW PARENT
+4 ;--- Procedure (closest to "Modality")
NEW PROC
+5 ;---- Stop time converted to seconds
NEW SEC
+6 ;-- Timestamp when transmission started
NEW START
+7 ;--- Timestamp when transmission completed
NEW STOP
+8 ;--- Duration of transmission
NEW TIME
+9 ;---- Type of tile (TXT, FULL, ABS, ...)
NEW TYP
+10 ;------ Scratch
NEW X
+11 ;
+12 KILL ^TMP("MAG",$JOB,"RTTIM")
+13 SET DEST=""
FOR
SET DEST=$ORDER(^MAG(2005,"ROUTE",DEST))
if DEST=""
QUIT
Begin DoDot:1
+14 SET STOP=""
FOR
SET STOP=$ORDER(^MAG(2005,"ROUTE",DEST,STOP))
if STOP=""
QUIT
Begin DoDot:2
+15 if 'STOP
QUIT
+16 SET SEC=$$SEC(STOP)
+17 SET D0=""
FOR
SET D0=$ORDER(^MAG(2005,"ROUTE",DEST,STOP,D0))
if D0=""
QUIT
Begin DoDot:3
+18 SET X=$GET(^MAG(2005,D0,0))
+19 SET PROC=$PIECE(X,"^",8)
if PROC=""
SET PROC="?"
+20 SET PARENT=$PIECE(X,"^",10)
if 'PARENT
SET PARENT=D0
+21 SET ^TMP("MAG",$JOB,"RTTIM",PROC,DEST,PARENT,2)=$GET(^TMP("MAG",$JOB,"RTTIM",PROC,DEST,PARENT,2))+1
+22 SET D1=""
FOR
SET D1=$ORDER(^MAG(2005,"ROUTE",DEST,STOP,D0,D1))
if D1=""
QUIT
Begin DoDot:4
+23 SET X=$GET(^MAG(2005,D0,4,D1,0))
if X=""
QUIT
+24 SET START=$PIECE(X,"^",5)
if 'START
QUIT
+25 SET TIME=SEC-$$SEC(START)
if TIME<0
SET TIME=TIME+86400
+26 SET ^TMP("MAG",$JOB,"RTTIM",PROC,DEST,PARENT,1)=$GET(^TMP("MAG",$JOB,"RTTIM",PROC,DEST,PARENT,1))+TIME
+27 QUIT
End DoDot:4
+28 QUIT
End DoDot:3
+29 QUIT
End DoDot:2
+30 QUIT
End DoDot:1
+31 SET PROC=""
FOR
SET PROC=$ORDER(^TMP("MAG",$JOB,"RTTIM",PROC))
if PROC=""
QUIT
Begin DoDot:1
+32 SET DEST=""
FOR
SET DEST=$ORDER(^TMP("MAG",$JOB,"RTTIM",PROC,DEST))
if DEST=""
QUIT
Begin DoDot:2
+33 NEW IMAGE
+34 SET (TIME,IMAGE)=0
+35 SET D0=""
FOR
SET D0=$ORDER(^TMP("MAG",$JOB,"RTTIM",PROC,DEST,D0))
if D0=""
QUIT
Begin DoDot:3
+36 SET X=$GET(^TMP("MAG",$JOB,"RTTIM",PROC,DEST,D0,1))
if 'X
QUIT
+37 SET TIME=TIME+X
SET IMAGE=IMAGE+^TMP("MAG",$JOB,"RTTIM",PROC,DEST,D0,2)
+38 QUIT
End DoDot:3
+39 if 'IMAGE
QUIT
+40 WRITE !,"Sending ",IMAGE," ",PROC," image"
if IMAGE'=1
WRITE "s"
+41 WRITE " to ",$PIECE($GET(^MAG(2005.2,DEST,0),"#"_DEST),"^",1)," took "
+42 SET X=$$HMS(TIME)
+43 WRITE X,"."
+44 WRITE !?5,$$HMS(TIME*100\IMAGE)," per 100 images."
+45 QUIT
End DoDot:2
+46 QUIT
End DoDot:1
+47 KILL ^TMP("MAG",$JOB,"RTTIM")
+48 QUIT
+49 ;
HMS(T) NEW H,M,S,X
+1 SET H=T\3600
SET M=T\60#60
SET S=T#60
SET X=""
+2 IF H
SET X=H_" hour"
if H'=1
SET X=X_"s"
+3 IF M
if X'=""
SET X=X_"; |"
SET X=X_M_" minute"
if M'=1
SET X=X_"s"
+4 IF S
if X'=""
SET X=$TRANSLATE(X,";|",",")_" |"
SET X=X_S_" second"
if S'=1
SET X=X_"s"
+5 if X["|"
SET X=$PIECE($TRANSLATE(X,";"),"|",1)_"and "_$PIECE(X,"|",2)
+6 QUIT X
+7 ;
SEC(DT) NEW R,X
+1 SET X=DT-(DT\1)*1000000
SET R=X\10000
SET R=R*60+(X\100#100)
SET R=R*60+(X#100)
+2 QUIT R
+3 ;
TRANSID(OUT,LOC) ; RPC = MAG DICOM ROUTE GET TRANS ID
+1 NEW PLACE,SITE,X
+2 SET PLACE=$SELECT($GET(LOC):$ORDER(^MAG(2006.1,"B",LOC,"")),1:0)
+3 if 'PLACE
SET PLACE=$ORDER(^MAG(2006.1,0))
+4 SET X=$GET(^MAG(2006.1,PLACE,0))
SET SITE=$PIECE(X,"^",9)
+5 if SITE=""
SET SITE=$PIECE(X,"^",2)
+6 if SITE=""
SET SITE="!"
+7 ;
+8 LOCK +^MAG(2006.1,PLACE,"TRANSACTION")
+9 SET OUT=$GET(^MAG(2006.1,PLACE,"TRANSACTION"))+1
+10 SET ^MAG(2006.1,PLACE,"TRANSACTION")=OUT
+11 LOCK -^MAG(2006.1,PLACE,"TRANSACTION")
+12 SET OUT=SITE_$TRANSLATE($JUSTIFY(OUT,12)," ",0)
+13 QUIT
+14 ;
TRANSTS(OUT,TRANSID) ; RPC = MAG DICOM ROUTE TRANSACT STS
+1 NEW CNT,D0,STS
+2 IF $GET(TRANSID)=""
SET OUT="-1,No Transaction ID Specified"
QUIT
+3 IF '$DATA(^MAGQUEUE(2006.035,"ID",TRANSID))
SET OUT="-2,Invalid Transaction ID"
QUIT
+4 SET D0=""
FOR
SET D0=$ORDER(^MAGQUEUE(2006.035,"ID",TRANSID,D0))
if D0=""
QUIT
Begin DoDot:1
+5 SET STS=$PIECE($GET(^MAGQUEUE(2006.035,D0,1)),"^",1)
if STS=""
SET STS="?"
+6 SET CNT(STS)=$GET(CNT(STS))+1
+7 QUIT
End DoDot:1
+8 SET OUT=""
FOR STS="WAITING","SENDING","SENT","FAILED","?"
Begin DoDot:1
+9 SET OUT=OUT_$GET(CNT(STS))_"="_STS_"^"
+10 QUIT
End DoDot:1
+11 QUIT
+12 ;
