94 lines
3.5 KiB
Mathematica
94 lines
3.5 KiB
Mathematica
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)
|
|
;
|