source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGQBUT.m@ 1470

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

initial load of FOIAVistA 6/30/08 version
File size: 9.3 KB
Line 
1MAGQBUT ;WOIFO/RMP - Imaging Background Processor Utilities [ 03/25/2001 11:20 ]
2 ;;3.0;IMAGING;**7,8,48,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 ;;
18FTYPE(RESULT) ;
19 ; RPC[MAGQ FTYPE]
20 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
21 N MAX,INDX,PLACE
22 S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
23 S U="^",MAX=$P(^MAG(2006.1,PLACE,2,0),U,4),INDX=0
24 Q:+MAX<1
25 F S INDX=$O(^MAG(2006.1,PLACE,2,INDX)) Q:INDX'?1N.N D Q:INDX=MAX
26 . S RESULT(INDX-1)=$G(^MAG(2006.1,PLACE,2,INDX,0))
27 Q
28CHGSERV(RESULT,NOTIFY) ;
29 ; RPC[MAGQ FS CHNGE]
30 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
31 N SPACE,DATA,IEN,SIZE,CWL,MIN,CNT,TNODE,TINT,NOW,TLTIME,TOD,PLACE,TS,AUTON
32 S U="^",(INDX,SPACE,SIZE,CNT)=0,(RESULT,IEN)=""
33 S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
34 S MIN=$$SPARM
35 S CWL=$$CWL^MAGBAPI(PLACE)
36 S DATA=$S(CWL?1N.N:$G(^MAG(2005.2,CWL,0)),1:0)
37 ;Check for scheduled purge
38 S AUTON=$G(^MAG(2006.1,PLACE,5))
39 I $P(AUTON,U,3) D
40 . N T1,T2
41 . S T1="0000",T2=$P(AUTON,U,5),T1=$E(T1,1,($L(T1)-$L(T2)))_T2
42 . I ($$FMADD^XLFDT($$NOW^XLFDT,-$P(AUTON,U,4),"","",""))>($P(AUTON,U,6)_"."_T1) D
43 . . S $P(RESULT,U,4)="PURGE"
44 . . S $P(^MAG(2006.1,PLACE,5),U,6)=$P($$NOW^XLFDT,".")
45 . . Q
46 . Q
47 I $P($G(^MAG(2006.1,PLACE,1)),U,10) D Q ;Cache balancing off
48 . S SPACE=+$P($G(^MAG(2005.2,CWL,0)),U,5),SIZE=+$P($G(^MAG(2005.2,CWL,0)),U,3)
49 . I (SIZE>0)&(((SPACE/SIZE)*100)>MIN) D Q
50 . . S $P(RESULT,U)=1
51 . . D Q
52 . . . I SIZE S $P(RESULT,U,5)=$P(((SPACE/SIZE)*100),".")_"."_$E($P(((SPACE/SIZE)*100),".",2),1,2) Q
53 . . . E S $P(RESULT,U,5)="0.00" Q
54 . E D
55 . . I SIZE S $P(RESULT,U,5)=$P(((SPACE/SIZE)*100),".")_"."_$E($P(((SPACE/SIZE)*100),".",2),1,2)
56 . . E S $P(RESULT,U,5)="0.00"
57 . . S $P(RESULT,U)=$S(SPACE>0:2,1:0)
58 . . S $P(RESULT,U,2,3)=$P(^MAG(2005.2,$P(^MAG(2006.1,PLACE,0),U,3),0),U,1,2)
59 . . I ($P($G(^MAG(2006.1,PLACE,5)),U)&(SPACE>0)) S $P(RESULT,U,4)="PURGE" Q
60 . . D:(NOTIFY!(SPACE>0)) TMESS(SPACE,PLACE)
61 . . Q
62 . Q
63 D FSP(MIN,.SPACE,.SIZE,.IEN,.TS,PLACE)
64 I SIZE S $P(RESULT,U,5)=$P(((SPACE/SIZE)*100),".")_"."_$E($P(((SPACE/SIZE)*100),".",2),1,2)
65 E S $P(RESULT,U,5)="0.00"
66 I IEN D SCWL(IEN,PLACE)
67 I SIZE>0,(((SPACE/SIZE)*100)>MIN) S $P(RESULT,U)=1 Q
68 S $P(RESULT,U)=$S(SPACE>0:2,1:0)
69 S $P(RESULT,U,2,3)=$P(^MAG(2005.2,$P(^MAG(2006.1,PLACE,0),U,3),0),U,1,2)
70 I ($P($G(^MAG(2006.1,PLACE,5)),U)&(SPACE>0)) D Q
71 . S $P(RESULT,U,4)="PURGE"
72 . D TPMESS^MAGQBUT5(PLACE)
73 . Q
74 D:(NOTIFY!(SPACE>0)) TMESS(TS,PLACE)
75 Q
76TMESS(TS,PLACE) ;Trigger a message
77 N TN S TN=^MAG(2006.1,PLACE,3)
78 Q:$$FMADD^XLFDT($P(TN,"^",11),"",$P(TN,"^",7),"","")>$$NOW^XLFDT
79 D ICCL^MAGQBUT1(CNT_U_TS_U_SPACE_U_$P($G(^MAG(2006.1,PLACE,5)),U),$P(TN,"^",7)_" hours.",PLACE)
80 Q
81TPURGE ;
82 S $P(RESULT,U,2,3)=$P(^MAG(2005.2,$P(^MAG(2006.1,PLACE,0),U,3),0),1,2)
83 S TNODE=^MAG(2006.1,PLACE,3)
84 S TINT=$P(TNODE,"^",8) I "^W^D^"[("^"_TINT_"^") D ;CONDITIONAL PURGE
85 . S NOW=$$NOW^XLFDT,TOD=$P(TNODE,"^",9)
86 . Q:NOW<$$FMADD^XLFDT($P(NOW,"."),"",TOD,"","")
87 . S TLTIME=$P(TNODE,"^",10)
88 . I NOW>$$FMADD^XLFDT(TLTIME,$S(TINT="D":1,TINT="W":7),"","","") D
89 . . S $P(RESULT,"^",4)="PURGE"
90 Q
91MAXSP(IEN,FS,SZ,NODE,MIN) ;
92 N SPACE,SIZE
93 S SPACE=+$P(NODE,U,5),SIZE=+$P(NODE,U,3)
94 I SIZE>0,(((SPACE/SIZE)*100)>MIN),SPACE>FS D Q 1
95 . S FS=SPACE,SZ=SIZE
96 Q 0
97HFIND(SHARE,IEN) ;HASHED SHARE AT THE SAME LOCATION
98 N INDEX,NODE,RESULT
99 S INDEX=0,RESULT=""
100 F S INDEX=$O(^MAG(2005.2,"AC",SHARE,INDEX)) Q:INDEX'?1N.N D
101 . Q:INDEX=IEN
102 . I $P(^MAG(2005.2,INDEX,0),"^",8)="Y" S RESULT=1
103 Q RESULT
104SPARM() ;Site Parameter for PERCENT server space to be held in reserve
105 N VALUE
106 S VALUE=$P($G(^MAG(2006.1,$$PLACE^MAGBAPI(+$G(DUZ(2))),1)),U,8)
107 Q $S(VALUE>0:VALUE,1:5)
108SCWL(IEN,PLACE) ;
109 S $P(^MAG(2006.1,PLACE,0),U,3)=IEN
110 S $P(^MAG(2006.1,PLACE,"PACS"),U,3)=IEN
111 Q
112FSP(MIN,SPACE,SIZE,IEN,TOTAL,PLACE) ; Find Space
113 N INDX,DATA S (TOTAL,INDX)=0
114 F S INDX=$O(^MAG(2005.2,INDX)) Q:INDX'?1N.N D
115 . S DATA=$G(^MAG(2005.2,INDX,0))
116 . Q:$P(DATA,U,6,7)'["1^MAG"
117 . Q:$P(DATA,U,9)="1" ;ROUTING SHARE
118 . Q:$P(DATA,U,10)'=PLACE
119 . I $P(DATA,U,8)'="Y",$$HFIND($P(DATA,"^",2),INDX) Q
120 . Q:$P(DATA,U,2)[":"
121 . Q:$E($P(DATA,U,2),1,2)'="\\"
122 . S TOTAL=TOTAL+(+$P(DATA,U,5))
123 . S CNT=CNT+1
124 . I $$MAXSP(INDX,.SPACE,.SIZE,DATA,MIN) S IEN=INDX
125 Q
126SLAD(RESULT) ;SITE LAST ACCESS DATE(DEFAULT TO 180)
127 N PLACE
128 S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
129 S RESULT=$S(+$P(^MAG(2006.1,PLACE,1),"^",2):+$P(^MAG(2006.1,PLACE,1),"^",2),1:180)
130 Q
131DQUE(QIEN) ;
132 N ZNODE,TYPE,MAGIEN,PLACE,QP,QT
133 S ZNODE=$G(^MAGQUEUE(2006.03,QIEN,0))
134 S PLACE=$P(ZNODE,U,12)
135 S TYPE=$P(ZNODE,U)
136 I TYPE="" D DBQ(QIEN,PLACE,ZNODE) Q
137 S QP=$O(^MAGQUEUE(2006.031,"C",PLACE,TYPE,""))
138 L +^MAGQUEUE(2006.031,QP,0)
139 S QT=+$P($G(^MAGQUEUE(2006.031,QP,0)),U,5)
140 S $P(^MAGQUEUE(2006.031,QP,0),U,5)=QT-1
141 L -^MAGQUEUE(2006.031,QP,0)
142 K ^MAGQUEUE(2006.03,"C",PLACE,$P(ZNODE,U),QIEN)
143 K ^MAGQUEUE(2006.03,QIEN,0)
144 I $P(ZNODE,U,5)]"" D
145 . K ^MAGQUEUE(2006.03,"D",PLACE,TYPE,$E($P(ZNODE,U,5),1,30),QIEN)
146 L +^MAGQUEUE(2006.03,0)
147 S $P(^MAGQUEUE(2006.03,0),"^",4)=$P(^MAGQUEUE(2006.03,0),"^",4)-1
148 L -^MAGQUEUE(2006.03,0)
149 Q:("^JBTOHD^PREFET^JUKEBOX^")'[("^"_TYPE_"^")
150 S MAGIEN=$P(ZNODE,U,7)
151 Q:'MAGIEN
152 I TYPE="JUKEBOX" D Q
153 . K ^MAGQUEUE(2006.03,"E",PLACE,MAGIEN,QIEN)
154 I "^JBTOHD^PREFET^"[("^"_TYPE_"^") D Q
155 . Q:$P(ZNODE,U,8)']""
156 . K ^MAGQUEUE(2006.03,"F",PLACE,MAGIEN,$P(ZNODE,U,8),QIEN)
157 . Q
158 Q
159DQUE1(RESULT,QIEN) ;[MAGQB QUEDEL]
160 D DQUE(QIEN)
161 Q
162DBQ(QIEN,PLACE,ZNODE) ;
163 N INDX
164 F INDX="DELETE","ABSTRACT","JUKEBOX","JBTOHD","PREFET","IMPORT" D
165 . K ^MAGQUEUE(2006.03,"C",PLACE,INDX,QIEN)
166 . K:$P(ZNODE,U,5)]"" ^MAGQUEUE(2006.03,"D",PLACE,INDX,$E($P(ZNODE,U,5),1,30),QIEN)
167 . I INDX="JUKEBOX" D
168 . . K:$P(ZNODE,U,7) ^MAGQUEUE(2006.03,"E",PLACE,$P(ZNODE,U,7),QIEN) Q
169 . I "^JBTOHD^PREFET^"[("^"_INDX_"^") D
170 . . K:($P(ZNODE,U,7)&$P(ZNODE,U,8)]"") ^MAGQUEUE(2006.03,"F",PLACE,$P(ZNODE,U,7),$P(ZNODE,U,8),QIEN) Q
171 K ^MAGQUEUE(2006.03,QIEN,0)
172 Q
173JBQUE(RESULT,QIEN) ; RPC[MAGQBP JBQUE]
174 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
175 S RESULT=$$JUKEBOX^MAGBAPI(QIEN,$$PLACE^MAGBAPI(+$G(DUZ(2))))
176 Q
177POSTI ;
178 D INI^MAGUSIT
179 N DIC,X,DA,Y,NODE1,NODE3,PLACE,KEYS
180 S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
181 Q:'PLACE
182 S DIC="^MAG(2006.1,"_PLACE_",2,",DIC(0)="XL",X="TXT",DLAYGO="2006.112"
183 S DA(1)=PLACE,DIC("P")="2006.112"
184 D ^DIC
185 S (DIE,DIC,DLAYGO)=2006.1,DA=PLACE,DIC(0)="XL"
186 S NODE1=$G(^MAG(2006.1,1,1)),NODE3=$G(^MAG(2006.1,PLACE,3)),DR=""
187 S KEYS=$G(^MAG(2006.1,PLACE,"KEYS"))
188 S DR=$S(($P(NODE1,"^",2)'?1N.N):"8///45",1:DR)
189 I ($P(NODE1,"^",5)'?1N.N) S DR=DR_$S((DR["/"):";",1:"")_"9///45"
190 I ($P(NODE1,"^",10)'?1N.N) S DR=DR_$S((DR["/"):";",1:"")_"20///1"
191 I ($P(NODE3,"^",1)'?1N.N) S DR=DR_$S((DR["/"):";",1:"")_"21///45"
192 I ($P(NODE3,"^",2)'?1N.N) S DR=DR_$S((DR["/"):";",1:"")_"22///45"
193 I ($P(NODE3,"^",3)'?1N.N) S DR=DR_$S((DR["/"):";",1:"")_"23///120"
194 I ($P(NODE3,"^",4)'?1N.N) S DR=DR_$S((DR["/"):";",1:"")_"24///120"
195 I ($P(NODE3,"^",5)'?1N.N) S DR=DR_$S((DR["/"):";",1:"")_"102///10"
196 I ($P(NODE3,"^",6)'?1N.N) S DR=DR_$S((DR["/"):";",1:"")_"103///15"
197 I ($P(NODE3,"^",7)'?1N.N) S DR=DR_$S((DR["/"):";",1:"")_"11.5///6"
198 S DR=DR_$S((DR["/"):";",1:"")_"11.6///D"
199 I ($P(NODE3,"^",9)'?1N.N) S DR=DR_$S((DR["/"):";",1:"")_"11.7///4"
200 I ($P(NODE3,"^",10)'?1N.E) D
201 . S DR=DR_$S((DR["/"):";",1:"")_"11.8///"_$$NOW^XLFDT
202 I ($P(NODE3,"^",11)'?1N.E) D
203 . S DR=DR_$S((DR["/"):";",1:"")_"11.9///"_$$NOW^XLFDT
204 I ($P(KEYS,"^",2)'?1N.N) S DR=DR_$S((DR["/"):";",1:"")_"121///60"
205 I ($P(KEYS,"^",3)'?1N.N) S DR=DR_$S((DR["/"):";",1:"")_"122///90"
206 D ^DIE
207 ; Enable the Imaging Health Summary component
208 I $D(^GMT(142.1,235)) D
209 . S (DIE,DIC)=142.1,DA=235
210 . S DR="5///@;8///@"
211 . D ^DIE
212 K DIE,DIC,DA,Y,X,DLAYGO,DR
213 D MMGRP^MAGQAI
214 Q
215X1 ; CLEANUP
216 N PC
217 S DIR(0)="Y",DIR("B")="YES"
218 S DIR("?")="This activity removes already processed queues which precede the current queue pointer. These queues are not necessary for file recovery.The current BP software will recover files during purge or by the verify."
219 S DIR("A")="Do you wish to remove old processed Background Processor Queues" D
220 . D ^DIR Q:($D(DIRUT)!(Y'="1"))
221 . F PC="JUKEBOX","JBTOHD","PREFET","IMPORT","GCC","DELETE" D FOQUE("",PC)
222 ; REINDEX FIELD 4 (COMPLETION STATUS) IN FILE 2006.03 (QUEUE)
223 K DIR
224 K ^MAGQUEUE(2006.03,"C")
225 S DIK="^MAGQUEUE(2006.03,"
226 D IXALL^DIK K DIK
227 K DIRUT
228 Q
229FOQUE(RESULT,PROC) ;[MAGQ COQ] PASS A BP PROCESS TO DELETE OLD FAILED QUEUES
230 N XX,JXMAX,JHMAX,QIEN,PLACE,LQP,CNT
231 S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2))),CNT=0
232 S QIEN=$O(^MAGQUEUE(2006.031,"C",PLACE,PROC,""))
233 I QIEN D
234 . S LQP=$P($G(^MAGQUEUE(2006.031,QIEN,0)),"^",2)
235 . Q:'LQP
236 . S XX=0
237 . F S XX=$O(^MAGQUEUE(2006.03,"C",PLACE,PROC,XX)) Q:'XX Q:XX>(LQP) D
238 . . S CNT=CNT+1
239 . . D DQUE(XX)
240 S RESULT=CNT
241 Q
Note: See TracBrowser for help on using the repository browser.