30 lines
2.7 KiB
Mathematica
30 lines
2.7 KiB
Mathematica
GMTSXQ02 ; SLC/JER - XQOR1 for Export w/Health Summary ;1/10/92 14:55
|
|
;;2.5;Health Summary;;Dec 16, 1992
|
|
XQOR1 ; SLC/KCM - Main Unwinding Loop ;3/13/90 11:34 ;
|
|
;;6.52;Copyright 1990, DVA;
|
|
LOOP ;From: EN^XQOR
|
|
I "QOL"[$P(^UTILITY("XQORS",$J,XQORS,"FLG"),"^"),'$D(^UTILITY("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
|
|
I $D(@(^UTILITY("XQORS",$J,XQORS,"REF")_"20)"))'[0 S Y=^(20) I $L(Y) K X X Y S:$D(X)'[0 ^UTILITY("XQORS",$J,XQORS,"X")=X
|
|
I $D(XQORQUIT)!$D(XQORPOP)!$D(DIROUT)!$D(DTOUT) G EXAT
|
|
I $D(XQORFLG) S:$D(XQORFLG("PS")) $P(^UTILITY("XQORS",$J,XQORS,"FLG"),"^",2)=+XQORFLG("PS") S:$D(XQORFLG("SH")) $P(^UTILITY("XQORS",$J,XQORS,"FLG"),"^",5)=+XQORFLG("SH") K XQORFLG
|
|
REDO D @$S("QM"[$P(^UTILITY("XQORS",$J,XQORS,"FLG"),"^"):"MENU^XQOR3","OX"[$P(^UTILITY("XQORS",$J,XQORS,"FLG"),"^"):"ACT^XQOR2",1:"NUL^XQOR2")
|
|
G:'^UTILITY("XQORS",$J,XQORS,"ITM") EXAT S ^UTILITY("XQORS",$J,XQORS,"TOT")=^UTILITY("XQORS",$J,XQORS,"ITM"),^UTILITY("XQORS",$J,XQORS,"ITM")=0
|
|
STAK S ^UTILITY("XQORS",$J,XQORS,"ITM")=^UTILITY("XQORS",$J,XQORS,"ITM")+1 G:^UTILITY("XQORS",$J,XQORS,"ITM")>^UTILITY("XQORS",$J,XQORS,"TOT") EXST
|
|
I '^UTILITY("XQORS",$J,XQORS,"ITM",^UTILITY("XQORS",$J,XQORS,"ITM")) S $P(^UTILITY("XQORS",$J,XQORS,"FLG"),"^",4)=1 D DJMP^XQOR4 K XQORPOP,XQORQUIT G NXT
|
|
I $D(^UTILITY("XQORS",$J,XQORS,"ITM",^UTILITY("XQORS",$J,XQORS,"ITM"),"MA")) S X=^UTILITY("XQORS",$J,XQORS,"ITM",^UTILITY("XQORS",$J,XQORS,"ITM"),"MA") D EN^XQOR G:$D(XQORQUIT)!$D(XQORPOP)!$D(DIROUT)!$D(DTOUT) NXT
|
|
S X=^UTILITY("XQORS",$J,XQORS,"ITM",^UTILITY("XQORS",$J,XQORS,"ITM")) D EN^XQOR
|
|
NXT K XQORQUIT I '$D(XQORPOP),'$D(DIROUT),'$D(DTOUT) G STAK
|
|
EXST S ^UTILITY("XQORS",$J,0,"FILE")=";"_$P(^UTILITY("XQORS",$J,XQORS,"VPT"),";",2) S:$D(^UTILITY("XQORS",$J,XQORS,"INP")) $P(^UTILITY("XQORS",$J,XQORS,"INP"),"^",4)="" K XQORPOP
|
|
I $P(^UTILITY("XQORS",$J,XQORS,"FLG"),"^",2)!$P(^UTILITY("XQORS",$J,XQORS,"FLG"),"^",4) S $P(^UTILITY("XQORS",$J,XQORS,"FLG"),"^",4)=""
|
|
I I '$D(DIROUT),'$D(DTOUT) D EACH I '$D(XQORQUIT),'$D(XQORPOP),'$D(DIROUT),'$D(DTOUT) K ^UTILITY("XQORS",$J,XQORS,"ITM") G REDO
|
|
EXAT I $P(^UTILITY("XQORS",$J,XQORS,"FLG"),"^",6) G EX^XQOR
|
|
I $D(@(^UTILITY("XQORS",$J,XQORS,"REF")_"15)"))'[0 S X=^(15) I $L(X) X X
|
|
EXCT I $D(^UTILITY("XQORS",$J,XQORS,"CTX","AD")) D EXIT^XQORO
|
|
G EX^XQOR
|
|
EACH I $P(^UTILITY("XQORS",$J,XQORS,"FLG"),"^",3),"AXLO"[$P(^UTILITY("XQORS",$J,XQORS,"FLG"),"^") D SHDR^XQOR4
|
|
S XQORNOD=^UTILITY("XQORS",$J,XQORS,"VPT"),XQORNOD(0)=^UTILITY("XQORS",$J,XQORS,"INP")
|
|
D:$D(OROLD) RSTR^XQORO ;OE/RR Context
|
|
I "QOL"[$P(^UTILITY("XQORS",$J,XQORS,"FLG"),"^"),$D(^UTILITY("XQORS",$J,0,"CTXT","ADD")) D EVERY^XQORO
|
|
Q
|