Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ZTM5

ZTM5.m

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