- 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 ---[H[J[2J[HXQOR2 1587 printed Feb 18, 2025@23:32:22 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")