source: FOIAVistA/tag/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJHVARS.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 8.1 KB
Line 
1PSJHVARS ;BIR/RSB-SAVE/RESTORE VARIABLES FOR HIDDEN MENUS ;24 Feb 99 / 10:42 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**16,22,30,58**;16 DEC 97
3 ;
4 ; Reference to ^ORD(101 is supported by DBIA 872.
5 ; Reference to ^%RCR is supported by DBIA 10022.
6 ; Reference to ^DIR is supported by DBIA 10026.
7 ;
8 ;PSJHIDFG will be defined if the user already in the hidden menu.
9 I $$HIDCHK() D Q
10 . W !,"HIDDEN MENUS MAY NOT BE CALLED RECURSIVELY!" S XQORQUIT=1
11 . N DIR S DIR(0)="E" D ^DIR
12 ; saves the variables in ^TMP
13 K ^TMP("PSJVARS",$J),^TMP("PSJ_ON_HIDDEN",$J)
14 F PSJRSB1=1:1 S PSJRSBV=$P($T(LIST+PSJRSB1),";;",2) Q:PSJRSBV="" D
15 .I $D(@PSJRSBV) S:$D(@PSJRSBV)'=10 ^TMP("PSJVARS",$J,PSJRSBV)=@PSJRSBV
16 I $D(DRG) MERGE ^TMP("PSJHDRG",$J)=DRG
17 ;save off ^TMP("PSJON",$J) because it gets killed down in hidden options
18 F PSJRSB1L=0:0 S PSJRSB1L=$O(^TMP("PSJON",$J,PSJRSB1L)) Q:'PSJRSB1L D
19 .S ^TMP("PSJ_ON_HIDDEN",$J,PSJRSB1L)=^TMP("PSJON",$J,PSJRSB1L)
20 K PSJRSB1,PSJRSB1L,PSJRSBV
21 NEW PSJX
22 F PSJX="P(","PSGEFN(","PSGVADR(","PSGVALG(","VADM(","VAIN(","VAIP(" D SVARRAY
23 I $D(^TMP("PSIV",$J)) S %X="^TMP(""PSIV"",$J,",%Y="^TMP(""PSJHTMP"",$J,""PSIV""," D %XY^%RCR
24 I $D(^TMP("PSJALL",$J)) S %X="^TMP(""PSJALL"",$J,",%Y="^TMP(""PSJHTMP"",$J,""PSJALL""," D %XY^%RCR
25 I $D(^TMP("PSJI",$J)) S %X="^TMP(""PSJI"",$J,",%Y="^TMP(""PSJHTMP"",$J,""PSJI""," D %XY^%RCR
26 I $D(^TMP("PSJPRO",$J)) S %X="^TMP(""PSJPRO"",$J,",%Y="^TMP(""PSJHTMP"",$J,""PSJPRO""," D %XY^%RCR
27 D SAVEPS ; Save the ^PS(53.45,DUZ,2) entry
28 Q
29SVARRAY ; Save array to ^TMP
30 NEW PSJVARX,X S PSJVARX=PSJX_"X)"
31 S X="" F S X=$O(@PSJVARX) Q:X="" S ^TMP("PSJVARS",$J,PSJX_$S(+X=X:X,1:""""_X_"""")_")")=@PSJVARX
32 Q
33RESTORE ; restores the variables from ^TMP
34 Q:$G(PSJHIDFG)
35 S PSJRSBV="" F S PSJRSBV=$O(^TMP("PSJVARS",$J,PSJRSBV)) Q:PSJRSBV="" D
36 .S @PSJRSBV=^TMP("PSJVARS",$J,PSJRSBV)
37 I $D(^TMP("PSJHDRG",$J)) K DRG MERGE DRG=^TMP("PSJHDRG",$J)
38 ;restore ^TMP("PSJON",$J) if it is not there
39 I '$D(^TMP("PSJON",$J)) D
40 .F PSJRSB1=0:0 S PSJRSB1=$O(^TMP("PSJ_ON_HIDDEN",$J,PSJRSB1)) Q:'PSJRSB1 D
41 ..S ^TMP("PSJON",$J,PSJRSB1)=^TMP("PSJ_ON_HIDDEN",$J,PSJRSB1)
42 I $D(^TMP("PSJHTMP",$J,"PSIV")) S %X="^TMP(""PSJHTMP"",$J,""PSIV"",",%Y="^TMP(""PSIV"",$J," D %XY^%RCR K ^TMP("PSJHTMP",$J,"PSIV")
43 I $D(^TMP("PSJHTMP",$J,"PSJALL")) S %X="^TMP(""PSJHTMP"",$J,""PSJALL"",",%Y="^TMP(""PSJALL"",$J," D %XY^%RCR K ^TMP("PSJHTMP",$J,"PSJALL")
44 I $D(^TMP("PSJHTMP",$J,"PSJI")) S %X="^TMP(""PSJHTMP"",$J,""PSJI"",",%Y="^TMP(""PSJI"",$J," D %XY^%RCR K ^TMP("PSJHTMP",$J,"PSJI")
45 I $D(^TMP("PSJHTMP",$J,"PSJPRO")) S %X="^TMP(""PSJHTMP"",$J,""PSJPRO"",",%Y="^TMP(""PSJPRO"",$J," D %XY^%RCR K ^TMP("PSJHTMP",$J,"PSJPRO")
46 K ^TMP("PSJVARS",$J),^TMP("PSJ_ON_HIDDEN",$J),^TMP("PSJHDRG",$J)
47 K PSJRSBV,PSJRSB1
48 D RESPS ; Restore any saved ^PS(53.45,DUZ,2) and ^PS(53.45,DUZ,4) entries
49 Q
50HIDCHK() ; XQORNEST(X) contains a list of selected protocols.
51 K ^TMP("PSJHIDCHK",$J) N PSJ,X,Y
52 F X=0:0 S X=$O(XQORNEST(X)) Q:'X S ^TMP("PSJHIDCHK",$J,+$P(XQORNEST(X),";"))=""
53 S X=+$O(^ORD(101,"B","PSJI LM LBLI",0))
54 S Y=+$O(^ORD(101,"B","PSJ LM RETURNS/DESTROYED MENU",0))
55 S PSJ=$S($D(^TMP("PSJHIDCHK",$J,X)):1,$D(^TMP("PSJHIDCHK",$J,Y)):1,1:0)
56 K ^TMP("PSJHIDCHK",$J)
57 Q PSJ
58SAVEPS ; Save the ^PS(53.45,DUZ,2) entry
59 ; Save the 2,0) node
60 I $D(^PS(53.45,DUZ,2,0)) D
61 .S ^TMP("PSJ5345",$J,DUZ,2,0)=^PS(53.45,DUZ,2,0)
62 ;Save the 2,n,0) nodes
63 S PSJLOOP=0
64 F PSJLOOP=$O(^PS(53.45,DUZ,2,PSJLOOP)) Q:(PSJLOOP="")!(PSJLOOP="B") D
65 .S ^TMP("PSJ5345",$J,DUZ,2,PSJLOOP,0)=^PS(53.45,DUZ,2,PSJLOOP,0)
66 ;Save the 2,"B" node
67 I $D(^PS(53.45,DUZ,2,"B")) D
68 .S PSJBLOOP=""
69 .F PSJBLOOP=$O(^PS(53.45,DUZ,2,"B",PSJBLOOP)) Q:PSJBLOOP="" D
70 ..S PSJCOUNT=""
71 ..F PSJCOUNT=$O(^PS(53.45,DUZ,2,"B",PSJBLOOP,PSJCOUNT)) Q:PSJCOUNT="" D
72 ...S ^TMP("PSJ5345",$J,DUZ,2,"B",PSJBLOOP,PSJCOUNT)=^PS(53.45,DUZ,2,"B",PSJBLOOP,PSJCOUNT)
73 ; Save the 4,0) node
74 ;I $D(^PS(53.45,DUZ,4,0)) D
75 ;.S ^TMP("PSJ5345",$J,DUZ,4,0)=^PS(53.45,DUZ,4,0)
76 ; Save the 4,n,0) nodes
77 ;S PSJLOOP=0
78 ;F PSJLOOP=$O(^PS(53.45,DUZ,4,PSJLOOP)) Q:PSJLOOP="" D
79 ;.S ^TMP("PSJ5345",$J,DUZ,4,PSJLOOP,0)=^PS(53.45,DUZ,4,PSJLOOP,0)
80 Q
81RESPS ; Restore any saved ^PS(53.45,DUZ,2) entry
82 ;Restore the 2,0 node
83 I $D(^TMP("PSJ5345",$J,DUZ,2,0)) D
84 .S ^PS(53.45,DUZ,2,0)=^TMP("PSJ5345",$J,DUZ,2,0)
85 ;Restore the 2,n,o) nodes
86 S PSJLOOP=0
87 F PSJLOOP=$O(^TMP("PSJ5345",$J,DUZ,2,PSJLOOP)) Q:(PSJLOOP="")!(PSJLOOP="B") D
88 .S ^PS(53.45,DUZ,2,PSJLOOP,0)=^TMP("PSJ5345",$J,DUZ,2,PSJLOOP,0)
89 ;Restore the 2,"B" nodes
90 I $D(^TMP("PSJ5345",$J,DUZ,2,"B")) D
91 .S PSJBLOOP=""
92 .F PSJBLOOP=$O(^TMP("PSJ5345",$J,DUZ,2,"B",PSJBLOOP)) Q:PSJBLOOP="" D
93 ..S PSJCOUNT=""
94 ..F PSJCOUNT=$O(^TMP("PSJ5345",$J,DUZ,2,"B",PSJBLOOP,PSJCOUNT)) Q:PSJCOUNT="" D
95 ...S ^PS(53.45,DUZ,2,"B",PSJBLOOP,PSJCOUNT)=^TMP("PSJ5345",$J,DUZ,2,"B",PSJBLOOP,PSJCOUNT)
96 ;Restore the 4,0) node
97 ;I $D(^TMP("PSJ5345",$J,DUZ,4,0)) D
98 ;.S ^PS(53.45,DUZ,4,0)=^TMP("PSJ5345",$J,DUZ,4,0)
99 ;Restore the 4,n,0) nodes
100 ;S PSJLOOP=0
101 ;F PSJLOOP=$O(^TMP("PSJ5345",$J,DUZ,4,PSJLOOP)) Q:PSJLOOP="" D
102 ;.S ^PS(53.45,DUZ,4,PSJLOOP,0)=^TMP("PSJ5345",$J,DUZ,4,PSJLOOP,0)
103 K ^TMP("PSJ5345",$J,DUZ)
104 Q
105LIST ;
106 ;;ADM
107 ;;AL
108 ;;C
109 ;;CHK
110 ;;DDH
111 ;;DFN
112 ;;DN
113 ;;DRGI
114 ;;DRGN
115 ;;DRGT
116 ;;DX
117 ;;DY
118 ;;FIL
119 ;;FQ
120 ;;GMRA
121 ;;GMRAL
122 ;;HDT
123 ;;I
124 ;;INFUSE
125 ;;J
126 ;;LIMIT
127 ;;LINE
128 ;;LOC
129 ;;N
130 ;;NAD
131 ;;ND
132 ;;ND0
133 ;;ND2
134 ;;ND4
135 ;;ND6
136 ;;NDP2
137 ;;NEXT
138 ;;NF
139 ;;NO
140 ;;O
141 ;;ON
142 ;;ON55
143 ;;ORIFN
144 ;;P16
145 ;;P17
146 ;;P(2)
147 ;;P(3)
148 ;;P(4)
149 ;;P(5)
150 ;;P(6)
151 ;;P(7)
152 ;;P(8)
153 ;;P(9)
154 ;;P(10)
155 ;;P(11)
156 ;;P(12)
157 ;;P(13)
158 ;;P(14)
159 ;;P(15)
160 ;;P(16)
161 ;;P(17)
162 ;;P(18)
163 ;;P(19)
164 ;;P(20)
165 ;;P(21)
166 ;;P(22)
167 ;;P(23)
168 ;;P("21FLG")
169 ;;P("CLRK")
170 ;;P("CUM")
171 ;;P("DO")
172 ;;P("DTYP")
173 ;;P("FRES")
174 ;;P("INS")
175 ;;P("IVRM")
176 ;;P("LF")
177 ;;P("LFA")
178 ;;P("LOG")
179 ;;P("MR")
180 ;;P("NEWON")
181 ;;P("OLDON")
182 ;;P("OPI")
183 ;;P("OT")
184 ;;P("PD")
185 ;;P("PON")
186 ;;P("PRY")
187 ;;P("REM")
188 ;;P("REN")
189 ;;P("RES")
190 ;;P("SYRS")
191 ;;PF
192 ;;PPAGE
193 ;;PPN
194 ;;PROVIDER
195 ;;PS
196 ;;PSFDT
197 ;;PSGACT
198 ;;PSGADR
199 ;;PSGADR(1)
200 ;;PSGAT
201 ;;PSGCANFL
202 ;;PSGDFLG
203 ;;PSGDI
204 ;;PSGDRG
205 ;;PSGDRGN
206 ;;PSGDO
207 ;;PSGDT
208 ;;PSGEB
209 ;;PSGEBN
210 ;;PSGEFN
211 ;;PSGF
212 ;;PSGFD
213 ;;PSGFDN
214 ;;PSGHSM
215 ;;PSGID
216 ;;PSGIVAC
217 ;;PSGIVBR
218 ;;PSGLAD
219 ;;PSGLAGE
220 ;;PSGLBID
221 ;;PSGLBSS
222 ;;PSGLDOB
223 ;;PSGLDT
224 ;;PSGLDX
225 ;;PSGLI
226 ;;PSGLIN
227 ;;PSGLPID
228 ;;PSGLPN
229 ;;PSGLPR
230 ;;PSGLRB
231 ;;PSGLSEX
232 ;;PSGLSSN
233 ;;PSGLTM
234 ;;PSGLTS
235 ;;PSGLWD
236 ;;PSGLWDN
237 ;;PSGLWGN
238 ;;PSGLWP1
239 ;;PSGLWP2
240 ;;PSGMR
241 ;;PSGMRN
242 ;;PSGNEDFD
243 ;;PSGNEF
244 ;;PSGNESD
245 ;;PSGOAT
246 ;;PSGOD
247 ;;PSGODDD
248 ;;PSGODDD(1)
249 ;;PSGODO
250 ;;PSGODT
251 ;;PSGOEA
252 ;;PSGOEAV
253 ;;PSGOEDMR
254 ;;PSGOEEG
255 ;;PSGOEEND
256 ;;PSGOEEWF
257 ;;PSGOENG
258 ;;PSGOENOF
259 ;;PSGOEPR
260 ;;PSGOFD
261 ;;PSGOFDN
262 ;;PSGOHSM
263 ;;PSGOINST
264 ;;PSGOL
265 ;;PSGOMR
266 ;;PSGOMRN
267 ;;PSGONC
268 ;;PSGOP
269 ;;PSGOPD
270 ;;PSGOPDN
271 ;;PSGOPR
272 ;;PSGOPRN
273 ;;PSGORD
274 ;;PSGOSCH
275 ;;PSGOSD
276 ;;PSGOSDN
277 ;;PSGOSI
278 ;;PSGOSM
279 ;;PSGOST
280 ;;PSGOSTN
281 ;;PSGP
282 ;;PSGP(0)
283 ;;PSGPD
284 ;;PSGPDN
285 ;;PSGPDRG
286 ;;PSGPDRGN
287 ;;PSGPI
288 ;;PSGPR
289 ;;PSGPRIO
290 ;;PSGPRN
291 ;;PSGPTMP
292 ;;PSGPTS
293 ;;PSGPXN
294 ;;PSGRRF
295 ;;PSGSCH
296 ;;PSGSD
297 ;;PSGSDN
298 ;;PSGSI
299 ;;PSGSM
300 ;;PSGSOXT
301 ;;PSGSOY
302 ;;PSGSS
303 ;;PSGSSH
304 ;;PSGST
305 ;;PSGSTAT
306 ;;PSGSTN
307 ;;PSGVADR
308 ;;PSGVALG
309 ;;PSGVBPN
310 ;;PSGVBTM
311 ;;PSGVBWN
312 ;;PSGVBWW
313 ;;PSGVBY
314 ;;PSIVAC
315 ;;PSIVBR
316 ;;PSIVDT
317 ;;PSIVON
318 ;;PSIVOF
319 ;;PSIVOV1
320 ;;PSIVOV2
321 ;;PSIV
322 ;;PSIVORF
323 ;;PSIVPL
324 ;;PSIVPR
325 ;;PSIVRD
326 ;;PSIVREA
327 ;;PSIVSITE
328 ;;PSIVSN
329 ;;PSIVST
330 ;;PSIVUP
331 ;;PSIVX1
332 ;;PSIVX2
333 ;;PSJ
334 ;;PSJAC
335 ;;PSJACND
336 ;;PSJACNWP
337 ;;PSJACOK
338 ;;PSJACPF
339 ;;PSJASK
340 ;;PSJCNT
341 ;;PSJF
342 ;;PSJHLMTN
343 ;;PSJINDEX
344 ;;PSJIVOF
345 ;;PSJIVORF
346 ;;PSJL
347 ;;PSJLABEL
348 ;;PSJLK
349 ;;PSJLM
350 ;;PSJLMCON
351 ;;PSJLMPRO
352 ;;PSJLN
353 ;;PSJNARC
354 ;;PSJNV
355 ;;PSJO
356 ;;PSJOCNT
357 ;;PSJOE
358 ;;PSJOEPF
359 ;;PSJOL
360 ;;PSJORD
361 ;;PSJORF
362 ;;PSJORIFN
363 ;;PSJORL
364 ;;PSJORQF
365 ;;PSJORVP
366 ;;PSJOS
367 ;;PSJPAC
368 ;;PSJPAD
369 ;;PSJPAGE
370 ;;PSJPBID
371 ;;PSJPCAF
372 ;;PSJPDD
373 ;;PSJPDOB
374 ;;PSJPDT
375 ;;PSJPDX
376 ;;PSJPEN
377 ;;PSJPHT
378 ;;PSJPHTD
379 ;;PSJPN
380 ;;PSJPPID
381 ;;PSJPRB
382 ;;PSJPROT
383 ;;PSJPSEX
384 ;;PSJPSSN
385 ;;PSJP
386 ;;PSJPTS
387 ;;PSJPTSP
388 ;;PSJPWD
389 ;;PSJPWDN
390 ;;PSJPWT
391 ;;PSJPWTD
392 ;;PSJSCHT
393 ;;PSJSEL
394 ;;PSJSEL1
395 ;;PSJSTOP
396 ;;PSJSYSL
397 ;;PSJSYSP
398 ;;PSJSYSP0
399 ;;PSJSYSU
400 ;;PSJSYSW
401 ;;PSJSYSW0
402 ;;PSJTF
403 ;;PSJTOO
404 ;;PSJUDPRF
405 ;;PSJX
406 ;;PSSPSP0
407 ;;Q
408 ;;QQ
409 ;;QUD
410 ;;QUX1
411 ;;RTE
412 ;;SCH
413 ;;SD
414 ;;SEGMENT(0)
415 ;;SM
416 ;;ST
417 ;;START
418 ;;STAT
419 ;;STATUS
420 ;;STOP
421 ;;STT
422 ;;SUB
423 ;;TYPE
424 ;;UDU
425 ;;V
426 ;;VA200
427 ;;VADM
428 ;;VAIN
429 ;;VAIP
430 ;;VALMCNT
431 ;;VALM("TITLE")
432 ;;WRD
433 ;;WS
434 ;;X
435 ;;X3
436 ;;X4
437 ;;X5
438 ;;XRTN
439 ;;Y
Note: See TracBrowser for help on using the repository browser.