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