MAGBRTLD ;WOIFO/EdM - List of destinations ; 03/09/2005 13:56
;;3.0;IMAGING;**9,11,30,51**;26-August-2005
;; +---------------------------------------------------------------+
;; | 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
;
LISTALL(TO,LIST) N DEST,N,X
S TO=$$UPNOPU(TO),N=0 K LIST
;
S DEST="" F S DEST=$O(^MAG(2005,"ROUTE",DEST)) Q:DEST="" D
. S:DEST["MAG(2005.2," DEST(+DEST)=""
. Q
;
S DEST="" F S DEST=$O(DEST(DEST)) Q:DEST="" D
. N PW
. S PW=$P($G(^MAG(2005.2,DEST,2)),"^",1,2)
. S $P(PW,"^",2)=$$DECRYP^MAGDRPC2($P(PW,"^",2))
. S X=$G(^MAG(2005.2,DEST,0))
. Q:$$UPNOPU($P(X,"^",1))'[TO
. S N=N+1,LIST(N)=$P(X,"^",2)_"^"_$P($G(^MAG(2005.2,DEST,4)),"^",2)_"^"_$P(X,"^",8)_"^"_PW_"^"_$P($G(^MAG(2005.2,DEST,3)),"^",5)_"^"_DEST
. Q
S LIST=N
Q
;
LIST(TO,LIST) N DEST,N,ORI,PRI,X
S TO=$$UPNOPU(TO),N=0 K LIST
;
S ORI="" F S ORI=$O(^MAGQUEUE(2006.035,"STS",ORI)) Q:ORI="" D
. S PRI="" F S PRI=$O(^MAGQUEUE(2006.035,"STS",ORI,"SENT",PRI)) Q:PRI="" D
. . S DEST="" F S DEST=$O(^MAGQUEUE(2006.035,"STS",ORI,"SENT",PRI,DEST)) Q:DEST="" D
. . . S:DEST["MAG(2005.2," DEST(+DEST)=""
. . . Q
. . Q
. Q
;
S DEST="" F S DEST=$O(DEST(DEST)) Q:DEST="" D
. N PW
. S PW=$P($G(^MAG(2005.2,DEST,2)),"^",1,2)
. S $P(PW,"^",2)=$$DECRYP^ROUTINE($P(PW,"^",2))
. S X=$G(^MAG(2005.2,DEST,0))
. Q:$$UPNOPU($P(X,"^",1))'[TO
. S N=N+1,LIST(N)=$P(X,"^",2)_"^"_$P($G(^MAG(2005.2,DEST,4)),"^",2)_"^"_$P(X,"^",8)_"^"_PW_"^"_$P($G(^MAG(2005.2,DEST,3)),"^",5)_"^"_DEST
. Q
S LIST=N
Q
;
AVERAGE() N A,D0,D1,N,P,X
S (A,N)=0
S D0=0 F S D0=$O(^MAGQUEUE(2006.036,D0)) Q:'D0 D
. S N=N+1
. S D1=0 F S D1=$O(^MAGQUEUE(2006.036,D0,1,D1)) Q:'D1 D
. . S X=$G(^MAGQUEUE(2006.036,D0,1,D1,0)) Q:$P(X,"^",6)'["Duration"
. . F P=1:1:4 S A=A+$P(X,"^",P)
. . Q
. Q
Q A/$S(N:N,1:1)
;
UPNOPU(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz !""#$%&'()*+,-./:;<=>?@[\]^_`{|}~","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
;
PURGSTAT N COUNT,DATE,FIRST,IMAGE,LAST,LOC
W !!,"Overview of images to be purged.",!
S LOC="" F S LOC=$O(^MAG(2005,"ROUTE",LOC)) Q:LOC="" D
. Q:LOC'["MAG(2005.2,"
. S FIRST=$O(^MAG(2005,"ROUTE",LOC,""))\1
. S LAST=$O(^MAG(2005,"ROUTE",LOC,""),-1)\1
. S COUNT=0
. S DATE="" F S DATE=$O(^MAG(2005,"ROUTE",LOC,DATE)) Q:DATE="" D
. . S IMAGE="" F S IMAGE=$O(^MAG(2005,"ROUTE",LOC,DATE,IMAGE)) Q:IMAGE="" S COUNT=COUNT+1
. . Q
. W !,COUNT," image" W:COUNT'=1 "s"
. W " to be purged on ",$P(^MAG(2005.2,+LOC,0),"^",2)
. W !?5,"(transmitted "
. I FIRST=LAST W " on ",$$FMD(FIRST)
. E W " between ",$$FMD(FIRST)," and ",$$FMD(LAST)
. W ")"
. Q
Q
;
FMD(X) Q (X#100)_" "_$P("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",X\100#100)_" "_(X\10000+1700)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGBRTLD 3653 printed Apr 09, 2024@21:03:03 Page 2
MAGBRTLD ;WOIFO/EdM - List of destinations ; 03/09/2005 13:56
+1 ;;3.0;IMAGING;**9,11,30,51**;26-August-2005
+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 ;
LISTALL(TO,LIST) NEW DEST,N,X
+1 SET TO=$$UPNOPU(TO)
SET N=0
KILL LIST
+2 ;
+3 SET DEST=""
FOR
SET DEST=$ORDER(^MAG(2005,"ROUTE",DEST))
if DEST=""
QUIT
Begin DoDot:1
+4 if DEST["MAG(2005.2,"
SET DEST(+DEST)=""
+5 QUIT
End DoDot:1
+6 ;
+7 SET DEST=""
FOR
SET DEST=$ORDER(DEST(DEST))
if DEST=""
QUIT
Begin DoDot:1
+8 NEW PW
+9 SET PW=$PIECE($GET(^MAG(2005.2,DEST,2)),"^",1,2)
+10 SET $PIECE(PW,"^",2)=$$DECRYP^MAGDRPC2($PIECE(PW,"^",2))
+11 SET X=$GET(^MAG(2005.2,DEST,0))
+12 if $$UPNOPU($PIECE(X,"^",1))'[TO
QUIT
+13 SET N=N+1
SET LIST(N)=$PIECE(X,"^",2)_"^"_$PIECE($GET(^MAG(2005.2,DEST,4)),"^",2)_"^"_$PIECE(X,"^",8)_"^"_PW_"^"_$PIECE($GET(^MAG(2005.2,DEST,3)),"^",5)_"^"_DEST
+14 QUIT
End DoDot:1
+15 SET LIST=N
+16 QUIT
+17 ;
LIST(TO,LIST) NEW DEST,N,ORI,PRI,X
+1 SET TO=$$UPNOPU(TO)
SET N=0
KILL LIST
+2 ;
+3 SET ORI=""
FOR
SET ORI=$ORDER(^MAGQUEUE(2006.035,"STS",ORI))
if ORI=""
QUIT
Begin DoDot:1
+4 SET PRI=""
FOR
SET PRI=$ORDER(^MAGQUEUE(2006.035,"STS",ORI,"SENT",PRI))
if PRI=""
QUIT
Begin DoDot:2
+5 SET DEST=""
FOR
SET DEST=$ORDER(^MAGQUEUE(2006.035,"STS",ORI,"SENT",PRI,DEST))
if DEST=""
QUIT
Begin DoDot:3
+6 if DEST["MAG(2005.2,"
SET DEST(+DEST)=""
+7 QUIT
End DoDot:3
+8 QUIT
End DoDot:2
+9 QUIT
End DoDot:1
+10 ;
+11 SET DEST=""
FOR
SET DEST=$ORDER(DEST(DEST))
if DEST=""
QUIT
Begin DoDot:1
+12 NEW PW
+13 SET PW=$PIECE($GET(^MAG(2005.2,DEST,2)),"^",1,2)
+14 SET $PIECE(PW,"^",2)=$$DECRYP^ROUTINE($PIECE(PW,"^",2))
+15 SET X=$GET(^MAG(2005.2,DEST,0))
+16 if $$UPNOPU($PIECE(X,"^",1))'[TO
QUIT
+17 SET N=N+1
SET LIST(N)=$PIECE(X,"^",2)_"^"_$PIECE($GET(^MAG(2005.2,DEST,4)),"^",2)_"^"_$PIECE(X,"^",8)_"^"_PW_"^"_$PIECE($GET(^MAG(2005.2,DEST,3)),"^",5)_"^"_DEST
+18 QUIT
End DoDot:1
+19 SET LIST=N
+20 QUIT
+21 ;
AVERAGE() NEW A,D0,D1,N,P,X
+1 SET (A,N)=0
+2 SET D0=0
FOR
SET D0=$ORDER(^MAGQUEUE(2006.036,D0))
if 'D0
QUIT
Begin DoDot:1
+3 SET N=N+1
+4 SET D1=0
FOR
SET D1=$ORDER(^MAGQUEUE(2006.036,D0,1,D1))
if 'D1
QUIT
Begin DoDot:2
+5 SET X=$GET(^MAGQUEUE(2006.036,D0,1,D1,0))
if $PIECE(X,"^",6)'["Duration"
QUIT
+6 FOR P=1:1:4
SET A=A+$PIECE(X,"^",P)
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
+9 QUIT A/$SELECT(N:N,1:1)
+10 ;
UPNOPU(X) QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz !""#$%&'()*+,-./:;<=>?@[\]^_`{|}~","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+1 ;
PURGSTAT NEW COUNT,DATE,FIRST,IMAGE,LAST,LOC
+1 WRITE !!,"Overview of images to be purged.",!
+2 SET LOC=""
FOR
SET LOC=$ORDER(^MAG(2005,"ROUTE",LOC))
if LOC=""
QUIT
Begin DoDot:1
+3 if LOC'["MAG(2005.2,"
QUIT
+4 SET FIRST=$ORDER(^MAG(2005,"ROUTE",LOC,""))\1
+5 SET LAST=$ORDER(^MAG(2005,"ROUTE",LOC,""),-1)\1
+6 SET COUNT=0
+7 SET DATE=""
FOR
SET DATE=$ORDER(^MAG(2005,"ROUTE",LOC,DATE))
if DATE=""
QUIT
Begin DoDot:2
+8 SET IMAGE=""
FOR
SET IMAGE=$ORDER(^MAG(2005,"ROUTE",LOC,DATE,IMAGE))
if IMAGE=""
QUIT
SET COUNT=COUNT+1
+9 QUIT
End DoDot:2
+10 WRITE !,COUNT," image"
if COUNT'=1
WRITE "s"
+11 WRITE " to be purged on ",$PIECE(^MAG(2005.2,+LOC,0),"^",2)
+12 WRITE !?5,"(transmitted "
+13 IF FIRST=LAST
WRITE " on ",$$FMD(FIRST)
+14 IF '$TEST
WRITE " between ",$$FMD(FIRST)," and ",$$FMD(LAST)
+15 WRITE ")"
+16 QUIT
End DoDot:1
+17 QUIT
+18 ;
FMD(X) QUIT (X#100)_" "_$PIECE("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",X\100#100)_" "_(X\10000+1700)
+1 ;
