XQOO2.m

XQOO2 ;LUKE/SEATTLE - Out Of Order Manager Utilities ;06/16/95  14:40

 ;;8.0;KERNEL;;Jul 10, 1995

 ;

SETS(XQI) ;Show the sets of options in ^XTMP return # in XQI

EN ;Option entry doesn't care about XQI

 N XQ,XQD,XQF,XQFLG,XQM,XQO,XQOO,XQU

 S (XQD,XQU)="",XQ=0

 I $O(^XTMP("XQOO",0))="" W !,"There are no defined option sets currently listed in ^XTMP." Q

 F XQI=1:1 S XQ=$O(^XTMP("XQOO",XQ)) Q:XQ=""  D

 .I '$D(^XTMP("XQOO",XQ,0))#2 D

 ..W !,XQI_".",?5,"Option set named '",XQ,"' Unknown creator or date of creation!"

 ..W !?5,*7,"Warning: Incomplete option set named '",XQ,"' with no zeroth node."

 ..S XQFLG=""

 ..Q

 .I $D(XQFLG) K XQFLG Q

 .S XQMESS=$P(^XTMP("XQOO",XQ,0),U),XQD=$P(^(0),U,2),XQU=$P(^(0),U,3)

 .W !!,XQI_".",?5,"Option set named '",XQ,"' created on ",XQD," by ",XQU

 .I $O(^XTMP("XQOO",XQ,0))'="" D

 ..S XQF=$O(^XTMP("XQOO",XQ,0)),XQO=$O(^XTMP("XQOO",XQ,XQF,0))

 ..S XQM=$P(^XTMP("XQOO",XQ,0),U),XQOO=""

 ..I XQF=19,$D(^DIC(19,XQO,0)) S XQOO=$P(^DIC(19,XQO,0),U,3)

 ..E  S:$D(^ORD(101,XQO,0)) XQOO=$P(^ORD(101,XQO,0),U,3)

 ..I XQOO=XQM W !?5,XQ,"'s options/protocols appear to be Out-Of-Order."

 ..E  W !?5,XQ,"'s options/protocols do not appear to be marked Out-Of-Order."

 ..Q

 .Q

 W !

 S XQI=XQI-1

 Q

 ;

BXREF(XQSTART,XQEND) ;List from XQSTART to XQEND in the "B" cross reference.

 N %,XQI,XQN

 S:'$D(IOSL)#2 IOSL=24

 I $L(XQSTART)>1 S %=$E(XQSTART,1,$L(XQSTART)-1)_$C($A($E(XQSTART,$L(XQSTART)))-1)_"z"

 E  S %=XQSTART

 W @IOF,"This range includes the following options:",!

 F XQI=1:1 Q:%=XQEND  S %=$O(^DIC(19,"B",%)) Q:%=""!($E(%,1,$L(XQEND))]XQEND)  S XQN=$O(^(%,0)) W !,%,"   ",$P(^DIC(19,XQN,0),U,2) D:XQI#(IOSL-3)=0 PAUSE I $D(XQUPAR) K XQUPAR G OUT

 D:XQI#(IOSL-3)'=0 PAUSE

 W @IOF,"And the following protocols:",!

 W !!,XQSTART,"  ",XQEND

 S %=XQSTART

 F XQI=1:1 Q:%=XQEND  S %=$O(^ORD(101,"B",%)) Q:%=""!($E(%,1,$L(XQEND))]XQEND)  S XQN=$O(^(%,0)) W !,%,"   ",$P(^ORD(101,XQN,0),U,2) D:XQI#(IOSL-3)=0 PAUSE I $D(XQUPAR) K XQUPAR Q

 Q

 ;

RANGE(XQS,XQE,XQR) ;Get a range of Options from XQS(tart) to XQE(nd)

 ;

 S DIR(0)="Y",DIR("A")="List all options in the Option File",DIR("B")="No" D ^DIR G:$D(DIRUT) OUT1 I Y S XQS="z",XQE="ZZZZZZZZ",XQR=1 G OUT

