XQ72A.m

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 ---XQ72A   833     printed  Apr 09, 2024@21:16:46                                                                                                                                                                                                        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