- 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 Feb 18, 2025@23:32:18 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