source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGBRTLD.m@ 1400

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^XUSRB1($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)
 ;