source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGDRPC2.m@ 1284

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

initial load of WorldVistAEHR
File size: 8.1 KB
Line 
1MAGDRPC2 ;WOIFO/EdM - Imaging RPCs ; 11/10/2005 08:19
2 ;;3.0;IMAGING;**11,30,51,50**;26-May-2006
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 ;
20SERVICE(OUT) ; RPC = MAG DICOM GET SERVICE INFO
21 N D0,X
22 S D0=$O(^MAG(2006.1,0)),OUT="-1,No Imaging Site Parameters defined" Q:'D0
23 S X=$G(^MAG(2006.1,D0,"GW"))
24 S OUT=$$ENCRYP^XUSRB1($$DECRYP($P(X,"^",1))_";"_$$DECRYP($P(X,"^",2)))
25 Q
26 ;
27SAME(SET,D0,NODE,PIECE,X) ; Called from FileMan ^DD
28 N L0
29 S L0=0 F S L0=$O(^MAG(2006.1,L0)) Q:'L0 D:L0'=D0
30 . S $P(^MAG(2006.1,L0,NODE),"^",PIECE)=$S(SET:X,1:"")
31 . Q
32 Q
33 ;
34IMAGE(OUT,D0) ; RPC = MAG DICOM GET BASIC IMAGE
35 N I,MSG,TARGET,V,VE,VI,X
36 K OUT S I=1
37 I '$G(D0) S OUT(1)="-1,Invalid IEN ("_$G(D0)_")" Q
38 I $D(^MAG(2005.1,D0,0)) S OUT(1)="-3,Image #"_D0_" has been deleted." Q
39 I '$D(^MAG(2005,D0,0)) S OUT(1)="-2,No data for """_D0_"""." Q
40 ;
41 D GETS^DIQ(2005,D0_",","*","REIN","TARGET","MSG")
42 S X="" F S X=$O(TARGET(2005,D0_",",X)) Q:X="" D
43 . S VI=$G(TARGET(2005,D0_",",X,"I"))
44 . S VE=$G(TARGET(2005,D0_",",X,"E"))
45 . S I=I+1,OUT(I)=X_"^"_VI S:VI'=VE OUT(I)=OUT(I)_"^"_VE
46 . Q
47 ;
48 D FILEFIND^MAGDFB(D0,"FULL",0,0,.X,.V)
49 S:X'<0 I=I+1,OUT(I)="Full FileName^"_X
50 S:V'<0 I=I+1,OUT(I)="Full Path+FileName^"_V
51 ;
52 D FILEFIND^MAGDFB(D0,"BIG",0,0,.X,.V)
53 S:X'<0 I=I+1,OUT(I)="Big FileName^"_X
54 S:V'<0 I=I+1,OUT(I)="Big Path+FileName^"_V
55 ;
56 D FILEFIND^MAGDFB(D0,"ABSTRACT",0,0,.X,.V)
57 S:X'<0 I=I+1,OUT(I)="Abstract FileName^"_X
58 S:V'<0 I=I+1,OUT(I)="Abstract Path+FileName^"_V
59 ;
60 S (V,X)=0 F S X=$O(^MAG(2005,D0,1,X)) Q:'X S V=V+1
61 S:V I=I+1,OUT(I)="# Images^"_V
62 ;
63 S OUT(1)=I-1
64 Q
65 ;
66GRPIMG(OUT,D0) ; RPC = MAG DICOM GET IMAGE GROUP
67 N I,D1,X
68 D CHK^MAGGSQI(.OUT,D0) I +$G(OUT(0))'=1 Q ; patient safety
69 K OUT S I=1
70 S D1=0 F S D1=$O(^MAG(2005,D0,1,D1)) Q:'D1 D
71 . S X=$P($G(^MAG(2005,D0,1,D1,0)),"^",1) Q:'X
72 . S I=I+1,OUT(I)=X
73 . Q
74 S OUT(1)=I-1
75 Q
76 ;
77DECRYP(X) Q $S(X="":"",1:$$DECRYP^XUSRB1(X))
78 ;
79IMGVER(OUT) ; RPC = MAG DICOM GET VERSION
80 N D0,DATINS,FME,FML,I,L,N,P,PATCH,X
81 D FIND^DIC(9.7,"",".01;2I;51I","QU","MAG*3.0","*","B","","","FML","FME")
82 S I="" F S I=$O(FML("DILIST","ID",I)) Q:I="" D
83 . S N=$G(FML("DILIST","ID",I,.01)) Q:$P(N,"*",2)'="3.0"
84 . S PATCH=$P(N,"*",3) Q:'PATCH
85 . S PATCH(PATCH)=1
86 . S DATINS=$G(FML("DILIST","ID",I,2)) Q:DATINS=""
87 . S P=$G(FML("DILIST","ID",I,51)) Q:P=""
88 . S L(DATINS,PATCH_"-"_P)=""
89 . Q
90 ;
91 S (DATINS,L,OUT)="" F S DATINS=$O(L(DATINS),-1) Q:DATINS="" D
92 . S PATCH="" F S PATCH=$O(L(DATINS,PATCH)) Q:PATCH="" D
93 . . S:OUT="" OUT=PATCH
94 . . S:$G(PATCH(+PATCH)) PATCH(+PATCH)=0,L=(+PATCH)_","_L
95 . . Q
96 . Q
97 S OUT=L_OUT
98 Q
99 ;
100PLACE(LOCATION) N D0,FST,LST
101 S FST=+$O(^MAG(2006.1,0)),LST=+$O(^MAG(2006.1," "),-1) Q:LST=FST FST
102 S D0=$O(^MAG(2006.1,"B",+$G(LOCATION),"")) Q:D0 D0
103 Q FST
104 ;
105ROUTEDAY ; Scan for Routing Activity
106 N BUCKET ;- Daily tallies
107 N D0 ;----- Image pointer for child of current parent
108 N D1 ;----- Pointer to multiple in image file
109 N D4 ;----- Loop counter
110 N DAY ;---- Current FileMan date
111 N DAYTIM ;- Current FileMan timestamp
112 N DEST ;--- Destination
113 N FIRST ;-- First date for scan
114 N FSTX ;--- First transmission for current study
115 N %H ;----- $Horolog timestamp
116 N IMAGE ;-- Image Pointer for current image
117 N LAST ;--- Last date for scan
118 N LSTQ ;--- Timestamp for last queue entry in current study
119 N P3 ;----- Highest IEN in statistics file
120 N P4 ;----- Number of entries in statistics file
121 N PARENT ;- Image Pointer for parent of current image
122 N R ;------ Retention Period
123 N X ;------ Scratch
124 N XMIT ;--- Total duration of transmissions for current study
125 ;
126 K ^TMP("MAG",$J,"RTD1")
127 K ^TMP("MAG",$J,"RTD2")
128 K ^TMP("MAG",$J,"RTD3")
129 S %H=$H-4 D YMD^%DTC S FIRST=X
130 S %H=$H+2 D YMD^%DTC S LAST=X
131 ;
132 S DEST="" F S DEST=$O(^MAG(2005,"ROUTE",DEST)) Q:DEST="" D
133 . S NAME(DEST)=$P($G(^MAG(2005.2,DEST,0)," ? "_DEST),"^",1)
134 . S DAYTIM=FIRST F D S DAYTIM=$O(^MAG(2005,"ROUTE",DEST,DAYTIM)) Q:DAYTIM="" Q:DAYTIM'<LAST
135 . . S DAY=DAYTIM\1
136 . . S IMAGE="" F S IMAGE=$O(^MAG(2005,"ROUTE",DEST,DAYTIM,IMAGE)) Q:IMAGE="" D
137 . . . S PARENT=$P($G(^MAG(2005,IMAGE,0)),"^",10)
138 . . . I PARENT,$G(^TMP("MAG",$J,"RTD3",PARENT)) S PARENT=0
139 . . . S:PARENT ^TMP("MAG",$J,"RTD3",PARENT)=1
140 . . . S (XMIT,LSTQ)=0,FSTX=1E9
141 . . . S D0=IMAGE,D1=0 D I PARENT F S D1=$O(^MAG(2005,PARENT,1,D1)) Q:'D1 S D0=+$P($G(^MAG(2005,PARENT,1,D1,0)),"^",1) D
142 . . . . Q:'D0
143 . . . . Q:$D(^TMP("MAG",$J,"RTD1",D0,D1))
144 . . . . S ^TMP("MAG",$J,"RTD1",D0,D1)=""
145 . . . . S D4=0 F S D4=$O(^MAG(2005,D0,4,D4)) Q:'D4 D
146 . . . . . S X=$G(^MAG(2005,D0,4,D4,0))
147 . . . . . Q:$P($P(X,"^",1),".",1)'=DAY
148 . . . . . Q:$P(X,"^",2)'=DEST
149 . . . . . S:$P(X,"^",6)>LSTQ LSTQ=$P(X,"^",6)
150 . . . . . S:$P(X,"^",5)<FSTX FSTX=$P(X,"^",5)
151 . . . . . S XMIT=XMIT+$$DELTA($P(X,"^",5),$P(X,"^",1))
152 . . . . . Q
153 . . . . Q
154 . . . S X=$$DELTA(LSTQ,FSTX)
155 . . . S:X>$G(BUCKET(DAY,DEST,1)) BUCKET(DAY,DEST,1)=X
156 . . . S X=$S(X<300:1,X<900:2,X<3600:3,1:4)
157 . . . S BUCKET(DAY,DEST,1,X)=$G(BUCKET(DAY,DEST,1,X))+1
158 . . . S:XMIT>$G(BUCKET(DAY,DEST,2)) BUCKET(DAY,DEST,2)=XMIT
159 . . . S X=$S(XMIT<300:1,XMIT<900:2,XMIT<3600:3,1:4)
160 . . . S BUCKET(DAY,DEST,2,X)=$G(BUCKET(DAY,DEST,2,X))+1
161 . . . Q
162 . . Q
163 . Q
164 ;
165 S X=$G(^TMP("MAG",$J,"RTD2",0)),P3=+$P(X,"^",3),P4=+$P(X,"^",4)
166 S DAY="" F S DAY=$O(BUCKET(DAY)) Q:DAY="" D
167 . S:'$D(^TMP("MAG",$J,"RTD2",DAY)) P4=P4+1,^TMP("MAG",$J,"RTD2",DAY,0)=DAY
168 . S D1=0,DEST="" F S DEST=$O(BUCKET(DAY,DEST)) Q:DEST="" D
169 . . S D1=D1+1
170 . . S X=$G(BUCKET(DAY,DEST,2,1)) ; Less than 5 minutes
171 . . S X=X_"^"_$G(BUCKET(DAY,DEST,2,2)) ; Less than 15 minutes
172 . . S X=X_"^"_$G(BUCKET(DAY,DEST,2,3)) ; Less than 1 hour
173 . . S X=X_"^"_$G(BUCKET(DAY,DEST,2,4)) ; 1 hour or more
174 . . S X=X_"^"_$G(BUCKET(DAY,DEST,2)) ; Longest
175 . . S X=X_"^Duration ("_NAME(DEST)_")"
176 . . S ^TMP("MAG",$J,"RTD2",DAY,1,D1,0)=X
177 . . S D1=D1+1
178 . . S X=$G(BUCKET(DAY,DEST,1,1)) ; Less than 5 minutes
179 . . S X=X_"^"_$G(BUCKET(DAY,DEST,1,2)) ; Less than 15 minutes
180 . . S X=X_"^"_$G(BUCKET(DAY,DEST,1,3)) ; Less than 1 hour
181 . . S X=X_"^"_$G(BUCKET(DAY,DEST,1,4)) ; 1 hour or more
182 . . S X=X_"^"_$G(BUCKET(DAY,DEST,1)) ; Longest
183 . . S X=X_"^Lag ("_NAME(DEST)_")"
184 . . S ^TMP("MAG",$J,"RTD2",DAY,1,D1,0)=X
185 . . Q
186 . S:DAY>P3 P3=DAY
187 . Q
188 ; Purge old entries
189 S R=$G(^MAGDICOM(2006.563,1,"RETAIN ROUTING STATISTICS")) S:R<1 R=30
190 S %H=$H-R D YMD^%DTC S DAY=X
191 S D0=0 F S D0=$O(^TMP("MAG",$J,"RTD2",D0)) Q:'D0 Q:D0'<DAY D
192 . K ^TMP("MAG",$J,"RTD2",D0) S P4=P4-1
193 . Q
194 ;
195 D ; Get routing statistics
196 . N A,W
197 . S (A,DAY)=0 F S DAY=$O(^TMP("MAG",$J,"RTD2",DAY)) Q:'DAY D
198 . . S:'A N=N+1,OUT(N)="Route",A=1
199 . . S N=N+1,OUT(N)="RDT="_DAY
200 . . S W=0 F S W=$O(^TMP("MAG",$J,"RTD2",DAY,1,W)) Q:'W D
201 . . . S X=$G(^TMP("MAG",$J,"RTD2",DAY,1,W,0))
202 . . . S N=N+1,OUT(N)="DST="_$P($P($P(X,"^",6),"(",2),")",1)
203 . . . S W=W+1,$P(X,"^",6,10)=$P($G(^TMP("MAG",$J,"RTD2",DAY,1,W,0)),"^",1,5)
204 . . . S N=N+1,OUT(N)="RST="_X
205 . . . Q
206 . . Q
207 . S:A N=N+1,OUT(N)="RouteEnd"
208 . Q
209 K ^TMP("MAG",$J,"RTD1")
210 K ^TMP("MAG",$J,"RTD2")
211 K ^TMP("MAG",$J,"RTD3")
212 Q
213 ;
214DELTA(START,STOP) N D,D1,D2,T1,T2
215 S D1=$P(START,".",1),D2=$P(STOP,".",1)
216 S T1=START*1E6#1E6,T2=STOP*1E6#1E6
217 S T1=T1\10000*60+(T1\100#100)*60+(T1#100)
218 S T2=T2\10000*60+(T2\100#100)*60+(T2#100)
219 S D=0 D:D1'=D2
220 . N %H,%T,%Y,X
221 . S X=D1 D H^%DTC S D1=%H
222 . S X=D2 D H^%DTC S D2=%H
223 . S D=D2-D1
224 . Q
225 Q D*86400+T2-T1
226 ;
Note: See TracBrowser for help on using the repository browser.