Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSJHVARS

PSJHVARS.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; Reference to ^ORD(101 is supported by DBIA 872.
  1. ; Reference to ^%RCR is supported by DBIA 10022.
  1. ; Reference to ^DIR is supported by DBIA 10026.
  1. ;
  1. ; PSJ*5*181 added: P(24),P(25) & PSGS0Y (it's zero & not O)
  1. ;PSJHIDFG will be defined if the user already in the hidden menu.
  1. I $$HIDCHK() D Q
  1. . W !,"HIDDEN MENUS MAY NOT BE CALLED RECURSIVELY!" S XQORQUIT=1
  1. . N DIR S DIR(0)="E" D ^DIR
  1. ; saves the variables in ^TMP
  1. K ^TMP("PSJVARS",$J),^TMP("PSJ_ON_HIDDEN",$J)
  1. F PSJRSB1=1:1 S PSJRSBV=$P($T(LIST+PSJRSB1),";;",2) Q:PSJRSBV="" D
  1. .I $D(@PSJRSBV) S:$D(@PSJRSBV)'=10 ^TMP("PSJVARS",$J,PSJRSBV)=@PSJRSBV
  1. I $D(DRG) MERGE ^TMP("PSJHDRG",$J)=DRG
  1. ;save off ^TMP("PSJON",$J) because it gets killed down in hidden options
  1. F PSJRSB1L=0:0 S PSJRSB1L=$O(^TMP("PSJON",$J,PSJRSB1L)) Q:'PSJRSB1L D
  1. .S ^TMP("PSJ_ON_HIDDEN",$J,PSJRSB1L)=^TMP("PSJON",$J,PSJRSB1L)
  1. K PSJRSB1,PSJRSB1L,PSJRSBV
  1. NEW PSJX
  1. F PSJX="P(","PSGEFN(","PSGVADR(","PSGVALG(","VADM(","VAIN(","VAIP(" D SVARRAY
  1. I $D(^TMP("PSIV",$J)) S %X="^TMP(""PSIV"",$J,",%Y="^TMP(""PSJHTMP"",$J,""PSIV""," D %XY^%RCR
  1. I $D(^TMP("PSJALL",$J)) S %X="^TMP(""PSJALL"",$J,",%Y="^TMP(""PSJHTMP"",$J,""PSJALL""," D %XY^%RCR
  1. I $D(^TMP("PSJI",$J)) S %X="^TMP(""PSJI"",$J,",%Y="^TMP(""PSJHTMP"",$J,""PSJI""," D %XY^%RCR
  1. I $D(^TMP("PSJPRO",$J)) S %X="^TMP(""PSJPRO"",$J,",%Y="^TMP(""PSJHTMP"",$J,""PSJPRO""," D %XY^%RCR
  1. D SAVEPS ; Save the ^PS(53.45,DUZ,2) entry
  1. Q
  1. SVARRAY ; Save array to ^TMP
  1. NEW PSJVARX,X S PSJVARX=PSJX_"X)"
  1. S X="" F S X=$O(@PSJVARX) Q:X="" S ^TMP("PSJVARS",$J,PSJX_$S(+X=X:X,1:""""_X_"""")_")")=@PSJVARX
  1. Q
  1. RESTORE ; restores the variables from ^TMP
  1. Q:$G(PSJHIDFG)
  1. S PSJRSBV="" F S PSJRSBV=$O(^TMP("PSJVARS",$J,PSJRSBV)) Q:PSJRSBV="" D
  1. .S @PSJRSBV=^TMP("PSJVARS",$J,PSJRSBV)
  1. I $D(^TMP("PSJHDRG",$J)) K DRG MERGE DRG=^TMP("PSJHDRG",$J)
  1. ;restore ^TMP("PSJON",$J) if it is not there
  1. I '$D(^TMP("PSJON",$J)) D
  1. .F PSJRSB1=0:0 S PSJRSB1=$O(^TMP("PSJ_ON_HIDDEN",$J,PSJRSB1)) Q:'PSJRSB1 D
  1. ..S ^TMP("PSJON",$J,PSJRSB1)=^TMP("PSJ_ON_HIDDEN",$J,PSJRSB1)
  1. I $D(^TMP("PSJHTMP",$J,"PSIV")) S %X="^TMP(""PSJHTMP"",$J,""PSIV"",",%Y="^TMP(""PSIV"",$J," D %XY^%RCR K ^TMP("PSJHTMP",$J,"PSIV")
  1. I $D(^TMP("PSJHTMP",$J,"PSJALL")) S %X="^TMP(""PSJHTMP"",$J,""PSJALL"",",%Y="^TMP(""PSJALL"",$J," D %XY^%RCR K ^TMP("PSJHTMP",$J,"PSJALL")
  1. I $D(^TMP("PSJHTMP",$J,"PSJI")) S %X="^TMP(""PSJHTMP"",$J,""PSJI"",",%Y="^TMP(""PSJI"",$J," D %XY^%RCR K ^TMP("PSJHTMP",$J,"PSJI")
  1. I $D(^TMP("PSJHTMP",$J,"PSJPRO")) S %X="^TMP(""PSJHTMP"",$J,""PSJPRO"",",%Y="^TMP(""PSJPRO"",$J," D %XY^%RCR K ^TMP("PSJHTMP",$J,"PSJPRO")
  1. K ^TMP("PSJVARS",$J),^TMP("PSJ_ON_HIDDEN",$J),^TMP("PSJHDRG",$J)
  1. K PSJRSBV,PSJRSB1
  1. D RESPS ; Restore any saved ^PS(53.45,DUZ,2) and ^PS(53.45,DUZ,4) entries
  1. Q
  1. HIDCHK() ; XQORNEST(X) contains a list of selected protocols.
  1. K ^TMP("PSJHIDCHK",$J) N PSJ,X,Y
  1. F X=0:0 S X=$O(XQORNEST(X)) Q:'X S ^TMP("PSJHIDCHK",$J,+$P(XQORNEST(X),";"))=""
  1. S X=+$O(^ORD(101,"B","PSJI LM LBLI",0))
  1. S Y=+$O(^ORD(101,"B","PSJ LM RETURNS/DESTROYED MENU",0))
  1. S PSJ=$S($D(^TMP("PSJHIDCHK",$J,X)):1,$D(^TMP("PSJHIDCHK",$J,Y)):1,1:0)
  1. K ^TMP("PSJHIDCHK",$J)
  1. Q PSJ
  1. SAVEPS ; Save the ^PS(53.45,DUZ,2) entry
  1. ; Save the 2,0) node
  1. I $D(^PS(53.45,DUZ,2,0)) D
  1. .S ^TMP("PSJ5345",$J,DUZ,2,0)=^PS(53.45,DUZ,2,0)
  1. ;Save the 2,n,0) nodes
  1. S PSJLOOP=0
  1. F PSJLOOP=$O(^PS(53.45,DUZ,2,PSJLOOP)) Q:(PSJLOOP="")!(PSJLOOP="B") D
  1. .S ^TMP("PSJ5345",$J,DUZ,2,PSJLOOP,0)=^PS(53.45,DUZ,2,PSJLOOP,0)
  1. ;Save the 2,"B" node
  1. I $D(^PS(53.45,DUZ,2,"B")) D
  1. .S PSJBLOOP=""
  1. .F PSJBLOOP=$O(^PS(53.45,DUZ,2,"B",PSJBLOOP)) Q:PSJBLOOP="" D
  1. ..S PSJCOUNT=""
  1. ..F PSJCOUNT=$O(^PS(53.45,DUZ,2,"B",PSJBLOOP,PSJCOUNT)) Q:PSJCOUNT="" D
  1. ...S ^TMP("PSJ5345",$J,DUZ,2,"B",PSJBLOOP,PSJCOUNT)=^PS(53.45,DUZ,2,"B",PSJBLOOP,PSJCOUNT)
  1. ; Save the 4,0) node
  1. ;I $D(^PS(53.45,DUZ,4,0)) D
  1. ;.S ^TMP("PSJ5345",$J,DUZ,4,0)=^PS(53.45,DUZ,4,0)
  1. ; Save the 4,n,0) nodes
  1. ;S PSJLOOP=0
  1. ;F PSJLOOP=$O(^PS(53.45,DUZ,4,PSJLOOP)) Q:PSJLOOP="" D
  1. ;.S ^TMP("PSJ5345",$J,DUZ,4,PSJLOOP,0)=^PS(53.45,DUZ,4,PSJLOOP,0)
  1. Q
  1. RESPS ; Restore any saved ^PS(53.45,DUZ,2) entry
  1. ;Restore the 2,0 node
  1. I $D(^TMP("PSJ5345",$J,DUZ,2,0)) D
  1. .S ^PS(53.45,DUZ,2,0)=^TMP("PSJ5345",$J,DUZ,2,0)
  1. ;Restore the 2,n,o) nodes
  1. S PSJLOOP=0
  1. F PSJLOOP=$O(^TMP("PSJ5345",$J,DUZ,2,PSJLOOP)) Q:(PSJLOOP="")!(PSJLOOP="B") D
  1. .S ^PS(53.45,DUZ,2,PSJLOOP,0)=^TMP("PSJ5345",$J,DUZ,2,PSJLOOP,0)
  1. ;Restore the 2,"B" nodes
  1. I $D(^TMP("PSJ5345",$J,DUZ,2,"B")) D
  1. .S PSJBLOOP=""
  1. .F PSJBLOOP=$O(^TMP("PSJ5345",$J,DUZ,2,"B",PSJBLOOP)) Q:PSJBLOOP="" D
  1. ..S PSJCOUNT=""
  1. ..F PSJCOUNT=$O(^TMP("PSJ5345",$J,DUZ,2,"B",PSJBLOOP,PSJCOUNT)) Q:PSJCOUNT="" D
  1. ...S ^PS(53.45,DUZ,2,"B",PSJBLOOP,PSJCOUNT)=^TMP("PSJ5345",$J,DUZ,2,"B",PSJBLOOP,PSJCOUNT)
  1. ;Restore the 4,0) node
  1. ;I $D(^TMP("PSJ5345",$J,DUZ,4,0)) D
  1. ;.S ^PS(53.45,DUZ,4,0)=^TMP("PSJ5345",$J,DUZ,4,0)
  1. ;Restore the 4,n,0) nodes
  1. ;S PSJLOOP=0
  1. ;F PSJLOOP=$O(^TMP("PSJ5345",$J,DUZ,4,PSJLOOP)) Q:PSJLOOP="" D
  1. ;.S ^PS(53.45,DUZ,4,PSJLOOP,0)=^TMP("PSJ5345",$J,DUZ,4,PSJLOOP,0)
  1. K ^TMP("PSJ5345",$J,DUZ)
  1. Q
  1. LIST ;
  1. ;;ADM
  1. ;;AL
  1. ;;C
  1. ;;CHK
  1. ;;DDH
  1. ;;DFN
  1. ;;DN
  1. ;;DRGI
  1. ;;DRGN
  1. ;;DRGT
  1. ;;DX
  1. ;;DY
  1. ;;FIL
  1. ;;FQ
  1. ;;GMRA
  1. ;;GMRAL
  1. ;;HDT
  1. ;;I
  1. ;;INFUSE
  1. ;;J
  1. ;;LIMIT
  1. ;;LINE
  1. ;;LOC
  1. ;;N
  1. ;;NAD
  1. ;;ND
  1. ;;ND0
  1. ;;ND2
  1. ;;ND4
  1. ;;ND6
  1. ;;NDP2
  1. ;;NEXT
  1. ;;NF
  1. ;;NO
  1. ;;O
  1. ;;ON
  1. ;;ON55
  1. ;;ORIFN
  1. ;;P16
  1. ;;P17
  1. ;;P(2)
  1. ;;P(3)
  1. ;;P(4)
  1. ;;P(5)
  1. ;;P(6)
  1. ;;P(7)
  1. ;;P(8)
  1. ;;P(9)
  1. ;;P(10)
  1. ;;P(11)
  1. ;;P(12)
  1. ;;P(13)
  1. ;;P(14)
  1. ;;P(15)
  1. ;;P(16)
  1. ;;P(17)
  1. ;;P(18)
  1. ;;P(19)
  1. ;;P(20)
  1. ;;P(21)
  1. ;;P(22)
  1. ;;P(23)
  1. ;;P(24)
  1. ;;P(25)
  1. ;;P("21FLG")
  1. ;;P("CLRK")
  1. ;;P("CUM")
  1. ;;P("DO")
  1. ;;P("DTYP")
  1. ;;P("FRES")
  1. ;;P("INS")
  1. ;;P("IVRM")
  1. ;;P("LF")
  1. ;;P("LFA")
  1. ;;P("LOG")
  1. ;;P("MR")
  1. ;;P("NEWON")
  1. ;;P("OLDON")
  1. ;;P("OPI")
  1. ;;P("OT")
  1. ;;P("PD")
  1. ;;P("PON")
  1. ;;P("PRY")
  1. ;;P("REM")
  1. ;;P("REN")
  1. ;;P("RES")
  1. ;;P("SYRS")
  1. ;;PF
  1. ;;PPAGE
  1. ;;PPN
  1. ;;PROVIDER
  1. ;;PS
  1. ;;PSFDT
  1. ;;PSGACT
  1. ;;PSGADR
  1. ;;PSGADR(1)
  1. ;;PSGAT
  1. ;;PSGCANFL
  1. ;;PSGDFLG
  1. ;;PSGDI
  1. ;;PSGDRG
  1. ;;PSGDRGN
  1. ;;PSGDO
  1. ;;PSGDT
  1. ;;PSGEB
  1. ;;PSGEBN
  1. ;;PSGEFN
  1. ;;PSGF
  1. ;;PSGFD
  1. ;;PSGFDN
  1. ;;PSGHSM
  1. ;;PSGID
  1. ;;PSGIVAC
  1. ;;PSGIVBR
  1. ;;PSGLAD
  1. ;;PSGLAGE
  1. ;;PSGLBID
  1. ;;PSGLBSS
  1. ;;PSGLDOB
  1. ;;PSGLDT
  1. ;;PSGLDX
  1. ;;PSGLI
  1. ;;PSGLIN
  1. ;;PSGLPID
  1. ;;PSGLPN
  1. ;;PSGLPR
  1. ;;PSGLRB
  1. ;;PSGLSEX
  1. ;;PSGLSSN
  1. ;;PSGLTM
  1. ;;PSGLTS
  1. ;;PSGLWD
  1. ;;PSGLWDN
  1. ;;PSGLWGN
  1. ;;PSGLWP1
  1. ;;PSGLWP2
  1. ;;PSGMR
  1. ;;PSGMRN
  1. ;;PSGNEDFD
  1. ;;PSGNEF
  1. ;;PSGNESD
  1. ;;PSGOAT
  1. ;;PSGOD
  1. ;;PSGODDD
  1. ;;PSGODDD(1)
  1. ;;PSGODO
  1. ;;PSGODT
  1. ;;PSGOEA
  1. ;;PSGOEAV
  1. ;;PSGOEDMR
  1. ;;PSGOEEG
  1. ;;PSGOEEND
  1. ;;PSGOEEWF
  1. ;;PSGOENG
  1. ;;PSGOENOF
  1. ;;PSGOEPR
  1. ;;PSGOFD
  1. ;;PSGOFDN
  1. ;;PSGOHSM
  1. ;;PSGOINST
  1. ;;PSGOL
  1. ;;PSGOMR
  1. ;;PSGOMRN
  1. ;;PSGONC
  1. ;;PSGOP
  1. ;;PSGOPD
  1. ;;PSGOPDN
  1. ;;PSGOPR
  1. ;;PSGOPRN
  1. ;;PSGORD
  1. ;;PSGOSCH
  1. ;;PSGOSD
  1. ;;PSGOSDN
  1. ;;PSGOSI
  1. ;;PSGOSM
  1. ;;PSGOST
  1. ;;PSGOSTN
  1. ;;PSGP
  1. ;;PSGP(0)
  1. ;;PSGPD
  1. ;;PSGPDN
  1. ;;PSGPDRG
  1. ;;PSGPDRGN
  1. ;;PSGPI
  1. ;;PSGPR
  1. ;;PSGPRIO
  1. ;;PSGPRN
  1. ;;PSGPTMP
  1. ;;PSGPTS
  1. ;;PSGRRF
  1. ;;PSGSCH
  1. ;;PSGSD
  1. ;;PSGSDN
  1. ;;PSGSI
  1. ;;PSGSM
  1. ;;PSGSOXT
  1. ;;PSGSOY
  1. ;;PSGS0Y
  1. ;;PSGSS
  1. ;;PSGSSH
  1. ;;PSGST
  1. ;;PSGSTAT
  1. ;;PSGSTN
  1. ;;PSGVADR
  1. ;;PSGVALG
  1. ;;PSGVBPN
  1. ;;PSGVBTM
  1. ;;PSGVBWN
  1. ;;PSGVBWW
  1. ;;PSGVBY
  1. ;;PSIVAC
  1. ;;PSIVBR
  1. ;;PSIVDT
  1. ;;PSIVON
  1. ;;PSIVOF
  1. ;;PSIVOV1
  1. ;;PSIVOV2
  1. ;;PSIV
  1. ;;PSIVORF
  1. ;;PSIVPL
  1. ;;PSIVPR
  1. ;;PSIVRD
  1. ;;PSIVREA
  1. ;;PSIVSITE
  1. ;;PSIVSN
  1. ;;PSIVST
  1. ;;PSIVUP
  1. ;;PSIVX1
  1. ;;PSIVX2
  1. ;;PSJ
  1. ;;PSJAC
  1. ;;PSJACND
  1. ;;PSJACNWP
  1. ;;PSJACOK
  1. ;;PSJACPF
  1. ;;PSJASK
  1. ;;PSJCNT
  1. ;;PSJF
  1. ;;PSJHLMTN
  1. ;;PSJINDEX
  1. ;;PSJIVOF
  1. ;;PSJIVORF
  1. ;;PSJL
  1. ;;PSJLABEL
  1. ;;PSJLK
  1. ;;PSJLM
  1. ;;PSJLMCON
  1. ;;PSJLMPRO
  1. ;;PSJLN
  1. ;;PSJNARC
  1. ;;PSJNV
  1. ;;PSJO
  1. ;;PSJOCNT
  1. ;;PSJOE
  1. ;;PSJOEPF
  1. ;;PSJOL
  1. ;;PSJORD
  1. ;;PSJORF
  1. ;;PSJORIFN
  1. ;;PSJORL
  1. ;;PSJORQF
  1. ;;PSJORVP
  1. ;;PSJOS
  1. ;;PSJPAC
  1. ;;PSJPAD
  1. ;;PSJPAGE
  1. ;;PSJPBID
  1. ;;PSJPCAF
  1. ;;PSJPDD
  1. ;;PSJPDOB
  1. ;;PSJPDT
  1. ;;PSJPDX
  1. ;;PSJPEN
  1. ;;PSJPHT
  1. ;;PSJPHTD
  1. ;;PSJPN
  1. ;;PSJPPID
  1. ;;PSJPRB
  1. ;;PSJPROT
  1. ;;PSJPSEX
  1. ;;PSJPSSN
  1. ;;PSJP
  1. ;;PSJPTS
  1. ;;PSJPTSP
  1. ;;PSJPWD
  1. ;;PSJPWDN
  1. ;;PSJPWT
  1. ;;PSJPWTD
  1. ;;PSJSCHT
  1. ;;PSJSEL
  1. ;;PSJSEL1
  1. ;;PSJSTOP
  1. ;;PSJSYSL
  1. ;;PSJSYSP
  1. ;;PSJSYSP0
  1. ;;PSJSYSU
  1. ;;PSJSYSW
  1. ;;PSJSYSW0
  1. ;;PSJTF
  1. ;;PSJTOO
  1. ;;PSJUDPRF
  1. ;;PSJX
  1. ;;PSSPSP0
  1. ;;Q
  1. ;;QQ
  1. ;;QUD
  1. ;;QUX1
  1. ;;RTE
  1. ;;SCH
  1. ;;SD
  1. ;;SEGMENT(0)
  1. ;;SM
  1. ;;ST
  1. ;;START
  1. ;;STAT
  1. ;;STATUS
  1. ;;STOP
  1. ;;STT
  1. ;;SUB
  1. ;;TYPE
  1. ;;UDU
  1. ;;V
  1. ;;VA200
  1. ;;VADM
  1. ;;VAIN
  1. ;;VAIP
  1. ;;VALMCNT
  1. ;;VALM("TITLE")
  1. ;;WRD
  1. ;;WS
  1. ;;X
  1. ;;X3
  1. ;;X4
  1. ;;X5
  1. ;;XRTN
  1. ;;Y