source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGDIR82.m@ 701

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

initial load of WorldVistAEHR

File size: 7.4 KB
Line 
1MAGDIR82 ;WOIFO/PMK - Read a DICOM image file ; 03/01/2006 14:04
2 ;;3.0;IMAGING;**11,30,51,20**;Apr 12, 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 ; M2MB server
19 ;
20 ; This routine is invoked by the ^MAGDIR8 to update statistics & add
21 ; an image to the background processor and auto-router queues.
22 ;
23 ; There are two entry points, one for the "ACQUIRED" RESULT item, and
24 ; the other (POSTPROC) for the "PROCESSED" RESULT item.
25 ;
26ACQUIRED ; update image acquisition statistics
27 N INSTNAME,LOCATION,STATUS
28 S STATUS=$P(ARGS,"|",1)
29 S LOCATION=$P(ARGS,"|",2)
30 S INSTNAME=$P(ARGS,"|",3)
31 D COUNT("ACQUIRED")
32 Q
33 ;
34POSTPROC ; update image processing statistics and add to BP & AR queues
35 N COUNTFLG,ERRCODE,EVAL,I,IMAGEPTR,INSTNAME,LOCATION,MACHID,MSG,STATUS
36 S STATUS=$P(ARGS,"|",1)
37 S LOCATION=$P(ARGS,"|",2)
38 S INSTNAME=$P(ARGS,"|",3)
39 S IMAGEPTR=$P(ARGS,"|",4)
40 S COUNTFLG=$P(ARGS,"|",5) ; zero for multiframe images
41 S EVAL=$P(ARGS,"|",6)
42 S MACHID=$P(ARGS,"|",7)
43 I COUNTFLG D
44 . D COUNT("PROCESSED") ; update the count
45 . Q:$T(SAVEUID^MAGDIR81)=""
46 . D SAVEUID^MAGDIR81(MACHID,"") ; clear the last image UID
47 . Q
48 ;
49 S ERRCODE=""
50 ;
51 I $$CONSOLID^MAGDFCNV D
52 . D POSTPRO2 ; consolidation code
53 . Q
54 E D
55 . D POSTPRO1 ; non-consolidation code
56 . Q
57 I ERRCODE="" D
58 . D RESULT^MAGDIR8(OPCODE,"|"_$P(ARGS,"|",2,999))
59 . Q
60 E D
61 . D ERROR^MAGDIR8(OPCODE,ERRCODE,.MSG,$T(+0))
62 . Q
63 Q
64 ;
65POSTPRO1 ; non-consolidation code version of post processing
66 Q:IMAGEPTR<0
67 ; add the image to the jukebox queue
68 D:'$$JUKEBOX^MAGBAPI(IMAGEPTR)
69 . S I=$O(MSG(" "),-1)
70 . S:I I=I+1,MSG(I)=" "
71 . S I=I+1,MSG(I)="JUKEBOX QUEUE CREATION ERROR:"
72 . S I=I+1,MSG(I)="An image has not been entered into the jukebox queue."
73 . S I=I+1,MSG(I)="Image pointer: "_IMAGEPTR
74 . D ERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
75 . S ERRCODE=-401
76 . Q
77 ;
78 D:EVAL ; Add the image to the routing evaluator queue
79 . D WARNROUT(0)
80 . D:$$EVAL^MAGBAPI(IMAGEPTR)<0
81 . . S I=$O(MSG(" "),-1)
82 . . S:I I=I+1,MSG(I)=" "
83 . . S I=I+1,MSG(I)="AUTOROUTER EVALUATION QUEUE CREATION ERROR:"
84 . . S I=I+1,MSG(I)="An image could not be evaluated for autorouting purposes."
85 . . S I=I+1,MSG(I)="Image pointer: "_IMAGEPTR
86 . . S I=I+1,MSG(I)="Error code is """_Z_"""."
87 . . D ERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
88 . . S ERRCODE=ERRCODE_"-402"
89 . . Q
90 . Q
91 Q
92 ;
93POSTPRO2 ; consolidation code version of post processing
94 N PLACE
95 Q:IMAGEPTR<0
96 S PLACE=$O(^MAG(2006.1,"B",LOCATION,""))
97 ;
98 ; add the image to the jukebox queue
99 D:'$$JUKEBOX^MAGBAPI(IMAGEPTR,PLACE)
100 . S I=$O(MSG(" "),-1)
101 . S:I I=I+1,MSG(I)=" "
102 . S I=I+1,MSG(I)="JUKEBOX QUEUE CREATION ERROR:"
103 . S I=I+1,MSG(I)="An image has not been entered into the jukebox queue."
104 . S I=I+1,MSG(I)="Image pointer: "_IMAGEPTR_" Location: "_LOCATION
105 . D ERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
106 . S ERRCODE=-403
107 . Q
108 ;
109 D:EVAL ; Add the image to the routing evaluator queue
110 . D WARNROUT(PLACE)
111 . D:$$EVAL^MAGBAPI(IMAGEPTR,PLACE)<0
112 . . S I=$O(MSG(" "),-1)
113 . . S:I I=I+1,MSG(I)=" "
114 . . S I=I+1,MSG(I)="AUTOROUTER EVALUATION QUEUE CREATION ERROR:"
115 . . S I=I+1,MSG(I)="An image could not be evaluated for autorouting purposes."
116 . . S I=I+1,MSG(I)="Image pointer: "_IMAGEPTR_" Place: "_PLACE
117 . . S I=I+1,MSG(I)="Error code is """_Z_"""."
118 . . D ERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
119 . . S ERRCODE=ERRCODE_"-404"
120 . . Q
121 . Q
122 Q
123 ;
124COUNT(STEP) ; update today's count
125 N %,D2,%H,NOW,PC,TODAY,X
126 D NOW^%DTC S TODAY=X,NOW=%
127 L +^MAGDAUDT(2006.5762,TODAY)
128 D:'$D(^MAGDAUDT(2006.5762,TODAY))
129 . S X=$G(^MAGDAUDT(2006.5762,0))
130 . S $P(X,"^",1,2)="DICOM INSTRUMENT STATISTICS^2006.5762"
131 . S $P(X,"^",3)=TODAY
132 . S $P(X,"^",4)=$P(X,"^",4)+1
133 . S ^MAGDAUDT(2006.5762,0)=X
134 . S ^MAGDAUDT(2006.5762,TODAY,0)=TODAY
135 . S ^MAGDAUDT(2006.5762,"B",TODAY,TODAY)=""
136 . Q
137 S D2=$O(^MAGDAUDT(2006.5762,TODAY,1,LOCATION,1,"B",INSTNAME,""))
138 D:'D2
139 . S D2=$O(^MAGDAUDT(2006.5762,TODAY,1,LOCATION,1," "),-1)+1
140 . S X=$G(^MAGDAUDT(2006.5762,TODAY,1,LOCATION,1,0))
141 . S $P(X,"^",2)="2006.576211"
142 . S $P(X,"^",3)=D2
143 . S $P(X,"^",4)=$P(X,"^",4)+1
144 . S ^MAGDAUDT(2006.5762,TODAY,1,LOCATION,0)=LOCATION
145 . S ^MAGDAUDT(2006.5762,TODAY,1,LOCATION,1,0)=X
146 . S ^MAGDAUDT(2006.5762,TODAY,1,LOCATION,1,D2,0)=INSTNAME
147 . S ^MAGDAUDT(2006.5762,TODAY,1,LOCATION,1,"B",INSTNAME,D2)=""
148 . Q
149 S X=$G(^MAGDAUDT(2006.5762,TODAY,1,LOCATION,1,D2,0))
150 S PC=$S(STEP="ACQUIRED":2,STEP="PROCESSED":4,1:6)
151 S $P(X,"^",PC)=$P(X,"^",PC)+1
152 S $P(X,"^",PC+1)=NOW
153 S ^MAGDAUDT(2006.5762,TODAY,1,LOCATION,1,D2,0)=X
154 L -^MAGDAUDT(2006.5762,TODAY)
155 Q
156 ;
157WARNROUT(PLACE) N LAST,X1,X2,X3
158 D:'PLACE
159 . S PLACE=$$PLACE^MAGDRPC2(LOCATION)
160 . Q
161 S LAST=$G(^MAG(2006.1,+PLACE,"LASTROUTE"))
162 S (X2,X3)=LAST\1 D:X3
163 . N DEST,E,I,PRI,T
164 . S X1=DT D ^%DTC Q:X<7
165 . S X2=$P(LAST,"^",2) Q:X2'<DT ; Only send one message per day
166 . S (E,T,I)=0 F S I=$O(^MAGQUEUE(2006.03,"C",PLACE,"EVAL",I)) Q:I="" S E=E+1
167 . S PRI="" F S PRI=$O(^MAGQUEUE(2006.035,"STS",LOCATION,"WAITING",PRI)) Q:PRI="" D
168 . . S DEST="" F S DEST=$O(^MAGQUEUE(2006.035,"STS",LOCATION,"WAITING",PRI,DEST)) Q:DEST="" D
169 . . . S I="" F S I=$O(^MAGQUEUE(2006.035,"STS",LOCATION,"WAITING",PRI,DEST,I)) Q:I="" S T=T+1
170 . . . Q
171 . . Q
172 . S I=$O(MSG(" "),-1)
173 . S:I I=I+1,MSG(I)=" "
174 . S I=I+1,MSG(I)="More than a week has elapsed since "_(X3#100)_"-"_$P("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",X3\100#100)_"-"_(X3\10000+1700)
175 . S I=I+1,MSG(I)="when the last activity occurred that is related"
176 . S I=I+1,MSG(I)="to the processing of Routed Image files."
177 . S I=I+1,MSG(I)=" "
178 . S I=I+1,MSG(I)="The site parameter for ""This is a Routing Site"" is"
179 . S I=I+1,MSG(I)="currently turned ON."
180 . S I=I+1,MSG(I)="If this site is no longer actively routing image files"
181 . S I=I+1,MSG(I)="this site parameter must be turned OFF."
182 . S I=I+1,MSG(I)="This parameter needs to be turned OFF on each VistA"
183 . S I=I+1,MSG(I)="DICOM Gateway that processes incoming images."
184 . S I=I+1,MSG(I)=" "
185 . S I=I+1,MSG(I)="There are currently "_E_" entr"_$S(E=1:"y",1:"ies")
186 . S I=I+1,MSG(I)="waiting to be processed in the evaluation queue."
187 . S I=I+1,MSG(I)=" "
188 . S I=I+1,MSG(I)="There are currently "_T_" entr"_$S(T=1:"y",1:"ies")
189 . S I=I+1,MSG(I)="waiting to be processed in the transmission queue."
190 . S I=I+1,MSG(I)=" "
191 . S I=I+1,MSG(I)="If this site is still a routing site, then both the"
192 . S I=I+1,MSG(I)="Routing Rule Evaluator and the Routing Transmitter"
193 . S I=I+1,MSG(I)="must be restarted."
194 . D ERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
195 . S ERRCODE=ERRCODE_"-405"
196 . S $P(^MAG(2006.1,PLACE,"LASTROUTE"),"^",2)=DT
197 . Q
198 Q
199 ;
Note: See TracBrowser for help on using the repository browser.