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

XQSTCK.m

Go to the documentation of this file.
  1. XQSTCK ;Luke/SEA - Stack utilities ;3/11/94 13:50 [ 04/02/2003 8:29 AM ]
  1. ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
  1. ;;8.0;KERNEL;;Jul 10, 1995
  1. PUSH(XQY,XQPSM,XQY0) ;Add an option to the stack
  1. S XQSTPT=^XUTL("XQ",$J,"T")
  1. S XQSTPT=XQSTPT+1
  1. S ^XUTL("XQ",$J,XQSTPT)=XQY_XQPSM_U_XQY0,^("T")=XQSTPT
  1. I $P(XQY0,U,14),$D(^DIC(19,XQY,20)),$L(^(20)) X ^(20)
  1. 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
  1. I $P(XQY0,U,17),$D(^DIC(19,XQY,26)),$L(^(26)) X ^(26)
  1. Q
  1. ;
  1. POP ;Pop one level on the stack
  1. I $P(XQY0,U,15),$D(^DIC(19,XQY,15)),$L(^(15)) X ^(15)
  1. P1 S XQSTPT=^XUTL("XQ",$J,"T")
  1. S XQSTPT=XQSTPT-1
  1. I XQSTPT=0 S XQSTPT=1
  1. S %=^XUTL("XQ",$J,XQSTPT),XQY=+%,XQY0=$P(%,XQPSM,2,99)
  1. I '$D(XQUIT),$P(XQY0,U,17),$D(^DIC(19,XQY,26)),$L(^(26)) X ^(26)
  1. S ^XUTL("XQ",$J,"T")=XQSTPT
  1. Q
  1. ;
  1. XACT ;Execute Exit Actions and Headers: input X=option number, no output.
  1. Q:'$D(^DIC(19,+XQEX,0))
  1. I $D(^DIC(19,+XQEX,15)),$L(^(15)) X ^(15)
  1. I $D(^DIC(19,+XQEX,26)),$L(^(26)) X ^(26)
  1. Q
  1. ;
  1. PM ;Put primary menu in stack position 1
  1. D GET I $D(XQFAIL) G OUT
  1. ;
  1. S ^XUTL("XQ",$J,1)=XQPM_XQPSM_U_XQY0
  1. S (XQY,XQDIC)=XQPM,XQPSM="P"_XQPM
  1. S ^XUTL("XQ",$J,"T")=1
  1. ;S XQSTPT=1
  1. G OUT
  1. Q
  1. ;
  1. PM1 ;Put primary menu in some other stack position
  1. ;called by XQGUI to start Option Selection Window
  1. D GET I $D(XQFAIL) G OUT
  1. ;
  1. S XQTT=^XUTL("XQ",$J,"T")
  1. F XQI=1:1:XQTT I +^XUTL("XQ",$J,XQI)=XQPM S ^XUTL("XQ",$J,"T")=XQI,XQI=0 Q
  1. G:XQI=0 OUT
  1. ;
  1. I XQI>0,$P(^XUTL("XQ",$J,XQTT),U,3)'="XQGUI" S XQTT=XQTT+1
  1. S ^XUTL("XQ",$J,XQTT)=XQPM_XQPSM_U_XQY0
  1. S ^XUTL("XQ",$J,"T")=XQTT
  1. G OUT
  1. Q
  1. ;
  1. GET ;Get the Primary Menu Option and set XQY0,XQDIC,XQPSM
  1. I '$D(DUZ)#2 D NODUZ S XQFAIL="" Q
  1. S XQPM=$G(^VA(200,DUZ,201)),XQPM=+XQPM I XQPM'>0 D NOPM S XQFAIL="" Q
  1. S (XQY,XQDIC)=XQPM,XQPSM="P"_XQPM
  1. ;
  1. S XQY0=$P(^XUTL("XQO","P"_XQPM,"^",XQPM),U,2,99)
  1. I '$L(XQY0) D NOXUTL S XQYO=$G(^XUTL("XQO","P"_XQPM,"^",XQPM))
  1. I '$L(XQY0) S XQY=XQPM D SET^XQCHK
  1. I XQY'>0 D FAIL S XQFAIL="" Q
  1. Q
  1. ;
  1. NOPM ;This user has no primary menu
  1. S XQER=" No primary menu "
  1. Q
  1. ;
  1. NODUZ ;There is no user connected with this process
  1. S XQER=" No user (DUZ) "
  1. Q
  1. ;
  1. NOXUTL ;No ^XUTL("XQO","P"_XQPM) on this system
  1. I $D(^XTMP("XQO","P"_XQMP)) M ^XUTL("XQO","P"_XQPM)=^XTMP("XQO","P"_XQPM)
  1. Q
  1. ;
  1. FAIL ;Absolute and utter failure
  1. S XQER=$S('$D(XQER):"",'$L(XQER):"",1:XQER)
  1. D ^XQDATE
  1. S ^XUTL("XQ",$J,XQNO)=" Failed: "_"^"_%Y_XQER
  1. Q
  1. ;
  1. OUT ;Exit point for all subroutines
  1. K %,%Y,XQER,XQI,XQPM,XQTT
  1. Q