XQOR2.m

XQOR2 ; SLC/KCM - Process Extended Actions, Protocols ;8/23/91  10:33 ;

 ;;8.0;KERNEL;;Jul 10, 1995

ACT ;From: STAK^XQOR1

 I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^TMP("XQORS",$J,XQORS,"REF")_"26)"))'[0 S X=^(26) X:$L(X) X

 S ORNSV="" I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^TMP("XQORS",$J,XQORS,"REF")_"24)"))'[0 S ORNSV=^(24)

 K Y S (J,^TMP("XQORS",$J,XQORS,"ITM"))=0

ORD S J=$O(@(^TMP("XQORS",$J,XQORS,"REF")_"10,"_J_")")) G:J'>0 SET

 I $D(@(^TMP("XQORS",$J,XQORS,"REF")_"10,"_J_",0)")) S X=^(0) I +X D:$L(ORNSV) ACT1 I $T S Y=$S(+$P(X,"^",3):+$P(X,"^",3),1:1000+J),Y(Y,J)=X

 G ORD

SET S (I,Y)=0

SET1 S Y=$O(Y(Y)) G:Y="" EX S J=0

SET2 S J=$O(Y(Y,J)) G:J="" SET1

 S ^TMP("XQORS",$J,XQORS,"ITM")=^TMP("XQORS",$J,XQORS,"ITM")+1,^TMP("XQORS",$J,XQORS,"ITM",^TMP("XQORS",$J,XQORS,"ITM"))=+Y(Y,J)_";"_$P(^TMP("XQORS",$J,XQORS,"VPT"),";",2)

 S ^TMP("XQORS",$J,XQORS,"ITM",^TMP("XQORS",$J,XQORS,"ITM"),"IEN")=J

 I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",+$P(Y(Y,J),"^",4) S ^TMP("XQORS",$J,XQORS,"ITM",^TMP("XQORS",$J,XQORS,"ITM"),"MA")=$P(Y(Y,J),"^",4)_^TMP("XQORS",$J,0,"FILE")

 I $L($P($G(@(^TMP("XQORS",$J,XQORS,"REF")_"10,"_J_",1)")),"^")) S ^TMP("XQORS",$J,XQORS,"PMT",$$UP($P(^(1),"^")),^TMP("XQORS",$J,XQORS,"ITM"))=""

 G SET2

EX K ORNSV Q

ACT1 N DA S DA(1)=+^TMP("XQORS",$J,XQORS,"VPT"),DA=J N J,X,Y X ORNSV

 Q

NUL ;From: STAK^XQOR1

 I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^TMP("XQORS",$J,XQORS,"REF")_"26)"))'[0 S X=^(26) X:$L(X) X

 S ^TMP("XQORS",$J,XQORS,"ITM")=0

 Q

UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XQOR2   1587     printed  Apr 09, 2024@21:12:01                                                                                                                                                                                                       Page 2

XQOR2     ; SLC/KCM - Process Extended Actions, Protocols ;8/23/91  10:33 ;

 +1       ;;8.0;KERNEL;;Jul 10, 1995

ACT       ;From: STAK^XQOR1

 +1        IF ^TMP("XQORS",$JOB,0,"FILE")=";ORD(101,"

               IF $DATA(@(^TMP("XQORS",$JOB,XQORS,"REF")_"26)"))'[0

                   SET X=^(26)

                   if $LENGTH(X)

                       XECUTE X

 +2        SET ORNSV=""

           IF ^TMP("XQORS",$JOB,0,"FILE")=";ORD(101,"

               IF $DATA(@(^TMP("XQORS",$JOB,XQORS,"REF")_"24)"))'[0

                   SET ORNSV=^(24)

 +3        KILL Y

           SET (J,^TMP("XQORS",$JOB,XQORS,"ITM"))=0

ORD        SET J=$ORDER(@(^TMP("XQORS",$JOB,XQORS,"REF")_"10,"_J_")"))

           if J'>0

               GOTO SET

 +1        IF $DATA(@(^TMP("XQORS",$JOB,XQORS,"REF")_"10,"_J_",0)"))

               SET X=^(0)

               IF +X

                   if $LENGTH(ORNSV)

                       DO ACT1

                   IF $TEST

                       SET Y=$SELECT(+$PIECE(X,"^",3):+$PIECE(X,"^",3),1:1000+J)

                       SET Y(Y,J)=X

 +2        GOTO ORD

SET        SET (I,Y)=0

SET1       SET Y=$ORDER(Y(Y))

           if Y=""

               GOTO EX

           SET J=0

SET2       SET J=$ORDER(Y(Y,J))

           if J=""

               GOTO SET1

 +1        SET ^TMP("XQORS",$JOB,XQORS,"ITM")=^TMP("XQORS",$JOB,XQORS,"ITM")+1

           SET ^TMP("XQORS",$JOB,XQORS,"ITM",^TMP("XQORS",$JOB,XQORS,"ITM"))=+Y(Y,J)_";"_$PIECE(^TMP("XQORS",$JOB,XQORS,"VPT"),";",2)

 +2        SET ^TMP("XQORS",$JOB,XQORS,"ITM",^TMP("XQORS",$JOB,XQORS,"ITM"),"IEN")=J

 +3        IF ^TMP("XQORS",$JOB,0,"FILE")=";ORD(101,"

               IF +$PIECE(Y(Y,J),"^",4)

                   SET ^TMP("XQORS",$JOB,XQORS,"ITM",^TMP("XQORS",$JOB,XQORS,"ITM"),"MA")=$PIECE(Y(Y,J),"^",4)_^TMP("XQORS",$JOB,0,"FILE")

 +4        IF $LENGTH($PIECE($GET(@(^TMP("XQORS",$JOB,XQORS,"REF")_"10,"_J_",1)")),"^"))

               SET ^TMP("XQORS",$JOB,XQORS,"PMT",$$UP($PIECE(^(1),"^")),^TMP("XQORS",$JOB,XQORS,"ITM"))=""

 +5        GOTO SET2

EX         KILL ORNSV

           QUIT 

ACT1       NEW DA

           SET DA(1)=+^TMP("XQORS",$JOB,XQORS,"VPT")

           SET DA=J

           NEW J,X,Y

           XECUTE ORNSV

 +1        QUIT 

NUL       ;From: STAK^XQOR1

 +1        IF ^TMP("XQORS",$JOB,0,"FILE")=";ORD(101,"

               IF $DATA(@(^TMP("XQORS",$JOB,XQORS,"REF")_"26)"))'[0

                   SET X=^(26)

                   if $LENGTH(X)

                       XECUTE X

 +2        SET ^TMP("XQORS",$JOB,XQORS,"ITM")=0

 +3        QUIT 

UP(X)      QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")