XQS R !?5,"From: ",XQS:DTIME S:'$T XQS=U G:XQS=U OUT1

 I XQS="?"!($L(XQS)>30)!(XQS=+XQS)!(XQS="") W *7,!?10,"Enter a partial option name, e.g., ""XQ"", or ""^"" to quit." G XQS

XQE R !?5,"To: ",XQE:DTIME S:'$T XQE=U G:XQE=U OUT1

 I XQE="?" W !,"Enter a partial option name, e.g. ""SD"", or ""^"" to quit." G XQE

 I XQE']XQS W *7,"The ending value preceeds the starting value." G XQS

OUT ;Normal exit

 S XQR=1

 K DIR

 Q

OUT1 ;Failure exit

 S (XQR,XQS,XQE)=0

 K DIR

 Q

 ;

PAUSE ;Hold screen

 N XQ

 R !!,"Hit RETURN to continue, or type ""^"" to quit: ",XQ:DTIME

 I XQ=U S XQUPAR="" Q

 E  W !

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XQOO2   2840     printed  Mar 13, 2025@21:10:45                                                                                                                                                                                                       Page 2

XQOO2     ;LUKE/SEATTLE - Out Of Order Manager Utilities ;06/16/95  14:40

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

 +2       ;

SETS(XQI) ;Show the sets of options in ^XTMP return # in XQI

EN        ;Option entry doesn't care about XQI

 +1        NEW XQ,XQD,XQF,XQFLG,XQM,XQO,XQOO,XQU

 +2        SET (XQD,XQU)=""

           SET XQ=0

 +3        IF $ORDER(^XTMP("XQOO",0))=""

               WRITE !,"There are no defined option sets currently listed in ^XTMP."

               QUIT 

 +4        FOR XQI=1:1

               SET XQ=$ORDER(^XTMP("XQOO",XQ))

               if XQ=""

                   QUIT 

               Begin DoDot:1

 +5                IF '$DATA(^XTMP("XQOO",XQ,0))#2

                       Begin DoDot:2

 +6                        WRITE !,XQI_".",?5,"Option set named '",XQ,"' Unknown creator or date of creation!"

 +7                        WRITE !?5,*7,"Warning: Incomplete option set named '",XQ,"' with no zeroth node."

 +8                        SET XQFLG=""

 +9                        QUIT 

                       End DoDot:2

 +10               IF $DATA(XQFLG)

                       KILL XQFLG

                       QUIT 

 +11               SET XQMESS=$PIECE(^XTMP("XQOO",XQ,0),U)

                   SET XQD=$PIECE(^(0),U,2)

                   SET XQU=$PIECE(^(0),U,3)

 +12               WRITE !!,XQI_".",?5,"Option set named '",XQ,"' created on ",XQD," by ",XQU

 +13               IF $ORDER(^XTMP("XQOO",XQ,0))'=""

                       Begin DoDot:2

 +14                       SET XQF=$ORDER(^XTMP("XQOO",XQ,0))

                           SET XQO=$ORDER(^XTMP("XQOO",XQ,XQF,0))

 +15                       SET XQM=$PIECE(^XTMP("XQOO",XQ,0),U)

                           SET XQOO=""

 +16                       IF XQF=19

                               IF $DATA(^DIC(19,XQO,0))

                                   SET XQOO=$PIECE(^DIC(19,XQO,0),U,3)

 +17                      IF '$TEST

                               if $DATA(^ORD(101,XQO,0))

                                   SET XQOO=$PIECE(^ORD(101,XQO,0),U,3)

 +18                       IF XQOO=XQM

                               WRITE !?5,XQ,"'s options/protocols appear to be Out-Of-Order."

 +19                      IF '$TEST

                               WRITE !?5,XQ,"'s options/protocols do not appear to be marked Out-Of-Order."

 +20                       QUIT 

                       End DoDot:2

 +21               QUIT 

               End DoDot:1

 +22       WRITE !

 +23       SET XQI=XQI-1

 +24       QUIT 

 +25      ;

