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

Last change on this file since 1361 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.5 KB
Line 
1MAGBRTLD ;WOIFO/EdM - List of destinations ; 03/09/2005 13:56
2 ;;3.0;IMAGING;**9,11,30,51**;26-August-2005
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 ;; | |
11 ;; | The Food and Drug Administration classifies this software as |
12 ;; | a medical device. As such, it may not be changed in any way. |
13 ;; | Modifications to this software may result in an adulterated |
14 ;; | medical device under 21CFR820, the use of which is considered |
15 ;; | to be a violation of US Federal Statutes. |
16 ;; +---------------------------------------------------------------+
17 ;;
18 Q
19 ;
20LISTALL(TO,LIST) N DEST,N,X
21 S TO=$$UPNOPU(TO),N=0 K LIST
22 ;
23 S DEST="" F S DEST=$O(^MAG(2005,"ROUTE",DEST)) Q:DEST="" D
24 . S:DEST["MAG(2005.2," DEST(+DEST)=""
25 . Q
26 ;
27 S DEST="" F S DEST=$O(DEST(DEST)) Q:DEST="" D
28 . N PW
29 . S PW=$P($G(^MAG(2005.2,DEST,2)),"^",1,2)
30 . S $P(PW,"^",2)=$$DECRYP^MAGDRPC2($P(PW,"^",2))
31 . S X=$G(^MAG(2005.2,DEST,0))
32 . Q:$$UPNOPU($P(X,"^",1))'[TO
33 . 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
34 . Q
35 S LIST=N
36 Q
37 ;
38LIST(TO,LIST) N DEST,N,ORI,PRI,X
39 S TO=$$UPNOPU(TO),N=0 K LIST
40 ;
41 S ORI="" F S ORI=$O(^MAGQUEUE(2006.035,"STS",ORI)) Q:ORI="" D
42 . S PRI="" F S PRI=$O(^MAGQUEUE(2006.035,"STS",ORI,"SENT",PRI)) Q:PRI="" D
43 . . S DEST="" F S DEST=$O(^MAGQUEUE(2006.035,"STS",ORI,"SENT",PRI,DEST)) Q:DEST="" D
44 . . . S:DEST["MAG(2005.2," DEST(+DEST)=""
45 . . . Q
46 . . Q
47 . Q
48 ;
49 S DEST="" F S DEST=$O(DEST(DEST)) Q:DEST="" D
50 . N PW
51 . S PW=$P($G(^MAG(2005.2,DEST,2)),"^",1,2)
52 . S $P(PW,"^",2)=$$DECRYP^XUSRB1($P(PW,"^",2))
53 . S X=$G(^MAG(2005.2,DEST,0))
54 . Q:$$UPNOPU($P(X,"^",1))'[TO
55 . 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
56 . Q
57 S LIST=N
58 Q
59 ;
60AVERAGE() N A,D0,D1,N,P,X
61 S (A,N)=0
62 S D0=0 F S D0=$O(^MAGQUEUE(2006.036,D0)) Q:'D0 D
63 . S N=N+1
64 . S D1=0 F S D1=$O(^MAGQUEUE(2006.036,D0,1,D1)) Q:'D1 D
65 . . S X=$G(^MAGQUEUE(2006.036,D0,1,D1,0)) Q:$P(X,"^",6)'["Duration"
66 . . F P=1:1:4 S A=A+$P(X,"^",P)
67 . . Q
68 . Q
69 Q A/$S(N:N,1:1)
70 ;
71UPNOPU(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz !""#$%&'()*+,-./:;<=>?@[\]^_`{|}~","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
72 ;
73PURGSTAT N COUNT,DATE,FIRST,IMAGE,LAST,LOC
74 W !!,"Overview of images to be purged.",!
75 S LOC="" F S LOC=$O(^MAG(2005,"ROUTE",LOC)) Q:LOC="" D
76 . Q:LOC'["MAG(2005.2,"
77 . S FIRST=$O(^MAG(2005,"ROUTE",LOC,""))\1
78 . S LAST=$O(^MAG(2005,"ROUTE",LOC,""),-1)\1
79 . S COUNT=0
80 . S DATE="" F S DATE=$O(^MAG(2005,"ROUTE",LOC,DATE)) Q:DATE="" D
81 . . S IMAGE="" F S IMAGE=$O(^MAG(2005,"ROUTE",LOC,DATE,IMAGE)) Q:IMAGE="" S COUNT=COUNT+1
82 . . Q
83 . W !,COUNT," image" W:COUNT'=1 "s"
84 . W " to be purged on ",$P(^MAG(2005.2,+LOC,0),"^",2)
85 . W !?5,"(transmitted "
86 . I FIRST=LAST W " on ",$$FMD(FIRST)
87 . E W " between ",$$FMD(FIRST)," and ",$$FMD(LAST)
88 . W ")"
89 . Q
90 Q
91 ;
92FMD(X) Q (X#100)_" "_$P("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",X\100#100)_" "_(X\10000+1700)
93 ;
Note: See TracBrowser for help on using the repository browser.