XQOR3.m

XQOR3 ; SLC/KCM - Process Menus, Protocol Menus ;4/8/94  12:03 ; [ 04/02/2003   8:29 AM ]

 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 ;;8.0;KERNEL;;Jul 10, 1995

MENU ;From: XQOR1

 S ^TMP("XQORS",$J,XQORS,"ITM")=0,XQORM=^TMP("XQORS",$J,XQORS,"VPT") S:$D(XQORM(0))[0 XQORM(0)="AD" I $D(XQORM("S")),'$L(XQORM("S")) K XQORM("S")

 D:^TMP("XQORS",$J,0,"FILE")=";ORD(101," MENU1 S:'$D(XQORM("H")) XQORM("H")="W @IOF I $D(@(^TMP(""XQORS"",$J,XQORS,""REF"")_""0)"")) S X=$P(^(0),""^"",2) W ?(36-($L(X)\2)),""--- ""_X_"" ---"",!"

 S X=$P(^TMP("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(^TMP("XQORS",$J,XQORS,"X")) X=^TMP("XQORS",$J,XQORS,"X")

 I $S($D(ORNSV):Y<1,1:1) S:$D(ORNSV) XQORM(0)=ORNSV D ^XQORM

 S I=0

SET S I=$O(Y(I)) G:I'>0 EX

 S ^TMP("XQORS",$J,XQORS,"ITM")=^TMP("XQORS",$J,XQORS,"ITM")+1

 S ^TMP("XQORS",$J,XQORS,"ITM",^TMP("XQORS",$J,XQORS,"ITM"))=$P(Y(I),"^",2)_^TMP("XQORS",$J,0,"FILE")

 S ^TMP("XQORS",$J,XQORS,"ITM",^TMP("XQORS",$J,XQORS,"ITM"),"IN")=Y(I)

 I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(^ORD(101,+^TMP("XQORS",$J,XQORS,"VPT"),10,+Y(I),0)),+$P(^(0),"^",4) S J=$P(^(0),"^",4),^TMP("XQORS",$J,XQORS,"ITM",^TMP("XQORS",$J,XQORS,"ITM"),"MA")=J_^TMP("XQORS",$J,0,"FILE")

 G SET

EX K J,ORNSV,XQORM Q

MENU1 ;Get Protocol file specific XQORM fields

 I '$D(XQORM("H")),$D(^ORD(101,+^TMP("XQORS",$J,XQORS,"VPT"),26))'[0,$L(^(26)) S XQORM("H")=^(26)

 I '$D(XQORM("S")),$D(^ORD(101,+^TMP("XQORS",$J,XQORS,"VPT"),24))'[0,$L(^(24)) S XQORM("S")=^(24)

 I '$D(XQORM("?")),$D(^ORD(101,+^TMP("XQORS",$J,XQORS,"VPT"),27))'[0,$L(^(27)) S XQORM("?")=^(27)

 I '$D(XQORM("A")),$D(^ORD(101,+^TMP("XQORS",$J,XQORS,"VPT"),28))'[0,$L(^(28)) S XQORM("A")=^(28)

 I '$D(XQORM("B")),$D(^ORD(101,+^TMP("XQORS",$J,XQORS,"VPT"),29))'[0,$L(^(29)) S XQORM("B")=^(29)

 I '$D(XQORM("M")),$D(^ORD(101,+^TMP("XQORS",$J,XQORS,"VPT"),4))'[0,+$P(^(4),"^",2) S XQORM("M")=$P(^(4),"^",2)

 Q

XQOR3     ; SLC/KCM - Process Menus, Protocol Menus ;4/8/94  12:03 ; [ 04/02/2003   8:29 AM ]

 +1       ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 +2       ;;8.0;KERNEL;;Jul 10, 1995

MENU      ;From: XQOR1

 +1        SET ^TMP("XQORS",$JOB,XQORS,"ITM")=0

           SET XQORM=^TMP("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 ^TMP("XQORS",$JOB,0,"FILE")=";ORD(101,"

               DO MENU1

           IF '$DATA(XQORM("H"))

               SET XQORM("H")="W @IOF I $D(@(^TMP(""XQORS"",$J,XQORS,""REF"")_""0)"")) S X=$P(^(0),""^"",2) W ?(36-($L(X)\2)),""--- ""_X_"" ---"",!"

 +3        SET X=$PIECE(^TMP("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(^TMP("XQORS",$JOB,XQORS,"X"))

               SET X=^TMP("XQORS",$JOB,XQORS,"X")

 +5        IF $SELECT($DATA(ORNSV):Y<1,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 ^TMP("XQORS",$JOB,XQORS,"ITM")=^TMP("XQORS",$JOB,XQORS,"ITM")+1

 +2        SET ^TMP("XQORS",$JOB,XQORS,"ITM",^TMP("XQORS",$JOB,XQORS,"ITM"))=$PIECE(Y(I),"^",2)_^TMP("XQORS",$JOB,0,"FILE")

 +3        SET ^TMP("XQORS",$JOB,XQORS,"ITM",^TMP("XQORS",$JOB,XQORS,"ITM"),"IN")=Y(I)

 +4        IF ^TMP("XQORS",$JOB,0,"FILE")=";ORD(101,"

               IF $DATA(^ORD(101,+^TMP("XQORS",$JOB,XQORS,"VPT"),10,+Y(I),0))

                   IF +$PIECE(^(0),"^",4)

                       SET J=$PIECE(^(0),"^",4)

                       SET ^TMP("XQORS",$JOB,XQORS,"ITM",^TMP("XQORS",$JOB,XQORS,"ITM"),"MA")=J_^TMP("XQORS",$JOB,0,"FILE")

 +5        GOTO SET

EX         KILL J,ORNSV,XQORM

           QUIT 

MENU1     ;Get Protocol file specific XQORM fields

 +1        IF '$DATA(XQORM("H"))

               IF $DATA(^ORD(101,+^TMP("XQORS",$JOB,XQORS,"VPT"),26))'[0

                   IF $LENGTH(^(26))

                       SET XQORM("H")=^(26)

 +2        IF '$DATA(XQORM("S"))

               IF $DATA(^ORD(101,+^TMP("XQORS",$JOB,XQORS,"VPT"),24))'[0

                   IF $LENGTH(^(24))

                       SET XQORM("S")=^(24)

 +3        IF '$DATA(XQORM("?"))

               IF $DATA(^ORD(101,+^TMP("XQORS",$JOB,XQORS,"VPT"),27))'[0

                   IF $LENGTH(^(27))

                       SET XQORM("?")=^(27)

 +4        IF '$DATA(XQORM("A"))

               IF $DATA(^ORD(101,+^TMP("XQORS",$JOB,XQORS,"VPT"),28))'[0

                   IF $LENGTH(^(28))

                       SET XQORM("A")=^(28)

 +5        IF '$DATA(XQORM("B"))

               IF $DATA(^ORD(101,+^TMP("XQORS",$JOB,XQORS,"VPT"),29))'[0

                   IF $LENGTH(^(29))

                       SET XQORM("B")=^(29)

 +6        IF '$DATA(XQORM("M"))

               IF $DATA(^ORD(101,+^TMP("XQORS",$JOB,XQORS,"VPT"),4))'[0

                   IF +$PIECE(^(4),"^",2)

                       SET XQORM("M")=$PIECE(^(4),"^",2)

 +7        QUIT