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

XQUIT.m

Go to the documentation of this file.
  1. XQUIT ;SEA/LUKE - Jump Utilities (Part II) ;06/23/98 11:28
  1. ;;8.0;KERNEL;**46,87**;Jul 10, 1995
  1. ;XQUIT has been set in an entry action
  1. ;
  1. I $D(XQRB) D RB Q ;Rubber band target set the XQUIT
  1. ;
  1. N %,XQFLAG,XQI,XQJ,XQOP,XQOPQT,XQX
  1. S XQX=0 ;Set to 1 if XQUIT EXECUTABLE field is executed
  1. ;
  1. S XQOPQT=$S($D(XQD):XQD,1:XQY) ;XQY if this is not a jump or jump is completed
  1. ;
  1. ;See if there is anything in the XQUIT XECUTABLE field
  1. D X
  1. Q:'$D(XQUIT) ;XQUIT cleared, we're done here
  1. ;
  1. I $D(ZTQUEUED) Q ;Tasked option, no messages allowed.
  1. ;
  1. ;Print the message unless the XQUIT EXECUTABLE field is filled in
  1. I 'XQX D MESS
  1. ;
  1. ;Single step, no stack resetting is necessary
  1. I $S('$D(XQJMP):0,XQJMP=1:0,(+XQSV=+^XUTL("XQ",$J,^XUTL("XQ",$J,"T"))):1,1:0) D
  1. .S XQY=+XQSV,XQDIC=$P(XQSV,U,2),XQY0=$P(XQSV,U,3,99)
  1. .S XQT=$P(XQY0,U,4)
  1. .K XQJMP,XQNO,XQOPQT,XQTT,XQUIT,XQUR,Y
  1. .Q
  1. Q:'$D(XQUIT)
  1. ;
  1. ;
  1. RESET ;Reset the stack to what it should be
  1. S XQY=+XQSV,XQDIC=$P(XQSV,U,2),XQY0=$P(XQSV,U,3,99)
  1. S XQT1=$S($D(XQTT):XQTT,1:^XUTL("XQ",$J,"T"))
  1. ;
  1. ;Regular "^" jumps
  1. ;Remove the new stuff we have put on the stack.
  1. ;
  1. D
  1. .S %=^XUTL("XQ",$J,XQT1) I $P(%,U,18),$D(^DIC(19,+%,26)),$L(^(26)) X ^(26) ;W " ==> ^XQUIT"
  1. .I $D(XQONSTK),$L(XQONSTK) F XQI=1:1 S %=$P(XQONSTK,U,XQI) Q:%="" D POP^XQ72(%)
  1. .Q
  1. ;.;Restore the old stack as it was.
  1. ;.F XQI=1:1:XQT S %=$G(XQOLDSTK(XQI)) Q:%="" D
  1. ;..Q:^XUTL("XQ",$J,XQI)=%
  1. ;..S ^XUTL("XQ",$J,XQI)=XQOLDSTK(XQI),XQTT=XQTT+1
  1. ;..Q
  1. ;.Q
  1. ;
  1. ;Reset the stack pointer
  1. I '$D(XQTT) S XQTT=^XUTL("XQ",$J,"T") ;We haven't been to POP^XQ72
  1. S ^XUTL("XQ",$J,"T")=$S(XQTT>1:XQTT,1:1)
  1. S XQT=$P(XQY0,U,4) ;Reset Option Type
  1. ;
  1. K XQJMP,XQONSTK,XQOPQT,XQSVSTK,XQTT,XQUR,Y
  1. Q
  1. ;
  1. ;
  1. RB ;Come here from ^XQ73 for Rubber Band jumps
  1. N %,XQOPQT,XQI,XQX
  1. S XQX=0 ;Flag that tells us if XQUIT EXECUTABLE is executed (XQX=1)
  1. S XQOPQT=$S($D(XQYY):XQYY,1:XQY) ;The option where XQUIT was born
  1. D X Q:'$D(XQUIT) ;Stop if the application cleared the XQUIT
  1. D:'XQX MESS ;Tell the user what's going on
  1. ;
  1. I $D(^XUTL("XQ",$J,"RBX")) D ;Unwind the jump
  1. .S %=0 F S %=$O(^XUTL("XQ",$J,"RBX",%)) Q:%="" X ^(%)
  1. .K ^XUTL("XQ",$J,"RBX"),XQRB
  1. .Q
  1. ;
  1. ;Reload the option we came from, and execute it's header. Quit.
  1. I ^XUTL("XQ",$J,^XUTL("XQ",$J,"T"))=-1 S (XQTT,^XUTL("XQ",$J,"T"))=$S(^("T")>1:^("T")-1,1:1)
  1. ;F XQI=XQTT:-1:1 S %=^XUTL("XQ",$J,XQI) Q:%=-1 S (^XUTL("XQ",$J,"T"),XQTT)=$S(%>0:%,1:1)
  1. S XQY=+XQSV,XQDIC=$P(XQSV,U,2),XQY0=$P(XQSV,U,3,99)
  1. S XQT=$P(XQY0,U,4)
  1. I $P(XQY0,U,17),$D(^DIC(19,XQY,26)),$L(^(26)) X ^(26)
  1. Q
  1. ;
  1. ;
  1. T ;Come here from XQT1+14 & 33 if a template finds XQUIT while executing
  1. D X
  1. Q:'$D(XQUIT)
  1. ;I 'XQX D MESS
  1. Q
  1. ;
  1. PM ;Come here from XQ12 if XQUIT is encounter at logon in a primary menu
  1. N XQOPQT,XQX
  1. S XQX=0
  1. S XQOPQT=XQY
  1. D X
  1. Q:'$D(XQUIT)
  1. I 'XQX D
  1. .I $D(^DIC(19,+XQY,21)),$P(^(21,0),U,3)>0 D DISPLAY^XQUTL
  1. .E D
  1. ..W !!," **> Sorry, access to your primary menu has been denied by the application.",!?6,"An XQUIT was encountered in the Entry Action code.",!?6,"Please see your computer person."
  1. ..D HOLD^XQUTL
  1. ..Q
  1. .Q
  1. Q
  1. ;
  1. ;
  1. ; ***** Subroutines ****
  1. ;
  1. MESS ;Tell the user what's going on unless we executed XQUIT EXECUTABLE field
  1. I 'XQX D
  1. .I '$D(XQNO) S XQNO=$P(XQY0,U,2)
  1. .;
  1. .I $D(^DIC(19,XQOPQT,21)),$P(^(21,0),U,3)>0 D DISPLAY^XQUTL
  1. .E D
  1. ..W !!," **> Sorry, access to this option has been denied by the application.",!!?7,"The variable XQUIT was encountered at the option",!?7,"'",XQNO,"'.",!?7,"You are being returned to:",!?7,"'",$P(XQSV,U,4),"'",!
  1. ..D HOLD^XQUTL
  1. ..Q
  1. .Q
  1. Q
  1. ;
  1. X ;If there is something in the XQUIT EXECUTABLE field, execute it.
  1. I '$D(XQOPQT) S XQOPQT=XQY
  1. I $D(^DIC(19,XQOPQT,22)),$L(^(22)) X ^(22) S XQX=1
  1. Q