- XQ72A ;SEA/LUKE - Jump Utilities (Part II) ;05/08/98 10:12
- ;;8.0;KERNEL;**46**;Jul 10, 1995
- ;
- NOJ ;Pop to target option and return, not a real jump.
- N %,XQI,XQT
- S XQT=XQTT
- F XQI=XQT:-1:1 S %=$P(XQSTK,",",XQI) Q:%="" Q:+XQY=+% D POP^XQ72(XQI)
- ;I $P(^XUTL("XQ",$J,(XQTT-XQI)),U,16)!($P(^(XQTT-XQI),U,18)) S XQEX=+^(XQTT-XQI) D XACT^XQ72
- S XQY0=$P(^XUTL("XQ",$J,XQI),U,2,99),XQM3=1
- K %,XQI,XQSM,XQST,XQSTK
- Q
- ;
- LAT ;Lateral shift in same parent. Not a real jump, realy.
- S ^DISV(DUZ,"XQ",XQMA)=XQY
- S XQY0=$P(^XUTL("XQO",XQDIC,U,+XQY),U,2,5)_"^^"_$P(^(+XQY),U,7,11)_"^^"_$P(^(+XQY),U,13)_"^^"_$P(^(+XQY),U,15,99)
- ;S XQTT=^XUTL("XQ",$J,"T")
- F XQI=XQTT:-1:1 S %=^XUTL("XQ",$J,XQI) Q:("MP"[$P(%,U,5)&($D(^DIC(19,+%,10,"B",+XQY)))) ;!((XQSTO)&($P(%,U)'["U"))
- S ^XUTL("XQ",$J,"T")=$S(XQI'<1:XQI,1:1)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQ72A 833 printed Feb 18, 2025@23:31:25 Page 2
- XQ72A ;SEA/LUKE - Jump Utilities (Part II) ;05/08/98 10:12
- +1 ;;8.0;KERNEL;**46**;Jul 10, 1995
- +2 ;
- NOJ ;Pop to target option and return, not a real jump.
- +1 NEW %,XQI,XQT
- +2 SET XQT=XQTT
- +3 FOR XQI=XQT:-1:1
- SET %=$PIECE(XQSTK,",",XQI)
- if %=""
- QUIT
- if +XQY=+%
- QUIT
- DO POP^XQ72(XQI)
- +4 ;I $P(^XUTL("XQ",$J,(XQTT-XQI)),U,16)!($P(^(XQTT-XQI),U,18)) S XQEX=+^(XQTT-XQI) D XACT^XQ72
- +5 SET XQY0=$PIECE(^XUTL("XQ",$JOB,XQI),U,2,99)
- SET XQM3=1
- +6 KILL %,XQI,XQSM,XQST,XQSTK
- +7 QUIT
- +8 ;
- LAT ;Lateral shift in same parent. Not a real jump, realy.
- +1 SET ^DISV(DUZ,"XQ",XQMA)=XQY
- +2 SET XQY0=$PIECE(^XUTL("XQO",XQDIC,U,+XQY),U,2,5)_"^^"_$PIECE(^(+XQY),U,7,11)_"^^"_$PIECE(^(+XQY),U,13)_"^^"_$PIECE(^(+XQY),U,15,99)
- +3 ;S XQTT=^XUTL("XQ",$J,"T")
- +4 ;!((XQSTO)&($P(%,U)'["U"))
- FOR XQI=XQTT:-1:1
- SET %=^XUTL("XQ",$JOB,XQI)
- if ("MP"[$PIECE(%,U,5)&($DATA(^DIC(19,+%,10,"B",+XQY))))
- QUIT
- +5 SET ^XUTL("XQ",$JOB,"T")=$SELECT(XQI'<1:XQI,1:1)
- +6 QUIT