| [613] | 1 | XQ72 ;SEA/MJM - ^Jump Utilities ;04/16/2002 14:02
|
|---|
| 2 | ;;8.0;KERNEL;**47,46,157**;Jul 10, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | JUMP ;Entry point for D+1^XQ and LEGAL^XQ74.
|
|---|
| 5 | ;With +XQY: target opt, XQY0: 0th node with pathway, XQY1: parent's
|
|---|
| 6 | ;0th node; XQ(XQ) array of alternate pathways, if any; XQDIC:
|
|---|
| 7 | ;P-tree of target option; XQPSM: XQDIC or mutiple trees (U66,P258)
|
|---|
| 8 | ;XQSV: XQY^XQDIC^XQY0 of origin (previous) option.
|
|---|
| 9 | ;
|
|---|
| 10 | ;** Variables **
|
|---|
| 11 | ;XQFLAG=1 usually means we're done. Head for the door.
|
|---|
| 12 | S XQJMP=1 ;Flag indicating we are in a jump process
|
|---|
| 13 | N XQFLAG,XQI,XQJ,XQTT,XQSTK,XQSVSTK,XQONSTK,XQOLDSTK
|
|---|
| 14 | ;
|
|---|
| 15 | ;Get current stack pointer and Primary Menu tree, set "all done" flag
|
|---|
| 16 | S XQTT=^XUTL("XQ",$J,"T"),XQPMEN="P"_^("XQM")
|
|---|
| 17 | ;
|
|---|
| 18 | ;If we are already in a rubber-band jump, unwind it
|
|---|
| 19 | 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
|
|---|
| 20 | ;
|
|---|
| 21 | ;Get the stack and see if target option is already on it
|
|---|
| 22 | S XQSTK=""
|
|---|
| 23 | F XQI=1:1:XQTT S XQOLDSTK(XQI)=^XUTL("XQ",$J,XQI),XQSTK=XQSTK_+XQOLDSTK(XQI)_","
|
|---|
| 24 | ;
|
|---|
| 25 | I (","_XQSTK)[(","_XQY_","),'$D(XQRB) D NOJ^XQ72A G OUT
|
|---|
| 26 | ;
|
|---|
| 27 | ;See if target option is in the current display tree (+XQDISTR)
|
|---|
| 28 | S XQDISTR=+XQSV
|
|---|
| 29 | 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
|
|---|
| 30 | 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
|
|---|
| 31 | ;
|
|---|
| 32 | ;Set XQMA to the parent of the tree we're jumping from
|
|---|
| 33 | S XQMA=$P(XQSV,U,2)
|
|---|
| 34 | I XQMA']"" S XQMA=XQY
|
|---|
| 35 | ;
|
|---|
| 36 | ;Find shortest path to target if there are more than one in XQ(XQ)
|
|---|
| 37 | I $D(XQ),XQ>0 D MPW G:XQ<0 OUT
|
|---|
| 38 | ;
|
|---|
| 39 | ;Get jump path and add parent menu option.
|
|---|
| 40 | S XQJP=$P(XQY0,U,5)
|
|---|
| 41 | I XQPSM["PXU" S %=0,%=$O(^DIC(19,"B","XUCOMMAND",%)),XQJP=%_","_XQJP
|
|---|
| 42 | I XQPSM["," S %=$P(XQPSM,",",2),XQJP=$P(%,"P",2)_","_XQJP
|
|---|
| 43 | S XQNP=XQTT_U_XQJP
|
|---|
| 44 | ;
|
|---|
| 45 | ;Save stack as it was before we messed with it.
|
|---|
| 46 | S XQSVSTK=XQTT_U_XQSTK
|
|---|
| 47 | S XQONSTK="" ;Those options we put on the stack are collected here.
|
|---|
| 48 | ;
|
|---|
| 49 | ;
|
|---|
| 50 | ;** BEGIN PROCESSING PRIMARY AND SECONDARY JUMPS **
|
|---|
| 51 | ;
|
|---|
| 52 | S XQNOW=^XUTL("XQ",$J,XQTT)
|
|---|
| 53 | ;
|
|---|
| 54 | ;See if we are jumping FROM a Secondary menu tree
|
|---|
| 55 | S XQFLAG=0
|
|---|
| 56 | S XQSFROM=$S($P(XQNOW,U)["U":1,1:0)
|
|---|
| 57 | I XQSFROM D
|
|---|
| 58 | .N %,XQI,XQT,XQDIC
|
|---|
| 59 | .S XQT=XQTT
|
|---|
| 60 | .S XQDIC=XQPSM I XQDIC["," S XQDIC=$P(XQDIC,",",2)
|
|---|
| 61 | .I $D(^XUTL("XQO",XQDIC,U,+XQSV)) S XQFLAG=1 D SAMTREE Q ;target in current tree.
|
|---|
| 62 | .F XQI=XQT:-1:1 S %=$P(^XUTL("XQ",$J,XQI),U,1) Q:%'[","&(%'["PXU") D POP(XQI) ;Remove current secondary from the stack
|
|---|
| 63 | .Q
|
|---|
| 64 | G:XQFLAG B1
|
|---|
| 65 | ;
|
|---|
| 66 | ;See if we're staying in the Primary Menu's tree
|
|---|
| 67 | S XQFLAG=0
|
|---|
| 68 | I $D(^XUTL("XQO",XQPMEN,U,XQY)) D
|
|---|
| 69 | .S XQJP=XQMA_","_XQJP
|
|---|
| 70 | .S XQFLAG=1
|
|---|
| 71 | .D:XQTT>1 SAMTREE
|
|---|
| 72 | .Q
|
|---|
| 73 | G:XQFLAG B1
|
|---|
| 74 | ;
|
|---|
| 75 | ;See if we are jumping TO a secondary menu: just load and go.
|
|---|
| 76 | S XQSTO=0
|
|---|
| 77 | S XQFLAG=0
|
|---|
| 78 | I XQPSM["U" D
|
|---|
| 79 | .S XQSTO=1
|
|---|
| 80 | .S XQFLAG=1
|
|---|
| 81 | .I XQPSM["," S XQDIC=$P(XQPSM,",",2)
|
|---|
| 82 | .S (^XUTL("XQ",$J,"T"),XQST)=XQTT
|
|---|
| 83 | .Q
|
|---|
| 84 | ;
|
|---|
| 85 | ;
|
|---|
| 86 | ;
|
|---|
| 87 | B1 ;Get the path of options and process them one by one
|
|---|
| 88 | S XQZ=$P(XQNP,U,2) I '$L(XQZ) S XQTT=1 G OUT
|
|---|
| 89 | 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
|
|---|
| 90 | ;
|
|---|
| 91 | I '$D(XQUIT) D
|
|---|
| 92 | .N %
|
|---|
| 93 | .S ^DISV(DUZ,"XQ",XQMA)=XQY
|
|---|
| 94 | .S %=$G(^XUTL("XQO",XQDIC,"^",XQY))
|
|---|
| 95 | .I %="" S %=$G(^DIC(19,"AXQ",XQDIC,"^",XQY))
|
|---|
| 96 | .I %]"" S XQY0=$P(%,U,2,5)_"^^"_$P(%,U,7,11)_"^^"_$P(%,U,13)_"^^"_$P(%,U,15,99)
|
|---|
| 97 | .E S XQFAIL=""
|
|---|
| 98 | .Q
|
|---|
| 99 | I $D(XQFAIL) K XQFAIL S XQTT=1
|
|---|
| 100 | ;
|
|---|
| 101 | ;
|
|---|
| 102 | OUT ;Reset the stack pointer, clean up, and return to XQ
|
|---|
| 103 | I '$D(XQTT) S XQTT=$G(^XUTL("XQ",$J,"T")) I XQTT="" S XQTT=1
|
|---|
| 104 | S ^XUTL("XQ",$J,"T")=XQTT
|
|---|
| 105 | ;
|
|---|
| 106 | 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
|
|---|
| 107 | ;
|
|---|
| 108 | I $D(XQUIT) K XQUIT G M1^XQ
|
|---|
| 109 | G M^XQ
|
|---|
| 110 | ;
|
|---|
| 111 | ;
|
|---|
| 112 | ;** SUBROUTINES **
|
|---|
| 113 | ;
|
|---|
| 114 | POP(XQSTPT) ;Pop one level on the stack
|
|---|
| 115 | ;Execute Exit Actions and Headers
|
|---|
| 116 | N %,XQY,XQY0
|
|---|
| 117 | S %=^XUTL("XQ",$J,XQSTPT)
|
|---|
| 118 | S XQY=+%,XQY0=$P(%,U,2,99)
|
|---|
| 119 | I $P(XQY0,U,15),$D(^DIC(19,XQY,15)),$L(^(15)) X ^(15) ;W " ==> POP^XQ72"
|
|---|
| 120 | S %=^XUTL("XQ",$J,XQSTPT-1)
|
|---|
| 121 | S XQY=+%,XQY0=$P(%,U,2,99)
|
|---|
| 122 | I $P(XQY0,U,17),$D(^DIC(19,XQY,26)),$L(^(26)) X ^(26) ;W " ==> POP^XQ72"
|
|---|
| 123 | I '$D(XQTT) S XQTT=^XUTL("XQ",$J,"T")
|
|---|
| 124 | S XQTT=XQTT-1 ;Reset stack pointer to next option
|
|---|
| 125 | Q
|
|---|
| 126 | ;
|
|---|
| 127 | JUMP1 ;Check pathway for prohibitions
|
|---|
| 128 | ;Push intermediate option onto the stack
|
|---|
| 129 | ;Execute Entry Actions and Headers
|
|---|
| 130 | S XQST=+XQNP
|
|---|
| 131 | S XQY0=$S($D(^XUTL("XQO",XQMA,U,+XQD))#2:$P(^(+XQD),U,2,99),1:^DIC(19,+XQD,0)),XQMA=XQD
|
|---|
| 132 | S ^XUTL("XQ",$J,XQTT+1)=XQD_XQPSM_U_XQY0 ;,^("T")=XQST+XQSTPT
|
|---|
| 133 | I $P(XQY0,U,14) Q:'$D(^DIC(19,XQD,20)) Q:'$L(^(20)) X ^(20) ;W " ==> JUMP1^XQ72"
|
|---|
| 134 | Q:$D(XQUIT)
|
|---|
| 135 | ;
|
|---|
| 136 | RXQ ;Return if XQUIT is cancelled by the application
|
|---|
| 137 | I $P(XQY0,U,17),$D(^DIC(19,XQD,26)),$L(^(26)) X ^(26) ;W " ==> JUMP1^XQ72"
|
|---|
| 138 | S XQTT=XQTT+1 ;Reset stack pointer
|
|---|
| 139 | S XQONSTK=XQTT_U_XQONSTK
|
|---|
| 140 | Q
|
|---|
| 141 | ;
|
|---|
| 142 | MPW ;Multiple paths, choose shortest or best
|
|---|
| 143 | 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
|
|---|
| 144 | 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)=""
|
|---|
| 145 | F XQI=1:1:XQ S %($L(XQ(XQI),","),XQI)=XQ(XQI)
|
|---|
| 146 | 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
|
|---|
| 147 | F XQI=1:1:XQ S %XQJP=XQ(XQI) Q:%XQJP="" D JMP^XQCHK Q:$L(%XQJP)
|
|---|
| 148 | I %XQJP="" W " ??",$C(7) S XQY=+XQSV,XQDIC=$P(XQSV,U,2),XQY0=$P(XQSV,U,3,99),XQ=-1 Q
|
|---|
| 149 | S XQY0=$P(XQY0,U,1,4)_U_XQ(XQI)_U_$P(XQY0,U,6,99)
|
|---|
| 150 | Q
|
|---|
| 151 | ;
|
|---|
| 152 | SAMTREE ;Jump target is in the same tree, find the modified path
|
|---|
| 153 | N XQI,XQJ,XQY1
|
|---|
| 154 | ;Find in XQI the 1st option in XQJP not already on the stack
|
|---|
| 155 | F XQI=1:1:$L(XQJP,",")-1 Q:XQSTK'[($P(XQJP,",",XQI)_",")
|
|---|
| 156 | ;Remove that part of jump path already on the stack
|
|---|
| 157 | S XQNP=$P(XQJP,",",XQI,99),XQNP=$L(XQNP,",")-1_U_XQNP
|
|---|
| 158 | ;
|
|---|
| 159 | ;Calculate where we push XQNP (the new path) onto the stack
|
|---|
| 160 | S %=$P(XQJP,",",1,XQI-1),XQY1=$P(%,",",$L(%,","))
|
|---|
| 161 | ;
|
|---|
| 162 | ;Pop the stack until we are pointing to where we need to be
|
|---|
| 163 | F XQM=XQTT:-1:2 Q:$P(XQSTK,",",XQM)=XQY1 D POP(XQM)
|
|---|
| 164 | Q
|
|---|
| 165 | ;
|
|---|
| 166 | ;
|
|---|
| 167 | SOLVE(XQY1,XQJP,XQNP) ;See if and where we are on the jump path.
|
|---|
| 168 | ;Returns the remainder of XQJP after XQY1 and everything
|
|---|
| 169 | ;under it is removed from the path. With XQJP = "1,2,3,4,5,"
|
|---|
| 170 | ;and XQY1 = 3 (or "3,"; or "2,3"; or "1,2,3,") it returns XQNP
|
|---|
| 171 | ;equal to "4,5,". If XQY1 is not in XQJP, XQNP is returned as
|
|---|
| 172 | ;null.
|
|---|
| 173 | ;
|
|---|
| 174 | N X,IN,OUT
|
|---|
| 175 | S IN=+XQY1
|
|---|
| 176 | S X=$S(XQY1[",":1,1:0) ;Is it a string or a number?
|
|---|
| 177 | S XQNP=$P($E(XQJP,$F(XQJP,XQY1)-X,99),",",2,99)
|
|---|
| 178 | I +XQNP=IN S XQNP="" ;No match
|
|---|
| 179 | Q
|
|---|
