XUTMONH1 ;SEA/RDS - TaskMan: Option, XUTMON, Part 4 (Help Modules) ;5/12/94 12:11
;;8.0;KERNEL;;Jul 10, 1995
;
Q
;
PRINT ;Subroutine--Print A Task
N ZTMT,ZTSK W:'ZTC @IOF,!,ZTH,! W:'ZTF !,"-------------------------------------------------------------------------------"
S X=0,ZTF=0 D EN^XUTMTP(ZTS) I $Y>18 W ! S ZTF=1,DIR(0)="E" D ^DIR S X=$D(DTOUT)!$D(DUOUT) Q:X W @IOF
S ZTC=ZTC+1 Q
;
OUT ;Tag for breaking FOR scope to exit early
Q
;
SCHED ;Display Schedule List
N DIR,DIRUT,DTOUT,DUOUT,X,ZT,ZT1,ZTC,ZTF,ZTH,ZTS S ZTC=0,ZTF=1,ZTH="Schedule list..."
S ZT1="" F ZT=0:0 S ZT1=$O(^%ZTSCH(ZT1)) Q:'ZT1 F ZTS=0:0 S ZTS=$O(^%ZTSCH(ZT1,ZTS)) Q:'ZTS D PRINT S ZTC=ZTC+1 G OUT:X
I 'ZTC W !!,"The Schedule List is empty."
W ! S DIR(0)="E",DIR("A")=$S(ZTC:"End of listing. ",1:"")_"Press RETURN to continue" D ^DIR Q
;
WAIT ;Display Waiting Lists
N DIR,DIRUT,DTOUT,DUOUT,X,ZT,ZT1,ZT2,ZT3,ZTC,ZTF,ZTH,ZTS S ZTC=0,ZTF=1,ZTH="Device waiting lists..."
S ZT1="" F ZT=0:0 S ZT1=$O(^%ZTSCH("IO",ZT1)),ZT2="" Q:ZT1="" F ZT=0:0 S ZT2=$O(^%ZTSCH("IO",ZT1,ZT2)),ZT3="" Q:'ZT2 F ZT=0:0 S ZT3=$O(^%ZTSCH("IO",ZT1,ZT2,ZT3)) Q:ZT3="" D W0 G OUT:X
I 'ZTC W !!,"The Device Waiting Lists are empty."
W ! S DIR(0)="E",DIR("A")=$S(ZTC:"End of listing. ",1:"")_"Press RETURN to continue" D ^DIR Q
;
W0 ;WAIT Subroutine--Extending IO Loop
S ZTS=ZT3 D PRINT S ZTC=ZTC+1 Q:X
Q
;
WAIT1 ;Display One Waiting List
N DIR,DIRUT,DTOUT,DUOUT,X,ZT,ZT1,ZT2,ZT3,ZTC,ZTF,ZTH,ZTIO,ZTION,ZTS
F ZT=0:0 D W2 Q:ZTION="" S ZT1=ZTIO D W1 Q:X
Q
;
W1 ;WAIT1 Subroutine--Extending Loop
S ZTC=0,ZTF=1,ZTH="Waiting list for device "_ZTION_"..."
S X=0,ZTC=0,ZT2="" F ZT=0:0 S ZT2=$O(^%ZTSCH("IO",ZT1,ZT2)),ZT3="" Q:'ZT2 F ZT=0:0 S ZT3=$O(^%ZTSCH("IO",ZT1,ZT2,ZT3)) Q:ZT3="" S ZTS=ZT3 D PRINT S ZTC=ZTC+1 G OUT:X
Q:X W:'ZTC !?5,"There are no tasks waiting for device ",ZTION,"." W ! Q
;
W2 ;WAIT1--prompt user for a device
S DIR(0)="PO^3.5:EMQZ"
S DIR("A")="Select DEVICE"
S DIR("?",1)=" Answer should be a device whose waiting list you want to see."
S DIR("?")=" Enter ?? for a list of devices with waiting tasks."
S DIR("??")="^D W3^XUTMONH1"
D ^DIR K DIR
I $D(DTOUT) W $C(7)
I $D(DIRUT) S ZTION="" Q
S ZTION=$P(Y,U,2),ZTIO=$P(Y(0),U,2)
Q
;
W3 ;W2--?? help for device selection
N ZT,ZT1,ZT2,ZT3,ZT4,ZTC
W !!?5,"These are the devices with waiting tasks:",!
S ZT1="IO",ZT2="" F ZT=0:0 S ZT2=$O(^%ZTSCH(ZT1,ZT2)) Q:ZT2="" W !?5,ZT2 D WCNT W ?40,ZTC," task",$S(ZTC=1:"",1:"s")
Q
;
WCNT ;W3--count tasks waiting for each device
S ZT3="",ZTC=0 F ZT=0:0 S ZT3=$O(^%ZTSCH(ZT1,ZT2,ZT3)),ZT4="" Q:ZT3="" F ZT=0:0 S ZT4=$O(^%ZTSCH(ZT1,ZT2,ZT3,ZT4)) Q:ZT4="" S ZTC=ZTC+1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUTMONH1 2743 printed Dec 13, 2024@02:13:24 Page 2
XUTMONH1 ;SEA/RDS - TaskMan: Option, XUTMON, Part 4 (Help Modules) ;5/12/94 12:11
+1 ;;8.0;KERNEL;;Jul 10, 1995
+2 ;
+3 QUIT
+4 ;
PRINT ;Subroutine--Print A Task
+1 NEW ZTMT,ZTSK
if 'ZTC
WRITE @IOF,!,ZTH,!
if 'ZTF
WRITE !,"-------------------------------------------------------------------------------"
+2 SET X=0
SET ZTF=0
DO EN^XUTMTP(ZTS)
IF $Y>18
WRITE !
SET ZTF=1
SET DIR(0)="E"
DO ^DIR
SET X=$DATA(DTOUT)!$DATA(DUOUT)
if X
QUIT
WRITE @IOF
+3 SET ZTC=ZTC+1
QUIT
+4 ;
OUT ;Tag for breaking FOR scope to exit early
+1 QUIT
+2 ;
SCHED ;Display Schedule List
+1 NEW DIR,DIRUT,DTOUT,DUOUT,X,ZT,ZT1,ZTC,ZTF,ZTH,ZTS
SET ZTC=0
SET ZTF=1
SET ZTH="Schedule list..."
+2 SET ZT1=""
FOR ZT=0:0
SET ZT1=$ORDER(^%ZTSCH(ZT1))
if 'ZT1
QUIT
FOR ZTS=0:0
SET ZTS=$ORDER(^%ZTSCH(ZT1,ZTS))
if 'ZTS
QUIT
DO PRINT
SET ZTC=ZTC+1
if X
GOTO OUT
+3 IF 'ZTC
WRITE !!,"The Schedule List is empty."
+4 WRITE !
SET DIR(0)="E"
SET DIR("A")=$SELECT(ZTC:"End of listing. ",1:"")_"Press RETURN to continue"
DO ^DIR
QUIT
+5 ;
WAIT ;Display Waiting Lists
+1 NEW DIR,DIRUT,DTOUT,DUOUT,X,ZT,ZT1,ZT2,ZT3,ZTC,ZTF,ZTH,ZTS
SET ZTC=0
SET ZTF=1
SET ZTH="Device waiting lists..."
+2 SET ZT1=""
FOR ZT=0:0
SET ZT1=$ORDER(^%ZTSCH("IO",ZT1))
SET ZT2=""
if ZT1=""
QUIT
FOR ZT=0:0
SET ZT2=$ORDER(^%ZTSCH("IO",ZT1,ZT2))
SET ZT3=""
if 'ZT2
QUIT
FOR ZT=0:0
SET ZT3=$ORDER(^%ZTSCH("IO",ZT1,ZT2,ZT3))
if ZT3=""
QUIT
DO W0
if X
GOTO OUT
+3 IF 'ZTC
WRITE !!,"The Device Waiting Lists are empty."
+4 WRITE !
SET DIR(0)="E"
SET DIR("A")=$SELECT(ZTC:"End of listing. ",1:"")_"Press RETURN to continue"
DO ^DIR
QUIT
+5 ;
W0 ;WAIT Subroutine--Extending IO Loop
+1 SET ZTS=ZT3
DO PRINT
SET ZTC=ZTC+1
if X
QUIT
+2 QUIT
+3 ;
WAIT1 ;Display One Waiting List
+1 NEW DIR,DIRUT,DTOUT,DUOUT,X,ZT,ZT1,ZT2,ZT3,ZTC,ZTF,ZTH,ZTIO,ZTION,ZTS
+2 FOR ZT=0:0
DO W2
if ZTION=""
QUIT
SET ZT1=ZTIO
DO W1
if X
QUIT
+3 QUIT
+4 ;
W1 ;WAIT1 Subroutine--Extending Loop
+1 SET ZTC=0
SET ZTF=1
SET ZTH="Waiting list for device "_ZTION_"..."
+2 SET X=0
SET ZTC=0
SET ZT2=""
FOR ZT=0:0
SET ZT2=$ORDER(^%ZTSCH("IO",ZT1,ZT2))
SET ZT3=""
if 'ZT2
QUIT
FOR ZT=0:0
SET ZT3=$ORDER(^%ZTSCH("IO",ZT1,ZT2,ZT3))
if ZT3=""
QUIT
SET ZTS=ZT3
DO PRINT
SET ZTC=ZTC+1
if X
GOTO OUT
+3 if X
QUIT
if 'ZTC
WRITE !?5,"There are no tasks waiting for device ",ZTION,"."
WRITE !
QUIT
+4 ;
W2 ;WAIT1--prompt user for a device
+1 SET DIR(0)="PO^3.5:EMQZ"
+2 SET DIR("A")="Select DEVICE"
+3 SET DIR("?",1)=" Answer should be a device whose waiting list you want to see."
+4 SET DIR("?")=" Enter ?? for a list of devices with waiting tasks."
+5 SET DIR("??")="^D W3^XUTMONH1"
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DTOUT)
WRITE $CHAR(7)
+8 IF $DATA(DIRUT)
SET ZTION=""
QUIT
+9 SET ZTION=$PIECE(Y,U,2)
SET ZTIO=$PIECE(Y(0),U,2)
+10 QUIT
+11 ;
W3 ;W2--?? help for device selection
+1 NEW ZT,ZT1,ZT2,ZT3,ZT4,ZTC
+2 WRITE !!?5,"These are the devices with waiting tasks:",!
+3 SET ZT1="IO"
SET ZT2=""
FOR ZT=0:0
SET ZT2=$ORDER(^%ZTSCH(ZT1,ZT2))
if ZT2=""
QUIT
WRITE !?5,ZT2
DO WCNT
WRITE ?40,ZTC," task",$SELECT(ZTC=1:"",1:"s")
+4 QUIT
+5 ;
WCNT ;W3--count tasks waiting for each device
+1 SET ZT3=""
SET ZTC=0
FOR ZT=0:0
SET ZT3=$ORDER(^%ZTSCH(ZT1,ZT2,ZT3))
SET ZT4=""
if ZT3=""
QUIT
FOR ZT=0:0
SET ZT4=$ORDER(^%ZTSCH(ZT1,ZT2,ZT3,ZT4))
if ZT4=""
QUIT
SET ZTC=ZTC+1
+2 QUIT
+3 ;
