XQ72 ;SEA/MJM - ^Jump Utilities ;04/16/2002 14:02
;;8.0;KERNEL;**47,46,157**;Jul 10, 1995
;
JUMP ;Entry point for D+1^XQ and LEGAL^XQ74.
;With +XQY: target opt, XQY0: 0th node with pathway, XQY1: parent's
;0th node; XQ(XQ) array of alternate pathways, if any; XQDIC:
;P-tree of target option; XQPSM: XQDIC or mutiple trees (U66,P258)
;XQSV: XQY^XQDIC^XQY0 of origin (previous) option.
;
;** Variables **
;XQFLAG=1 usually means we're done. Head for the door.
S XQJMP=1 ;Flag indicating we are in a jump process
N XQFLAG,XQI,XQJ,XQTT,XQSTK,XQSVSTK,XQONSTK,XQOLDSTK
;
;Get current stack pointer and Primary Menu tree, set "all done" flag
S XQTT=^XUTL("XQ",$J,"T"),XQPMEN="P"_^("XQM")
;
;If we are already in a rubber-band jump, unwind it
I $D(^XUTL("XQ",$J,"RBX")) S XQFLG=1,XQSAV=XQY_U_XQPSM_U_XQY0,XQY=+^("RBX"),XQY0=$P(^("RBX"),U,2,99) D RBX^XQ73 S XQY=+XQSAV,XQPSM=$P(XQSAV,U,2),XQY0=$P(XQSAV,U,3,99) K XQFLG,XQSAV
;
;Get the stack and see if target option is already on it
S XQSTK=""
F XQI=1:1:XQTT S XQOLDSTK(XQI)=^XUTL("XQ",$J,XQI),XQSTK=XQSTK_+XQOLDSTK(XQI)_","
;
I (","_XQSTK)[(","_XQY_","),'$D(XQRB) D NOJ^XQ72A G OUT
;
;See if target option is in the current display tree (+XQDISTR)
S XQDISTR=+XQSV
I $S('$D(^XUTL("XQO",XQDISTR,0)):1,'$D(^DIC(19,XQDISTR,99)):1,^DIC(19,XQDISTR,99)'=$P(^XUTL("XQO",XQDISTR,0),U,2):1,1:0) L +^XUTL("XQO",XQDISTR):5 S XQSAVE=XQDIC,XQDIC=XQDISTR D ^XQSET L -^XUTL("XQO",XQDISTR) S XQDIC=XQSAVE
I $D(^XUTL("XQO",XQDISTR,"^",+XQY)),($P(^(+XQY),U,6)=+XQY!($P(^(+XQY),U,6)="")) S XQY0=$P(^(+XQY),U,2,99),^DISV(DUZ,"XQ",XQDISTR)=XQY G OUT
;
;Set XQMA to the parent of the tree we're jumping from
S XQMA=$P(XQSV,U,2)
I XQMA']"" S XQMA=XQY
;
;Find shortest path to target if there are more than one in XQ(XQ)
I $D(XQ),XQ>0 D MPW G:XQ<0 OUT
;
;Get jump path and add parent menu option.
S XQJP=$P(XQY0,U,5)
I XQPSM["PXU" S %=0,%=$O(^DIC(19,"B","XUCOMMAND",%)),XQJP=%_","_XQJP
I XQPSM["," S %=$P(XQPSM,",",2),XQJP=$P(%,"P",2)_","_XQJP
S XQNP=XQTT_U_XQJP
;
;Save stack as it was before we messed with it.
S XQSVSTK=XQTT_U_XQSTK
S XQONSTK="" ;Those options we put on the stack are collected here.
;
;
;** BEGIN PROCESSING PRIMARY AND SECONDARY JUMPS **
;
S XQNOW=^XUTL("XQ",$J,XQTT)
;
;See if we are jumping FROM a Secondary menu tree
S XQFLAG=0
S XQSFROM=$S($P(XQNOW,U)["U":1,1:0)
I XQSFROM D
.N %,XQI,XQT,XQDIC
.S XQT=XQTT
.S XQDIC=XQPSM I XQDIC["," S XQDIC=$P(XQDIC,",",2)
.I $D(^XUTL("XQO",XQDIC,U,+XQSV)) S XQFLAG=1 D SAMTREE Q ;target in current tree.
.F XQI=XQT:-1:1 S %=$P(^XUTL("XQ",$J,XQI),U,1) Q:%'[","&(%'["PXU") D POP(XQI) ;Remove current secondary from the stack
.Q
G:XQFLAG B1
;
;See if we're staying in the Primary Menu's tree
S XQFLAG=0
I $D(^XUTL("XQO",XQPMEN,U,XQY)) D
.S XQJP=XQMA_","_XQJP
.S XQFLAG=1
.D:XQTT>1 SAMTREE
.Q
G:XQFLAG B1
;
;See if we are jumping TO a secondary menu: just load and go.
S XQSTO=0
S XQFLAG=0
I XQPSM["U" D
.S XQSTO=1
.S XQFLAG=1
.I XQPSM["," S XQDIC=$P(XQPSM,",",2)
.S (^XUTL("XQ",$J,"T"),XQST)=XQTT
.Q
;
;
;
B1 ;Get the path of options and process them one by one
S XQZ=$P(XQNP,U,2) I '$L(XQZ) S XQTT=1 G OUT
I '$D(XQUIT) F XQSTPT=1:1 S XQD=$P(XQZ,",",XQSTPT) Q:(+XQD=+XQY)!('$L(XQD)) D JUMP1 I $D(XQUIT) S XQUIT=2 D ^XQUIT Q:$D(XQUIT) D RXQ
;
I '$D(XQUIT) D
.N %
.S ^DISV(DUZ,"XQ",XQMA)=XQY
.S %=$G(^XUTL("XQO",XQDIC,"^",XQY))
.I %="" S %=$G(^DIC(19,"AXQ",XQDIC,"^",XQY))
.I %]"" S XQY0=$P(%,U,2,5)_"^^"_$P(%,U,7,11)_"^^"_$P(%,U,13)_"^^"_$P(%,U,15,99)
.E S XQFAIL=""
.Q
I $D(XQFAIL) K XQFAIL S XQTT=1
;
;
OUT ;Reset the stack pointer, clean up, and return to XQ
I '$D(XQTT) S XQTT=$G(^XUTL("XQ",$J,"T")) I XQTT="" S XQTT=1
S ^XUTL("XQ",$J,"T")=XQTT
;
K %,%XQJP,X,XQ,XQCH,XQD,XQDISTR,XQEX,XQI,XQII,XQJ,XQJMP,XQJP,XQJS,XQK,XQMA,XQN,XQNO,XQNOW,XQNO1,XQNP,XQOLDSTK,XQPMEN,XQSAV,XQSTO,XQSFROM,XQST,XQSTK,XQSTPT,XQSVSTK,XQT,XQTT,XQV,XQW,XQY1,XQZ,Y,Z
;
I $D(XQUIT) K XQUIT G M1^XQ
G M^XQ
;
;
;** SUBROUTINES **
;
POP(XQSTPT) ;Pop one level on the stack
;Execute Exit Actions and Headers
N %,XQY,XQY0
S %=^XUTL("XQ",$J,XQSTPT)
S XQY=+%,XQY0=$P(%,U,2,99)
I $P(XQY0,U,15),$D(^DIC(19,XQY,15)),$L(^(15)) X ^(15) ;W " ==> POP^XQ72"
S %=^XUTL("XQ",$J,XQSTPT-1)
S XQY=+%,XQY0=$P(%,U,2,99)
I $P(XQY0,U,17),$D(^DIC(19,XQY,26)),$L(^(26)) X ^(26) ;W " ==> POP^XQ72"
I '$D(XQTT) S XQTT=^XUTL("XQ",$J,"T")
S XQTT=XQTT-1 ;Reset stack pointer to next option
Q
;
JUMP1 ;Check pathway for prohibitions
;Push intermediate option onto the stack
;Execute Entry Actions and Headers
S XQST=+XQNP
S XQY0=$S($D(^XUTL("XQO",XQMA,U,+XQD))#2:$P(^(+XQD),U,2,99),1:^DIC(19,+XQD,0)),XQMA=XQD
S ^XUTL("XQ",$J,XQTT+1)=XQD_XQPSM_U_XQY0 ;,^("T")=XQST+XQSTPT
I $P(XQY0,U,14) Q:'$D(^DIC(19,XQD,20)) Q:'$L(^(20)) X ^(20) ;W " ==> JUMP1^XQ72"
Q:$D(XQUIT)
;
RXQ ;Return if XQUIT is cancelled by the application
I $P(XQY0,U,17),$D(^DIC(19,XQD,26)),$L(^(26)) X ^(26) ;W " ==> JUMP1^XQ72"
S XQTT=XQTT+1 ;Reset stack pointer
S XQONSTK=XQTT_U_XQONSTK
Q
;
MPW ;Multiple paths, choose shortest or best
S XQ(XQ+1)=$P(XQY0,U,5),XQJ=1,%="" F XQI=0:0 S %=$O(XQ(%)) Q:%=""!(%'=+%) S XQ(XQJ)=XQ(%),XQJ=XQJ+1
S XQ=XQJ-1 F XQJ=1:1:$L(XQSTK,",")-2 S X=","_$P(XQSTK,",",XQJ)_"," F XQI=1:1:XQ S %=","_XQ(XQI) I %[X,'$D(Y(XQI)) S XQ(XQI)=$E(X,2,99)_$P(XQ(XQI),X,2,99),Y(XQI)=""
F XQI=1:1:XQ S %($L(XQ(XQI),","),XQI)=XQ(XQI)
S X="",Z=1 F XQI=1:1:XQ S X=$O(%(X)) Q:X="" S Y="" F XQJ=0:0 S Y=$O(%(X,Y)) Q:Y="" S XQ(Z)=%(X,Y),Z=Z+1
F XQI=1:1:XQ S %XQJP=XQ(XQI) Q:%XQJP="" D JMP^XQCHK Q:$L(%XQJP)
I %XQJP="" W " ??",$C(7) S XQY=+XQSV,XQDIC=$P(XQSV,U,2),XQY0=$P(XQSV,U,3,99),XQ=-1 Q
S XQY0=$P(XQY0,U,1,4)_U_XQ(XQI)_U_$P(XQY0,U,6,99)
Q
;
SAMTREE ;Jump target is in the same tree, find the modified path
N XQI,XQJ,XQY1
;Find in XQI the 1st option in XQJP not already on the stack
F XQI=1:1:$L(XQJP,",")-1 Q:XQSTK'[($P(XQJP,",",XQI)_",")
;Remove that part of jump path already on the stack
S XQNP=$P(XQJP,",",XQI,99),XQNP=$L(XQNP,",")-1_U_XQNP
;
;Calculate where we push XQNP (the new path) onto the stack
S %=$P(XQJP,",",1,XQI-1),XQY1=$P(%,",",$L(%,","))
;
;Pop the stack until we are pointing to where we need to be
F XQM=XQTT:-1:2 Q:$P(XQSTK,",",XQM)=XQY1 D POP(XQM)
Q
;
;
SOLVE(XQY1,XQJP,XQNP) ;See if and where we are on the jump path.
;Returns the remainder of XQJP after XQY1 and everything
;under it is removed from the path. With XQJP = "1,2,3,4,5,"
;and XQY1 = 3 (or "3,"; or "2,3"; or "1,2,3,") it returns XQNP
;equal to "4,5,". If XQY1 is not in XQJP, XQNP is returned as
;null.
;
N X,IN,OUT
S IN=+XQY1
S X=$S(XQY1[",":1,1:0) ;Is it a string or a number?
S XQNP=$P($E(XQJP,$F(XQJP,XQY1)-X,99),",",2,99)
I +XQNP=IN S XQNP="" ;No match
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQ72 6915 printed Apr 09, 2024@21:07:42 Page 2
XQ72 ;SEA/MJM - ^Jump Utilities ;04/16/2002 14:02
+1 ;;8.0;KERNEL;**47,46,157**;Jul 10, 1995
+2 ;
JUMP ;Entry point for D+1^XQ and LEGAL^XQ74.
+1 ;With +XQY: target opt, XQY0: 0th node with pathway, XQY1: parent's
+2 ;0th node; XQ(XQ) array of alternate pathways, if any; XQDIC:
+3 ;P-tree of target option; XQPSM: XQDIC or mutiple trees (U66,P258)
+4 ;XQSV: XQY^XQDIC^XQY0 of origin (previous) option.
+5 ;
+6 ;** Variables **
+7 ;XQFLAG=1 usually means we're done. Head for the door.
+8 ;Flag indicating we are in a jump process
SET XQJMP=1
+9 NEW XQFLAG,XQI,XQJ,XQTT,XQSTK,XQSVSTK,XQONSTK,XQOLDSTK
+10 ;
+11 ;Get current stack pointer and Primary Menu tree, set "all done" flag
+12 SET XQTT=^XUTL("XQ",$JOB,"T")
SET XQPMEN="P"_^("XQM")
+13 ;
+14 ;If we are already in a rubber-band jump, unwind it
+15 IF $DATA(^XUTL("XQ",$JOB,"RBX"))
SET XQFLG=1
SET XQSAV=XQY_U_XQPSM_U_XQY0
SET XQY=+^("RBX")
SET XQY0=$PIECE(^("RBX"),U,2,99)
DO RBX^XQ73
SET XQY=+XQSAV
SET XQPSM=$PIECE(XQSAV,U,2)
SET XQY0=$PIECE(XQSAV,U,3,99)
KILL XQFLG,XQSAV
+16 ;
+17 ;Get the stack and see if target option is already on it
+18 SET XQSTK=""
+19 FOR XQI=1:1:XQTT
SET XQOLDSTK(XQI)=^XUTL("XQ",$JOB,XQI)
SET XQSTK=XQSTK_+XQOLDSTK(XQI)_","
+20 ;
+21 IF (","_XQSTK)[(","_XQY_",")
IF '$DATA(XQRB)
DO NOJ^XQ72A
GOTO OUT
+22 ;
+23 ;See if target option is in the current display tree (+XQDISTR)
+24 SET XQDISTR=+XQSV
+25 IF $SELECT('$DATA(^XUTL("XQO",XQDISTR,0)):1,'$DATA(^DIC(19,XQDISTR,99)):1,^DIC(19,XQDISTR,99)'=$PIECE(^XUTL("XQO",XQDISTR,0),U,2):1,1:0)
LOCK +^XUTL("XQO",XQDISTR):5
SET XQSAVE=XQDIC
SET XQDIC=XQDISTR
DO ^XQSET
LOCK -^XUTL("XQO",XQDISTR)
SET XQDIC=XQSAVE
+26 IF $DATA(^XUTL("XQO",XQDISTR,"^",+XQY))
IF ($PIECE(^(+XQY),U,6)=+XQY!($PIECE(^(+XQY),U,6)=""))
SET XQY0=$PIECE(^(+XQY),U,2,99)
SET ^DISV(DUZ,"XQ",XQDISTR)=XQY
GOTO OUT
+27 ;
+28 ;Set XQMA to the parent of the tree we're jumping from
+29 SET XQMA=$PIECE(XQSV,U,2)
+30 IF XQMA']""
SET XQMA=XQY
+31 ;
+32 ;Find shortest path to target if there are more than one in XQ(XQ)
+33 IF $DATA(XQ)
IF XQ>0
DO MPW
if XQ<0
GOTO OUT
+34 ;
+35 ;Get jump path and add parent menu option.
+36 SET XQJP=$PIECE(XQY0,U,5)
+37 IF XQPSM["PXU"
SET %=0
SET %=$ORDER(^DIC(19,"B","XUCOMMAND",%))
SET XQJP=%_","_XQJP
+38 IF XQPSM[","
SET %=$PIECE(XQPSM,",",2)
SET XQJP=$PIECE(%,"P",2)_","_XQJP
+39 SET XQNP=XQTT_U_XQJP
+40 ;
+41 ;Save stack as it was before we messed with it.
+42 SET XQSVSTK=XQTT_U_XQSTK
+43 ;Those options we put on the stack are collected here.
SET XQONSTK=""
+44 ;
+45 ;
+46 ;** BEGIN PROCESSING PRIMARY AND SECONDARY JUMPS **
+47 ;
+48 SET XQNOW=^XUTL("XQ",$JOB,XQTT)
+49 ;
+50 ;See if we are jumping FROM a Secondary menu tree
+51 SET XQFLAG=0
+52 SET XQSFROM=$SELECT($PIECE(XQNOW,U)["U":1,1:0)
+53 IF XQSFROM
Begin DoDot:1
+54 NEW %,XQI,XQT,XQDIC
+55 SET XQT=XQTT
+56 SET XQDIC=XQPSM
IF XQDIC[","
SET XQDIC=$PIECE(XQDIC,",",2)
+57 ;target in current tree.
IF $DATA(^XUTL("XQO",XQDIC,U,+XQSV))
SET XQFLAG=1
DO SAMTREE
QUIT
+58 ;Remove current secondary from the stack
FOR XQI=XQT:-1:1
SET %=$PIECE(^XUTL("XQ",$JOB,XQI),U,1)
if %'[","&(%'["PXU")
QUIT
DO POP(XQI)
+59 QUIT
End DoDot:1
+60 if XQFLAG
GOTO B1
+61 ;
+62 ;See if we're staying in the Primary Menu's tree
+63 SET XQFLAG=0
+64 IF $DATA(^XUTL("XQO",XQPMEN,U,XQY))
Begin DoDot:1
+65 SET XQJP=XQMA_","_XQJP
+66 SET XQFLAG=1
+67 if XQTT>1
DO SAMTREE
+68 QUIT
End DoDot:1
+69 if XQFLAG
GOTO B1
+70 ;
+71 ;See if we are jumping TO a secondary menu: just load and go.
+72 SET XQSTO=0
+73 SET XQFLAG=0
+74 IF XQPSM["U"
Begin DoDot:1
+75 SET XQSTO=1
+76 SET XQFLAG=1
+77 IF XQPSM[","
SET XQDIC=$PIECE(XQPSM,",",2)
+78 SET (^XUTL("XQ",$JOB,"T"),XQST)=XQTT
+79 QUIT
End DoDot:1
+80 ;
+81 ;
+82 ;
B1 ;Get the path of options and process them one by one
+1 SET XQZ=$PIECE(XQNP,U,2)
IF '$LENGTH(XQZ)
SET XQTT=1
GOTO OUT
+2 IF '$DATA(XQUIT)
FOR XQSTPT=1:1
SET XQD=$PIECE(XQZ,",",XQSTPT)
if (+XQD=+XQY)!('$LENGTH(XQD))
QUIT
DO JUMP1
IF $DATA(XQUIT)
SET XQUIT=2
DO ^XQUIT
if $DATA(XQUIT)
QUIT
DO RXQ
+3 ;
+4 IF '$DATA(XQUIT)
Begin DoDot:1
+5 NEW %
+6 SET ^DISV(DUZ,"XQ",XQMA)=XQY
+7 SET %=$GET(^XUTL("XQO",XQDIC,"^",XQY))
+8 IF %=""
SET %=$GET(^DIC(19,"AXQ",XQDIC,"^",XQY))
+9 IF %]""
SET XQY0=$PIECE(%,U,2,5)_"^^"_$PIECE(%,U,7,11)_"^^"_$PIECE(%,U,13)_"^^"_$PIECE(%,U,15,99)
+10 IF '$TEST
SET XQFAIL=""
+11 QUIT
End DoDot:1
+12 IF $DATA(XQFAIL)
KILL XQFAIL
SET XQTT=1
+13 ;
+14 ;
OUT ;Reset the stack pointer, clean up, and return to XQ
+1 IF '$DATA(XQTT)
SET XQTT=$GET(^XUTL("XQ",$JOB,"T"))
IF XQTT=""
SET XQTT=1
+2 SET ^XUTL("XQ",$JOB,"T")=XQTT
+3 ;
+4 KILL %,%XQJP,X,XQ,XQCH,XQD,XQDISTR,XQEX,XQI,XQII,XQJ,XQJMP,XQJP,XQJS,XQK,XQMA,XQN,XQNO,XQNOW,XQNO1,XQNP,XQOLDSTK,XQPMEN,XQSAV,XQSTO,XQSFROM,XQST,XQSTK,XQSTPT,XQSVSTK,XQT,XQTT,XQV,XQW,XQY1,XQZ,Y,Z
+5 ;
+6 IF $DATA(XQUIT)
KILL XQUIT
GOTO M1^XQ
+7 GOTO M^XQ
+8 ;
+9 ;
+10 ;** SUBROUTINES **
+11 ;
POP(XQSTPT) ;Pop one level on the stack
+1 ;Execute Exit Actions and Headers
+2 NEW %,XQY,XQY0
+3 SET %=^XUTL("XQ",$JOB,XQSTPT)
+4 SET XQY=+%
SET XQY0=$PIECE(%,U,2,99)
+5 ;W " ==> POP^XQ72"
IF $PIECE(XQY0,U,15)
IF $DATA(^DIC(19,XQY,15))
IF $LENGTH(^(15))
XECUTE ^(15)
+6 SET %=^XUTL("XQ",$JOB,XQSTPT-1)
+7 SET XQY=+%
SET XQY0=$PIECE(%,U,2,99)
+8 ;W " ==> POP^XQ72"
IF $PIECE(XQY0,U,17)
IF $DATA(^DIC(19,XQY,26))
IF $LENGTH(^(26))
XECUTE ^(26)
+9 IF '$DATA(XQTT)
SET XQTT=^XUTL("XQ",$JOB,"T")
+10 ;Reset stack pointer to next option
SET XQTT=XQTT-1
+11 QUIT
+12 ;
JUMP1 ;Check pathway for prohibitions
+1 ;Push intermediate option onto the stack
+2 ;Execute Entry Actions and Headers
+3 SET XQST=+XQNP
+4 SET XQY0=$SELECT($DATA(^XUTL("XQO",XQMA,U,+XQD))#2:$PIECE(^(+XQD),U,2,99),1:^DIC(19,+XQD,0))
SET XQMA=XQD
+5 ;,^("T")=XQST+XQSTPT
SET ^XUTL("XQ",$JOB,XQTT+1)=XQD_XQPSM_U_XQY0
+6 ;W " ==> JUMP1^XQ72"
IF $PIECE(XQY0,U,14)
if '$DATA(^DIC(19,XQD,20))
QUIT
if '$LENGTH(^(20))
QUIT
XECUTE ^(20)
+7 if $DATA(XQUIT)
QUIT
+8 ;
RXQ ;Return if XQUIT is cancelled by the application
+1 ;W " ==> JUMP1^XQ72"
IF $PIECE(XQY0,U,17)
IF $DATA(^DIC(19,XQD,26))
IF $LENGTH(^(26))
XECUTE ^(26)
+2 ;Reset stack pointer
SET XQTT=XQTT+1
+3 SET XQONSTK=XQTT_U_XQONSTK
+4 QUIT
+5 ;
MPW ;Multiple paths, choose shortest or best
+1 SET XQ(XQ+1)=$PIECE(XQY0,U,5)
SET XQJ=1
SET %=""
FOR XQI=0:0
SET %=$ORDER(XQ(%))
if %=""!(%'=+%)
QUIT
SET XQ(XQJ)=XQ(%)
SET XQJ=XQJ+1
+2 SET XQ=XQJ-1
FOR XQJ=1:1:$LENGTH(XQSTK,",")-2
SET X=","_$PIECE(XQSTK,",",XQJ)_","
FOR XQI=1:1:XQ
SET %=","_XQ(XQI)
IF %[X
IF '$DATA(Y(XQI))
SET XQ(XQI)=$EXTRACT(X,2,99)_$PIECE(XQ(XQI),X,2,99)
SET Y(XQI)=""
+3 FOR XQI=1:1:XQ
SET %($LENGTH(XQ(XQI),","),XQI)=XQ(XQI)
+4 SET X=""
SET Z=1
FOR XQI=1:1:XQ
SET X=$ORDER(%(X))
if X=""
QUIT
SET Y=""
FOR XQJ=0:0
SET Y=$ORDER(%(X,Y))
if Y=""
QUIT
SET XQ(Z)=%(X,Y)
SET Z=Z+1
+5 FOR XQI=1:1:XQ
SET %XQJP=XQ(XQI)
if %XQJP=""
QUIT
DO JMP^XQCHK
if $LENGTH(%XQJP)
QUIT
+6 IF %XQJP=""
WRITE " ??",$CHAR(7)
SET XQY=+XQSV
SET XQDIC=$PIECE(XQSV,U,2)
SET XQY0=$PIECE(XQSV,U,3,99)
SET XQ=-1
QUIT
+7 SET XQY0=$PIECE(XQY0,U,1,4)_U_XQ(XQI)_U_$PIECE(XQY0,U,6,99)
+8 QUIT
+9 ;
SAMTREE ;Jump target is in the same tree, find the modified path
+1 NEW XQI,XQJ,XQY1
+2 ;Find in XQI the 1st option in XQJP not already on the stack
+3 FOR XQI=1:1:$LENGTH(XQJP,",")-1
if XQSTK'[($PIECE(XQJP,",",XQI)_",")
QUIT
+4 ;Remove that part of jump path already on the stack
+5 SET XQNP=$PIECE(XQJP,",",XQI,99)
SET XQNP=$LENGTH(XQNP,",")-1_U_XQNP
+6 ;
+7 ;Calculate where we push XQNP (the new path) onto the stack
+8 SET %=$PIECE(XQJP,",",1,XQI-1)
SET XQY1=$PIECE(%,",",$LENGTH(%,","))
+9 ;
+10 ;Pop the stack until we are pointing to where we need to be
+11 FOR XQM=XQTT:-1:2
if $PIECE(XQSTK,",",XQM)=XQY1
QUIT
DO POP(XQM)
+12 QUIT
+13 ;
+14 ;
SOLVE(XQY1,XQJP,XQNP) ;See if and where we are on the jump path.
+1 ;Returns the remainder of XQJP after XQY1 and everything
+2 ;under it is removed from the path. With XQJP = "1,2,3,4,5,"
+3 ;and XQY1 = 3 (or "3,"; or "2,3"; or "1,2,3,") it returns XQNP
+4 ;equal to "4,5,". If XQY1 is not in XQJP, XQNP is returned as
+5 ;null.
+6 ;
+7 NEW X,IN,OUT
+8 SET IN=+XQY1
+9 ;Is it a string or a number?
SET X=$SELECT(XQY1[",":1,1:0)
+10 SET XQNP=$PIECE($EXTRACT(XQJP,$FIND(XQJP,XQY1)-X,99),",",2,99)
+11 ;No match
IF +XQNP=IN
SET XQNP=""
+12 QUIT
