source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRNINES7.m@ 1334

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

initial load of FOIAVistA 6/30/08 version
File size: 6.6 KB
Line 
1LRNINES7 ;DAL/HOAK SEARCH FOR 7 9s ; 10/14/96 16:02
2 ;;5.2;LAB SERVICE;**156**;Sep 27, 1994
3 ;
4INIT ;
5 ;
6 ;
7 ;^LR(582,"CH",9999999,0) = 0^1^2970522.101919^389^72^CH 0522 106^^MONARCH 2
8CONTROL ;
9 K ^TMP("LR",$J,"7-9s")
10 D FINDLR
11 S LRTIC=""
12 ;
13 D FIXALL
14END ;
15 ;
16DONE W !!,"All occurences of 7 9s have been removed and their effects in"
17 W !,"your data base have been disarmed.",!
18 D ^LRKILL
19 QUIT
20 ;
21TASK ;
22 ;-->Task the job to look for 7-9s that were created Today
23 ;
24 K ^TMP("LR",$J,"7-9s")
25 ;
26 S LRCOUNT=0
27 S LRCNTLR=500
28 S LRT70=LRCNTLR,LRIN=0,LRA=1,LRI=1
29 I IOST["C-" W @IOF D
30 . S DX=3,DY=10 X IOXY
31 . D JOBTIME
32 . D TITLE^XPDID("SEARCHING ^LR(")
33 ;
34 S X1=DT,X2=-1 D C^%DTC S LRDT0=X
35 S LRDFN=0
36 F LRODT=LRDT0,DT D
37 . F S LRDFN=$O(^LRO(69,LRODT,1,"AA",LRDFN)) Q:+LRDFN'>0 D SET(LRDFN)
38 ;
39 ;
40 D SCRNOFF
41 I '$D(TMP("LR",$J,"7-9s")) D
42 . Q:IOST'["C-"
43 . W !!,"Mission debreifing:"
44 . W !,"No problems related to 7-9s have been observed for Yesterday and Today."
45 QUIT
46 ;
47FINDLR ;----------find ALL the 7 nines in ALL OF LR
48 ;---> ^LR(0)=LAB DATA^63^464^355
49 ;
50 S LRCNTLR=$P(^LR(0),U,4)
51 S LRT70=LRCNTLR,LRIN=0,LRA=1,LRI=1
52 ;
53 I IOST["C-" W @IOF D
54 . S DX=3,DY=10 X IOXY
55 . D JOBTIME
56 . D TITLE^XPDID("SEARCHING ^LR(")
57 S LRDFN=0,LRCOUNT=0
58 F S LRDFN=$O(^LR(LRDFN)) Q:+LRDFN'>0 D
59 . ;--------check all ^LR(subscripts
60 . D SET(LRDFN)
61 S DX=5,DY=15 X IOXY
62 W "Found ",LRCOUNT," occurrances of 7 9s in ^LR" H 2
63 D SCRNOFF
64 QUIT
65 ;
66SET(LRDFN) ;
67 ;
68 ;
69 I IOST["C-" D MOVE
70 F LRSUB="CH","MI" D
71 . I $D(^LR(LRDFN,LRSUB,9999999,0)) D
72 .. S ^TMP("LR",$J,"7-9s",LRDFN,LRSUB)="" S LRCOUNT=LRCOUNT+1
73 QUIT
74 ;
75FIXALL ;
76 ;
77 ;
78COUNT ;
79 S LRCOUNT=0
80 S LRX6=0
81 F S LRX6=$O(^TMP("LR",$J,"7-9s",LRX6)) Q:+LRX6'>0 S LRCOUNT=LRCOUNT+1
82 S LRCNTLR=LRCOUNT
83 I IOST["C-" W @IOF D
84 . S DX=3,DY=10 X IOXY
85 . D JOBTIME
86 . D TITLE^XPDID("Fixing ^LR(, ^LRO(68, ^LRO(69, and ^LAC(")
87 S LRDFN=0
88 F S LRDFN=$O(^TMP("LR",$J,"7-9s",LRDFN)) Q:+LRDFN'>0 D
89 . S LRSUB=""
90 . F S LRSUB=$O(^TMP("LR",$J,"7-9s",LRDFN,LRSUB)) Q:LRSUB="" D
91 .. I IOST["C-" D MOVE
92 .. Q:'$D(^LR(LRDFN,LRSUB,9999999,0))
93 .. S LRNODE=^LR(LRDFN,LRSUB,9999999,0)
94 .. D ACCN(LRNODE)
95 I IOST["C-" D MOVE
96 QUIT
97 ;
98 ;
99ACCN(LRNODE) ;
100 ;-->If LRNODE is not there or it is not an accn we still could
101 ;--> LAC( involved
102 ;
103 I '$D(LRNODE) D CHKLAC QUIT
104 ;
105 K LRAA,LRAD,LRAN,LRACCN,LRODT,LRSN
106 ;
107 ;
108BAKDOR ;-->Maybe the ^LAC can provide accn.
109 ;
110 S LRACCN=$P(LRNODE,U,6) ;--CH 0522 106
111 S LRAA=$O(^LRO(68,"B",$P(LRACCN," "),0))
112 S LRAD=$E($P(LRNODE,U,3),1,3)_$P(LRACCN," ",2) ;-- 297_0522
113 S LRAN=$P(LRACCN," ",3) ;--106
114 I $G(LRAA)'>0!($L(LRAD)'>4)!($G(LRAN)'>0) S LROK=0 QUIT
115LRSN ;
116 I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) S LRSN=$P(^(0),U,5)
117LRODT ;
118 I $G(LRSN)>0 S LRODT=+$G(^LRO(69,LRAD,1,LRSN,1))
119 ;
120 ;
121 I $G(LRODT)'>0,$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) S LRODT=LRAD
122 I $G(LRODT)'>0,$P(LRNODE,U,3)'="" S LRODT=$P(LRNODE,U,3) D
123 . S LRODT1=LRODT
124 . S LRODT=$P(LRODT,".")
125 . I $G(LRODT1)>0 S LRIDT=9999999-LRODT1
126 . D LAC(LRDFN,LRODT1,LRIDT) K LRODT
127 Q:'$G(LRODT)
128 ;
129 ;
130LRIDT ;
131 ;
132 S LRODT1=LRODT
133 S LRODT=$P(LRODT,".")
134 I $G(LRODT1)>0 S LRIDT=9999999-LRODT1
135 ;
136 D FIX68
137 ;
138BYE68 D LAC(LRDFN,LRODT1,LRIDT)
139 ;
140 QUIT
141 ;
142LAC(LRDFN,LRODT,LRIDT) ;
143 K LRTOE
144 ;^LAC("LRAC",34390,1,22,1,1,1,2970702.184153,0)
145 ;^LAC("LRAC",582,1,4,1,1,1,0,0) = 0^58-2*^2970522.101919^CH 0522 106^9999999
146 ;^LAC("LRAC",582,1,4,1,1,1,0,1,0) = ^64.705^7^7
147 ;
148 S LRTIC=0
149 F S LRTIC=$O(^LAC("LRAC",LRDFN,1,LRTIC)) Q:+LRTIC'>0 D
150 . S LRTAC=0
151 . F S LRTAC=$O(^LAC("LRAC",LRDFN,1,LRTIC,1,LRTAC)) Q:+LRTAC'>0 D
152 .. Q:'$D(^LAC("LRAC",LRDFN,1,LRTIC,1,LRTAC,1,0,0)) S LACNODE=^(0)
153 .. I $P(LACNODE,U)=0 D FIXLAC
154 .. S LRACCN=$P(LACNODE,U,4)
155 .. ;I $G(LRAN)'>0,$D(LRACCN) D BAKDOR
156 D:'$G(LRTOE) FIXLR
157 Q
158FIXLAC ;
159 ;^LAC("LRAC",34390,1,22,1,1,1,2970702.184153,0)
160 ; good girl-> /\
161 S LRLONG=$L(LACNODE)
162 S LACNODE=$E(LACNODE,2,LRLONG)
163 ; ^LAC("LRAC",582,1,4,1,1,1,0,1,7,0) = 20.^L^8
164 ;^LAC("LRAC",582,1,4,1,1,1,0,0) = 0^58-2*^2970522.101919^CH 0522 106^9999999-----------------------------/\<----bad girl
165 S %Y="^LAC(""LRAC"",LRDFN,1,LRTIC,1,LRTAC,1,LRODT1,"
166 S %X="^LAC(""LRAC"",LRDFN,1,LRTIC,1,LRTAC,1,0,"
167 D %XY^%RCR
168 S $P(^LAC("LRAC",LRDFN,1,LRTIC,1,LRTAC,1,LRODT1,0),U)=LRODT1
169 S $P(^LAC("LRAC",LRDFN,1,LRTIC,1,LRTAC,1,LRODT1,0),U,5)=LRIDT
170 K ^LAC("LRAC",LRDFN,1,LRTIC,1,LRTAC,1,0)
171 ;
172 D FIXLR
173 S LRTOE=1
174 ;^LAC("LRAC",582,1,4,1,1,1,0,1,0) = ^64.705^7^7
175 ;^LAC("LRAC",582,1,4,1,1,1,0,1,1,0) = 76.^^2
176 ;F S LRTOE=$
177 ;
178 Q
179CHKLAC ;
180 Q:'$D(LRNODE)
181 S LRODT=$P(LRNODE,U,3)
182 ;
183 I '$D(LRODT) S ^TMP("LR",$J,"CANT",LRDFN)="" QUIT
184 ;
185 S LRIDT=9999999-LRODT S LRODT=$P(LRODT,".")
186 D LAC(LRDFN,LRODT,LRIDT)
187 Q
188FIXLR ;
189 ;S ^LR(582,"CH",9999999,0)="0^1^2970522.101919^389^72^CH 0522 106^^MONARCH 24332^58-2*"
190 ;
191 S %Y="^LR(LRDFN,LRSUB,LRIDT,"
192 S %X="^LR(LRDFN,LRSUB,9999999,"
193 D %XY^%RCR
194 S ^LR(LRDFN,LRSUB,LRIDT,0)=$G(^LR(LRDFN,LRSUB,9999999,0))
195 S $P(^LR(LRDFN,LRSUB,LRIDT,0),U)=LRODT1
196 K ^LR(LRDFN,LRSUB,9999999)
197 Q
198FIX68 ;
199 ; COLL. TIME
200 ;^LRO(69,2970522,1,434,1)=2970522.073815^1^1658^C^^^^550
201 ;
202 Q:$G(LRSN)'>0
203 Q:'$D(^LRO(69,LRODT,1,LRSN,1))
204 S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,5)=LRIDT
205 S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U)=+^LRO(69,LRODT,1,LRSN,1)
206 ;
207 Q
208 ;
209JOBTIME ;
210 ;
211 Q:IOST'["C-"
212 ;
213 ;
214 K LRALT
215 S (LRT70,LRJT0,XPDIDVT)=LRCNTLR,LRIN=0,LRA=1,LRI=1
216 I IOST["C-" D INIT^XPDID
217 S XPDIDTOT=LRCNTLR
218 ;
219 ;
220 Q:$E(IOST,1,2)'="C-"
221 S OK=1
222 S DX=1,DY=8 X IOXY
223 D SCRNON
224 QUIT
225 ;
226MOVE ;
227 Q:IOST'["C-"
228 ;
229 I LRJT0<80 D ALT QUIT
230 Q:$G(LRALT)=1
231 S LRECIP=+$P((LRJT0/70),".") I LRECIP<1 S LRECIP=1
232 S DX=(2+LRIN)/LRECIP,DY=8 X IOXY D
233 . I '$G(LRTIC) S LRTIC=$P((LRJT0/70),".")
234 . S LRTIC=LRTIC+LRECIP S LRIN=LRIN+1
235 . D UPDATE^XPDID(LRIN)
236 . QUIT
237 . W IORVON
238 . W ">"
239 . W IORVOFF
240 . S DX=38,DY=10 X IOXY
241 . W IOELALL
242 . W $P((LRIN/LRJT0)*100,"."),"%"
243 ;I 'OK D SCRNOFF
244 ;
245 ;
246 ;
247 Q
248ALT ;
249 Q:IOST'["C-"
250 ;
251 Q:$G(LRALT)=1
252 S (LRT70,LRJT0)=LRCNTLR,LRIN=0,LRA=1,LRI=1
253 S LRALT=1
254 S LRTJ0=70
255 F I=1:1:70 D
256 . S DX=(2+LRIN),DY=8 X IOXY D
257 . S LRIN=LRIN+1
258 . D UPDATE^XPDID(LRIN)
259 . QUIT
260 . W IORVON
261 . W ">"
262 . W IORVOFF
263 . S DX=38,DY=10 X IOXY
264 . W IOELALL
265 . S LRHUN=(LRIN/LRJT0)*100 I LRHUN>100 S LRHUN=100
266 . W $P(LRHUN,"."),"%"
267 ;
268 Q
269 ;
270SCRNON ;
271 Q:IOST'["C-"
272 ;D GSET^%ZISS W IOG1
273 D ENS^%ZISS S %ZIS="I"
274 D FLASH
275 Q
276FLASH ;
277 Q
278 ;S LRDT7=LRIDT
279 I '$G(LRDT7) S LRDT7=LR(1)
280 S DX=13,DY=20 X IOXY
281 ;W IORVON
282 W IODHLT,$$CJ^XLFSTR($$FMTE^XLFDT(LRDT7,"D"),IOM)
283 S DY=DY+1 X IOXY
284 W IODHLB,$$CJ^XLFSTR($$FMTE^XLFDT(LRDT7,"D"),IOM)
285 ;W IOIND
286 ;W IORVOFF
287 ;S DY=DY-1 X IOXY
288 ;W " "
289 ;S DY=DY+3 X IOXY
290 ;W $G(LRI)
291 Q
292SCRNOFF ;
293 Q:IOST'["C-"
294 ;
295 S (LRT70,LRJT0,XPDIDVT)=LRCNTLR,LRIN=0,LRA=1,LRI=1
296 D EXIT^XPDID("DONE")
297 ;W IOBOFF
298 ;D KILL^%ZISS
299 ;
300 ;
301 Q
Note: See TracBrowser for help on using the repository browser.