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

ZTM.m

Go to the documentation of this file.
  1. %ZTM ;SEA/RDS-TaskMan: Manager, Part 1 (Main Loop) ;10/02/08 09:00
  1. ;;8.0;KERNEL;**24,36,64,67,118,127,136,275,355,446**;JUL 10, 1995;Build 35
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;%ZTCHK is set to 1 @ top of SCHQ, set to 0 if sent a task to SM
  1. LOOP ;Taskman's Main Loop
  1. S %ZTRUN=1,%ZTCHK=1
  1. F %ZTLOOP=0:1 S %ZTLOOP=%ZTLOOP#16 D CHECK,SCHQ,IDLE:%ZTCHK
  1. S %ZTFALL="" G LOOP
  1. ;
  1. CHECK ;LOOP--Check Status And Update Loop Data
  1. ;Do CHECK if sent a new job or %ZTLOOP=0.
  1. Q:%ZTLOOP&$G(%ZTCHK)
  1. I $D(^%ZTSCH("STOP","MGR",%ZTPAIR)) G HALT^%ZTM0
  1. S ^%ZTSCH("RUN")=$H,ZTPAIR="",%ZTIME=$$H3($H)
  1. I $D(^%ZTSCH("WAIT","MGR"))#2 D STATUS("WAIT","Taskman Waiting") H 5 G CHECK
  1. ;
  1. I '$D(^%ZTSCH("UPDATE",$J)) D UPDATE^%ZTM5
  1. I %ZTVLI D STATUS("PAUSE","Logons Inhibited") H 60 G CHECK ;Set in %ZTM5
  1. I @%ZTNLG D INHIBIT^%ZTM5(1),STATUS("PAUSE","No Signons Allowed") H 60 G CHECK
  1. I $G(^%ZIS(14.5,"LOGON",%ZTVOL)) D INHIBIT^%ZTM5(0) ;Check field
  1. I $D(ZTREQUIR)#2 D STATUS("PAUSE","Required link to "_ZTREQUIR_" is down.") H 60 D REQUIR^%ZTM5 G CHECK
  1. ;
  1. I $D(^%ZTSCH("LINK"))#2,$$DIFF($H,^("LINK"))>900 D LINK^%ZTM3
  1. ;Job Limit check done in NEWJOB. p446
  1. ;
  1. I $L(%ZTPFLG("BAL")) D I ZTOVERLD G CHECK
  1. . S ZTOVERLD=0
  1. . Q:%ZTPFLG("LBT")>%ZTIME ;Running, Not time to recheck
  1. . S %ZTPFLG("LBT")=%ZTIME+%ZTPFLG("BI") ;Next time to check.
  1. . D BALANCE^%ZTM6 Q:'ZTOVERLD
  1. . D STATUS("BALANCE","Load Balance Wait.")
  1. . ;Start submanagers for C list work
  1. . I $D(^%ZTSCH("C",%ZTPAIR))>9 D NEWJOB(%ZTUCI,%ZTVOL,"")
  1. . N T F T=1:2:%ZTPFLG("BI") H 2 Q:$$STOPWT^%ZTM6() ;p446 Wait, Check if leave early
  1. . Q
  1. ;
  1. I %ZTRUN D STATUS("RUN","Main Loop")
  1. I '%ZTRUN D
  1. . D STATUS("RUN","Taskman Job Limit Reached"),CHECK^%ZTM6
  1. . S %ZTPFLG("JLC")=(%ZTPFLG("JLC")+1)#3
  1. . I '%ZTPFLG("JLC") S %ZTRUN=%ZTVMJ>$$ACTJ^%ZOSV ;ReCheck for job limit p446
  1. Q
  1. ;
  1. STATUS(ST,MSG) ;Record TM status
  1. N F
  1. ;p446 Only update status every 5 seconds, unless MSG has changed.
  1. S F=(MSG'=$G(%ZTPFLG("StatusM")))
  1. I $G(%ZTPFLG("Status"))>%ZTIME,'$G(F) Q
  1. S ^%ZTSCH("STATUS",$J)=$H_"^"_ST_"^"_$G(%ZTPAIR)_"^"_MSG
  1. S %ZTPFLG("Status")=%ZTIME+5,%ZTPFLG("StatusM")=MSG
  1. Q
  1. ;
  1. TLOCK(M) ;Lock/unlock the SCHQ node
  1. I M>0 L +^%ZTSCH("SCHQ"):%ZTLKTM Q $T
  1. L -^%ZTSCH("SCHQ") Q
  1. ;
  1. SCHQ ;LOOP--Check Schedule List
  1. S %ZTIME=$$H3($H),ZTDTH=0,ZTSK=0,%ZTCHK=1,IO=""
  1. I '$$TLOCK(1) Q ;Lock and Sync %ZTSCH
  1. S1 S ZTDTH=$O(^%ZTSCH(ZTDTH)),ZTSK=0 I (ZTDTH>%ZTIME)!('ZTDTH)!(ZTDTH'?1.N) D TLOCK(-1) Q
  1. I +ZTDTH<0 K ^%ZTSCH(ZTDTH) G S1
  1. S2 S ZTSK=$O(^%ZTSCH(ZTDTH,ZTSK)) I ZTSK="" G S1
  1. S ZTST=$G(^%ZTSCH(ZTDTH,ZTSK))
  1. ;Get task lock then release SCHQ lock
  1. L +^%ZTSK(ZTSK):0 G S2:'$T
  1. K ^%ZTSCH(ZTDTH,ZTSK) D TLOCK(-1)
  1. I $D(^%ZTSK(ZTSK,0))[0 D TSKSTAT("I") L -^%ZTSK(ZTSK) Q ;p446
  1. I $L($P($G(^%ZTSK(ZTSK,.1)),U,10)) D TSKSTAT("D","Stopped") L -^%ZTSK(ZTSK) Q ;p446
  1. D ^%ZTM1
  1. I %ZTREJCT L -^%ZTSK(ZTSK) Q ;p446, Need to get SCHQ lock again.
  1. ;Count tasks
  1. S %ZTMON(%ZTMON)=$G(%ZTMON(%ZTMON))+1
  1. ;
  1. SEND ;Send Task To Submanager
  1. S %ZTCHK=0,ZTPAIR=""
  1. I ZTDVOL'=%ZTVOL D XLINK^%ZTM2 G:'ZTJOBIT SCHX
  1. ;Clear before job cmd
  1. L +^%ZTSCH("JOBQ"):99
  1. I (ZTYPE'="C")&(%ZTNODE[ZTNODE) D
  1. . D TSKSTAT(3,"Placed on JOB List")
  1. . S ^%ZTSCH("JOB",ZTDTH,ZTSK)=IO ;No other lock on JOB
  1. E D
  1. . D TSKSTAT("M","Placed on C List")
  1. . S ZTPAIR=ZTDVOL_$S($L(ZTNODE):":"_ZTNODE,1:"")
  1. . S ^%ZTSCH("C",ZTPAIR,ZTDTH,ZTSK)=IO
  1. ;
  1. L -^%ZTSK(ZTSK),-^%ZTSCH("JOBQ")
  1. ;Check if need new sub-manager.
  1. I (ZTYPE="C")!$$NEWSUB,'$$OOS(ZTPAIR) D NEWJOB(ZTUCI,ZTDVOL,ZTNODE)
  1. SCHX ;Clear all locks
  1. L K ZTREP
  1. Q
  1. ;
  1. IDLE ;LOOP--DEV Node Maintenance; Backup JOB Commands
  1. N R,C,T
  1. I %ZTMON("NEXT")'>%ZTIME D MON ;See if time to update %ZTMON
  1. S (ZTREC,ZTCVOL)="" H 1 ;This is the main hang
  1. I $D(^%ZTSCH("STOP","MGR",%ZTPAIR)) Q
  1. ;job off a new submanager if MIN count < # SUBs
  1. I $$NEWSUB D NEWJOB(%ZTUCI,%ZTVOL,"")
  1. ;Job off a new submanagers if the JOB list is long.
  1. S R=$NA(^%ZTSCH("JOB")),C=0,T=15
  1. F S R=$Q(@R),C=C+1 Q:R'["JOB" I C>T D NEWJOB(%ZTUCI,%ZTVOL,"") Q ;Just start one at a time ;p446
  1. ;Other Idle work.
  1. L +^%ZTSCH("IDLE",%ZTPAIR):%ZTLKTM Q:'$T D IDLE1 L -^%ZTSCH("IDLE",%ZTPAIR)
  1. Q
  1. ;
  1. IDLE1 ;only proceed with idle work if 60 seconds since last check
  1. I $$DIFF(%ZTIME,^%ZTSCH("IDLE"),1)<60 Q
  1. S ^%ZTSCH("IDLE")=%ZTIME ;Set new time.
  1. I %ZTPFLG("XUSCNT") D TOUCH^XUSCNT
  1. D I1,I2 X "JOB DETACH^%ZTM"
  1. Q
  1. ;
  1. I1 ;clear out old DEV nodes
  1. N X,%ZTIO S %ZTIO=""
  1. F S %ZTIO=$O(^%ZTSCH("DEV",%ZTIO)) Q:%ZTIO="" L +^%ZTSCH("DEV",%ZTIO):0 I $T D L -^%ZTSCH("DEV",%ZTIO)
  1. . S X=$G(^%ZTSCH("DEV",%ZTIO)) Q:'$L(X)
  1. . I $$DIFF(%ZTIME,X,1)>120 K ^%ZTSCH("DEV",%ZTIO)
  1. . Q
  1. Q
  1. ;
  1. I2 ;job new submanagers cross-volume for each unfinished C list
  1. I $D(^%ZTSCH("C")) D
  1. . N Y,ZTUCI,ZTVOL,ZTNODE,$ETRAP,$ESTACK S $ET="S $EC="""" D ERCL^%ZTM2"
  1. . S ZTVOL="" F S ZTVOL=$O(^%ZTSCH("C",ZTVOL)) Q:ZTVOL="" D
  1. .. I $O(^%ZTSCH("C",ZTVOL,0))="" Q
  1. .. S ZTNODE="",ZTDVOL=ZTVOL S:ZTDVOL[":" ZTNODE=$P(ZTDVOL,":",2),ZTDVOL=$P(ZTDVOL,":")
  1. .. S X=$G(^%ZTSCH("C",ZTVOL))
  1. .. I $D(^%ZTSCH("LINK",ZTDVOL))!(X>9)!$$OOS(ZTVOL) Q
  1. .. S ^%ZTSCH("C",ZTVOL)=X+1
  1. .. S ZTUCI=$O(^%ZIS(14.6,"AV",ZTDVOL,""))
  1. .. D NEWJOB(ZTUCI,ZTDVOL,ZTNODE)
  1. .. Q
  1. . Q
  1. Q
  1. ;
  1. MON ;Set Next %ZTMON each Hour
  1. I %ZTMON("DAY")<+$H D DAY^%ZTM5
  1. S %ZTMON=$P($H,",",2)\3600,%ZTMON(%ZTMON)=0
  1. S %ZTMON("NEXT")=($H*86400)+(%ZTMON+1*3600)
  1. D HOUR^%ZTM5
  1. Q
  1. ;
  1. NEWJOB(ZTUCI,ZTDVOL,ZTNODE) ;Start a new Job
  1. S %ZTRUN=%ZTVMJ>$$ACTJ^%ZOSV ;Check for job limit p446
  1. ;At the job limit if $ZTRUN=0
  1. I '%ZTRUN D STATUS("RUN","Taskman Job Limit Reached") Q
  1. S ZTUCI=$G(ZTUCI),ZTDVOL=$G(ZTDVOL),ZTNODE=$G(ZTNODE)
  1. X %ZTJOB H %ZTSLO ;If job doesn't work, will catch next time.
  1. Q
  1. ;
  1. DIFF(N,O,T) ;Diff in sec.
  1. Q:$G(T) N-O ;For new seconds times
  1. Q N-O*86400-$P(O,",",2)+$P(N,",",2)
  1. ;
  1. OOS(BV) ;Check if Box-Volume is Out Of Service, Return 1 if OOS.
  1. Q:BV="" 0 N %
  1. S %=$O(^%ZIS(14.7,"B",BV,0)),%=$G(^%ZIS(14.7,+%,0))
  1. Q:%="" 1 Q $P(%,U,11)=1
  1. ;
  1. H3(%) ;Convert $H to seconds.
  1. Q 86400*%+$P(%,",",2)
  1. ;
  1. H0(%) ;Covert from seconds to $H
  1. Q (%\86400)_","_(%#86400)
  1. ;
  1. SUBOK() ;Check if sub's are starting, return 1 if OK
  1. N T L +^%ZTSCH("SUB",%ZTPAIR):0 S T=$T
  1. S ^%ZTSCH("SUB",%ZTPAIR,0)=($G(^%ZTSCH("SUB",%ZTPAIR,0))+1)_"^"_$H
  1. I T L -^%ZTSCH("SUB",%ZTPAIR)
  1. Q ^%ZTSCH("SUB",%ZTPAIR,0)<10
  1. ;
  1. NEWSUB() ;See if we need a new submanager
  1. N SUBS,T
  1. L +^%ZTSCH("SUB",%ZTPAIR):0 S T=$T ;Sync ^%ZTSCH("SUB",%ZTPAIR)
  1. S SUBS=^%ZTSCH("SUB",%ZTPAIR)
  1. I T L -^%ZTSCH("SUB",%ZTPAIR)
  1. Q SUBS<%ZTPFLG("MINSUB")
  1. ;
  1. TSKSTAT(CODE,MSG) ; Update task's status
  1. S $P(^%ZTSK(ZTSK,.1),U,1,4)=$G(CODE)_U_$H_U_$G(MSG)_U_$J
  1. Q
  1. ;
  1. DETACH ;Do slow work in background job
  1. D PARAMS^%ZTM5 S $ET="D ^%ZTER"
  1. D I5,I6
  1. Q
  1. ;
  1. I5 ;Clean up %ZTSCH
  1. S ZTDTH="0,0" F S ZTDTH=$O(^%ZTSCH(ZTDTH)) Q:ZTDTH'["," D
  1. . L +^%ZTSCH("SCHQ"):%ZTLKTM Q:'$T ;Keep others out while cleaning
  1. . N ZTSK,X
  1. . S ZTSK=$O(^%ZTSCH(ZTDTH,0)) I ZTSK>0 S X=^(ZTSK),^%ZTSCH($$H3(ZTDTH),ZTSK)=X K ^%ZTSCH(ZTDTH,ZTSK)
  1. . L -^%ZTSCH("SCHQ")
  1. . Q
  1. Q
  1. ;
  1. I6 ;Check on persistent jobs, Locks can take time, Called from %ZTM0 at start.
  1. S ZTSK=0 F S ZTSK=$O(^%ZTSCH("TASK",ZTSK)) Q:ZTSK'>0 D:$D(^%ZTSCH("TASK",ZTSK,"P"))
  1. . L +^%ZTSCH("TASK",ZTSK):%ZTLKTM E Q ;Still running
  1. . D:$D(^%ZTSCH("TASK",ZTSK,"P")) REQP^%ZTLOAD3(ZTSK) ;START NEW TASK.
  1. . K ^%ZTSCH("TASK",ZTSK)
  1. . L -^%ZTSCH("TASK",ZTSK)
  1. . Q
  1. K %ZTVS
  1. Q
  1. ;