ZTM6.m

%ZTM6 ;SEA/RDS-TaskMan: Manager, Part 8 (Load Balancing) ;07/01/08  15:46

 ;;8.0;KERNEL;**23,118,127,136,355,446**;JUL 10, 1995;Build 35

 ;Per VHA Directive 2004-038, this routine should not be modified.

 ;

BALANCE ;CHECK^%ZTM--determine whether cpu should wait for balance

 ;Return ZTOVERLD =1 if need to wait, 0 to run

 ;The TM with the largest value sets ^%ZTSCH("LOAD")=who^value^when p446

 ;If your value is greater or equal then you run.

 ;If your value is less you wait unless you set LOAD then you run.

 ;Tell sub-managers by setting ^%ZTSCH("LOADA",%ZTPAIR)=run^value^time^$J

 ;Use %ZTLKTM for lock timeout

 S ZTOVERLD=0 ;p446 Default

 TSTART

 L +^%ZTSCH("LOAD"):(%ZTLKTM+1) E  TROLLBACK  Q  ;p446 Keep working if can't get lock

 N X,ZTIME,ZTLEFT,ZTPREV

 N $ES,$ET S $ET="Q:$ES>0  D ERR^%ZTM6"

 S ZTOVERLD=0,ZTPREV=+$P($G(^%ZTSCH("LOAD")),"^",2),ZTIME=$$H3($H)

 S @("ZTLEFT="_%ZTPFLG("BAL"))

 S ZTIME=$$H3($H),ZTOVERLD=$$COMPARE(%ZTPAIR,ZTLEFT,ZTPREV)

 ;If we are RUNNING have other submanagers wait

 I 'ZTOVERLD D

 . S X="" F  S X=$O(^%ZTSCH("LOADA",X)) Q:X=""  S $P(^(X),"^")=1 ;Have others wait

 . S ^%ZTSCH("LOAD")=%ZTPAIR_"^"_ZTLEFT_"^"_ZTIME

 ;Now set a value that is used by our %ZTMS to run/wait also

 S ^%ZTSCH("LOADA",%ZTPAIR)=ZTOVERLD_"^"_ZTLEFT_"^"_ZTIME_"^"_$J

 L -^%ZTSCH("LOAD")

 TCOMMIT

 Q

 ;

STOPWT() ;See if we should stop Balance wait, Called from %ZTM.

 L +^%ZTSCH("LOAD"):%ZTLKTM Q:'$T 1 ;Run if can't get lock

 N I,J S I="",J=1

 F  S I=$O(^%ZTSCH("LOADA",I)) Q:I=""  I '^(I) S J=0

 L -^%ZTSCH("LOAD")

 Q J ;Return: 1 stop waiting, 0 keep waiting. (Someone is in run state)

 ;

CHECK ;Called when job limit reached.

 ;If not doing balancing, remove node and quit

 N I,J,K

 I %ZTPFLG("BAL")="" K ^%ZTSCH("LOADA",%ZTPAIR) Q

 L +^%ZTSCH("LOAD"):%ZTLKTM Q:'$T  ;Get it next time

 ;If at job limit see if sub-managers should run

 S I=$P($G(^%ZTSCH("LOAD")),"^",2),J=$P($G(^%ZTSCH("LOADA",%ZTPAIR)),"^",2)

 S K=(J<I),$P(^%ZTSCH("LOADA",%ZTPAIR),"^",1)=K

 L -^%ZTSCH("LOAD")

 Q

 ;

COMPARE(ID,ZTLEFT,ZTPREV) ;

 ;BALANCE--compare our cpu capacity left to that of previous checker

 ;input:  cpu name, cpu capacity left, cpu capacity of previous checker

 ;output: whether current cpu should wait, 0=run, 1=wait

 N X

 I ZTLEFT'<ZTPREV Q 0

 S X=^%ZTSCH("LOAD")

 I $P(X,"^",3)+(%ZTPFLG("BI")+5)<ZTIME Q 0

 Q $P(X,"^")'[ID

 ;

ERR ;Clean up if error

 S %ZTPFLG("EBAL")=1+$G(%ZTPFLG("EBAL")),ZTOVERLD=0

 I $G(%ZTPFLG("EBAL"))>10 D ^%ZTER S %ZTPFLG("BAL")="" ;Only stop after 10 errors ;p446

 S $EC=""

 ;TROLLBACK

 L -^%ZTSCH("LOAD")

 Q

 ;

H3(%) ;Convert $H to seconds

 Q 86400*%+$P(%,",",2)

 ;

VXD(BIAS) ;--algorithm for VAX DSM

 ;Capacity Left=Available Jobs + BIAS

 Q $$AVJ^%ZOSV()+$G(BIAS)

 ;

