- 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 Jan 18, 2025@03:13:25 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