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