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/ZTMONH2.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: 1.6 KB
RevLine 
[613]1ZTMONH2 ;SEA/RDS-TaskMan: Option, ZTMON, Part 5 (Help Modules) ;11/29/90 11:27 ;
2 ;;7.1;KERNEL;;May 11, 1993
3 ;
4ENTRY G ^ZTMON
5 ;
6PRINT ;Subroutine--Print A Task
7 N ZTMT,ZTSK W:'ZTC @IOF,!,ZTH,! W:'ZTF !,"-------------------------------------------------------------------------------"
8 S X=0,ZTF=0,ZTMT=ZTS,ZTMT(0)="P" D ^ZTMT 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 ;
14JOB ;Display Job List
15 N DIR,DIRUT,DTOUT,DUOUT,X,ZT,ZT1,ZT2,ZTC,ZTF,ZTH,ZTS S ZTC=0,ZTF=1,ZTH="Job list..."
16 S ZT1="" F ZT=0:0 S ZT1=$O(^%ZTSCH("JOB",ZT1)),ZT2=0 Q:ZT1="" F ZT=0:0 S ZT2=$O(^%ZTSCH("JOB",ZT1,ZT2)) Q:'ZT2 S ZTS=ZT2 D PRINT S ZTC=ZTC+1 G OUT:X
17 I 'ZTC W !!,"The Job List is empty."
18 W ! S DIR(0)="E",DIR("A")=$S(ZTC:"End of listing. ",1:"")_"Press RETURN to continue" D ^DIR Q
19 ;
20TASK ;Display Task List
21 N DIR,DIRUT,DTOUT,DUOUT,X,ZTC,ZTF,ZTH,ZTS S ZTC=0,ZTF=1,ZTH="Task list..."
22 F ZTS=0:0 S ZTS=$O(^%ZTSCH("TASK",ZTS)) Q:'ZTS D PRINT S ZTC=ZTC+1 G OUT:X
23 I 'ZTC W !!,"The Task List is empty."
24 W ! S DIR(0)="E",DIR("A")=$S(ZTC:"End of listing. ",1:"")_"Press RETURN to continue" D ^DIR Q
25 ;
26LINK ;Display Link Lists
27 N DIR,DIRUT,DTOUT,DUOUT,X,ZT,ZT1,ZT2,ZTC,ZTF,ZTS S ZTC=0,ZTF=1,ZTH="Link lists..."
28 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=$O(^%ZTSCH("LINK",ZT1,ZT2,ZTS)) Q:'ZTS D PRINT S ZTC=ZTC+1 G OUT:X
29 I 'ZTC W !!,"The Link List is empty."
30 W ! S DIR(0)="E",DIR("A")=$S(ZTC:"End of listing. ",1:"")_"Press RETURN to continue" D ^DIR Q
31 ;
Note: See TracBrowser for help on using the repository browser.