source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUTMQ2.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
RevLine 
[613]1XUTMQ2 ;SEA/RDS - TaskMan: Option, XUTMINQ, Part 4 (Modules) ;6/21/95 16:25
2 ;;8.0;KERNEL;;Jul 10, 1995
3 ;
4ENTRY G ^XUTMQ
5 ;
6PRINT ;Subroutine--Print A Task
7 N XUTMT,ZTSK W:'ZTC @IOF,!,ZTH,! W:'ZTF !,"-------------------------------------------------------------------------------"
8 S X=0,ZTC=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
9 S ZTC=ZTC+1 Q
10 ;
11OUT ;Tag for breaking FOR scope to exit early
12 Q
13 ;
14LINK ;Cross-cpu waiting lists.
15 N DIR,DIRUT,DTOUT,DUOUT,X,ZT,ZT1,ZT2,ZTC,ZTF,ZTH,ZTS S ZTC=0,ZTF=1,ZTH="Tasks waiting for dropped links..."
16 S ZT1="" F ZT=0:0 S ZT1=$O(^%ZTSCH("LINK",ZT1)),ZT2="" Q:ZT1="" F ZT=0:0 S ZT2=$O(^%ZTSCH("LINK",ZT1,ZT2)) Q:'ZT2 F ZTS=0:0 S ZTS=$O(^%ZTSCH("LINK",ZT1,ZT2,ZTS)) Q:'ZTS D PRINT G OUT:X
17 I 'ZTC W !!,"There are no tasks on this volume set that are waiting for dropped links."
18 W ! S DIR(0)="E",DIR("A")=$S(ZTC:"End of listing. ",1:"")_"Press RETURN to continue" D ^DIR Q
19 ;
20RUN ;Running tasks.
21 N XUTMT,ZTSK,ZT1
22 I ^%ZOSF("OS")["VAX DSM" F ZT1=0:0 D VAX1 Q:ZT1'>0
23 S XUTMT(0)="R4"
24 S XUTMT("CLEAR")=1
25 S XUTMT("EOL")=1
26 S XUTMT("HEADER")="Running tasks..."
27 S XUTMT("NODE")="^%ZTSCH(""TASK"","
28 S XUTMT("NONE")="There are no tasks listed as running."
29 D ^XUTMT Q
30 ;
31VAX1 ;Use VMS to help clean the TASK list
32 N $ETRAP,PID S $ETRAP="K ^%ZTSCH(""TASK"",ZT1) S $ECODE="""""
33VAX2 S ZT1=$O(^%ZTSCH("TASK",ZT1)) Q:ZT1'>0
34 S PID=$P((^%ZTSCH("TASK",ZT1)),U,10) Q:'PID
35 S Y=$&ZLIB.%GETJPI(PID,"PID")
36 Q
37 ;
38FUT ;Future tasks.
39 N DIR,DIRUT,DTOUT,DUOUT,X,ZT,ZT1,ZT2,ZT3,ZTC,ZTF,ZTH,ZTS
40 K ^TMP($J)
41 S ZTC=0,ZTF=1,ZTH="Scheduled and waiting tasks..."
42 W !!,"Building sorted list of tasks..."
43 ;
44F1 S ZT1="" F S ZT1=$O(^%ZTSCH("JOB",ZT1)) Q:ZT1="" D
45 .S ZT2="" F S ZT2=$O(^%ZTSCH("JOB",ZT1,ZT2)) Q:'ZT2 D
46 .. D SORT(ZT1,ZT2) ;S ^TMP($J,99999-ZT1,99999-$P(ZT1,",",2),ZT2)=""
47 .Q
48 ;
49F2 S ZT1=$$H3^%ZTM($H) F S ZT1=$O(^%ZTSCH(ZT1)) Q:'ZT1 D
50 .S ZTS=0 F S ZTS=$O(^%ZTSCH(ZT1,ZTS)) Q:'ZTS D
51 .. D SORT(ZT1,ZTS) ;S ^TMP($J,99999-ZT1,99999-$P(ZT1,",",2),ZTS)=""
52 .Q
53 ;
54F3 S ZT1="" F S ZT1=$O(^%ZTSCH("IO",ZT1)) Q:ZT1="" D
55 .S ZT2="" F S ZT2=$O(^%ZTSCH("IO",ZT1,ZT2)) Q:'ZT2 D
56 ..S ZT3=0 F S ZT3=$O(^%ZTSCH("IO",ZT1,ZT2,ZT3)) Q:ZT3="" D
57 ... D SORT(ZT2,ZT3) ;S ^TMP($J,99999-ZT2,99999-$P(ZT2,",",2),ZT3)=""
58 .Q
59 ;
60F4 S ZT1="" F S ZT1=$O(^%ZTSCH("LINK",ZT1)) Q:'ZT1 D
61 .S ZT2="" F S ZT2=$O(^%ZTSCH("LINK",ZT1,ZT2)) Q:'ZT2 D
62 ..S ZTS=0 F S ZTS=$O(^%ZTSCH("LINK",ZT1,ZT2,ZTS)) Q:'ZTS D
63 ... D SORT(ZT2,ZTS) ;S ^TMP($J,99999-ZT2,99999-$P(ZT2,",",2),ZTS)=""
64 .Q
65 W "finished!"
66 ;
67F5 ;
68 G:$O(^TMP($J,0))="" F6
69 S ZTSAVE("^TMP($J,")="" D EN^XUTMDEVQ("LIST^XUTMQ","TASK LIST",.ZTSAVE)
70 K ^TMP($J)
71 Q
72 S ZT1="" F S ZT1=$O(^TMP($J,ZT1),-1) Q:ZT1="" D I X Q
73 . S ZTS=0 F S ZTS=$O(^TMP($J,ZT1,ZTS)) Q:'ZTS D PRINT I X Q
74 .Q
75 I X K ^TMP($J) Q
76 ;
77F6 I 'ZTC W !!,"There are no future tasks on this volume set."
78 W ! S DIR(0)="E",DIR("A")="Press RETURN to continue" D
79 .I ZTC S DIR("A")="End of listing. "_DIR("A")
80 D ^DIR K ^TMP($J) Q
81 ;
82SORT(ZTDTH,ZTSK) ;
83 I ZTDTH["," S ZTDTH=$$H3^%ZTM(ZTDTH)
84 S ^TMP($J,ZTDTH,ZTSK)=""
85 Q
Note: See TracBrowser for help on using the repository browser.