MSM4() ;Use MSMv4 LAT calcuation

 N MAXJOB,CURJOB

 X "S MAXJOB=$V($V(3,-5),-3,0),CURJOB=$V(168,-4,2)"

 Q MAXJOB-CURJOB*255\MAXJOB

 ;

CACHE1(BIAS) ;Use available jobs

 N CUR,MAX

 Q $$AVJ^%ZOSV()+$G(BIAS)

 ;

CACHE2(%COM,%LOG) ;Cache, Pull metric data

 N TMP,$ET

 S $ETRAP="S $ECODE="""" Q ZTPREV"

 S %LOG=$G(%LOG,"VISTA$METRIC")

 I $L($G(%COM)) S TMP=$ZF(-1,%COM)

 Q $ZF("TRNLNM",%LOG)

 ;

RNDRBN() ;Round Robin

 ;value^node^time

 N R,R2

 L +^%ZTSCH("RNDRBN"):$G(%ZTLKTM,1)

 S R=$G(^%ZTSCH("RNDRBN"))

 I $P(R,U,2)=%ZTPAIR S R2=+R G RX

 I ZTIME<$P(R,U,3) S R2=R-1 G RX

 S R2=R+2#512,^%ZTSCH("RNDRBN")=R2_U_%ZTPAIR_U_(ZTIME+%ZTPFLG("BI"))

RX L -^%ZTSCH("RNDRBN")

 Q R2

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ZTM6   3470     printed  Mar 13, 2025@21:21:15                                                                                                                                                                                                        Page 2

%ZTM6     ;SEA/RDS-TaskMan: Manager, Part 8 (Load Balancing) ;07/01/08  15:46

 +1       ;;8.0;KERNEL;**23,118,127,136,355,446**;JUL 10, 1995;Build 35

 +2       ;Per VHA Directive 2004-038, this routine should not be modified.

 +3       ;

BALANCE   ;CHECK^%ZTM--determine whether cpu should wait for balance

 +1       ;Return ZTOVERLD =1 if need to wait, 0 to run

 +2       ;The TM with the largest value sets ^%ZTSCH("LOAD")=who^value^when p446

 +3       ;If your value is greater or equal then you run.

 +4       ;If your value is less you wait unless you set LOAD then you run.

 +5       ;Tell sub-managers by setting ^%ZTSCH("LOADA",%ZTPAIR)=run^value^time^$J

 +6       ;Use %ZTLKTM for lock timeout

 +7       ;p446 Default

           SET ZTOVERLD=0

 +8        TSTART 

 +9       ;p446 Keep working if can't get lock

           LOCK +^%ZTSCH("LOAD"):(%ZTLKTM+1)

          IF '$TEST

               TROLLBACK 

               QUIT 

 +10       NEW X,ZTIME,ZTLEFT,ZTPREV

 +11       NEW $ESTACK,$ETRAP

           SET $ETRAP="Q:$ES>0  D ERR^%ZTM6"

 +12       SET ZTOVERLD=0

           SET ZTPREV=+$PIECE($GET(^%ZTSCH("LOAD")),"^",2)

           SET ZTIME=$$H3($HOROLOG)

 +13       SET @("ZTLEFT="_%ZTPFLG("BAL"))

 +14       SET ZTIME=$$H3($HOROLOG)

           SET ZTOVERLD=$$COMPARE(%ZTPAIR,ZTLEFT,ZTPREV)

 +15      ;If we are RUNNING have other submanagers wait

 +16       IF 'ZTOVERLD

               Begin DoDot:1

 +17      ;Have others wait

                   SET X=""

                   FOR 

                       SET X=$ORDER(^%ZTSCH("LOADA",X))

                       if X=""

                           QUIT 

                       SET $PIECE(^(X),"^")=1

 +18               SET ^%ZTSCH("LOAD")=%ZTPAIR_"^"_ZTLEFT_"^"_ZTIME

               End DoDot:1

 +19      ;Now set a value that is used by our %ZTMS to run/wait also

 +20       SET ^%ZTSCH("LOADA",%ZTPAIR)=ZTOVERLD_"^"_ZTLEFT_"^"_ZTIME_"^"_$JOB

 +21       LOCK -^%ZTSCH("LOAD")

 +22       TCOMMIT 

 +23       QUIT 

 +24      ;

STOPWT()  ;See if we should stop Balance wait, Called from %ZTM.

 +1       ;Run if can't get lock

           LOCK +^%ZTSCH("LOAD"):%ZTLKTM

           if '$TEST

               QUIT 1

 +2        NEW I,J

           SET I=""

           SET J=1

 +3        FOR 

               SET I=$ORDER(^%ZTSCH("LOADA",I))

               if I=""

                   QUIT 

               IF '^(I)

                   SET J=0

 +4        LOCK -^%ZTSCH("LOAD")

 +5       ;Return: 1 stop waiting, 0 keep waiting. (Someone is in run state)

           QUIT J

 +6       ;

CHECK     ;Called when job limit reached.

 +1       ;If not doing balancing, remove node and quit

 +2        NEW I,J,K

 +3        IF %ZTPFLG("BAL")=""

               KILL ^%ZTSCH("LOADA",%ZTPAIR)

               QUIT 

 +4       ;Get it next time

           LOCK +^%ZTSCH("LOAD"):%ZTLKTM

           if '$TEST

               QUIT 

 +5       ;If at job limit see if sub-managers should run

 +6        SET I=$PIECE($GET(^%ZTSCH("LOAD")),"^",2)

           SET J=$PIECE($GET(^%ZTSCH("LOADA",%ZTPAIR)),"^",2)

 +7        SET K=(J<I)

           SET $PIECE(^%ZTSCH("LOADA",%ZTPAIR),"^",1)=K

 +8        LOCK -^%ZTSCH("LOAD")

 +9        QUIT 

 +10      ;

COMPARE(ID,ZTLEFT,ZTPREV) ;

 +1       ;BALANCE--compare our cpu capacity left to that of previous checker

 +2       ;input:  cpu name, cpu capacity left, cpu capacity of previous checker

 +3       ;output: whether current cpu should wait, 0=run, 1=wait

 +4        NEW X

 +5        IF ZTLEFT'<ZTPREV

               QUIT 0

 +6        SET X=^%ZTSCH("LOAD")

 +7        IF $PIECE(X,"^",3)+(%ZTPFLG("BI")+5)<ZTIME

               QUIT 0

 +8        QUIT $PIECE(X,"^")'[ID

 +9       ;

ERR       ;Clean up if error

 +1        SET %ZTPFLG("EBAL")=1+$GET(%ZTPFLG("EBAL"))

           SET ZTOVERLD=0

 +2       ;Only stop after 10 errors ;p446

           IF $GET(%ZTPFLG("EBAL"))>10

               DO ^%ZTER

               SET %ZTPFLG("BAL")=""

 +3        SET $ECODE=""

 +4       ;TROLLBACK

 +5        LOCK -^%ZTSCH("LOAD")

 +6        QUIT 

 +7       ;

H3(%)     ;Convert $H to seconds

 +1        QUIT 86400*%+$PIECE(%,",",2)

 +2       ;

VXD(BIAS) ;--algorithm for VAX DSM

 +1       ;Capacity Left=Available Jobs + BIAS

 +2        QUIT $$AVJ^%ZOSV()+$GET(BIAS)

 +3       ;

MSM4()    ;Use MSMv4 LAT calcuation

 +1        NEW MAXJOB,CURJOB

 +2        XECUTE "S MAXJOB=$V($V(3,-5),-3,0),CURJOB=$V(168,-4,2)"

 +3        QUIT MAXJOB-CURJOB*255\MAXJOB

 +4       ;

CACHE1(BIAS) ;Use available jobs

 +1        NEW CUR,MAX

 +2        QUIT $$AVJ^%ZOSV()+$GET(BIAS)

 +3       ;

CACHE2(%COM,%LOG) ;Cache, Pull metric data

 +1        NEW TMP,$ETRAP

 +2        SET $ETRAP="S $ECODE="""" Q ZTPREV"

 +3        SET %LOG=$GET(%LOG,"VISTA$METRIC")

 +4        IF $LENGTH($GET(%COM))

               SET TMP=$ZF(-1,%COM)

 +5        QUIT $ZF("TRNLNM",%LOG)

 +6       ;

RNDRBN()  ;Round Robin

 +1       ;value^node^time

 +2        NEW R,R2

 +3        LOCK +^%ZTSCH("RNDRBN"):$GET(%ZTLKTM,1)

 +4        SET R=$GET(^%ZTSCH("RNDRBN"))

 +5        IF $PIECE(R,U,2)=%ZTPAIR

               SET R2=+R

               GOTO RX

 +6        IF ZTIME<$PIECE(R,U,3)

               SET R2=R-1

               GOTO RX

 +7        SET R2=R+2#512

           SET ^%ZTSCH("RNDRBN")=R2_U_%ZTPAIR_U_(ZTIME+%ZTPFLG("BI"))

RX         LOCK -^%ZTSCH("RNDRBN")

 +1        QUIT R2