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 ---[H[J[2J[HXQOO2 2840 printed Dec 13, 2024@02:05:51 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
