XQOO3 ;Luke/Sea - Out-Of-Order Utilities ;01/14/97 13:57
;;8.0;KERNEL;**57**;Jul 10, 1995
;
LALL ;List all options and protocols that are Out Of Order
N XQ,XQMES,XQTXT,XQIEN
S (XQIEN,XQS)=0
F Q:XQIEN'=+XQIEN D
.S XQIEN=$O(^DIC(19,XQIEN))
.Q:XQIEN'=+XQIEN
.I $D(^DIC(19,XQIEN,0)),$P(^(0),U,3)]"" D
..S XQMES=$P(^DIC(19,XQIEN,0),U,3),XQNM=$P(^(0),U),XQMT=$P(^(0),U,2)
..S ^TMP($J,"XQOO",XQMES,XQNM)=XQMT
..S:'$D(XQ(XQMES)) XQ(XQMES)=0,XQS=XQS+1 S XQ(XQMES)=XQ(XQMES)+1
..Q
.Q
;
I XQS=0 W !,"No options marked ""Out-Of-Order"" were found." Q
I XQS=1 D
.S XQMES="",XQMES=$O(XQ(XQMES))
.W !,"There is one set of options marked ""Out-Of-Order"" with the message:",!!?5,XQMES
.S XQN(1)=XQMES,XQUR=1
.Q
I XQS>1 W !,"There are "_XQS_" sets of options Out-Of-Order with the messages:" S %="" F XQI=1:1:XQS D
.S %=$O(XQ(%)) W !!?1,XQI_".",?4,%," ("_XQ(%)_" option"_$S(XQ(%)=1:":",1:"s)")
.I XQ(%)=1 S X=$O(^TMP($J,"XQOO",%,"")) W " ",X,", ",^(X),")"
.S XQN(XQI)=%
.Q
;
ASK3 ;See a particular set in detail
S DIR(0)="Y",DIR("A")="Would you like to see more detail?"
S DIR("B")="NO",DIR("?")="If you enter YES you can see the options/protocols of a set."
W ! D ^DIR G:Y=0!($D(DIRUT)) OUT
I XQS>1 W !!,"To see the options of a particular set enter a number between 1 and "_XQS_": " R XQUR:DTIME
I XQUR=U!(XQUR="") G OUT
I XQUR["?"!(XQUR'=+XQUR)!(XQUR>XQS)!(XQUR<1) W !?5,"Enter a number between 1 and "_XQS,!?5,"or ""^"" to quit without seeing a detailed option set." G ASK3
I XQUR=U!(XQUR="") G OUT
S XQMES=XQN(XQUR)
D HEAD(XQMES)
S %=0 F XQI=1:1 S %=$O(^TMP($J,"XQOO",XQMES,%)) Q:%="" W !,XQI_".",?5,%," ",^(%)
G OUT
Q
;
HEAD(XQMES) ;Print page header
W @IOF
W !,"Out-Of-Order with the message """_XQMES_"""",!!
Q
;
OUT ;Clean up and quit
K X,XQI,XQMT,XQN,XQNM,XQS,XQUR
K ^TMP($J,"XQOO")
W !
Q
;
LAPR ;List all the protocols that are OOO
N XQ,XQMES,XQTXT,XQIEN
S (XQIEN,XQS)=0
F Q:XQIEN'=+XQIEN D
.S XQIEN=$O(^ORD(101,XQIEN))
.Q:XQIEN'=+XQIEN
.I $D(^ORD(101,XQIEN,0)),$P(^(0),U,3)]"" D
..S XQMES=$P(^ORD(101,XQIEN,0),U,3),XQNM=$P(^(0),U),XQMT=$P(^(0),U,2)
..S ^TMP($J,"XQOO",XQMES,XQNM)=XQMT
..S:'$D(XQ(XQMES)) XQ(XQMES)=0,XQS=XQS+1 S XQ(XQMES)=XQ(XQMES)+1
..Q
.Q
;
I XQS=0 W !,"No protocols marked ""Out-Of-Order"" were found." Q
I XQS=1 D
.S XQMES="",XQMES=$O(XQ(XQMES))
.W !,"There is one set of protocols marked ""Out-Of-Order"" with the message:",!!?5,XQMES
.S XQN(1)=XQMES
.Q
I XQS>1 W !,"There are "_XQS_" sets of protocols Out-Of-Order with the messages:" S %="" F XQI=1:1:XQS D
.S %=$O(XQ(%)) W !!?1,XQI_".",?4,%," ("_XQ(%)_" protocol"_$S(XQ(%)=1:":",1:"s)")
.I XQ(%)=1 S X=$O(^TMP($J,"XQOO",%,"")) W " ",X,", ",^(X),")"
.S XQN(XQI)=%
.Q
;
ASK4 ;See a particular set in detail
I XQS>1 D I XQUR=U G OUT
.W !!,"To see the protocols of a particular set enter a number between 1 and "_XQS_": " R XQUR:DTIME
.I XQUR=U!(XQUR="") S XQUR=U Q
.I XQUR["?"!(XQUR'=+XQUR)!(XQUR>XQS)!(XQUR<1) D
..W !?5,"Enter a number between 1 and "_XQS,!?5,"or ""^"" to quit without seeing a detailed set." R XQUR:DTIME
..I XQUR=U!(XQUR="") S XQUR=U Q
..I XQUR'=+XQUR!(XQUR>XQS)!(XQUR<1) S XQUR=U
..Q
.Q
;
I XQS=1 D I XQUR=U G OUT
.S DIR(0)="Y",DIR("A")="Do you want to see it in detail? ",DIR("B")="Y" D ^DIR K DIR
.S XQUR=$S(Y=1:1,1:U)
.Q
;
S XQPAGE=$S($D(IOSL):IOSL,1:20),XQLINE=2
S XQMES=XQN(XQUR)
D HEAD(XQMES)
S %=0 F XQI=1:1 S %=$O(^TMP($J,"XQOO",XQMES,%)) Q:%="" W !,XQI_".",?5,%," ",^(%),XQLINE," ",XQPAGE S XQLINE=XQLINE+1 I XQLINE=XQPAGE D PAUSE^XQOO2 S XQLINE=0 Q:$D(XQUPAR)
G OUT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQOO3 3673 printed Apr 09, 2024@21:05:17 Page 2
XQOO3 ;Luke/Sea - Out-Of-Order Utilities ;01/14/97 13:57
+1 ;;8.0;KERNEL;**57**;Jul 10, 1995
+2 ;
LALL ;List all options and protocols that are Out Of Order
+1 NEW XQ,XQMES,XQTXT,XQIEN
+2 SET (XQIEN,XQS)=0
+3 FOR
if XQIEN'=+XQIEN
QUIT
Begin DoDot:1
+4 SET XQIEN=$ORDER(^DIC(19,XQIEN))
+5 if XQIEN'=+XQIEN
QUIT
+6 IF $DATA(^DIC(19,XQIEN,0))
IF $PIECE(^(0),U,3)]""
Begin DoDot:2
+7 SET XQMES=$PIECE(^DIC(19,XQIEN,0),U,3)
SET XQNM=$PIECE(^(0),U)
SET XQMT=$PIECE(^(0),U,2)
+8 SET ^TMP($JOB,"XQOO",XQMES,XQNM)=XQMT
+9 if '$DATA(XQ(XQMES))
SET XQ(XQMES)=0
SET XQS=XQS+1
SET XQ(XQMES)=XQ(XQMES)+1
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 ;
+13 IF XQS=0
WRITE !,"No options marked ""Out-Of-Order"" were found."
QUIT
+14 IF XQS=1
Begin DoDot:1
+15 SET XQMES=""
SET XQMES=$ORDER(XQ(XQMES))
+16 WRITE !,"There is one set of options marked ""Out-Of-Order"" with the message:",!!?5,XQMES
+17 SET XQN(1)=XQMES
SET XQUR=1
+18 QUIT
End DoDot:1
+19 IF XQS>1
WRITE !,"There are "_XQS_" sets of options Out-Of-Order with the messages:"
SET %=""
FOR XQI=1:1:XQS
Begin DoDot:1
+20 SET %=$ORDER(XQ(%))
WRITE !!?1,XQI_".",?4,%," ("_XQ(%)_" option"_$SELECT(XQ(%)=1:":",1:"s)")
+21 IF XQ(%)=1
SET X=$ORDER(^TMP($JOB,"XQOO",%,""))
WRITE " ",X,", ",^(X),")"
+22 SET XQN(XQI)=%
+23 QUIT
End DoDot:1
+24 ;
ASK3 ;See a particular set in detail
+1 SET DIR(0)="Y"
SET DIR("A")="Would you like to see more detail?"
+2 SET DIR("B")="NO"
SET DIR("?")="If you enter YES you can see the options/protocols of a set."
+3 WRITE !
DO ^DIR
if Y=0!($DATA(DIRUT))
GOTO OUT
+4 IF XQS>1
WRITE !!,"To see the options of a particular set enter a number between 1 and "_XQS_": "
READ XQUR:DTIME
+5 IF XQUR=U!(XQUR="")
GOTO OUT
+6 IF XQUR["?"!(XQUR'=+XQUR)!(XQUR>XQS)!(XQUR<1)
WRITE !?5,"Enter a number between 1 and "_XQS,!?5,"or ""^"" to quit without seeing a detailed option set."
GOTO ASK3
+7 IF XQUR=U!(XQUR="")
GOTO OUT
+8 SET XQMES=XQN(XQUR)
+9 DO HEAD(XQMES)
+10 SET %=0
FOR XQI=1:1
SET %=$ORDER(^TMP($JOB,"XQOO",XQMES,%))
if %=""
QUIT
WRITE !,XQI_".",?5,%," ",^(%)
+11 GOTO OUT
+12 QUIT
+13 ;
HEAD(XQMES) ;Print page header
+1 WRITE @IOF
+2 WRITE !,"Out-Of-Order with the message """_XQMES_"""",!!
+3 QUIT
+4 ;
OUT ;Clean up and quit
+1 KILL X,XQI,XQMT,XQN,XQNM,XQS,XQUR
+2 KILL ^TMP($JOB,"XQOO")
+3 WRITE !
+4 QUIT
+5 ;
LAPR ;List all the protocols that are OOO
+1 NEW XQ,XQMES,XQTXT,XQIEN
+2 SET (XQIEN,XQS)=0
+3 FOR
if XQIEN'=+XQIEN
QUIT
Begin DoDot:1
+4 SET XQIEN=$ORDER(^ORD(101,XQIEN))
+5 if XQIEN'=+XQIEN
QUIT
+6 IF $DATA(^ORD(101,XQIEN,0))
IF $PIECE(^(0),U,3)]""
Begin DoDot:2
+7 SET XQMES=$PIECE(^ORD(101,XQIEN,0),U,3)
SET XQNM=$PIECE(^(0),U)
SET XQMT=$PIECE(^(0),U,2)
+8 SET ^TMP($JOB,"XQOO",XQMES,XQNM)=XQMT
+9 if '$DATA(XQ(XQMES))
SET XQ(XQMES)=0
SET XQS=XQS+1
SET XQ(XQMES)=XQ(XQMES)+1
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 ;
+13 IF XQS=0
WRITE !,"No protocols marked ""Out-Of-Order"" were found."
QUIT
+14 IF XQS=1
Begin DoDot:1
+15 SET XQMES=""
SET XQMES=$ORDER(XQ(XQMES))
+16 WRITE !,"There is one set of protocols marked ""Out-Of-Order"" with the message:",!!?5,XQMES
+17 SET XQN(1)=XQMES
+18 QUIT
End DoDot:1
+19 IF XQS>1
WRITE !,"There are "_XQS_" sets of protocols Out-Of-Order with the messages:"
SET %=""
FOR XQI=1:1:XQS
Begin DoDot:1
+20 SET %=$ORDER(XQ(%))
WRITE !!?1,XQI_".",?4,%," ("_XQ(%)_" protocol"_$SELECT(XQ(%)=1:":",1:"s)")
+21 IF XQ(%)=1
SET X=$ORDER(^TMP($JOB,"XQOO",%,""))
WRITE " ",X,", ",^(X),")"
+22 SET XQN(XQI)=%
+23 QUIT
End DoDot:1
+24 ;
ASK4 ;See a particular set in detail
+1 IF XQS>1
Begin DoDot:1
+2 WRITE !!,"To see the protocols of a particular set enter a number between 1 and "_XQS_": "
READ XQUR:DTIME
+3 IF XQUR=U!(XQUR="")
SET XQUR=U
QUIT
+4 IF XQUR["?"!(XQUR'=+XQUR)!(XQUR>XQS)!(XQUR<1)
Begin DoDot:2
+5 WRITE !?5,"Enter a number between 1 and "_XQS,!?5,"or ""^"" to quit without seeing a detailed set."
READ XQUR:DTIME
+6 IF XQUR=U!(XQUR="")
SET XQUR=U
QUIT
+7 IF XQUR'=+XQUR!(XQUR>XQS)!(XQUR<1)
SET XQUR=U
+8 QUIT
End DoDot:2
+9 QUIT
End DoDot:1
IF XQUR=U
GOTO OUT
+10 ;
+11 IF XQS=1
Begin DoDot:1
+12 SET DIR(0)="Y"
SET DIR("A")="Do you want to see it in detail? "
SET DIR("B")="Y"
DO ^DIR
KILL DIR
+13 SET XQUR=$SELECT(Y=1:1,1:U)
+14 QUIT
End DoDot:1
IF XQUR=U
GOTO OUT
+15 ;
+16 SET XQPAGE=$SELECT($DATA(IOSL):IOSL,1:20)
SET XQLINE=2
+17 SET XQMES=XQN(XQUR)
+18 DO HEAD(XQMES)
+19 SET %=0
FOR XQI=1:1
SET %=$ORDER(^TMP($JOB,"XQOO",XQMES,%))
if %=""
QUIT
WRITE !,XQI_".",?5,%," ",^(%),XQLINE," ",XQPAGE
SET XQLINE=XQLINE+1
IF XQLINE=XQPAGE
DO PAUSE^XQOO2
SET XQLINE=0
if $DATA(XQUPAR)
QUIT
+20 GOTO OUT
+21 QUIT
