XUSCNT ;ISF/RWF - Job counting for GTM ;6/24/04 15:22
;;8.0;KERNEL;**275**;July 10, 1995;
;0 return CNT
;1 inc CNT
;-1 dec CNT
COUNT(INC,JOB) ;Keep count of jobs
N XUCNT,X
S JOB=$G(JOB,$J)
;Return Current Count
I INC=0 D TOUCH Q +$G(^XUTL("XUSYS","CNT"))
;Increment Count
I INC>0 D Q
. S X=$G(^XUTL("XUSYS",JOB,"NM")) K ^XUTL("XUSYS",JOB) S ^XUTL("XUSYS",JOB,"NM")=X
. D TOUCH
. L +^XUTL("XUSYS","CNT"):5
. S XUCNT=$G(^XUTL("XUSYS","CNT"))+1,^XUTL("XUSYS","CNT")=XUCNT
. L -^XUTL("XUSYS","CNT")
. Q
;Decrement Count
I INC<0 D Q
. L +^XUTL("XUSYS","CNT"):5
. S XUCNT=$G(^XUTL("XUSYS","CNT"))-1,^XUTL("XUSYS","CNT")=$S(XUCNT>0:XUCNT,1:0)
. L -^XUTL("XUSYS","CNT")
. K ^XUTL("XUSYS",JOB)
Q
;
CHECK(JOB) ;Check if job number active
; 0 = Job doesn't seem to be running
; 1 = Job maybe running
; 2 = Job still has Lock out.
Q:$G(JOB)'>0 0
I '$D(^XUTL("XUSYS",JOB)) Q 0
N LK,%T
S %T=0,LK=$$GETLOCK()
I $L(LK) L +@LK:0 S %T=$T L:%T -@LK
Q $S(%T:2,1:1)
;
SETLOCK(NLK) ;Set the Lock we will keep
I $L($G(NLK)) S ^XUTL("XUSYS",$J,"LOCK")=NLK
E K ^XUTL("XUSYS",$J,"LOCK")
D TOUCH ;Update the time
Q
;
TOUCH ;Update the time
S ^XUTL("XUSYS",$J,0)=$H
Q
;
GETLOCK() ;Get the node to Lock
Q $G(^XUTL("XUSYS",$J,"LOCK"))
;
CLEAR(DB) ;Check for locks and time clear old ones.
N %J,%T,CNT,CT,LK,IM,IMAGE,H K ^TMP($J)
D TOUCH ;See that we are current
;S %J=0 F S %J=$ZPID(%J) Q:%J'>0 S ^TMP($J,%J)="",^TMP($J,%J,1)=$ZGETJPI(%J,"IMAGNAME")
S DB=+$G(DB),IMAGE="mumps" ;$ZGETJPI($J,"IMAGNAME") ; ours
S %J=0,CNT=0,H=$H,CT=$$H3($H)
I DB W !,"Current Job Count: ",$$COUNT(0)
F S %J=$O(^XUTL("XUSYS",%J)) Q:%J'>0 D
. S CNT=CNT+1
. I DB W !,CNT," Job: ",%J
. S LK=$G(^XUTL("XUSYS",%J,"LOCK")) ;Get lock name
. I '$L(LK) W:DB " No Lock node"
. I $L(LK) L +@LK:0 S %T=$T D Q:'%T L -@LK ;Quit if lock still held
. . I '%T,DB W " Lock Held"
. . I %T,DB W " Lock Fail"
. S IM=$G(^TMP($J,%J,1))
. I IM=IMAGE W:DB " Image Match: ",IM Q
. I IM["ZFOO.EXE" W:DB " ZFOO Image" Q ;Quit if in same image
. S H=$G(^XUTL("XUSYS",%J,0)) I H>0 S H=$$H3(H)
. I H+60>CT D Q ;Updated in last 30 seconds.
. . I DB W " Current TimeStamp"
. S NM=$G(^XUTL("XUSYS",%J,"NM"))
. I NM["Task " S TM=+$P(NM,"Task ",2) I TM>0 D Q:%
. . S TM(1)=$G(^%ZTSK(TM,.1)),%=(TM(1)=5)
. . I DB,% W " Running Task"
. . Q
. ;More checks
. D COUNT(-1,%J) I DB W " Not Active: Removed" ;Not Active
. Q
L +^XUTL("XUSYS","CNT"):3
S CNT=0,%J=0 F S %J=$O(^XUTL("XUSYS",%J)) Q:%J'>0 S CNT=CNT+1
S ^XUTL("XUSYS","CNT")=CNT
L -^XUTL("XUSYS","CNT")
I DB W !,"New JOB count: ",CNT
Q
;
H3(%H) ;Just seconds
Q %H*86400+$P(%H,",",2)
;
;Called from the X-REF both the volume and Max signon from file 8989.3
XREF(X1,V) ;V="S" or "K"
N %,N
S %=$G(^XTV(8989.3,1,4,X1,0)),N=$P(%,"^") Q:%=""
I V="K" K ^XTV(8989.3,"AMAX",N) Q
S ^XTV(8989.3,"AMAX",N)=$P(%,"^",3)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSCNT 2975 printed Oct 16, 2024@18:13:01 Page 2
XUSCNT ;ISF/RWF - Job counting for GTM ;6/24/04 15:22
+1 ;;8.0;KERNEL;**275**;July 10, 1995;
+2 ;0 return CNT
+3 ;1 inc CNT
+4 ;-1 dec CNT
COUNT(INC,JOB) ;Keep count of jobs
+1 NEW XUCNT,X
+2 SET JOB=$GET(JOB,$JOB)
+3 ;Return Current Count
+4 IF INC=0
DO TOUCH
QUIT +$GET(^XUTL("XUSYS","CNT"))
+5 ;Increment Count
+6 IF INC>0
Begin DoDot:1
+7 SET X=$GET(^XUTL("XUSYS",JOB,"NM"))
KILL ^XUTL("XUSYS",JOB)
SET ^XUTL("XUSYS",JOB,"NM")=X
+8 DO TOUCH
+9 LOCK +^XUTL("XUSYS","CNT"):5
+10 SET XUCNT=$GET(^XUTL("XUSYS","CNT"))+1
SET ^XUTL("XUSYS","CNT")=XUCNT
+11 LOCK -^XUTL("XUSYS","CNT")
+12 QUIT
End DoDot:1
QUIT
+13 ;Decrement Count
+14 IF INC<0
Begin DoDot:1
+15 LOCK +^XUTL("XUSYS","CNT"):5
+16 SET XUCNT=$GET(^XUTL("XUSYS","CNT"))-1
SET ^XUTL("XUSYS","CNT")=$SELECT(XUCNT>0:XUCNT,1:0)
+17 LOCK -^XUTL("XUSYS","CNT")
+18 KILL ^XUTL("XUSYS",JOB)
End DoDot:1
QUIT
+19 QUIT
+20 ;
CHECK(JOB) ;Check if job number active
+1 ; 0 = Job doesn't seem to be running
+2 ; 1 = Job maybe running
+3 ; 2 = Job still has Lock out.
+4 if $GET(JOB)'>0
QUIT 0
+5 IF '$DATA(^XUTL("XUSYS",JOB))
QUIT 0
+6 NEW LK,%T
+7 SET %T=0
SET LK=$$GETLOCK()
+8 IF $LENGTH(LK)
LOCK +@LK:0
SET %T=$TEST
if %T
LOCK -@LK
+9 QUIT $SELECT(%T:2,1:1)
+10 ;
SETLOCK(NLK) ;Set the Lock we will keep
+1 IF $LENGTH($GET(NLK))
SET ^XUTL("XUSYS",$JOB,"LOCK")=NLK
+2 IF '$TEST
KILL ^XUTL("XUSYS",$JOB,"LOCK")
+3 ;Update the time
DO TOUCH
+4 QUIT
+5 ;
TOUCH ;Update the time
+1 SET ^XUTL("XUSYS",$JOB,0)=$HOROLOG
+2 QUIT
+3 ;
GETLOCK() ;Get the node to Lock
+1 QUIT $GET(^XUTL("XUSYS",$JOB,"LOCK"))
+2 ;
CLEAR(DB) ;Check for locks and time clear old ones.
+1 NEW %J,%T,CNT,CT,LK,IM,IMAGE,H
KILL ^TMP($JOB)
+2 ;See that we are current
DO TOUCH
+3 ;S %J=0 F S %J=$ZPID(%J) Q:%J'>0 S ^TMP($J,%J)="",^TMP($J,%J,1)=$ZGETJPI(%J,"IMAGNAME")
+4 ;$ZGETJPI($J,"IMAGNAME") ; ours
SET DB=+$GET(DB)
SET IMAGE="mumps"
+5 SET %J=0
SET CNT=0
SET H=$HOROLOG
SET CT=$$H3($HOROLOG)
+6 IF DB
WRITE !,"Current Job Count: ",$$COUNT(0)
+7 FOR
SET %J=$ORDER(^XUTL("XUSYS",%J))
if %J'>0
QUIT
Begin DoDot:1
+8 SET CNT=CNT+1
+9 IF DB
WRITE !,CNT," Job: ",%J
+10 ;Get lock name
SET LK=$GET(^XUTL("XUSYS",%J,"LOCK"))
+11 IF '$LENGTH(LK)
if DB
WRITE " No Lock node"
+12 ;Quit if lock still held
IF $LENGTH(LK)
LOCK +@LK:0
SET %T=$TEST
Begin DoDot:2
+13 IF '%T
IF DB
WRITE " Lock Held"
+14 IF %T
IF DB
WRITE " Lock Fail"
End DoDot:2
if '%T
QUIT
LOCK -@LK
+15 SET IM=$GET(^TMP($JOB,%J,1))
+16 IF IM=IMAGE
if DB
WRITE " Image Match: ",IM
QUIT
+17 ;Quit if in same image
IF IM["ZFOO.EXE"
if DB
WRITE " ZFOO Image"
QUIT
+18 SET H=$GET(^XUTL("XUSYS",%J,0))
IF H>0
SET H=$$H3(H)
+19 ;Updated in last 30 seconds.
IF H+60>CT
Begin DoDot:2
+20 IF DB
WRITE " Current TimeStamp"
End DoDot:2
QUIT
+21 SET NM=$GET(^XUTL("XUSYS",%J,"NM"))
+22 IF NM["Task "
SET TM=+$PIECE(NM,"Task ",2)
IF TM>0
Begin DoDot:2
+23 SET TM(1)=$GET(^%ZTSK(TM,.1))
SET %=(TM(1)=5)
+24 IF DB
IF %
WRITE " Running Task"
+25 QUIT
End DoDot:2
if %
QUIT
+26 ;More checks
+27 ;Not Active
DO COUNT(-1,%J)
IF DB
WRITE " Not Active: Removed"
+28 QUIT
End DoDot:1
+29 LOCK +^XUTL("XUSYS","CNT"):3
+30 SET CNT=0
SET %J=0
FOR
SET %J=$ORDER(^XUTL("XUSYS",%J))
if %J'>0
QUIT
SET CNT=CNT+1
+31 SET ^XUTL("XUSYS","CNT")=CNT
+32 LOCK -^XUTL("XUSYS","CNT")
+33 IF DB
WRITE !,"New JOB count: ",CNT
+34 QUIT
+35 ;
H3(%H) ;Just seconds
+1 QUIT %H*86400+$PIECE(%H,",",2)
+2 ;
+3 ;Called from the X-REF both the volume and Max signon from file 8989.3
XREF(X1,V) ;V="S" or "K"
+1 NEW %,N
+2 SET %=$GET(^XTV(8989.3,1,4,X1,0))
SET N=$PIECE(%,"^")
if %=""
QUIT
+3 IF V="K"
KILL ^XTV(8989.3,"AMAX",N)
QUIT
+4 SET ^XTV(8989.3,"AMAX",N)=$PIECE(%,"^",3)
+5 QUIT
