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

ZTMS1.m

Go to the documentation of this file. 
  1. %ZTMS1 ;SEA/RDS-TaskMan: Submanager, (Loop & Get Task) ;10/07/08  15:46
  1.  ;;8.0;KERNEL;**36,49,104,118,127,136,275,446**;JUL 10, 1995;Build 35
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;Use ZTLKTM for Lock timeout. p446
  1. SUBMGR ;START--outer submanager loop
  1.  D GETTASK G:ZTSK'>0 QUIT^%ZTMS ;task locked
  1.  S STATUS="Run Task "_ZTSK
  1.  D PROCESS^%ZTMS2 G:$D(ZTQUIT) QUIT^%ZTMS
  1.  S STATUS="Idle"
  1.  G SUBMGR
  1.  ;
  1. GETTASK ;SUBMGR--retain the partition; check Waiting Lists every 1 seconds
  1.  D SUB(1) S ZTSK=0
  1.  ;
  1.  F ZRT=0:0 D  Q:$$EXIT  S %=$S($O(^%ZTSCH("JOB",0))>0:1,1:$$FIRST()),ZRT=ZRT+% H % ;Space out the SM loop
  1.  . I $D(^%ZTSCH("WAIT","SUB")) S STATUS="Wait Node" H 5 Q  ;Wait
  1.  . S %ZTIME=$$H3($H),ZTSK=0 I $D(^%ZTSCH("STOP","SUB",ZTPAIR)) Q
  1.  . D C Q:ZTSK!(ZTYPE="C")  ;Do directed work before check for balance
  1.  . ;If more than xx tasks in JOB Queue don't balance wait. p446
  1.  . I $$BALANCE S ZRT=ZRT-.9,STATUS="Balance Wait" I $$JCNT(ZTPFLG("BalLimit")) Q  ;Wait for balance, Slow ZRT rise.
  1.  . D JOB,IOQ:'ZTSK ;Look for work
  1.  . Q
  1.  D SUB(-1) ;Adjust counter
  1.  Q
  1.  ;
  1. EXIT() ;GETTASK--decide whether to exit retention loop
  1.  I ZTSK,$D(^%ZTSCH("NO-OPTION")),$P(^%ZTSK(ZTSK,0),"^",1,2)="ZTSK^XQ1" D
  1.  . D SCHTM^%ZTMS2(ZTDTH+60) S ZTSK=0
  1.  . Q
  1.  I ZTSK G YES
  1.  I $D(^%ZTSCH("STOP","SUB",ZTPAIR)) G YES
  1.  I ZTPFLG("RT")>ZRT G NO ;Retention time check
  1.  I $$SUB(0)>ZTPFLG("MIN") G YES ;Let extras go
  1. NO ;Don't exit, Update status node
  1.  L +^%ZTSCH("SUB",ZTPFLG("HOME"),$J):10 ;p446
  1.  S ^%ZTSCH("SUB",ZTPFLG("HOME"),$J)=$H_"^"_$G(STATUS)_"^"_$G(STATUS("Bal")) ;Keep our node current
  1.  I ZTPFLG("XUSCNT") D SETLOCK^XUSCNT($NA(^%ZTSCH("SUBLK",ZTPFLG("HOME"),$J)))
  1.  L -^%ZTSCH("SUB",ZTPFLG("HOME"),$J) ;p446
  1.  Q 0
  1.  ;
  1. YES ;EXIT--Yes ;p446
  1.  Q 1
  1.  ;
  1. C ;GETTASK--On C type volume sets, get tasks from Cross-Volume Job List
  1.  S STATUS="C List",ZTSK=0
  1.  I $O(^%ZTSCH("C",ZTPAIR,0))="" Q
  1.  L +^%ZTSCH("C",ZTPAIR):ZTLKTM I '$T S STATUS="No C Lock" Q
  1.  S ZTDTH="",^%ZTSCH("C",ZTPAIR)=0
  1.  F  S ZTDTH=$O(^%ZTSCH("C",ZTPAIR,ZTDTH)),ZTSK=0 Q:ZTDTH=""  D  Q:ZTSK
  1.  . F  S ZTSK=$O(^%ZTSCH("C",ZTPAIR,ZTDTH,ZTSK)),ZX=0 Q:ZTSK=""  D  Q:ZX
  1.  .. I $D(^%ZTSK(ZTSK,0))[0!'ZTSK D  Q
  1.  ... I ZTSK'=0,$D(^%ZTSK(ZTSK)) D TSKSTAT("I")
  1.  ... K ^%ZTSCH("C",ZTPAIR,ZTDTH,ZTSK) S ZTSK=0
  1.  ... Q
  1.  .. L +^%ZTSK(ZTSK):0 Q:'$T
  1.  .. S %ZTIO=^%ZTSCH("C",ZTPAIR,ZTDTH,ZTSK),ZTQUEUED=.5
  1.  .. I %ZTIO]"" S ZTDEVN=1
  1.  .. K ^%ZTSCH("C",ZTPAIR,ZTDTH,ZTSK)
  1.  .. S ZX=1
  1.  .. Q
  1.  . Q
  1.  L -^%ZTSCH("C",ZTPAIR) ;If ZTSK>0 then ^%ZTSK(ztsk) is locked.
  1.  Q
  1.  ;
  1. BALANCE() ;GETTASK--check load balance, and wait while Manager waits
  1.  Q:ZTPAIR="" 0
  1.  S STATUS("Bal")=0
  1.  ;Try and Lock so we are synced. If can't get Lock run. ;p446
  1.  L +^%ZTSCH("LOADA"):0
  1.  I $T S STATUS("Bal")=+$G(^%ZTSCH("LOADA",ZTPAIR)) L -^%ZTSCH("LOADA")
  1.  I STATUS("Bal") H 1 ;Added set var & Hang. p446
  1.  Q STATUS("Bal")
  1.  ;
  1. JOB ;GETTASK--search Partition Waiting List
  1.  S ZTSK=0,ZTDTH=0,ZTQUEUED=0,STATUS="JOB Q"
  1.  L +^%ZTSCH("JOBQ"):ZTLKTM I '$T S STATUS="No JOBQ Lock" Q
  1. J2 S ZTDTH=$O(^%ZTSCH("JOB",ZTDTH)),ZTSK=0 I ZTDTH="" L -^%ZTSCH("JOBQ") Q
  1. J3 S ZTSK=$O(^%ZTSCH("JOB",ZTDTH,ZTSK)),ZTQUEUED=0 I ZTSK'>0 G J2
  1.  L +^%ZTSK(ZTSK):0 I '$T S STATUS="No ZTSK Lock" G J3 ;p446 Back to 0
  1.  I $D(^%ZTSCH("JOB",ZTDTH,ZTSK))[0 L -^%ZTSK(ZTSK) S STATUS="JOB cleared" G J3
  1.  I $D(^%ZTSK(ZTSK,0))[0 D BADTASK L -^%ZTSK(ZTSK) G J3
  1.  S %ZTIO=^%ZTSCH("JOB",ZTDTH,ZTSK),ZTQUEUED=.5,STATUS="Work Task "_ZTSK
  1.  K ^%ZTSCH("JOB",ZTDTH,ZTSK)
  1.  L -^%ZTSCH("JOBQ") ;Now can release JOBQ
  1.  ;try and only pick up work for this node.
  1.  S ZTREC=$G(^%ZTSK(ZTSK,0)),%=$P(ZTREC,U,14) I %[":",%'[ZTNODE D  ;p446
  1.  . L +^%ZTSCH("C",%):99 ;p446
  1.  . S ^%ZTSCH("C",%,ZTDTH,ZTSK)=%ZTIO
  1.  . L -^%ZTSCH("C",%),-^%ZTSK(ZTSK) ;p446
  1.  . S ZTSK=0,%ZTIO="" ;p446
  1.  . Q
  1.  I %ZTIO'="" S ZTDEVN=1
  1.  ;On exit we have ^%ZTSK(ZTSK) Locked if ZTSK>0.
  1.  Q
  1.  ;
  1. BADTASK ;JOB--unschedule tasks with bad numbers or incomplete records
  1.  S %ZTIO=^%ZTSCH("JOB",ZTDTH,ZTSK) I %ZTIO]"" S ZTDEVN=1
  1.  I ZTSK'=0,$D(^%ZTSK(ZTSK)) D TSKSTAT("I",3)
  1.  K ^%ZTSCH("JOB",ZTDTH,ZTSK)
  1.  S ZTQUEUED=0
  1.  I %ZTIO]"" D DEVLK(-1,%ZTIO)
  1.  Q
  1.  ;
  1. IOQ ;GETTASK--search Device Waiting List, Lock IO then DEV.
  1.  S ZTSK=0 I '$D(^%ZTSCH("IO")) Q
  1.  ;Lock to just to get last scan
  1.  L +^%ZTSCH("IO"):ZTLKTM I '$T S STATUS="No IO Lock" Q
  1.  S ZTI=$G(^%ZTSCH("IO")),ZTH=%ZTIME,%ZTIO=$P(ZTI,"^",2)
  1.  I $$I1() S ^%ZTSCH("IO")=ZTH_"^"_%ZTIO ;See if need to update
  1.  L -^%ZTSCH("IO") ;Update p446
  1.  Q
  1.  ;
  1. I1() ;Keep 2 sec apart
  1.  N ZTDEVOK,X1
  1.  I $$PDIFF(%ZTIME,+ZTI,1)'>1 Q 0 ;
  1. I2 S %ZTIO=$O(^%ZTSCH("IO",%ZTIO)),ZTDTH="" I %ZTIO="" G IOX
  1.  I $D(^%ZTSCH("IO",%ZTIO))<9 G I2
  1.  S IOT=^%ZTSCH("IO",%ZTIO)
  1.  I IOT'["RES" G I2:'$$DEVLK(1,%ZTIO) ;lock device if not Resource.
  1.  I '$D(^%ZTSCH("DEVTRY",%ZTIO)) S ^%ZTSCH("DEVTRY",%ZTIO)=%ZTIME ;Set problem device check
  1.  S X=%ZTIO,X1=IOT,ZTDEVOK=X D DEVOK^%ZOSV I Y D DEVLK(-1,%ZTIO) G I2
  1. I3 S ZTDTH=$O(^%ZTSCH("IO",%ZTIO,ZTDTH)),ZTSK=0 I ZTDTH="" D DEVLK(-1,%ZTIO) G I2
  1. I5 S ZTSK=$O(^%ZTSCH("IO",%ZTIO,ZTDTH,ZTSK)) I ZTSK'>0 G I3
  1.  L +^%ZTSK(ZTSK):0 G I5:('$T)
  1.  S ZTQUEUED=.5 D DQ^%ZTM4 I $G(^%ZTSK(ZTSK,0))="" L -^%ZTSK(ZTSK) G I5
  1.  S ZTH=%ZTIME-20 ;Leave ^%ZTSCH("DEV",io) locked, Released in %ZTMS2
  1. IOX ;
  1.  Q 1
  1.  ;
  1. DEVLK(X,ZIO,TO) ;1=Lock/-1=unlock the ^%ZTSCH("DEV",ZIO) node.
  1.  I X<0 L -^%ZTSCH("DEV",ZIO) Q
  1.  L +^%ZTSCH("DEV",ZIO):+$G(TO,ZTLKTM) I '$T Q 0
  1.  Q 1
  1.  ;
  1. SUB(X) ;Inc/Dec SUB or return SUB count
  1.  N % L +^%ZTSCH("SUB",ZTPFLG("HOME")):5
  1.  S %=+$G(^%ZTSCH("SUB",ZTPFLG("HOME"))) S:%<1 %=0
  1.  I X>0 D
  1.  . L +^%ZTSCH("SUBLK",ZTPFLG("HOME"),$J):5 ;p446
  1.  . S ^%ZTSCH("SUB",ZTPFLG("HOME"))=%+1,^%ZTSCH("SUB",ZTPFLG("HOME"),$J)=$H_"^"_$G(STATUS)
  1.  . Q
  1.  I X<0 D
  1.  . S ^%ZTSCH("SUB",ZTPFLG("HOME"))=$S(%>0:%-1,1:0) K ^%ZTSCH("SUB",ZTPFLG("HOME"),$J)
  1.  . L -^%ZTSCH("SUBLK",ZTPFLG("HOME"),$J) ;p446
  1.  . Q
  1.  L -^%ZTSCH("SUB",ZTPFLG("HOME"))
  1.  Q:X=0 % Q
  1.  ;
  1. JCNT(MAXWAIT) ;See if less that MaxWait tasks in JOB list p446
  1.  N Z2,Z3 S Z3=$NA(^%ZTSCH("JOB"))
  1.  F Z2=1:1:MAXWAIT+1 S Z3=$Q(@Z3) Q:Z3'["JOB"
  1.  Q (MAXWAIT>Z2)
  1.  ;
  1. PDIFF(N,O,T) ;Positive Diff
  1.  Q $TR($$DIFF(N,O,$G(T)),"-")
  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. 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. H3(%) ;Convert $H to seconds.
  1.  Q 86400*%+$P(%,",",2)
  1. H0(%) ;Covert from seconds to $H
  1.  Q (%\86400)_","_(%#86400)
  1.  ;
  1. FIRST() ;See if SM with lowest $J
  1.  I $O(^%ZTSCH("SUB",ZTPFLG("HOME"),0))=$J Q 1
  1.  Q 2