- 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 Jan 18, 2025@03:08:21 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