VALMXQ02 ; alb/mjk - XQOR1 for export with LM v1 ; 3/30/93
;;1;List Manager;;Aug 13, 1993
;
;
XQOR1 ; SLC/KCM - Main Unwinding Loop ;3/23/92 08:34 ;
;;6.7;Sidewinder;**14**;Jan 08, 1993
LOOP ;From: EN^XQOR
I "QOLD"[$P(^TMP("XQORS",$J,XQORS,"FLG"),"^"),'$D(^TMP("XQORS",$J,0,"CTXT","ADD")) D ENTRY^XQORO G:$D(XQORQUIT)!$D(XQORPOP)!$D(DIROUT)!$D(DTOUT) EXCT
D EACH G:$D(XQORQUIT)!$D(XQORPOP)!$D(DIROUT)!$D(DTOUT) EXCT
; Start RT Log, IF PROTOCOL HAS AN ENTRY ACTION AND IF $D(XRTL)
I $D(@(^TMP("XQORS",$J,XQORS,"REF")_"20)"))'[0 S Y=^(20) I $L(Y) D:$D(XRTL) T0^%ZOSV D N X X Y S:$D(X)'[0 ^TMP("XQORS",$J,XQORS,"X")=X
. I $L($T(LOGRSRC^%ZOSV)),$G(^TMP("XQORS",$J,XQORS,"REF"))["ORD(101,",$P(@(^("REF")_"0)"),"^",4)'="M",$P(^(0),"^",4)'="Q" S ORX=$P(^(0),"^") D:'$D(XQXFLG) ABT^XQ12 D:$P(XQXFLG,"^",2)=1 LOGRSRC^%ZOSV("*"_ORX)
I $D(XRT0) S XRTN=$P($G(^ORD(101,+$G(XQORNOD),0)),U) I XRTN]"" D T1^%ZOSV ; Stop RT Log
I $L($T(LOGRSRC^%ZOSV)),$G(^TMP("XQORS",$J,XQORS,"REF"))["ORD(101,",$P(@(^("REF")_"0)"),"^",4)'="M",$P(^(0),"^",4)'="Q" S ORX=$P(^(0),"^") D:'$D(XQXFLG) ABT^XQ12 D:$P(XQXFLG,"^",2)=1 LOGRSRC^%ZOSV("*"_ORX)
I $D(XQORQUIT)!$D(XQORPOP)!$D(DIROUT)!$D(DTOUT) G EXAT
I $D(XQORFLG) S:$D(XQORFLG("PS")) $P(^TMP("XQORS",$J,XQORS,"FLG"),"^",2)=+XQORFLG("PS") S:$D(XQORFLG("SH")) $P(^TMP("XQORS",$J,XQORS,"FLG"),"^",5)=+XQORFLG("SH") K XQORFLG
REDO D @$S("QM"[$P(^TMP("XQORS",$J,XQORS,"FLG"),"^"):"MENU^XQOR3","DOX"[$P(^TMP("XQORS",$J,XQORS,"FLG"),"^"):"ACT^XQOR2","T"[$P(^TMP("XQORS",$J,XQORS,"FLG"),"^"):"EN^XQORD",1:"NUL^XQOR2")
G:'^TMP("XQORS",$J,XQORS,"ITM") EXAT S ^TMP("XQORS",$J,XQORS,"TOT")=^TMP("XQORS",$J,XQORS,"ITM"),^TMP("XQORS",$J,XQORS,"ITM")=0
STAK S ^TMP("XQORS",$J,XQORS,"ITM")=^TMP("XQORS",$J,XQORS,"ITM")+1 G:^TMP("XQORS",$J,XQORS,"ITM")>^TMP("XQORS",$J,XQORS,"TOT") EXST
I '^TMP("XQORS",$J,XQORS,"ITM",^TMP("XQORS",$J,XQORS,"ITM")) S $P(^TMP("XQORS",$J,XQORS,"FLG"),"^",4)=1 D DJMP^XQOR4 K XQORPOP,XQORQUIT G NXT
I $D(^TMP("XQORS",$J,XQORS,"ITM",^TMP("XQORS",$J,XQORS,"ITM"),"MA")) S X=^TMP("XQORS",$J,XQORS,"ITM",^TMP("XQORS",$J,XQORS,"ITM"),"MA") D EN^XQOR G:$D(XQORQUIT)!$D(XQORPOP)!$D(DIROUT)!$D(DTOUT) NXT
S X=^TMP("XQORS",$J,XQORS,"ITM",^TMP("XQORS",$J,XQORS,"ITM")) D EN^XQOR
NXT K XQORQUIT I '$D(XQORPOP),'$D(DIROUT),'$D(DTOUT) G STAK
EXST S ^TMP("XQORS",$J,0,"FILE")=";"_$P(^TMP("XQORS",$J,XQORS,"VPT"),";",2) S:$D(^TMP("XQORS",$J,XQORS,"INP")) $P(^TMP("XQORS",$J,XQORS,"INP"),"^",4)="" K XQORPOP
S XQORNOD=^TMP("XQORS",$J,XQORS,"VPT"),XQORNOD(0)=^TMP("XQORS",$J,XQORS,"INP")
I $P(^TMP("XQORS",$J,XQORS,"FLG"),"^",2)!$P(^TMP("XQORS",$J,XQORS,"FLG"),"^",4) S $P(^TMP("XQORS",$J,XQORS,"FLG"),"^",4)=""
I I '$D(DIROUT),'$D(DTOUT) D EACH I '$D(XQORQUIT),'$D(XQORPOP),'$D(DIROUT),'$D(DTOUT) K ^TMP("XQORS",$J,XQORS,"ITM") G REDO
EXAT I $P(^TMP("XQORS",$J,XQORS,"FLG"),"^",6) G EX^XQOR
I $D(@(^TMP("XQORS",$J,XQORS,"REF")_"15)"))'[0 S X=^(15) I $L(X) X X
EXCT I $D(^TMP("XQORS",$J,XQORS,"CTX","AD")) D EXIT^XQORO
G EX^XQOR
EACH I $P(^TMP("XQORS",$J,XQORS,"FLG"),"^",3),"AXLOD"[$P(^TMP("XQORS",$J,XQORS,"FLG"),"^") D SHDR^XQOR4
D:$D(OROLD) RSTR^XQORO ;OE/RR Context
I "QOLD"[$P(^TMP("XQORS",$J,XQORS,"FLG"),"^"),$D(^TMP("XQORS",$J,0,"CTXT","ADD")) D EVERY^XQORO
Q
VALMXQ02 ; alb/mjk - XQOR1 for export with LM v1 ; 3/30/93
+1 ;;1;List Manager;;Aug 13, 1993
+2 ;
+3 ;
XQOR1 ; SLC/KCM - Main Unwinding Loop ;3/23/92 08:34 ;
+1 ;;6.7;Sidewinder;**14**;Jan 08, 1993
LOOP ;From: EN^XQOR
+1 IF "QOLD"[$PIECE(^TMP("XQORS",$JOB,XQORS,"FLG"),"^")
IF '$DATA(^TMP("XQORS",$JOB,0,"CTXT","ADD"))
DO ENTRY^XQORO
IF $DATA(XQORQUIT)!$DATA(XQORPOP)!$DATA(DIROUT)!$DATA(DTOUT)
GOTO EXCT
+2 DO EACH
IF $DATA(XQORQUIT)!$DATA(XQORPOP)!$DATA(DIROUT)!$DATA(DTOUT)
GOTO EXCT
+3 ; Start RT Log, IF PROTOCOL HAS AN ENTRY ACTION AND IF $D(XRTL)
+4 IF $DATA(@(^TMP("XQORS",$JOB,XQORS,"REF")_"20)"))'[0
SET Y=^(20)
IF $LENGTH(Y)
IF $DATA(XRTL)
DO T0^%ZOSV
Begin DoDot:1
+5 IF $LENGTH($TEXT(LOGRSRC^%ZOSV))
IF $GET(^TMP("XQORS",$JOB,XQORS,"REF"))["ORD(101,"
IF $PIECE(@(^("REF")_"0)"),"^",4)'="M"
IF $PIECE(^(0),"^",4)'="Q"
SET ORX=$PIECE(^(0),"^")
IF '$DATA(XQXFLG)
DO ABT^XQ12
IF $PIECE(XQXFLG,"^",2)=1
DO LOGRSRC^%ZOSV("*"_ORX)
End DoDot:1
NEW X
XECUTE Y
IF $DATA(X)'[0
SET ^TMP("XQORS",$JOB,XQORS,"X")=X
+6 ; Stop RT Log
IF $DATA(XRT0)
SET XRTN=$PIECE($GET(^ORD(101,+$GET(XQORNOD),0)),U)
IF XRTN]""
DO T1^%ZOSV
+7 IF $LENGTH($TEXT(LOGRSRC^%ZOSV))
IF $GET(^TMP("XQORS",$JOB,XQORS,"REF"))["ORD(101,"
IF $PIECE(@(^("REF")_"0)"),"^",4)'="M"
IF $PIECE(^(0),"^",4)'="Q"
SET ORX=$PIECE(^(0),"^")
IF '$DATA(XQXFLG)
DO ABT^XQ12
IF $PIECE(XQXFLG,"^",2)=1
DO LOGRSRC^%ZOSV("*"_ORX)
+8 IF $DATA(XQORQUIT)!$DATA(XQORPOP)!$DATA(DIROUT)!$DATA(DTOUT)
GOTO EXAT
+9 IF $DATA(XQORFLG)
IF $DATA(XQORFLG("PS"))
SET $PIECE(^TMP("XQORS",$JOB,XQORS,"FLG"),"^",2)=+XQORFLG("PS")
IF $DATA(XQORFLG("SH"))
SET $PIECE(^TMP("XQORS",$JOB,XQORS,"FLG"),"^",5)=+XQORFLG("SH")
KILL XQORFLG
REDO DO @$SELECT("QM"[$PIECE(^TMP("XQORS",$JOB,XQORS,"FLG"),"^"):"MENU^XQOR3","DOX"[$PIECE(^TMP("XQORS",$JOB,XQORS,"FLG"),"^"):"ACT^XQOR2","T"[$PIECE(^TMP("XQORS",$JOB,XQORS,"FLG"),"^"):"EN^XQORD",1:"NUL^XQOR2")
+1 IF '^TMP("XQORS",$JOB,XQORS,"ITM")
GOTO EXAT
SET ^TMP("XQORS",$JOB,XQORS,"TOT")=^TMP("XQORS",$JOB,XQORS,"ITM")
SET ^TMP("XQORS",$JOB,XQORS,"ITM")=0
STAK SET ^TMP("XQORS",$JOB,XQORS,"ITM")=^TMP("XQORS",$JOB,XQORS,"ITM")+1
IF ^TMP("XQORS",$JOB,XQORS,"ITM")>^TMP("XQORS",$JOB,XQORS,"TOT")
GOTO EXST
+1 IF '^TMP("XQORS",$JOB,XQORS,"ITM",^TMP("XQORS",$JOB,XQORS,"ITM"))
SET $PIECE(^TMP("XQORS",$JOB,XQORS,"FLG"),"^",4)=1
DO DJMP^XQOR4
KILL XQORPOP,XQORQUIT
GOTO NXT
+2 IF $DATA(^TMP("XQORS",$JOB,XQORS,"ITM",^TMP("XQORS",$JOB,XQORS,"ITM"),"MA"))
SET X=^TMP("XQORS",$JOB,XQORS,"ITM",^TMP("XQORS",$JOB,XQORS,"ITM"),"MA")
DO EN^XQOR
IF $DATA(XQORQUIT)!$DATA(XQORPOP)!$DATA(DIROUT)!$DATA(DTOUT)
GOTO NXT
+3 SET X=^TMP("XQORS",$JOB,XQORS,"ITM",^TMP("XQORS",$JOB,XQORS,"ITM"))
DO EN^XQOR
NXT KILL XQORQUIT
IF '$DATA(XQORPOP)
IF '$DATA(DIROUT)
IF '$DATA(DTOUT)
GOTO STAK
EXST SET ^TMP("XQORS",$JOB,0,"FILE")=";"_$PIECE(^TMP("XQORS",$JOB,XQORS,"VPT"),";",2)
IF $DATA(^TMP("XQORS",$JOB,XQORS,"INP"))
SET $PIECE(^TMP("XQORS",$JOB,XQORS,"INP"),"^",4)=""
KILL XQORPOP
+1 SET XQORNOD=^TMP("XQORS",$JOB,XQORS,"VPT")
SET XQORNOD(0)=^TMP("XQORS",$JOB,XQORS,"INP")
+2 IF $PIECE(^TMP("XQORS",$JOB,XQORS,"FLG"),"^",2)!$PIECE(^TMP("XQORS",$JOB,XQORS,"FLG"),"^",4)
SET $PIECE(^TMP("XQORS",$JOB,XQORS,"FLG"),"^",4)=""
+3 IF $TEST
IF '$DATA(DIROUT)
IF '$DATA(DTOUT)
DO EACH
IF '$DATA(XQORQUIT)
IF '$DATA(XQORPOP)
IF '$DATA(DIROUT)
IF '$DATA(DTOUT)
KILL ^TMP("XQORS",$JOB,XQORS,"ITM")
GOTO REDO
EXAT IF $PIECE(^TMP("XQORS",$JOB,XQORS,"FLG"),"^",6)
GOTO EX^XQOR
+1 IF $DATA(@(^TMP("XQORS",$JOB,XQORS,"REF")_"15)"))'[0
SET X=^(15)
IF $LENGTH(X)
XECUTE X
EXCT IF $DATA(^TMP("XQORS",$JOB,XQORS,"CTX","AD"))
DO EXIT^XQORO
+1 GOTO EX^XQOR
EACH IF $PIECE(^TMP("XQORS",$JOB,XQORS,"FLG"),"^",3)
IF "AXLOD"[$PIECE(^TMP("XQORS",$JOB,XQORS,"FLG"),"^")
DO SHDR^XQOR4
+1 ;OE/RR Context
IF $DATA(OROLD)
DO RSTR^XQORO
+2 IF "QOLD"[$PIECE(^TMP("XQORS",$JOB,XQORS,"FLG"),"^")
IF $DATA(^TMP("XQORS",$JOB,0,"CTXT","ADD"))
DO EVERY^XQORO
+3 QUIT
