1 | VALMXQ02 ; alb/mjk - XQOR1 for export with LM v1 ; 3/30/93
|
---|
2 | ;;1;List Manager;**2**;Aug 13, 1993
|
---|
3 | ;
|
---|
4 | ;
|
---|
5 | XQOR1 ; SLC/KCM - Main Unwinding Loop ;3/23/92 08:34 ;
|
---|
6 | ;;6.7;Sidewinder;**14**;Jan 08, 1993
|
---|
7 | LOOP ;From: EN^XQOR
|
---|
8 | 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
|
---|
9 | D EACH G:$D(XQORQUIT)!$D(XQORPOP)!$D(DIROUT)!$D(DTOUT) EXCT
|
---|
10 | ; Start RT Log, IF PROTOCOL HAS AN ENTRY ACTION AND IF $D(XRTL)
|
---|
11 | I $D(@(^TMP("XQORS",$J,XQORS,"REF")_"20)"))'[0 S Y=^(20) I $L(Y) D:$D(XRTL) T0^%ZOSV N X X Y S:$D(X)'[0 ^TMP("XQORS",$J,XQORS,"X")=X
|
---|
12 | I $D(XRT0) S XRTN=$P($G(^ORD(101,+$G(XQORNOD),0)),U) I XRTN]"" D T1^%ZOSV ; Stop RT Log
|
---|
13 | I $D(XQORQUIT)!$D(XQORPOP)!$D(DIROUT)!$D(DTOUT) G EXAT
|
---|
14 | 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
|
---|
15 | 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")
|
---|
16 | G:'^TMP("XQORS",$J,XQORS,"ITM") EXAT S ^TMP("XQORS",$J,XQORS,"TOT")=^TMP("XQORS",$J,XQORS,"ITM"),^TMP("XQORS",$J,XQORS,"ITM")=0
|
---|
17 | 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
|
---|
18 | 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
|
---|
19 | 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
|
---|
20 | S X=^TMP("XQORS",$J,XQORS,"ITM",^TMP("XQORS",$J,XQORS,"ITM")) D EN^XQOR
|
---|
21 | NXT K XQORQUIT I '$D(XQORPOP),'$D(DIROUT),'$D(DTOUT) G STAK
|
---|
22 | 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
|
---|
23 | S XQORNOD=^TMP("XQORS",$J,XQORS,"VPT"),XQORNOD(0)=^TMP("XQORS",$J,XQORS,"INP")
|
---|
24 | I $P(^TMP("XQORS",$J,XQORS,"FLG"),"^",2)!$P(^TMP("XQORS",$J,XQORS,"FLG"),"^",4) S $P(^TMP("XQORS",$J,XQORS,"FLG"),"^",4)=""
|
---|
25 | 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
|
---|
26 | EXAT I $P(^TMP("XQORS",$J,XQORS,"FLG"),"^",6) G EX^XQOR
|
---|
27 | I $D(@(^TMP("XQORS",$J,XQORS,"REF")_"15)"))'[0 S X=^(15) I $L(X) X X
|
---|
28 | EXCT I $D(^TMP("XQORS",$J,XQORS,"CTX","AD")) D EXIT^XQORO
|
---|
29 | G EX^XQOR
|
---|
30 | EACH I $P(^TMP("XQORS",$J,XQORS,"FLG"),"^",3),"AXLOD"[$P(^TMP("XQORS",$J,XQORS,"FLG"),"^") D SHDR^XQOR4
|
---|
31 | D:$D(OROLD) RSTR^XQORO ;OE/RR Context
|
---|
32 | I "QOLD"[$P(^TMP("XQORS",$J,XQORS,"FLG"),"^"),$D(^TMP("XQORS",$J,0,"CTXT","ADD")) D EVERY^XQORO
|
---|
33 | Q
|
---|