GMTSXQ04 ; SLC/JER - XQOR3 for Export w/Health Summary ;1/10/92 14:58
;;2.5;Health Summary;;Dec 16, 1992
XQOR3 ; SLC/KCM - Process Menus, Protocol Menus ;12/5/89 10:16 ;
;;6.52;Copyright 1990, DVA;
S ^UTILITY("XQORS",$J,XQORS,"ITM")=0,XQORM=^UTILITY("XQORS",$J,XQORS,"VPT") S:$D(XQORM(0))[0 XQORM(0)="AD" I $D(XQORM("S")),'$L(XQORM("S")) K XQORM("S")
D:^UTILITY("XQORS",$J,0,"FILE")=";ORD(101," MENU1 S:'$D(XQORM("H")) XQORM("H")="W @IOF,*13 I $D(@(^UTILITY(""XQORS"",$J,XQORS,""REF"")_""0)"")) S X=$P(^(0),""^"",2) W ?(36-($L(X)\2)),""--- ""_X_"" ---"",!"
S X=$P(^UTILITY("XQORS",$J,XQORS,"INP"),"^",4) I X[";" D EAT^XQORM1 I $E(X)'=";" S X=$P(X,";",2,99),ORNSV=XQORM(0) S XQORM(0)=$S(+XQORM(0):+XQORM(0),1:"")_$S(XQORM(0)["F":"F",1:"") S XQORM("H")="" D ^XQORM
S:$D(^UTILITY("XQORS",$J,XQORS,"X")) X=^UTILITY("XQORS",$J,XQORS,"X")
I $S($D(ORNSV):Y<0,1:1) S:$D(ORNSV) XQORM(0)=ORNSV D ^XQORM
S I=0
SET S I=$O(Y(I)) G:I'>0 EX
S ^UTILITY("XQORS",$J,XQORS,"ITM")=^UTILITY("XQORS",$J,XQORS,"ITM")+1
S ^UTILITY("XQORS",$J,XQORS,"ITM",^UTILITY("XQORS",$J,XQORS,"ITM"))=$P(Y(I),"^",2)_^UTILITY("XQORS",$J,0,"FILE")
S ^UTILITY("XQORS",$J,XQORS,"ITM",^UTILITY("XQORS",$J,XQORS,"ITM"),"IN")=Y(I)
I ^UTILITY("XQORS",$J,0,"FILE")=";ORD(101,",$D(^ORD(101,+^UTILITY("XQORS",$J,XQORS,"VPT"),10,+Y(I),0)),+$P(^(0),"^",4) S ^UTILITY("XQORS",$J,XQORS,"ITM",^UTILITY("XQORS",$J,XQORS,"ITM"),"MA")=$P(^(0),"^",4)_^UTILITY("XQORS",$J,0,"FILE")
G SET
EX K ORNSV,XQORM Q
I '$D(XQORM("H")),$D(^ORD(101,+^UTILITY("XQORS",$J,XQORS,"VPT"),26))'[0,$L(^(26)) S XQORM("H")=^(26)
I '$D(XQORM("S")),$D(^ORD(101,+^UTILITY("XQORS",$J,XQORS,"VPT"),24))'[0,$L(^(24)) S XQORM("S")=^(24)
I '$D(XQORM("?")),$D(^ORD(101,+^UTILITY("XQORS",$J,XQORS,"VPT"),27))'[0,$L(^(27)) S XQORM("?")=^(27)
I '$D(XQORM("A")),$D(^ORD(101,+^UTILITY("XQORS",$J,XQORS,"VPT"),28))'[0,$L(^(28)) S XQORM("A")=^(28)
I '$D(XQORM("B")),$D(^ORD(101,+^UTILITY("XQORS",$J,XQORS,"VPT"),29))'[0,$L(^(29)) S XQORM("B")=^(29)
I '$D(XQORM("M")),$D(^ORD(101,+^UTILITY("XQORS",$J,XQORS,"VPT"),4))'[0,+$P(^(4),"^",2) S XQORM("M")=$P(^(4),"^",2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSXQ04 2184 printed Dec 13, 2024@02:01:06 Page 2
GMTSXQ04 ; SLC/JER - XQOR3 for Export w/Health Summary ;1/10/92 14:58
+1 ;;2.5;Health Summary;;Dec 16, 1992
XQOR3 ; SLC/KCM - Process Menus, Protocol Menus ;12/5/89 10:16 ;
+1 ;;6.52;Copyright 1990, DVA;
+1 SET ^UTILITY("XQORS",$JOB,XQORS,"ITM")=0
SET XQORM=^UTILITY("XQORS",$JOB,XQORS,"VPT")
if $DATA(XQORM(0))[0
SET XQORM(0)="AD"
IF $DATA(XQORM("S"))
IF '$LENGTH(XQORM("S"))
KILL XQORM("S")
+2 if ^UTILITY("XQORS",$JOB,0,"FILE")=";ORD(101,"
DO MENU1
if '$DATA(XQORM("H"))
SET XQORM("H")="W @IOF,*13 I $D(@(^UTILITY(""XQORS"",$J,XQORS,""REF"")_""0)"")) S X=$P(^(0),""^"",2) W ?(36-($L(X)\2)),""--- ""_X_"" ---"",!"
+3 SET X=$PIECE(^UTILITY("XQORS",$JOB,XQORS,"INP"),"^",4)
IF X[";"
DO EAT^XQORM1
IF $EXTRACT(X)'=";"
SET X=$PIECE(X,";",2,99)
SET ORNSV=XQORM(0)
SET XQORM(0)=$SELECT(+XQORM(0):+XQORM(0),1:"")_$SELECT(XQORM(0)["F":"F",1:"")
SET XQORM("H")=""
DO ^XQORM
+4 if $DATA(^UTILITY("XQORS",$JOB,XQORS,"X"))
SET X=^UTILITY("XQORS",$JOB,XQORS,"X")
+5 IF $SELECT($DATA(ORNSV):Y<0,1:1)
if $DATA(ORNSV)
SET XQORM(0)=ORNSV
DO ^XQORM
+6 SET I=0
SET SET I=$ORDER(Y(I))
if I'>0
GOTO EX
+1 SET ^UTILITY("XQORS",$JOB,XQORS,"ITM")=^UTILITY("XQORS",$JOB,XQORS,"ITM")+1
+2 SET ^UTILITY("XQORS",$JOB,XQORS,"ITM",^UTILITY("XQORS",$JOB,XQORS,"ITM"))=$PIECE(Y(I),"^",2)_^UTILITY("XQORS",$JOB,0,"FILE")
+3 SET ^UTILITY("XQORS",$JOB,XQORS,"ITM",^UTILITY("XQORS",$JOB,XQORS,"ITM"),"IN")=Y(I)
+4 IF ^UTILITY("XQORS",$JOB,0,"FILE")=";ORD(101,"
IF $DATA(^ORD(101,+^UTILITY("XQORS",$JOB,XQORS,"VPT"),10,+Y(I),0))
IF +$PIECE(^(0),"^",4)
SET ^UTILITY("XQORS",$JOB,XQORS,"ITM",^UTILITY("XQORS",$JOB,XQORS,"ITM"),"MA")=$PIECE(^(0),"^",4)_^UTILITY("XQORS",$JOB,0,"FILE")
+5 GOTO SET
EX KILL ORNSV,XQORM
QUIT
+1 IF '$DATA(XQORM("H"))
IF $DATA(^ORD(101,+^UTILITY("XQORS",$JOB,XQORS,"VPT"),26))'[0
IF $LENGTH(^(26))
SET XQORM("H")=^(26)
+2 IF '$DATA(XQORM("S"))
IF $DATA(^ORD(101,+^UTILITY("XQORS",$JOB,XQORS,"VPT"),24))'[0
IF $LENGTH(^(24))
SET XQORM("S")=^(24)
+3 IF '$DATA(XQORM("?"))
IF $DATA(^ORD(101,+^UTILITY("XQORS",$JOB,XQORS,"VPT"),27))'[0
IF $LENGTH(^(27))
SET XQORM("?")=^(27)
+4 IF '$DATA(XQORM("A"))
IF $DATA(^ORD(101,+^UTILITY("XQORS",$JOB,XQORS,"VPT"),28))'[0
IF $LENGTH(^(28))
SET XQORM("A")=^(28)
+5 IF '$DATA(XQORM("B"))
IF $DATA(^ORD(101,+^UTILITY("XQORS",$JOB,XQORS,"VPT"),29))'[0
IF $LENGTH(^(29))
SET XQORM("B")=^(29)
+6 IF '$DATA(XQORM("M"))
IF $DATA(^ORD(101,+^UTILITY("XQORS",$JOB,XQORS,"VPT"),4))'[0
IF +$PIECE(^(4),"^",2)
SET XQORM("M")=$PIECE(^(4),"^",2)
+7 QUIT
