source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQSTCK.m@ 975

Last change on this file since 975 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1XQSTCK ;Luke/SEA - Stack utilities ;3/11/94 13:50 [ 07/30/94 10:48 PM ]
2 ;;8.0;KERNEL;;Jul 10, 1995
3PUSH(XQY,XQPSM,XQY0) ;Add an option to the stack
4 S XQSTPT=^XUTL("XQ",$J,"T")
5 S XQSTPT=XQSTPT+1
6 S ^XUTL("XQ",$J,XQSTPT)=XQY_XQPSM_U_XQY0,^("T")=XQSTPT
7 I $P(XQY0,U,14),$D(^DIC(19,XQY,20)),$L(^(20)) X ^(20)
8 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
9 I $P(XQY0,U,17),$D(^DIC(19,XQY,26)),$L(^(26)) X ^(26)
10 Q
11 ;
12POP ;Pop one level on the stack
13 I $P(XQY0,U,15),$D(^DIC(19,XQY,15)),$L(^(15)) X ^(15)
14P1 S XQSTPT=^XUTL("XQ",$J,"T")
15 S XQSTPT=XQSTPT-1
16 I XQSTPT=0 S XQSTPT=1
17 S %=^XUTL("XQ",$J,XQSTPT),XQY=+%,XQY0=$P(%,XQPSM,2,99)
18 I '$D(XQUIT),$P(XQY0,U,17),$D(^DIC(19,XQY,26)),$L(^(26)) X ^(26)
19 S ^XUTL("XQ",$J,"T")=XQSTPT
20 Q
21 ;
22XACT ;Execute Exit Actions and Headers: input X=option number, no output.
23 Q:'$D(^DIC(19,+XQEX,0))
24 I $D(^DIC(19,+XQEX,15)),$L(^(15)) X ^(15)
25 I $D(^DIC(19,+XQEX,26)),$L(^(26)) X ^(26)
26 Q
27 ;
28PM ;Put primary menu in stack position 1
29 D GET I $D(XQFAIL) G OUT
30 ;
31 S ^XUTL("XQ",$J,1)=XQPM_XQPSM_U_XQY0
32 S (XQY,XQDIC)=XQPM,XQPSM="P"_XQPM
33 S ^XUTL("XQ",$J,"T")=1
34 ;S XQSTPT=1
35 G OUT
36 Q
37 ;
38PM1 ;Put primary menu in some other stack position
39 ;called by XQGUI to start Option Selection Window
40 D GET I $D(XQFAIL) G OUT
41 ;
42 S XQTT=^XUTL("XQ",$J,"T")
43 F XQI=1:1:XQTT I +^XUTL("XQ",$J,XQI)=XQPM S ^XUTL("XQ",$J,"T")=XQI,XQI=0 Q
44 G:XQI=0 OUT
45 ;
46 I XQI>0,$P(^XUTL("XQ",$J,XQTT),U,3)'="XQGUI" S XQTT=XQTT+1
47 S ^XUTL("XQ",$J,XQTT)=XQPM_XQPSM_U_XQY0
48 S ^XUTL("XQ",$J,"T")=XQTT
49 G OUT
50 Q
51 ;
52GET ;Get the Primary Menu Option and set XQY0,XQDIC,XQPSM
53 I '$D(DUZ)#2 D NODUZ S XQFAIL="" Q
54 S XQPM=$G(^VA(200,DUZ,201)),XQPM=+XQPM I XQPM'>0 D NOPM S XQFAIL="" Q
55 S (XQY,XQDIC)=XQPM,XQPSM="P"_XQPM
56 ;
57 S XQY0=$P(^XUTL("XQO","P"_XQPM,"^",XQPM),U,2,99)
58 I '$L(XQY0) D NOXUTL S XQYO=$G(^XUTL("XQO","P"_XQPM,"^",XQPM))
59 I '$L(XQY0) S XQY=XQPM D SET^XQCHK
60 I XQY'>0 D FAIL S XQFAIL="" Q
61 Q
62 ;
63NOPM ;This user has no primary menu
64 S XQER=" No primary menu "
65 Q
66 ;
67NODUZ ;There is no user connected with this process
68 S XQER=" No user (DUZ) "
69 Q
70 ;
71NOXUTL ;No ^XUTL("XQO","P"_XQPM) on this system
72 I $D(^XTMP("XQO","P"_XQMP)) M ^XUTL("XQO","P"_XQPM)=^XTMP("XQO","P"_XQPM)
73 Q
74 ;
75FAIL ;Absolute and utter failure
76 S XQER=$S('$D(XQER):"",'$L(XQER):"",1:XQER)
77 D ^XQDATE
78 S ^XUTL("XQ",$J,XQNO)=" Failed: "_"^"_%Y_XQER
79 Q
80 ;
81OUT ;Exit point for all subroutines
82 K %,%Y,XQER,XQI,XQPM,XQTT
83 Q
Note: See TracBrowser for help on using the repository browser.