BXREF(XQSTART,XQEND) ;List from XQSTART to XQEND in the "B" cross reference.

 +1        NEW %,XQI,XQN

 +2        if '$DATA(IOSL)#2

               SET IOSL=24

 +3        IF $LENGTH(XQSTART)>1

               SET %=$EXTRACT(XQSTART,1,$LENGTH(XQSTART)-1)_$CHAR($ASCII($EXTRACT(XQSTART,$LENGTH(XQSTART)))-1)_"z"

 +4       IF '$TEST

               SET %=XQSTART

 +5        WRITE @IOF,"This range includes the following options:",!

 +6        FOR XQI=1:1

               if %=XQEND

                   QUIT 

               SET %=$ORDER(^DIC(19,"B",%))

               if %=""!($EXTRACT(%,1,$LENGTH(XQEND))]XQEND)

                   QUIT 

               SET XQN=$ORDER(^(%,0))

               WRITE !,%,"   ",$PIECE(^DIC(19,XQN,0),U,2)

               if XQI#(IOSL-3)=0

                   DO PAUSE

               IF $DATA(XQUPAR)

                   KILL XQUPAR

                   GOTO OUT

 +7        if XQI#(IOSL-3)'=0

               DO PAUSE

 +8        WRITE @IOF,"And the following protocols:",!

 +9        WRITE !!,XQSTART,"  ",XQEND

 +10       SET %=XQSTART

 +11       FOR XQI=1:1

               if %=XQEND

                   QUIT 

               SET %=$ORDER(^ORD(101,"B",%))

               if %=""!($EXTRACT(%,1,$LENGTH(XQEND))]XQEND)

                   QUIT 

               SET XQN=$ORDER(^(%,0))

               WRITE !,%,"   ",$PIECE(^ORD(101,XQN,0),U,2)

               if XQI#(IOSL-3)=0

                   DO PAUSE

               IF $DATA(XQUPAR)

                   KILL XQUPAR

                   QUIT 

 +12       QUIT 

 +13      ;

RANGE(XQS,XQE,XQR) ;Get a range of Options from XQS(tart) to XQE(nd)

 +1       ;

 +2        SET DIR(0)="Y"

           SET DIR("A")="List all options in the Option File"

           SET DIR("B")="No"

           DO ^DIR

           if $DATA(DIRUT)

               GOTO OUT1

           IF Y

               SET XQS="z"

               SET XQE="ZZZZZZZZ"

               SET XQR=1

               GOTO OUT

XQS        READ !?5,"From: ",XQS:DTIME

           if '$TEST

               SET XQS=U

           if XQS=U

               GOTO OUT1

 +1        IF XQS="?"!($LENGTH(XQS)>30)!(XQS=+XQS)!(XQS="")

               WRITE *7,!?10,"Enter a partial option name, e.g., ""XQ"", or ""^"" to quit."

               GOTO XQS

XQE        READ !?5,"To: ",XQE:DTIME

           if '$TEST

               SET XQE=U

           if XQE=U

               GOTO OUT1

 +1        IF XQE="?"

               WRITE !,"Enter a partial option name, e.g. ""SD"", or ""^"" to quit."

               GOTO XQE

 +2        IF XQE']XQS

               WRITE *7,"The ending value preceeds the starting value."

               GOTO XQS

OUT       ;Normal exit

 +1        SET XQR=1

 +2        KILL DIR

 +3        QUIT 

OUT1      ;Failure exit

 +1        SET (XQR,XQS,XQE)=0

 +2        KILL DIR

 +3        QUIT 

 +4       ;

PAUSE     ;Hold screen

 +1        NEW XQ

 +2        READ !!,"Hit RETURN to continue, or type ""^"" to quit: ",XQ:DTIME

 +3        IF XQ=U

               SET XQUPAR=""

               QUIT 

 +4       IF '$TEST

               WRITE !

 +5        QUIT