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

XUSCNT.m

Go to the documentation of this file.
  1. XUSCNT ;ISF/RWF - Job counting for GTM ;6/24/04 15:22
  1. ;;8.0;KERNEL;**275**;July 10, 1995;
  1. ;0 return CNT
  1. ;1 inc CNT
  1. ;-1 dec CNT
  1. COUNT(INC,JOB) ;Keep count of jobs
  1. N XUCNT,X
  1. S JOB=$G(JOB,$J)
  1. ;Return Current Count
  1. I INC=0 D TOUCH Q +$G(^XUTL("XUSYS","CNT"))
  1. ;Increment Count
  1. I INC>0 D Q
  1. . S X=$G(^XUTL("XUSYS",JOB,"NM")) K ^XUTL("XUSYS",JOB) S ^XUTL("XUSYS",JOB,"NM")=X
  1. . D TOUCH
  1. . L +^XUTL("XUSYS","CNT"):5
  1. . S XUCNT=$G(^XUTL("XUSYS","CNT"))+1,^XUTL("XUSYS","CNT")=XUCNT
  1. . L -^XUTL("XUSYS","CNT")
  1. . Q
  1. ;Decrement Count
  1. I INC<0 D Q
  1. . L +^XUTL("XUSYS","CNT"):5
  1. . S XUCNT=$G(^XUTL("XUSYS","CNT"))-1,^XUTL("XUSYS","CNT")=$S(XUCNT>0:XUCNT,1:0)
  1. . L -^XUTL("XUSYS","CNT")
  1. . K ^XUTL("XUSYS",JOB)
  1. Q
  1. ;
  1. CHECK(JOB) ;Check if job number active
  1. ; 0 = Job doesn't seem to be running
  1. ; 1 = Job maybe running
  1. ; 2 = Job still has Lock out.
  1. Q:$G(JOB)'>0 0
  1. I '$D(^XUTL("XUSYS",JOB)) Q 0
  1. N LK,%T
  1. S %T=0,LK=$$GETLOCK()
  1. I $L(LK) L +@LK:0 S %T=$T L:%T -@LK
  1. Q $S(%T:2,1:1)
  1. ;
  1. SETLOCK(NLK) ;Set the Lock we will keep
  1. I $L($G(NLK)) S ^XUTL("XUSYS",$J,"LOCK")=NLK
  1. E K ^XUTL("XUSYS",$J,"LOCK")
  1. D TOUCH ;Update the time
  1. Q
  1. ;
  1. TOUCH ;Update the time
  1. S ^XUTL("XUSYS",$J,0)=$H
  1. Q
  1. ;
  1. GETLOCK() ;Get the node to Lock
  1. Q $G(^XUTL("XUSYS",$J,"LOCK"))
  1. ;
  1. CLEAR(DB) ;Check for locks and time clear old ones.
  1. N %J,%T,CNT,CT,LK,IM,IMAGE,H K ^TMP($J)
  1. D TOUCH ;See that we are current
  1. ;S %J=0 F S %J=$ZPID(%J) Q:%J'>0 S ^TMP($J,%J)="",^TMP($J,%J,1)=$ZGETJPI(%J,"IMAGNAME")
  1. S DB=+$G(DB),IMAGE="mumps" ;$ZGETJPI($J,"IMAGNAME") ; ours
  1. S %J=0,CNT=0,H=$H,CT=$$H3($H)
  1. I DB W !,"Current Job Count: ",$$COUNT(0)
  1. F S %J=$O(^XUTL("XUSYS",%J)) Q:%J'>0 D
  1. . S CNT=CNT+1
  1. . I DB W !,CNT," Job: ",%J
  1. . S LK=$G(^XUTL("XUSYS",%J,"LOCK")) ;Get lock name
  1. . I '$L(LK) W:DB " No Lock node"
  1. . I $L(LK) L +@LK:0 S %T=$T D Q:'%T L -@LK ;Quit if lock still held
  1. . . I '%T,DB W " Lock Held"
  1. . . I %T,DB W " Lock Fail"
  1. . S IM=$G(^TMP($J,%J,1))
  1. . I IM=IMAGE W:DB " Image Match: ",IM Q
  1. . I IM["ZFOO.EXE" W:DB " ZFOO Image" Q ;Quit if in same image
  1. . S H=$G(^XUTL("XUSYS",%J,0)) I H>0 S H=$$H3(H)
  1. . I H+60>CT D Q ;Updated in last 30 seconds.
  1. . . I DB W " Current TimeStamp"
  1. . S NM=$G(^XUTL("XUSYS",%J,"NM"))
  1. . I NM["Task " S TM=+$P(NM,"Task ",2) I TM>0 D Q:%
  1. . . S TM(1)=$G(^%ZTSK(TM,.1)),%=(TM(1)=5)
  1. . . I DB,% W " Running Task"
  1. . . Q
  1. . ;More checks
  1. . D COUNT(-1,%J) I DB W " Not Active: Removed" ;Not Active
  1. . Q
  1. L +^XUTL("XUSYS","CNT"):3
  1. S CNT=0,%J=0 F S %J=$O(^XUTL("XUSYS",%J)) Q:%J'>0 S CNT=CNT+1
  1. S ^XUTL("XUSYS","CNT")=CNT
  1. L -^XUTL("XUSYS","CNT")
  1. I DB W !,"New JOB count: ",CNT
  1. Q
  1. ;
  1. H3(%H) ;Just seconds
  1. Q %H*86400+$P(%H,",",2)
  1. ;
  1. ;Called from the X-REF both the volume and Max signon from file 8989.3
  1. XREF(X1,V) ;V="S" or "K"
  1. N %,N
  1. S %=$G(^XTV(8989.3,1,4,X1,0)),N=$P(%,"^") Q:%=""
  1. I V="K" K ^XTV(8989.3,"AMAX",N) Q
  1. S ^XTV(8989.3,"AMAX",N)=$P(%,"^",3)
  1. Q