%ZTM5 ;SEA/RDS-TaskMan: Manager, Part 5 (Short Subroutines) ;10/01/08 14:35
;;8.0;KERNEL;**24,36,118,127,136,162,275,355,446**;JUL 10, 1995;Build 44
;Per VHA Directive 2004-038, this routine should not be modified.
;
ER ;primary error trap for manager
S %ZTERLGR=$$LGR^%ZOSV,ZTERCODE=$$EC^%ZOSV ;Grab LGR and EC first p446
S $ETRAP="D ER2^%ZTM5"
D ^%ZTER ;Record error now p446
L ;Clear all locks
S ^%ZTSCH("RUN")=$H
D STATUS^%ZTM("ERROR","Recording A Trapped Error.") ;p446
;
N ZT1,ZT2 ;p446
I '$$SCREEN^%ZTER(ZTERCODE) D
. L +^%ZTSCH("ER"):15 H 1 S ZT1=$H,ZT2=$P(ZT1,",",2),ZT1=+ZT1 ;p446
. S ^%ZTSCH("ER",ZT1,ZT2)=ZTERCODE,^(ZT2,1)="Caused by the manager." ;p446
. L -^%ZTSCH("ER")
. Q
;
K ZTERCODE
;Lets wait before restarting.
ER2 H 10 S $ET="Q:$STACK S $EC="""" G RESTART^%ZTM0" S $EC=",U99,"
;
UPDATE ;CHECK^%ZTM/LOOKUP^%ZTM0--update TaskMan site parameters
L +^%ZTSCH("UPDATE",$J):99
I '$D(^%ZTSCH("LOAD")) S ^%ZTSCH("LOAD")="" ;Starting value p446
D PARAMS ;p446
D MON^%ZTM ;Setup Task Counting
S ^%ZTSCH("UPDATE",$J)=$H
K ^%ZTSCH("LOADA",%ZTPAIR) ;Clear LB in case we stop doing LB.
L -^%ZTSCH("UPDATE",$J)
I "GP"'[%ZTYPE D X "HALT "
. K ^%ZTSCH("STATUS")
. S ^%ZTSCH("RUN")=%ZTNODE_" is the wrong type of volume set for TaskMan."
. Q
Q
;
PARAMS ;Setup Parameters ;p446
S %ZTOS=^%ZOSF("OS"),U="^"
D GETENV^%ZOSV
S %ZTUCI=$P(Y,U),%ZTVOL=$P(Y,U,2),%ZTNODE=$P(Y,U,3),%ZTPAIR=$P(Y,U,4)
S %ZTVSN=+$O(^%ZIS(14.5,"B",%ZTVOL,"")),%ZTVSS=$G(^%ZIS(14.5,%ZTVSN,0))
S %ZTVLI=($P(%ZTVSS,U,2)="Y") ;Did site set Inhibit.
S %ZTYPE("V")=$P(%ZTVSS,U,10) ;get vol set type
U1 ;
S %ZTPN=+$O(^%ZIS(14.7,"B",%ZTPAIR,"")),%ZTPS=$G(^%ZIS(14.7,%ZTPN,0))
S %ZTPT=+$P(%ZTPS,U,4) ;Priority
S %ZTSIZ=+$P(%ZTPS,U,5) ;par size
S %ZTRET=+$P(%ZTPS,U,6) ;Retention Time
S %ZTVMJ=+$P(%ZTPS,U,7) ;TM job limit
S %ZTSLO=+$P(%ZTPS,U,8) ;TM slow down
S %ZTYPE=$P(%ZTPS,U,9) ;TM Mode
K %ZTPFLG S %ZTPFLG="" ;Start Clean
S %ZTPFLG("DCL")=$P(%ZTPS,U,10) ;TM mode, VAX DCL
S %ZTPFLG("BAL")=$G(^%ZIS(14.7,%ZTPN,2))
S %ZTPFLG("MINSUB")=$S($P(%ZTPS,U,12):$P(%ZTPS,U,12),1:1)
S %ZTPFLG("LBT")=0,%ZTPFLG("BI")=$S($P(%ZTPS,U,14):$P(%ZTPS,U,14),1:120) ;Balance Interval ;p446
S %ZTPFLG("JLC")=0 ;Job Limit check ;P446
S %ZTPFLG("TM-DELAY")=$P($G(^%ZIS(14.7,%ZTPN,3),"^60"),U,2) ;Start Delay
S %ZTPFLG("START")=+$H
S %ZTPFLG("XUSCNT")=0 I %ZTOS["GT.M" S %ZTPFLG("XUSCNT")=$L($T(^XUSCNT))
S %ZTLKTM=+$G(^DD("DILOCKTM"),1) ;Lock timeout p446
S %ZTMON("DAY")=+$H
;For Cache Map CPF to Node.
I %ZTOS["OpenM",$ZV["VMS" D
. N I,X,Y S Y=$P(%ZTPAIR,":"),X=Y
. F S X=$O(^%ZIS(14.7,"B",X)) Q:X'[Y D
. . S I=$O(^%ZIS(14.7,"B",X,0)),Z=^%ZIS(14.7,I,0)
. . 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)
. Q
Q
;
HOUR ;Run once an hour for each taskman
D SUBCHK
D SCHCHK
Q
;
DAY ;Run once a DAY for each Taskman
D MON
Q
;
MON ;Save off the monitor data
N X S X=""
F I=0:1:23 S X=X_(+$G(%ZTMON(I)))_"^",%ZTMON(I)=0
S ^%ZTSCH("MON",%ZTPAIR,%ZTMON("DAY"))=X
S %ZTMON("DAY")=+$H
Q
;
SUBCHK ;Job the SUB check routine
J SUBCHK^%ZTMS5(%ZTLKTM)
Q
;
SCHCHK ;Queue the check of the option schedule file. ;p446
I $$DIFF^%ZTM(%ZTIME,$G(^%ZTSCH("HOUR")),1)<3599 Q
S ^%ZTSCH("HOUR")=%ZTIME
N ZTRTN,ZTDTH,ZTDESC,ZTSK,ZTIO,DUZ
S DUZ=.5,ZTRTN="HOUR^XUTMHR",ZTIO="",ZTDTH=$H,ZTDESC="Taskman Hourly Job"
D ^%ZTLOAD
Q
;
REQUIR ;UPDATE/CHECK^%ZTM--ensure required links are available
K ZTREQUIR N ZT1,ZTN,ZTS,ZTU S ZT1=0
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
K ZT,ZT1,ZTN,ZTS,ZTU
Q
;
TEST ;REQUIR--test a required volume set
N $ET,$ES,NULL
S ZTN=$P(ZTS,U),NULL="" I ZTN="" Q
I ZTN=%ZTVOL Q
I $P(ZTS,U,3)="N" S ZTREQUIR=ZTN Q
I $P(ZTS,U,4)="Y" S ZTREQUIR=ZTN Q
S ZTU=$O(^%ZIS(14.6,"AV",ZTN,"")) I ZTU="" Q
S $ET="S ZTREQUIR=ZTN,$EC=NULL Q"
S @("X=$D(^[ZTU,ZTN]DIC(0))")
L +^%ZTSCH("LINK",ZTN):99
I $D(^%ZTSCH("LINK",ZTN)) S ^%ZTSCH("LINK")=0
L -^%ZTSCH("LINK",ZTN)
Q
;
LINK(ZTVOL) ;internal Kernel extrinsic function
;input--volume set where task should run
;output--UCI,volume set where record must be created
;after call check 1--if value is "", the input or file is bad
;after call check 2--if $P(value,",",2) is current volume set then
;...no extended reference should be used
;
L0 ;was a volume set passed in?
N ZTN,ZTU,ZTV,ZTVD,ZTVN
I $G(ZTVOL)'?2.7U Q ""
;
L1 ;is this volume set on file?
S ZTVN=$O(^%ZIS(14.5,"B",ZTVOL,""))
I ZTVN="" Q ""
I $D(^%ZIS(14.5,ZTVN,0))[0 Q ""
S ZTVD=^%ZIS(14.5,ZTVN,0)
;
L2 ;is there a TaskMan Files Volume Set? if not, skip next section
S ZTN=$P(ZTVD,"^",7)
I ZTN="" S ZTV=ZTVOL G L4
;
L3 ;if there is a separate TaskMan Files Volume Set, is it on file?
I $D(^%ZIS(14.5,ZTN,0))[0 Q ""
S ZTVD=^%ZIS(14.5,ZTN,0)
S ZTV=$P(ZTVD,"^")
I ZTV="" Q ""
;
L4 ;if there is a TaskMan Files UCI, return UCI,volume set
S ZTU=$P(ZTVD,"^",6)
I ZTU="" Q ""
Q ZTU_","_ZTV
;
;
INHIBIT(Y) ;Set/Clear the Inhibit logon field
I Y=1 S $P(^%ZIS(14.5,%ZTVSN,0),U,2)="S",^%ZIS(14.5,"LOGON",%ZTVOL)=1 Q
I Y=0 S $P(^%ZIS(14.5,%ZTVSN,0),U,2)="N" K ^%ZIS(14.5,"LOGON",%ZTVOL) Q
Q
%ZTM5 ;SEA/RDS-TaskMan: Manager, Part 5 (Short Subroutines) ;10/01/08 14:35
+1 ;;8.0;KERNEL;**24,36,118,127,136,162,275,355,446**;JUL 10, 1995;Build 44
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
ER ;primary error trap for manager
+1 ;Grab LGR and EC first p446
SET %ZTERLGR=$$LGR^%ZOSV
SET ZTERCODE=$$EC^%ZOSV
+2 SET $ETRAP="D ER2^%ZTM5"
+3 ;Record error now p446
DO ^%ZTER
+4 ;Clear all locks
LOCK
+5 SET ^%ZTSCH("RUN")=$HOROLOG
+6 ;p446
DO STATUS^%ZTM("ERROR","Recording A Trapped Error.")
+7 ;
+8 ;p446
NEW ZT1,ZT2
+9 IF '$$SCREEN^%ZTER(ZTERCODE)
Begin DoDot:1
+10 ;p446
LOCK +^%ZTSCH("ER"):15
HANG 1
SET ZT1=$HOROLOG
SET ZT2=$PIECE(ZT1,",",2)
SET ZT1=+ZT1
+11 ;p446
SET ^%ZTSCH("ER",ZT1,ZT2)=ZTERCODE
SET ^(ZT2,1)="Caused by the manager."
+12 LOCK -^%ZTSCH("ER")
+13 QUIT
End DoDot:1
+14 ;
+15 KILL ZTERCODE
+16 ;Lets wait before restarting.
ER2 HANG 10
SET $ETRAP="Q:$STACK S $EC="""" G RESTART^%ZTM0"
SET $ECODE=",U99,"
+1 ;
UPDATE ;CHECK^%ZTM/LOOKUP^%ZTM0--update TaskMan site parameters
+1 LOCK +^%ZTSCH("UPDATE",$JOB):99
+2 ;Starting value p446
IF '$DATA(^%ZTSCH("LOAD"))
SET ^%ZTSCH("LOAD")=""
+3 ;p446
DO PARAMS
+4 ;Setup Task Counting
DO MON^%ZTM
+5 SET ^%ZTSCH("UPDATE",$JOB)=$HOROLOG
+6 ;Clear LB in case we stop doing LB.
KILL ^%ZTSCH("LOADA",%ZTPAIR)
+7 LOCK -^%ZTSCH("UPDATE",$JOB)
+8 IF "GP"'[%ZTYPE
Begin DoDot:1
+9 KILL ^%ZTSCH("STATUS")
+10 SET ^%ZTSCH("RUN")=%ZTNODE_" is the wrong type of volume set for TaskMan."
+11 QUIT
End DoDot:1
XECUTE "HALT "
+12 QUIT
+13 ;
PARAMS ;Setup Parameters ;p446
+1 SET %ZTOS=^%ZOSF("OS")
SET U="^"
+2 DO GETENV^%ZOSV
+3 SET %ZTUCI=$PIECE(Y,U)
SET %ZTVOL=$PIECE(Y,U,2)
SET %ZTNODE=$PIECE(Y,U,3)
SET %ZTPAIR=$PIECE(Y,U,4)
+4 SET %ZTVSN=+$ORDER(^%ZIS(14.5,"B",%ZTVOL,""))
SET %ZTVSS=$GET(^%ZIS(14.5,%ZTVSN,0))
+5 ;Did site set Inhibit.
SET %ZTVLI=($PIECE(%ZTVSS,U,2)="Y")
+6 ;get vol set type
SET %ZTYPE("V")=$PIECE(%ZTVSS,U,10)
U1 ;
+1 SET %ZTPN=+$ORDER(^%ZIS(14.7,"B",%ZTPAIR,""))
SET %ZTPS=$GET(^%ZIS(14.7,%ZTPN,0))
+2 ;Priority
SET %ZTPT=+$PIECE(%ZTPS,U,4)
+3 ;par size
SET %ZTSIZ=+$PIECE(%ZTPS,U,5)
+4 ;Retention Time
SET %ZTRET=+$PIECE(%ZTPS,U,6)
+5 ;TM job limit
SET %ZTVMJ=+$PIECE(%ZTPS,U,7)
+6 ;TM slow down
SET %ZTSLO=+$PIECE(%ZTPS,U,8)
+7 ;TM Mode
SET %ZTYPE=$PIECE(%ZTPS,U,9)
+8 ;Start Clean
KILL %ZTPFLG
SET %ZTPFLG=""
+9 ;TM mode, VAX DCL
SET %ZTPFLG("DCL")=$PIECE(%ZTPS,U,10)
+10 SET %ZTPFLG("BAL")=$GET(^%ZIS(14.7,%ZTPN,2))
+11 SET %ZTPFLG("MINSUB")=$SELECT($PIECE(%ZTPS,U,12):$PIECE(%ZTPS,U,12),1:1)
+12 ;Balance Interval ;p446
SET %ZTPFLG("LBT")=0
SET %ZTPFLG("BI")=$SELECT($PIECE(%ZTPS,U,14):$PIECE(%ZTPS,U,14),1:120)
+13 ;Job Limit check ;P446
SET %ZTPFLG("JLC")=0
+14 ;Start Delay
SET %ZTPFLG("TM-DELAY")=$PIECE($GET(^%ZIS(14.7,%ZTPN,3),"^60"),U,2)
+15 SET %ZTPFLG("START")=+$HOROLOG
+16 SET %ZTPFLG("XUSCNT")=0
IF %ZTOS["GT.M"
SET %ZTPFLG("XUSCNT")=$LENGTH($TEXT(^XUSCNT))
+17 ;Lock timeout p446
SET %ZTLKTM=+$GET(^DD("DILOCKTM"),1)
+18 SET %ZTMON("DAY")=+$HOROLOG
+19 ;For Cache Map CPF to Node.
+20 IF %ZTOS["OpenM"
IF $ZV["VMS"
Begin DoDot:1
+21 NEW I,X,Y
SET Y=$PIECE(%ZTPAIR,":")
SET X=Y
+22 FOR
SET X=$ORDER(^%ZIS(14.7,"B",X))
IF X'[Y
QUIT
Begin DoDot:2
+23 SET I=$ORDER(^%ZIS(14.7,"B",X,0))
SET Z=^%ZIS(14.7,I,0)
+24 SET I=$PIECE(Z,U,10)
IF $LENGTH(I)
SET %ZTPFLG("Q",$PIECE($PIECE(Z,U),":",2))=I
SET %ZTPFLG("Q",I)=$PIECE($PIECE(Z,U),":",2)
End DoDot:2
+25 QUIT
End DoDot:1
+26 QUIT
+27 ;
HOUR ;Run once an hour for each taskman
+1 DO SUBCHK
+2 DO SCHCHK
+3 QUIT
+4 ;
DAY ;Run once a DAY for each Taskman
+1 DO MON
+2 QUIT
+3 ;
MON ;Save off the monitor data
+1 NEW X
SET X=""
+2 FOR I=0:1:23
SET X=X_(+$GET(%ZTMON(I)))_"^"
SET %ZTMON(I)=0
+3 SET ^%ZTSCH("MON",%ZTPAIR,%ZTMON("DAY"))=X
+4 SET %ZTMON("DAY")=+$HOROLOG
+5 QUIT
+6 ;
SUBCHK ;Job the SUB check routine
+1 JOB SUBCHK^%ZTMS5(%ZTLKTM)
+2 QUIT
+3 ;
SCHCHK ;Queue the check of the option schedule file. ;p446
+1 IF $$DIFF^%ZTM(%ZTIME,$GET(^%ZTSCH("HOUR")),1)<3599
QUIT
+2 SET ^%ZTSCH("HOUR")=%ZTIME
+3 NEW ZTRTN,ZTDTH,ZTDESC,ZTSK,ZTIO,DUZ
+4 SET DUZ=.5
SET ZTRTN="HOUR^XUTMHR"
SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTDESC="Taskman Hourly Job"
+5 DO ^%ZTLOAD
+6 QUIT
+7 ;
REQUIR ;UPDATE/CHECK^%ZTM--ensure required links are available
+1 KILL ZTREQUIR
NEW ZT1,ZTN,ZTS,ZTU
SET ZT1=0
+2 FOR
SET ZT1=$ORDER(^%ZIS(14.5,ZT1))
IF 'ZT1
QUIT
IF $DATA(^%ZIS(14.5,ZT1,0))#2
SET ZTS=^(0)
IF $PIECE(ZTS,U,5)="Y"
DO TEST
IF $DATA(ZTREQUIR)#2
QUIT
+3 KILL ZT,ZT1,ZTN,ZTS,ZTU
+4 QUIT
+5 ;
TEST ;REQUIR--test a required volume set
+1 NEW $ETRAP,$ESTACK,NULL
+2 SET ZTN=$PIECE(ZTS,U)
SET NULL=""
IF ZTN=""
QUIT
+3 IF ZTN=%ZTVOL
QUIT
+4 IF $PIECE(ZTS,U,3)="N"
SET ZTREQUIR=ZTN
QUIT
+5 IF $PIECE(ZTS,U,4)="Y"
SET ZTREQUIR=ZTN
QUIT
+6 SET ZTU=$ORDER(^%ZIS(14.6,"AV",ZTN,""))
IF ZTU=""
QUIT
+7 SET $ETRAP="S ZTREQUIR=ZTN,$EC=NULL Q"
+8 SET @("X=$D(^[ZTU,ZTN]DIC(0))")
+9 LOCK +^%ZTSCH("LINK",ZTN):99
+10 IF $DATA(^%ZTSCH("LINK",ZTN))
SET ^%ZTSCH("LINK")=0
+11 LOCK -^%ZTSCH("LINK",ZTN)
+12 QUIT
+13 ;
LINK(ZTVOL) ;internal Kernel extrinsic function
+1 ;input--volume set where task should run
+2 ;output--UCI,volume set where record must be created
+3 ;after call check 1--if value is "", the input or file is bad
+4 ;after call check 2--if $P(value,",",2) is current volume set then
+5 ;...no extended reference should be used
+6 ;
L0 ;was a volume set passed in?
+1 NEW ZTN,ZTU,ZTV,ZTVD,ZTVN
+2 IF $GET(ZTVOL)'?2.7U
QUIT ""
+3 ;
L1 ;is this volume set on file?
+1 SET ZTVN=$ORDER(^%ZIS(14.5,"B",ZTVOL,""))
+2 IF ZTVN=""
QUIT ""
+3 IF $DATA(^%ZIS(14.5,ZTVN,0))[0
QUIT ""
+4 SET ZTVD=^%ZIS(14.5,ZTVN,0)
+5 ;
L2 ;is there a TaskMan Files Volume Set? if not, skip next section
+1 SET ZTN=$PIECE(ZTVD,"^",7)
+2 IF ZTN=""
SET ZTV=ZTVOL
GOTO L4
+3 ;
L3 ;if there is a separate TaskMan Files Volume Set, is it on file?
+1 IF $DATA(^%ZIS(14.5,ZTN,0))[0
QUIT ""
+2 SET ZTVD=^%ZIS(14.5,ZTN,0)
+3 SET ZTV=$PIECE(ZTVD,"^")
+4 IF ZTV=""
QUIT ""
+5 ;
L4 ;if there is a TaskMan Files UCI, return UCI,volume set
+1 SET ZTU=$PIECE(ZTVD,"^",6)
+2 IF ZTU=""
QUIT ""
+3 QUIT ZTU_","_ZTV
+4 ;
+5 ;
INHIBIT(Y) ;Set/Clear the Inhibit logon field
+1 IF Y=1
SET $PIECE(^%ZIS(14.5,%ZTVSN,0),U,2)="S"
SET ^%ZIS(14.5,"LOGON",%ZTVOL)=1
QUIT
+2 IF Y=0
SET $PIECE(^%ZIS(14.5,%ZTVSN,0),U,2)="N"
KILL ^%ZIS(14.5,"LOGON",%ZTVOL)
QUIT
+3 QUIT
