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

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

initial load of FOIAVistA 6/30/08 version

File size: 4.3 KB
Line 
1%ZTM5 ;SEA/RDS-TaskMan: Manager, Part 5 (Short Subroutines) ;10/29/2003 22:07
2 ;;8.0;KERNEL;**24,36,118,127,136,162,275,355**;JUL 10, 1995;Build 9
3 ;
4ER ;primary error trap for manager
5 S %ZTERLGR=$$LGR^%ZOSV
6 S $ETRAP="D ER2^%ZTM5"
7 L S ^%ZTSCH("RUN")=$H
8 S ^%ZTSCH("STATUS",$J)=$H_"^ERROR^Recording A Trapped Error."
9 ;
10 S ZTERCODE=$$EC^%ZOSV,ZTE=""
11 I '$$SCREEN^%ZTER(ZTERCODE) D
12 . L ^%ZTSCH("ER") H 1 S ZT=$H
13 . S ^%ZTSCH("ER",+ZT,$P(ZT,",",2))=ZTERCODE
14 . S ^($P(ZT,",",2),1)="Caused by the manager." L
15 . Q
16 ;
17 D ^%ZTER K ZTERCODE
18 ;Lets wait before restarting.
19ER2 H 10 S $ET="Q:$STACK S $EC="""" G RESTART^%ZTM0" S $EC=",U99,"
20 ;
21UPDATE ;CHECK^%ZTM/LOOKUP^%ZTM0--update TaskMan site parameters
22 L ^%ZTSCH("UPDATE",$J)
23 S %ZTOS=^%ZOSF("OS"),U="^"
24 D GETENV^%ZOSV
25 S %ZTUCI=$P(Y,U),%ZTVOL=$P(Y,U,2),%ZTNODE=$P(Y,U,3),%ZTPAIR=$P(Y,U,4)
26 S %ZTVSN=+$O(^%ZIS(14.5,"B",%ZTVOL,"")),%ZTVSS=$G(^%ZIS(14.5,%ZTVSN,0))
27 S %ZTVLI=($P(%ZTVSS,U,2)="Y") ;Did site set Inhibit.
28 S %ZTYPE("V")=$P(%ZTVSS,U,10) ;get vol set type
29U1 ;
30 S %ZTPN=+$O(^%ZIS(14.7,"B",%ZTPAIR,"")),%ZTPS=$G(^%ZIS(14.7,%ZTPN,0))
31 S %ZTPT=+$P(%ZTPS,U,4) ;Priority
32 S %ZTSIZ=+$P(%ZTPS,U,5) ;par size
33 S %ZTRET=+$P(%ZTPS,U,6) ;Retention Time
34 S %ZTVMJ=+$P(%ZTPS,U,7) ;TM job limit
35 S %ZTSLO=+$P(%ZTPS,U,8) ;TM slow down
36 S %ZTYPE=$P(%ZTPS,U,9) ;TM Mode
37 S %ZTPFLG("DCL")=$P(%ZTPS,U,10) ;TM mode, VAX DCL
38 S %ZTPFLG("BAL")=$E($G(^%ZIS(14.7,%ZTPN,2)),1,40)
39 S %ZTPFLG("MINSUB")=$S($P(%ZTPS,U,12):$P(%ZTPS,U,12),1:1)
40 S %ZTPFLG("LBT")=0,%ZTPFLG("BI")=$S($P(%ZTPS,U,14):$P(%ZTPS,U,14),1:30) ;Balance Interval
41 S %ZTPFLG("TM-DELAY")=$P($G(^%ZIS(14.7,%ZTPN,3),"^60"),U,2) ;Start Delay
42 S %ZTPFLG("START")=+$H
43 S %ZTPFLG("XUSCNT")=0 I %ZTOS["GT.M" S %ZTPFLG("XUSCNT")=$L($T(^XUSCNT))
44 S ^%ZTSCH("UPDATE",$J)=$H
45 S %ZTMON("DAY")=+$H D MON^%ZTM ;Setup Task Counting
46 K ^%ZTSCH("LOADA",%ZTPAIR) ;Clear LB in case we stop doing LB.
47 L
48 I "GP"'[%ZTYPE D HALT
49 . K ^%ZTSCH("STATUS")
50 . S ^%ZTSCH("RUN")=%ZTNODE_" is the wrong type of volume set for TaskMan."
51 . Q
52 ;For Cache Map CPF to Node.
53 I %ZTOS["OpenM",$ZV["VMS" D
54 . N I,X,Y S Y=$P(%ZTPAIR,":"),X=Y
55 . F S X=$O(^%ZIS(14.7,"B",X)) Q:X'[Y D
56 . . S I=$O(^%ZIS(14.7,"B",X,0)),Z=^%ZIS(14.7,I,0)
57 . . S I=$P(Z,U,10) S:$L(I) %ZTPFLG("Q",$P($P(Z,U),":",2))=I,%ZTPFLG("Q",I)=$P($P(Z,U),":",2)
58 . Q
59 Q
60 ;
61HOUR ;Run once an hour for each taskman
62 D SUBCHK
63 Q
64 ;
65DAY ;Run once a DAY for each Taskman
66 D MON
67 Q
68 ;
69MON ;Save off the monitor data
70 N X S X=""
71 F I=0:1:23 S X=X_$G(%ZTMON(I))_"^",%ZTMON(I)=0
72 S ^%ZTSCH("MON",%ZTPAIR,%ZTMON("DAY"))=X
73 S %ZTMON("DAY")=+$H
74 Q
75 ;
76SUBCHK ;Job the SUB check routine
77 J SUBCHK^%ZTMS5
78 Q
79 ;
80REQUIR ;UPDATE/CHECK^%ZTM--ensure required links are available
81 K ZTREQUIR N ZT1,ZTN,ZTS,ZTU S ZT1=0
82 F S ZT1=$O(^%ZIS(14.5,ZT1)) Q:'ZT1 I $D(^%ZIS(14.5,ZT1,0))#2 S ZTS=^(0) I $P(ZTS,U,5)="Y" D TEST I $D(ZTREQUIR)#2 Q
83 K ZT,ZT1,ZTN,ZTS,ZTU
84 Q
85 ;
86TEST ;REQUIR--test a required volume set
87 N $ET,$ES,NULL
88 S ZTN=$P(ZTS,U),NULL="" I ZTN="" Q
89 I ZTN=%ZTVOL Q
90 I $P(ZTS,U,3)="N" S ZTREQUIR=ZTN Q
91 I $P(ZTS,U,4)="Y" S ZTREQUIR=ZTN Q
92 S ZTU=$O(^%ZIS(14.6,"AV",ZTN,"")) I ZTU="" Q
93 S $ET="S ZTREQUIR=ZTN,$EC=NULL Q"
94 S X=$D(^[ZTU,ZTN]DIC(0))
95 L +^%ZTSCH("LINK",ZTN)
96 I $D(^%ZTSCH("LINK",ZTN)) S ^%ZTSCH("LINK")=0
97 L -^%ZTSCH("LINK",ZTN)
98 Q
99 ;
100LINK(ZTVOL) ;internal Kernel extrinsic function
101 ;input--volume set where task should run
102 ;output--UCI,volume set where record must be created
103 ;after call check 1--if value is "", the input or file is bad
104 ;after call check 2--if $P(value,",",2) is current volume set then
105 ;...no extended reference should be used
106 ;
107L0 ;was a volume set passed in?
108 N ZTN,ZTU,ZTV,ZTVD,ZTVN
109 I $G(ZTVOL)'?2.7U Q ""
110 ;
111L1 ;is this volume set on file?
112 S ZTVN=$O(^%ZIS(14.5,"B",ZTVOL,""))
113 I ZTVN="" Q ""
114 I $D(^%ZIS(14.5,ZTVN,0))[0 Q ""
115 S ZTVD=^%ZIS(14.5,ZTVN,0)
116 ;
117L2 ;is there a TaskMan Files Volume Set? if not, skip next section
118 S ZTN=$P(ZTVD,"^",7)
119 I ZTN="" S ZTV=ZTVOL G L4
120 ;
121L3 ;if there is a separate TaskMan Files Volume Set, is it on file?
122 I $D(^%ZIS(14.5,ZTN,0))[0 Q ""
123 S ZTVD=^%ZIS(14.5,ZTN,0)
124 S ZTV=$P(ZTVD,"^")
125 I ZTV="" Q ""
126 ;
127L4 ;if there is a TaskMan Files UCI, return UCI,volume set
128 S ZTU=$P(ZTVD,"^",6)
129 I ZTU="" Q ""
130 Q ZTU_","_ZTV
131 ;
132 ;
133INHIBIT(Y) ;Set/Clear the Inhibit logon field
134 I Y=1 S $P(^%ZIS(14.5,%ZTVSN,0),U,2)="S",^%ZIS(14.5,"LOGON",%ZTVOL)=1 Q
135 I Y=0 S $P(^%ZIS(14.5,%ZTVSN,0),U,2)="N" K ^%ZIS(14.5,"LOGON",%ZTVOL) Q
136 Q
Note: See TracBrowser for help on using the repository browser.