| 1 | XQSTCK ;Luke/SEA - Stack utilities ;3/11/94 13:50 [ 07/30/94 10:48 PM ]
|
|---|
| 2 | ;;8.0;KERNEL;;Jul 10, 1995
|
|---|
| 3 | PUSH(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 | ;
|
|---|
| 12 | POP ;Pop one level on the stack
|
|---|
| 13 | I $P(XQY0,U,15),$D(^DIC(19,XQY,15)),$L(^(15)) X ^(15)
|
|---|
| 14 | P1 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 | ;
|
|---|
| 22 | XACT ;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 | ;
|
|---|
| 28 | PM ;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 | ;
|
|---|
| 38 | PM1 ;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 | ;
|
|---|
| 52 | GET ;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 | ;
|
|---|
| 63 | NOPM ;This user has no primary menu
|
|---|
| 64 | S XQER=" No primary menu "
|
|---|
| 65 | Q
|
|---|
| 66 | ;
|
|---|
| 67 | NODUZ ;There is no user connected with this process
|
|---|
| 68 | S XQER=" No user (DUZ) "
|
|---|
| 69 | Q
|
|---|
| 70 | ;
|
|---|
| 71 | NOXUTL ;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 | ;
|
|---|
| 75 | FAIL ;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 | ;
|
|---|
| 81 | OUT ;Exit point for all subroutines
|
|---|
| 82 | K %,%Y,XQER,XQI,XQPM,XQTT
|
|---|
| 83 | Q
|
|---|
