XQSTCK ;Luke/SEA - Stack utilities ;3/11/94 13:50 [ 07/30/94 10:48 PM ]
;;8.0;KERNEL;;Jul 10, 1995
PUSH(XQY,XQPSM,XQY0) ;Add an option to the stack
S XQSTPT=^XUTL("XQ",$J,"T")
S XQSTPT=XQSTPT+1
S ^XUTL("XQ",$J,XQSTPT)=XQY_XQPSM_U_XQY0,^("T")=XQSTPT
I $P(XQY0,U,14),$D(^DIC(19,XQY,20)),$L(^(20)) X ^(20)
I $D(XQUIT) S TITLE="Menu Error",MESS="'XQUIT' Encountered at Option "_$P(XQY0,U,2)_" ["_$P(XQY0,U)_"]" D POP^XQGP(MESS,TITLE),P1 K XQUIT Q
I $P(XQY0,U,17),$D(^DIC(19,XQY,26)),$L(^(26)) X ^(26)
Q
;
POP ;Pop one level on the stack
I $P(XQY0,U,15),$D(^DIC(19,XQY,15)),$L(^(15)) X ^(15)
P1 S XQSTPT=^XUTL("XQ",$J,"T")
S XQSTPT=XQSTPT-1
I XQSTPT=0 S XQSTPT=1
S %=^XUTL("XQ",$J,XQSTPT),XQY=+%,XQY0=$P(%,XQPSM,2,99)
I '$D(XQUIT),$P(XQY0,U,17),$D(^DIC(19,XQY,26)),$L(^(26)) X ^(26)
S ^XUTL("XQ",$J,"T")=XQSTPT
Q
;
XACT ;Execute Exit Actions and Headers: input X=option number, no output.
Q:'$D(^DIC(19,+XQEX,0))
I $D(^DIC(19,+XQEX,15)),$L(^(15)) X ^(15)
I $D(^DIC(19,+XQEX,26)),$L(^(26)) X ^(26)
Q
;
PM ;Put primary menu in stack position 1
D GET I $D(XQFAIL) G OUT
;
S ^XUTL("XQ",$J,1)=XQPM_XQPSM_U_XQY0
S (XQY,XQDIC)=XQPM,XQPSM="P"_XQPM
S ^XUTL("XQ",$J,"T")=1
;S XQSTPT=1
G OUT
Q
;
PM1 ;Put primary menu in some other stack position
;called by XQGUI to start Option Selection Window
D GET I $D(XQFAIL) G OUT
;
S XQTT=^XUTL("XQ",$J,"T")
F XQI=1:1:XQTT I +^XUTL("XQ",$J,XQI)=XQPM S ^XUTL("XQ",$J,"T")=XQI,XQI=0 Q
G:XQI=0 OUT
;
I XQI>0,$P(^XUTL("XQ",$J,XQTT),U,3)'="XQGUI" S XQTT=XQTT+1
S ^XUTL("XQ",$J,XQTT)=XQPM_XQPSM_U_XQY0
S ^XUTL("XQ",$J,"T")=XQTT
G OUT
Q
;
GET ;Get the Primary Menu Option and set XQY0,XQDIC,XQPSM
I '$D(DUZ)#2 D NODUZ S XQFAIL="" Q
S XQPM=$G(^VA(200,DUZ,201)),XQPM=+XQPM I XQPM'>0 D NOPM S XQFAIL="" Q
S (XQY,XQDIC)=XQPM,XQPSM="P"_XQPM
;
S XQY0=$P(^XUTL("XQO","P"_XQPM,"^",XQPM),U,2,99)
I '$L(XQY0) D NOXUTL S XQYO=$G(^XUTL("XQO","P"_XQPM,"^",XQPM))
I '$L(XQY0) S XQY=XQPM D SET^XQCHK
I XQY'>0 D FAIL S XQFAIL="" Q
Q
;
NOPM ;This user has no primary menu
S XQER=" No primary menu "
Q
;
NODUZ ;There is no user connected with this process
S XQER=" No user (DUZ) "
Q
;
NOXUTL ;No ^XUTL("XQO","P"_XQPM) on this system
I $D(^XTMP("XQO","P"_XQMP)) M ^XUTL("XQO","P"_XQPM)=^XTMP("XQO","P"_XQPM)
Q
;
FAIL ;Absolute and utter failure
S XQER=$S('$D(XQER):"",'$L(XQER):"",1:XQER)
D ^XQDATE
S ^XUTL("XQ",$J,XQNO)=" Failed: "_"^"_%Y_XQER
Q
;
OUT ;Exit point for all subroutines
K %,%Y,XQER,XQI,XQPM,XQTT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQSTCK 2568 printed Dec 13, 2024@02:06:45 Page 2
XQSTCK ;Luke/SEA - Stack utilities ;3/11/94 13:50 [ 07/30/94 10:48 PM ]
+1 ;;8.0;KERNEL;;Jul 10, 1995
PUSH(XQY,XQPSM,XQY0) ;Add an option to the stack
+1 SET XQSTPT=^XUTL("XQ",$JOB,"T")
+2 SET XQSTPT=XQSTPT+1
+3 SET ^XUTL("XQ",$JOB,XQSTPT)=XQY_XQPSM_U_XQY0
SET ^("T")=XQSTPT
+4 IF $PIECE(XQY0,U,14)
IF $DATA(^DIC(19,XQY,20))
IF $LENGTH(^(20))
XECUTE ^(20)
+5 IF $DATA(XQUIT)
SET TITLE="Menu Error"
SET MESS="'XQUIT' Encountered at Option "_$PIECE(XQY0,U,2)_" ["_$PIECE(XQY0,U)_"]"
DO POP^XQGP(MESS,TITLE)
DO P1
KILL XQUIT
QUIT
+6 IF $PIECE(XQY0,U,17)
IF $DATA(^DIC(19,XQY,26))
IF $LENGTH(^(26))
XECUTE ^(26)
+7 QUIT
+8 ;
POP ;Pop one level on the stack
+1 IF $PIECE(XQY0,U,15)
IF $DATA(^DIC(19,XQY,15))
IF $LENGTH(^(15))
XECUTE ^(15)
P1 SET XQSTPT=^XUTL("XQ",$JOB,"T")
+1 SET XQSTPT=XQSTPT-1
+2 IF XQSTPT=0
SET XQSTPT=1
+3 SET %=^XUTL("XQ",$JOB,XQSTPT)
SET XQY=+%
SET XQY0=$PIECE(%,XQPSM,2,99)
+4 IF '$DATA(XQUIT)
IF $PIECE(XQY0,U,17)
IF $DATA(^DIC(19,XQY,26))
IF $LENGTH(^(26))
XECUTE ^(26)
+5 SET ^XUTL("XQ",$JOB,"T")=XQSTPT
+6 QUIT
+7 ;
XACT ;Execute Exit Actions and Headers: input X=option number, no output.
+1 if '$DATA(^DIC(19,+XQEX,0))
QUIT
+2 IF $DATA(^DIC(19,+XQEX,15))
IF $LENGTH(^(15))
XECUTE ^(15)
+3 IF $DATA(^DIC(19,+XQEX,26))
IF $LENGTH(^(26))
XECUTE ^(26)
+4 QUIT
+5 ;
PM ;Put primary menu in stack position 1
+1 DO GET
IF $DATA(XQFAIL)
GOTO OUT
+2 ;
+3 SET ^XUTL("XQ",$JOB,1)=XQPM_XQPSM_U_XQY0
+4 SET (XQY,XQDIC)=XQPM
SET XQPSM="P"_XQPM
+5 SET ^XUTL("XQ",$JOB,"T")=1
+6 ;S XQSTPT=1
+7 GOTO OUT
+8 QUIT
+9 ;
PM1 ;Put primary menu in some other stack position
+1 ;called by XQGUI to start Option Selection Window
+2 DO GET
IF $DATA(XQFAIL)
GOTO OUT
+3 ;
+4 SET XQTT=^XUTL("XQ",$JOB,"T")
+5 FOR XQI=1:1:XQTT
IF +^XUTL("XQ",$JOB,XQI)=XQPM
SET ^XUTL("XQ",$JOB,"T")=XQI
SET XQI=0
QUIT
+6 if XQI=0
GOTO OUT
+7 ;
+8 IF XQI>0
IF $PIECE(^XUTL("XQ",$JOB,XQTT),U,3)'="XQGUI"
SET XQTT=XQTT+1
+9 SET ^XUTL("XQ",$JOB,XQTT)=XQPM_XQPSM_U_XQY0
+10 SET ^XUTL("XQ",$JOB,"T")=XQTT
+11 GOTO OUT
+12 QUIT
+13 ;
GET ;Get the Primary Menu Option and set XQY0,XQDIC,XQPSM
+1 IF '$DATA(DUZ)#2
DO NODUZ
SET XQFAIL=""
QUIT
+2 SET XQPM=$GET(^VA(200,DUZ,201))
SET XQPM=+XQPM
IF XQPM'>0
DO NOPM
SET XQFAIL=""
QUIT
+3 SET (XQY,XQDIC)=XQPM
SET XQPSM="P"_XQPM
+4 ;
+5 SET XQY0=$PIECE(^XUTL("XQO","P"_XQPM,"^",XQPM),U,2,99)
+6 IF '$LENGTH(XQY0)
DO NOXUTL
SET XQYO=$GET(^XUTL("XQO","P"_XQPM,"^",XQPM))
+7 IF '$LENGTH(XQY0)
SET XQY=XQPM
DO SET^XQCHK
+8 IF XQY'>0
DO FAIL
SET XQFAIL=""
QUIT
+9 QUIT
+10 ;
NOPM ;This user has no primary menu
+1 SET XQER=" No primary menu "
+2 QUIT
+3 ;
NODUZ ;There is no user connected with this process
+1 SET XQER=" No user (DUZ) "
+2 QUIT
+3 ;
NOXUTL ;No ^XUTL("XQO","P"_XQPM) on this system
+1 IF $DATA(^XTMP("XQO","P"_XQMP))
MERGE ^XUTL("XQO","P"_XQPM)=^XTMP("XQO","P"_XQPM)
+2 QUIT
+3 ;
FAIL ;Absolute and utter failure
+1 SET XQER=$SELECT('$DATA(XQER):"",'$LENGTH(XQER):"",1:XQER)
+2 DO ^XQDATE
+3 SET ^XUTL("XQ",$JOB,XQNO)=" Failed: "_"^"_%Y_XQER
+4 QUIT
+5 ;
OUT ;Exit point for all subroutines
+1 KILL %,%Y,XQER,XQI,XQPM,XQTT
+2 QUIT
