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

XQ72.m

Go to the documentation of this file. 
  1. XQ72 ;SEA/MJM - ^Jump Utilities ;04/16/2002  14:02 [ 07/29/2004   9:01 AM ]
  1.  ;;8.0;KERNEL;**47,46,157**;Jul 10, 1995
  1.  ;
  1. JUMP ;Entry point for D+1^XQ and  LEGAL^XQ74.
  1.  ;With +XQY: target opt, XQY0: 0th node with pathway, XQY1: parent's
  1.  ;0th node; XQ(XQ) array of alternate pathways, if any; XQDIC:
  1.  ;P-tree of target option; XQPSM: XQDIC or mutiple trees (U66,P258)
  1.  ;XQSV: XQY^XQDIC^XQY0 of origin (previous) option.
  1.  ;
  1.  ;** Variables **
  1.  ;XQFLAG=1 usually means we're done.  Head for the door.
  1.  S XQJMP=1 ;Flag indicating we are in a jump process
  1.  N XQFLAG,XQI,XQJ,XQTT,XQSTK,XQSVSTK,XQONSTK,XQOLDSTK
  1.  ;
  1.  ;Get current stack pointer and Primary Menu tree, set "all done" flag
  1.  S XQTT=^XUTL("XQ",$J,"T"),XQPMEN="P"_^("XQM")
  1.  ;
  1.  ;If we are already in a rubber-band jump, unwind it
  1.  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
  1.  ;
  1.  ;Get the stack and see if target option is already on it
  1.  S XQSTK=""
  1.  F XQI=1:1:XQTT S XQOLDSTK(XQI)=^XUTL("XQ",$J,XQI),XQSTK=XQSTK_+XQOLDSTK(XQI)_","
  1.  ;
  1.  I (","_XQSTK)[(","_XQY_","),'$D(XQRB) D NOJ^XQ72A G OUT
  1.  ;
  1.  ;See if target option is in the current display tree (+XQDISTR)
  1.  S XQDISTR=+XQSV
  1.  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
  1.  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
  1.  ;
  1.  ;Set XQMA to the parent of the tree we're jumping from
  1.  S XQMA=$P(XQSV,U,2)
  1.  I XQMA']"" S XQMA=XQY
  1.  ;
  1.  ;Find shortest path to target if there are more than one in XQ(XQ)
  1.  I $D(XQ),XQ>0 D MPW G:XQ<0 OUT
  1.  ;
  1.  ;Get jump path and add parent menu option.
  1.  S XQJP=$P(XQY0,U,5)
  1.  I XQPSM["PXU" S %=0,%=$O(^DIC(19,"B","XUCOMMAND",%)),XQJP=%_","_XQJP
  1.  I XQPSM["," S %=$P(XQPSM,",",2),XQJP=$P(%,"P",2)_","_XQJP
  1.  S XQNP=XQTT_U_XQJP
  1.  ;
  1.  ;Save stack as it was before we messed with it.
  1.  S XQSVSTK=XQTT_U_XQSTK
  1.  S XQONSTK="" ;Those options we put on the stack are collected here.
  1.  ;
  1.  ;
  1.  ;** BEGIN PROCESSING PRIMARY AND SECONDARY JUMPS **
  1.  ;
  1.  S XQNOW=^XUTL("XQ",$J,XQTT)
  1.  ;
  1.  ;See if we are jumping FROM a Secondary menu tree
  1.  S XQFLAG=0
  1.  S XQSFROM=$S($P(XQNOW,U)["U":1,1:0)
  1.  I XQSFROM D
  1.  .N %,XQI,XQT,XQDIC
  1.  .S XQT=XQTT
  1.  .S XQDIC=XQPSM I XQDIC["," S XQDIC=$P(XQDIC,",",2)
  1.  .I $D(^XUTL("XQO",XQDIC,U,+XQSV)) S XQFLAG=1 D SAMTREE Q  ;target in current tree.
  1.  .F XQI=XQT:-1:1 S %=$P(^XUTL("XQ",$J,XQI),U,1) Q:%'[","&(%'["PXU")  D POP(XQI) ;Remove current secondary from the stack
  1.  .Q
  1.  G:XQFLAG B1
  1.  ;
  1.  ;See if we're staying in the Primary Menu's tree
  1.  S XQFLAG=0
  1.  I $D(^XUTL("XQO",XQPMEN,U,XQY)) D
  1.  .S XQJP=XQMA_","_XQJP
  1.  .S XQFLAG=1
  1.  .D:XQTT>1 SAMTREE
  1.  .Q
  1.  G:XQFLAG B1
  1.  ;
  1.  ;See if we are jumping TO a secondary menu: just load and go.
  1.  S XQSTO=0
  1.  S XQFLAG=0
  1.  I XQPSM["U" D
  1.  .S XQSTO=1
  1.  .S XQFLAG=1
  1.  .I XQPSM["," S XQDIC=$P(XQPSM,",",2)
  1.  .S (^XUTL("XQ",$J,"T"),XQST)=XQTT
  1.  .Q
  1.  ;
  1.  ;
  1.  ;
  1. B1 ;Get the path of options and process them one by one
  1.  S XQZ=$P(XQNP,U,2) I '$L(XQZ) S XQTT=1 G OUT
  1.  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
  1.  ;
  1.  I '$D(XQUIT) D
  1.  .N %
  1.  .S ^DISV(DUZ,"XQ",XQMA)=XQY
  1.  .S %=$G(^XUTL("XQO",XQDIC,"^",XQY))
  1.  .I %="" S %=$G(^DIC(19,"AXQ",XQDIC,"^",XQY))
  1.  .I %]"" S XQY0=$P(%,U,2,5)_"^^"_$P(%,U,7,11)_"^^"_$P(%,U,13)_"^^"_$P(%,U,15,99)
  1.  .E  S XQFAIL=""
  1.  .Q
  1.  I $D(XQFAIL) K XQFAIL S XQTT=1
  1.  ;
  1.  ;
  1. OUT ;Reset the stack pointer, clean up, and return to XQ
  1.  I '$D(XQTT) S XQTT=$G(^XUTL("XQ",$J,"T")) I XQTT="" S XQTT=1
  1.  S ^XUTL("XQ",$J,"T")=XQTT
  1.  ;
  1.  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
  1.  ;
  1.  I $D(XQUIT) K XQUIT G M1^XQ
  1.  G M^XQ
  1.  ;
  1.  ;
  1.  ;** SUBROUTINES **
  1.  ;
  1. POP(XQSTPT) ;Pop one level on the stack
  1.  ;Execute Exit Actions and Headers
  1.  N %,XQY,XQY0
  1.  S %=^XUTL("XQ",$J,XQSTPT)
  1.  S XQY=+%,XQY0=$P(%,U,2,99)
  1.  I $P(XQY0,U,15),$D(^DIC(19,XQY,15)),$L(^(15)) X ^(15) ;W " ==> POP^XQ72"
  1.  S %=^XUTL("XQ",$J,XQSTPT-1)
  1.  S XQY=+%,XQY0=$P(%,U,2,99)
  1.  I $P(XQY0,U,17),$D(^DIC(19,XQY,26)),$L(^(26)) X ^(26) ;W " ==> POP^XQ72"
  1.  I '$D(XQTT) S XQTT=^XUTL("XQ",$J,"T")
  1.  S XQTT=XQTT-1 ;Reset stack pointer to next option
  1.  Q
  1.  ;
  1. JUMP1 ;Check pathway for prohibitions
  1.  ;Push intermediate option onto the stack
  1.  ;Execute Entry Actions and Headers
  1.  S XQST=+XQNP
  1.  S XQY0=$S($D(^XUTL("XQO",XQMA,U,+XQD))#2:$P(^(+XQD),U,2,99),1:^DIC(19,+XQD,0)),XQMA=XQD
  1.  S ^XUTL("XQ",$J,XQTT+1)=XQD_XQPSM_U_XQY0 ;,^("T")=XQST+XQSTPT
  1.  I $P(XQY0,U,14) Q:'$D(^DIC(19,XQD,20))  Q:'$L(^(20))  X ^(20) ;W " ==> JUMP1^XQ72"
  1.  Q:$D(XQUIT)
  1.  ;
  1. RXQ ;Return if XQUIT is cancelled by the application
  1.  I $P(XQY0,U,17),$D(^DIC(19,XQD,26)),$L(^(26)) X ^(26) ;W " ==> JUMP1^XQ72"
  1.  S XQTT=XQTT+1 ;Reset stack pointer
  1.  S XQONSTK=XQTT_U_XQONSTK
  1.  Q
  1.  ;
  1. MPW ;Multiple paths, choose shortest or best
  1.  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
  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)=""
  1.  F XQI=1:1:XQ S %($L(XQ(XQI),","),XQI)=XQ(XQI)
  1.  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
  1.  F XQI=1:1:XQ S %XQJP=XQ(XQI) Q:%XQJP=""  D JMP^XQCHK Q:$L(%XQJP)
  1.  I %XQJP="" W " ??",$C(7) S XQY=+XQSV,XQDIC=$P(XQSV,U,2),XQY0=$P(XQSV,U,3,99),XQ=-1 Q
  1.  S XQY0=$P(XQY0,U,1,4)_U_XQ(XQI)_U_$P(XQY0,U,6,99)
  1.  Q
  1.  ;
  1. SAMTREE ;Jump target is in the same tree, find the modified path
  1.  N XQI,XQJ,XQY1
  1.  ;Find in XQI the 1st option in XQJP not already on the stack
  1.  F XQI=1:1:$L(XQJP,",")-1  Q:XQSTK'[($P(XQJP,",",XQI)_",")
  1.  ;Remove that part of jump path already on the stack
  1.  S XQNP=$P(XQJP,",",XQI,99),XQNP=$L(XQNP,",")-1_U_XQNP
  1.  ;
  1.  ;Calculate where we push XQNP (the new path) onto the stack
  1.  S %=$P(XQJP,",",1,XQI-1),XQY1=$P(%,",",$L(%,","))
  1.  ;
  1.  ;Pop the stack until we are pointing to where we need to be
  1.  F XQM=XQTT:-1:2 Q:$P(XQSTK,",",XQM)=XQY1  D POP(XQM)
  1.  Q
  1.  ;
  1.  ;
  1. SOLVE(XQY1,XQJP,XQNP) ;See if and where we are on the jump path.
  1.  ;Returns the remainder of XQJP after XQY1 and everything
  1.  ;under it is removed from the path.  With XQJP = "1,2,3,4,5,"
  1.  ;and XQY1 = 3 (or "3,"; or "2,3"; or "1,2,3,") it returns XQNP
  1.  ;equal to "4,5,".  If XQY1 is not in XQJP, XQNP is returned as
  1.  ;null.
  1.  ;
  1.  N X,IN,OUT
  1.  S IN=+XQY1
  1.  S X=$S(XQY1[",":1,1:0) ;Is it a string or a number?
  1.  S XQNP=$P($E(XQJP,$F(XQJP,XQY1)-X,99),",",2,99)
  1.  I +XQNP=IN S XQNP="" ;No match
  1.  Q