HLOPROC1 ;ALB/CJM/OAK/PIJ- Process Manager - 10/4/94 1pm ;12/30/2010
;;1.6;HEALTH LEVEL SEVEN;**126,138,139,147,153**;Oct 13, 1995;Build 11
;Per VHA Directive 2004-038, this routine should not be modified.
;
;
GETWORK(PROCESS) ;
;This is the GETWORK function for the process manager
;Finds a process that needs to be started
;
N NAME,IEN,GOTWORK
;this is how HL7 can be stopped via Taskman
I $$S^%ZTLOAD D STOPHL7 Q 0
S GOTWORK=0
S IEN=+$G(PROCESS("IEN"))
F S IEN=$O(^HLD(779.3,"C",1,IEN)) Q:IEN=$G(PROCESS("IEN")) I IEN D Q:GOTWORK
.N PROC,COUNT,QUEUED,RUNNING
.Q:'$$GETPROC(IEN,.PROC)
.Q:PROC("VMS SERVICE")
.Q:PROC("NAME")="PROCESS MANAGER"
.Q:'PROC("ACTIVE")
.S PROCESS("COUNT")=1
.S QUEUED=+$G(^HLC("HL7 PROCESS COUNTS","QUEUED",PROC("NAME")))
.S:QUEUED<0 QUEUED=0
.S RUNNING=+$G(^HLC("HL7 PROCESS COUNTS","RUNNING",PROC("NAME")))
.S:RUNNING<0 RUNNING=0
.S COUNT=QUEUED+RUNNING
.I COUNT<PROC("MINIMUM") S GOTWORK=1,PROCESS("IEN")=IEN,PROCESS("NAME")=PROC("NAME"),PROCESS("COUNT")=(PROC("MINIMUM")-COUNT),PROCESS("NODE")=PROC("NODE") Q
.I COUNT<PROC("MAXIMUM"),$$FMDIFF^XLFDT($$NOW^XLFDT,PROC("LAST DT/TM"),2)>PROC("WAIT SECONDS"),'QUEUED S GOTWORK=1,PROCESS("IEN")=IEN,PROCESS("NAME")=PROC("NAME"),PROCESS("COUNT")=1,PROCESS("NODE")=PROC("NODE") Q
I 'GOTWORK K PROCESS
Q GOTWORK
;
DOWORK(PROCESS) ;
;starts a process
;
;don't start a new task if stopped
Q:$$CHKSTOP^HLOPROC
;
N ZTRTN,ZTDESC,ZTSAVE,ZTIO,ZTSK,I,ZTDTH,ZTCPU
S:'$G(PROCESS("COUNT")) PROCESS("COUNT")=1
F I=1:1:PROCESS("COUNT") D
.S ZTRTN="PROCESS^HLOPROC"
.S ZTDESC="HL7 - "_PROCESS("NAME")
.S ZTIO=""
.S ZTSAVE("PROCNAME")=PROCESS("NAME")
.S ZTDTH=$H
.I $L(PROCESS("NODE")) S ZTCPU=PROCESS("NODE")
.D ^%ZTLOAD
.I $D(ZTSK) D
..;lock before changing counts
..L +HL7("COUNTING PROCESSES"):20
..I $$INC^HLOSITE($NA(^HLC("HL7 PROCESS COUNTS","QUEUED",PROCESS("NAME"))))
..S $P(^HLD(779.3,PROCESS("IEN"),0),"^",6)=$$NOW^XLFDT,^HLTMP("HL7 QUEUED PROCESSES",ZTSK)=$H_"^"_PROCESS("NAME")
..L -HL7("COUNTING PROCESSES")
Q
;
GETPROC(IEN,PROCESS) ;
;given the ien of the HL7 Process Registry entry, returns the entry as a subscripted array in .PROCESS
;
;Output: Function returns 0 on failure, 1 on success
;
N NODE
S NODE=$G(^HLD(779.3,IEN,0))
Q:NODE="" 0
S PROCESS("NAME")=$P(NODE,"^")
S PROCESS("IEN")=IEN
S PROCESS("ACTIVE")=$P(NODE,"^",2)
S PROCESS("MINIMUM")=+$P(NODE,"^",3)
S PROCESS("MAXIMUM")=+$P(NODE,"^",4)
S PROCESS("WAIT SECONDS")=+($P(NODE,"^",5))*60
I 'PROCESS("WAIT SECONDS") S PROCESS("WAIT SECONDS")=1000
S PROCESS("LAST DT/TM")=$P(NODE,"^",6)
S PROCESS("VMS SERVICE")=$P(NODE,"^",15)
S PROCESS("NODE")=$P(NODE,"^",16)
I PROCESS("NODE") D
.S PROCESS("NODE")=$P($G(^%ZIS(14.7,PROCESS("NODE"),0)),"^")
E S PROCESS("NODE")=""
I '$L(PROCESS("NODE")) S PROCESS("NODE")=$$GETNODE^HLOSITE
Q 1
;
STOPHL7 ;shut down HLO HL7
N ZTSK,DOLLARJ
;let other processes know that starting/stopping is underway
S $P(^HLD(779.1,1,0),"^",9)=0
S ZTSK=""
F S ZTSK=$O(^HLTMP("HL7 QUEUED PROCESSES",ZTSK)) Q:ZTSK="" D DQ^%ZTLOAD
S DOLLARJ=""
F S DOLLARJ=$O(^HLTMP("HL7 RUNNING PROCESSES",DOLLARJ)) Q:DOLLARJ="" S ZTSK=$P($G(^HLTMP("HL7 RUNNING PROCESSES",DOLLARJ)),"^",2) I ZTSK]"" D PCLEAR^%ZTLOAD(ZTSK) I $$ASKSTOP^%ZTLOAD(ZTSK)
D CHKQUED
Q
;
STARTHL7 ;
;start HL7 system
;
N PROCESS
S $P(^HLD(779.1,1,0),"^",9)=1
D RECOUNT()
D RESET
;
L +^HLTMP("PROCESS MANAGER"):20
;if the lock was obtained then the Process Manager isn't running
I $T D
.L -^HLTMP("PROCESS MANAGER")
.S PROCESS("IEN")=$O(^HLD(779.3,"B","PROCESS MANAGER",0))
.D GETPROC(PROCESS("IEN"),.PROCESS)
.D DOWORK(.PROCESS)
Q
;
QUIT1(COUNT) ;just returns 1 as function value first time around,then 0, insuring that the DO WORK function is called just once
I '$G(COUNT) S COUNT=1 Q 1
Q 0
;
CHKDEAD(WORK) ;
;did any process terminate without erasing itself?
;WORK (pass by reference, not required) by the Process Manager that is not used and not required
N DOLLARJ S DOLLARJ=""
L +HL7("COUNTING PROCESSES"):20
Q:'$T
F S DOLLARJ=$O(^HLTMP("HL7 RUNNING PROCESSES",DOLLARJ)) Q:DOLLARJ="" I DOLLARJ'=$J L +^HLTMP("HL7 RUNNING PROCESSES",DOLLARJ):1 D:$T
.L -^HLTMP("HL7 RUNNING PROCESSES",DOLLARJ)
.N PROC
.S PROC=$P($G(^HLTMP("HL7 RUNNING PROCESSES",DOLLARJ)),"^",3)
.K ^HLTMP("HL7 RUNNING PROCESSES",DOLLARJ)
.Q:PROC=""
.I $$INC^HLOSITE($NA(^HLC("HL7 PROCESS COUNTS","RUNNING",PROC)),-1)<0,$$INC^HLOSITE($NA(^HLC("HL7 PROCESS COUNTS","RUNNING",PROC)),1)
L -HL7("COUNTING PROCESSES")
Q
CHKQUED ;did any queued task get dequeued without being erased?
N PROC,JOB
L +HL7("COUNTING PROCESSES"):20
Q:'$T
S JOB=""
F S JOB=$O(^HLTMP("HL7 QUEUED PROCESSES",JOB)) Q:JOB="" I '$$QUEUED(JOB) D
.N PROC
.S PROC=$P($G(^HLTMP("HL7 QUEUED PROCESSES",JOB)),"^",2)
.I PROC]"",$$INC^HLOSITE($NA(^HLC("HL7 PROCESS COUNTS","QUEUED",PROC)),-1)<0,$$INC^HLOSITE($NA(^HLC("HL7 PROCESS COUNTS","QUEUED",PROC)),1)
.K ^HLTMP("HL7 QUEUED PROCESSES",JOB)
L -HL7("COUNTING PROCESSES")
Q
;
QUEUED(TASK) ;
;function returns 0 if ZTSK is not queued to run, 1 if it is
N ZTSK
S ZTSK=TASK
D ISQED^%ZTLOAD
Q:ZTSK(0) 1
Q 0
;
CNTLIVE ;count the running processes
N JOB,COUNTS,PROC
L +HL7("COUNTING PROCESSES"):20
Q:'$T
S JOB=""
F S JOB=$O(^HLTMP("HL7 RUNNING PROCESSES",JOB)) Q:JOB="" S PROC=$P($G(^HLTMP("HL7 RUNNING PROCESSES",JOB)),"^",3) I PROC]"" S COUNTS(PROC)=$G(COUNTS(PROC))+1
S PROC="" F S PROC=$O(COUNTS(PROC)) Q:PROC="" S ^HLC("HL7 PROCESS COUNTS","RUNNING",PROC)=COUNTS(PROC)
S PROC="" F S PROC=$O(^HLC("HL7 PROCESS COUNTS","RUNNING",PROC)) Q:PROC="" S ^HLC("HL7 PROCESS COUNTS","RUNNING",PROC)=+$G(COUNTS(PROC))
L -HL7("COUNTING PROCESSES")
Q
;
CNTQUED ;count the queued tasks
N JOB,COUNTS,PROC
L +HL7("COUNTING PROCESSES"):20
Q:'$T
S JOB=""
F S JOB=$O(^HLTMP("HL7 QUEUED PROCESSES",JOB)) Q:JOB="" S PROC=$P($G(^HLTMP("HL7 QUEUED PROCESSES",JOB)),"^",2) I PROC]"" S COUNTS(PROC)=$G(COUNTS(PROC))+1
S PROC="" F S PROC=$O(COUNTS(PROC)) Q:PROC="" S ^HLC("HL7 PROCESS COUNTS","QUEUED",PROC)=COUNTS(PROC)
S PROC="" F S PROC=$O(^HLC("HL7 PROCESS COUNTS","QUEUED",PROC)) Q:PROC="" S ^HLC("HL7 PROCESS COUNTS","QUEUED",PROC)=+$G(COUNTS(PROC))
L -HL7("COUNTING PROCESSES")
Q
;
RECOUNT(RECOUNT) ;check that the processes that are supposed to be running actually are, same for the queued processes
;Input:
; RECOUNT (pass by reference, optional) not used, but passed in by the process manager
;
;
;check for processes that are supposed to be running or queued but aren't
D CHKDEAD(),CHKQUED
;
;recount the processes
D CNTLIVE,CNTQUED
Q
;
RESET ;
N CTR,DT,LINK,QUEUE,MSGIEN
K ^HLTMP("FAILING LINKS")
S LINK=""
F S LINK=$O(^HLB("QUEUE","OUT",LINK)) Q:LINK="" D
. S DT=$G(^HLB("QUEUE","OUT",LINK))
. I DT'="" S ^HLTMP("FAILING LINKS",LINK)=DT ;; down link (has a DT/TM)
Q
;
ERROR ;
;cleanup if the error occurred during queue recount
L -^HLTMP("PROCESS MANAGER")
D:$G(HLON) STARTHL7
D RCNT^HLOSITE("U")
I $L($G(LOCK)) L -@LOCK
D ^%ZTER
D UNWIND^%ZTER
Q
;*****End HL*1.6*138
QCOUNT(WORK) ;count messages pending on all the queues
N LOCK,FROM,LINK,QUEUE
D RCNT^HLOSITE("S") ; Set RECOUNT FLAG on
;
; recount each OUT queue
;first delete counters for non-existent queues
S LINK=""
F S LINK=$O(^HLC("QUEUECOUNT","OUT",LINK)) Q:LINK="" D
. S QUEUE=""
. F S QUEUE=$O(^HLC("QUEUECOUNT","OUT",LINK,QUEUE)) Q:QUEUE="" I '$O(^HLB("QUEUE","OUT",LINK,QUEUE,0)) D
. . S LOCK=$NA(RECOUNT("OUT",LINK,QUEUE))
. . L +@LOCK:1 Q:'$T ;If lock not obtained skip recount for this queue
. .I '$O(^HLB("QUEUE","OUT",LINK,QUEUE,0)) S ^HLC("QUEUECOUNT","OUT",LINK,QUEUE)=0
. . L -@LOCK
;
;now count the queues
S LINK=""
F S LINK=$O(^HLB("QUEUE","OUT",LINK)) Q:LINK="" D
. S QUEUE=""
. F S QUEUE=$O(^HLB("QUEUE","OUT",LINK,QUEUE)) Q:QUEUE="" D
. . S LOCK=$NA(RECOUNT("OUT",LINK,QUEUE))
. . L +@LOCK:1 Q:'$T ;If lock not obtained skip recount for this queue
. . S (MSGIEN,CTR)=0
. . F S MSGIEN=$O(^HLB("QUEUE","OUT",LINK,QUEUE,MSGIEN)) Q:MSGIEN="" S CTR=CTR+1
. . S ^HLC("QUEUECOUNT","OUT",LINK,QUEUE)=CTR
. . L -@LOCK
;
; recount each sequence queue
;first delete counts for non-existent queues
S QUEUE=""
F S QUEUE=$O(^HLC("QUEUECOUNT","SEQUENCE",QUEUE)) Q:QUEUE="" D
. Q:$G(^HLB("QUEUE","SEQUENCE",QUEUE))!$O(^HLB("QUEUE","SEQUENCE",QUEUE,0))
. S LOCK=$NA(RECOUNT("SEQUENCE",QUEUE))
. L +@LOCK:1 Q:'$T
. I '$G(^HLB("QUEUE","SEQUENCE",QUEUE)),'$O(^HLB("QUEUE","SEQUENCE",QUEUE,0)) S ^HLC("QUEUECOUNT","SEQUENCE",QUEUE)=0
. L -@LOCK
;
;now count the queues
S QUEUE=""
F S QUEUE=$O(^HLB("QUEUE","SEQUENCE",QUEUE)) Q:QUEUE="" D
.S LOCK=$NA(RECOUNT("SEQUENCE",QUEUE))
. L +@LOCK:1 Q:'$T ;should not fail, but if it does, skip the recount of this queue
.;
.S (MSGIEN,CTR)=0
.;count msg even if not on the queue if the queue is waiting on it
. I +$G(^HLB("QUEUE","SEQUENCE",QUEUE)) S CTR=1
.;
. F S MSGIEN=$O(^HLB("QUEUE","SEQUENCE",QUEUE,MSGIEN)) Q:MSGIEN="" S CTR=CTR+1
. S ^HLC("QUEUECOUNT","SEQUENCE",QUEUE)=CTR
. L -@LOCK
;
;
; now caculate the all-inclusive counter
S QUEUE=""
S CTR=0
F S QUEUE=$O(^HLC("QUEUECOUNT","SEQUENCE",QUEUE)) Q:QUEUE="" S CTR=CTR+$G(^HLC("QUEUECOUNT","SEQUENCE",QUEUE))
S ^HLC("QUEUECOUNT","SEQUENCE")=CTR
;
;
; recount IN queues
;
;first delete counts for non-existent queues
S FROM=""
F S FROM=$O(^HLC("QUEUECOUNT","IN",FROM)) Q:FROM="" D
. S QUEUE=""
. F S QUEUE=$O(^HLC("QUEUECOUNT","IN",FROM,QUEUE)) Q:QUEUE="" I '$O(^HLB("QUEUE","IN",FROM,QUEUE,0)) D
. . S LOCK=$NA(RECOUNT("IN","FROM",QUEUE))
. . L +@LOCK:1 Q:'$T ;If lock not obtained skip recount for this queue
. .I '$O(^HLB("QUEUE","IN",FROM,QUEUE,0)) S ^HLC("QUEUECOUNT","IN",FROM,QUEUE)=0
. . L -@LOCK
;
;now count the queues
S FROM=""
F S FROM=$O(^HLB("QUEUE","IN",FROM)) Q:FROM="" D
. S QUEUE=""
. F S QUEUE=$O(^HLB("QUEUE","IN",FROM,QUEUE)) Q:QUEUE="" D
. . S LOCK=$NA(RECOUNT("IN","FROM",QUEUE))
. . L +@LOCK:1 Q:'$T ;If lock not obtained skip recount for this queue
. . S (MSGIEN,CTR)=0
. . F S MSGIEN=$O(^HLB("QUEUE","IN",FROM,QUEUE,MSGIEN)) Q:MSGIEN="" D
. . . S CTR=CTR+1
. . S ^HLC("QUEUECOUNT","IN",FROM,QUEUE)=CTR
. . L -@LOCK
;
;recount flag not needed anymore
D RCNT^HLOSITE("U")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOPROC1 10545 printed Oct 16, 2024@17:59:46 Page 2
HLOPROC1 ;ALB/CJM/OAK/PIJ- Process Manager - 10/4/94 1pm ;12/30/2010
+1 ;;1.6;HEALTH LEVEL SEVEN;**126,138,139,147,153**;Oct 13, 1995;Build 11
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;
GETWORK(PROCESS) ;
+1 ;This is the GETWORK function for the process manager
+2 ;Finds a process that needs to be started
+3 ;
+4 NEW NAME,IEN,GOTWORK
+5 ;this is how HL7 can be stopped via Taskman
+6 IF $$S^%ZTLOAD
DO STOPHL7
QUIT 0
+7 SET GOTWORK=0
+8 SET IEN=+$GET(PROCESS("IEN"))
+9 FOR
SET IEN=$ORDER(^HLD(779.3,"C",1,IEN))
if IEN=$GET(PROCESS("IEN"))
QUIT
IF IEN
Begin DoDot:1
+10 NEW PROC,COUNT,QUEUED,RUNNING
+11 if '$$GETPROC(IEN,.PROC)
QUIT
+12 if PROC("VMS SERVICE")
QUIT
+13 if PROC("NAME")="PROCESS MANAGER"
QUIT
+14 if 'PROC("ACTIVE")
QUIT
+15 SET PROCESS("COUNT")=1
+16 SET QUEUED=+$GET(^HLC("HL7 PROCESS COUNTS","QUEUED",PROC("NAME")))
+17 if QUEUED<0
SET QUEUED=0
+18 SET RUNNING=+$GET(^HLC("HL7 PROCESS COUNTS","RUNNING",PROC("NAME")))
+19 if RUNNING<0
SET RUNNING=0
+20 SET COUNT=QUEUED+RUNNING
+21 IF COUNT<PROC("MINIMUM")
SET GOTWORK=1
SET PROCESS("IEN")=IEN
SET PROCESS("NAME")=PROC("NAME")
SET PROCESS("COUNT")=(PROC("MINIMUM")-COUNT)
SET PROCESS("NODE")=PROC("NODE")
QUIT
+22 IF COUNT<PROC("MAXIMUM")
IF $$FMDIFF^XLFDT($$NOW^XLFDT,PROC("LAST DT/TM"),2)>PROC("WAIT SECONDS")
IF 'QUEUED
SET GOTWORK=1
SET PROCESS("IEN")=IEN
SET PROCESS("NAME")=PROC("NAME")
SET PROCESS("COUNT")=1
SET PROCESS("NODE")=PROC("NODE")
QUIT
End DoDot:1
if GOTWORK
QUIT
+23 IF 'GOTWORK
KILL PROCESS
+24 QUIT GOTWORK
+25 ;
DOWORK(PROCESS) ;
+1 ;starts a process
+2 ;
+3 ;don't start a new task if stopped
+4 if $$CHKSTOP^HLOPROC
QUIT
+5 ;
+6 NEW ZTRTN,ZTDESC,ZTSAVE,ZTIO,ZTSK,I,ZTDTH,ZTCPU
+7 if '$GET(PROCESS("COUNT"))
SET PROCESS("COUNT")=1
+8 FOR I=1:1:PROCESS("COUNT")
Begin DoDot:1
+9 SET ZTRTN="PROCESS^HLOPROC"
+10 SET ZTDESC="HL7 - "_PROCESS("NAME")
+11 SET ZTIO=""
+12 SET ZTSAVE("PROCNAME")=PROCESS("NAME")
+13 SET ZTDTH=$HOROLOG
+14 IF $LENGTH(PROCESS("NODE"))
SET ZTCPU=PROCESS("NODE")
+15 DO ^%ZTLOAD
+16 IF $DATA(ZTSK)
Begin DoDot:2
+17 ;lock before changing counts
+18 LOCK +HL7("COUNTING PROCESSES"):20
+19 IF $$INC^HLOSITE($NAME(^HLC("HL7 PROCESS COUNTS","QUEUED",PROCESS("NAME"))))
+20 SET $PIECE(^HLD(779.3,PROCESS("IEN"),0),"^",6)=$$NOW^XLFDT
SET ^HLTMP("HL7 QUEUED PROCESSES",ZTSK)=$HOROLOG_"^"_PROCESS("NAME")
+21 LOCK -HL7("COUNTING PROCESSES")
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
GETPROC(IEN,PROCESS) ;
+1 ;given the ien of the HL7 Process Registry entry, returns the entry as a subscripted array in .PROCESS
+2 ;
+3 ;Output: Function returns 0 on failure, 1 on success
+4 ;
+5 NEW NODE
+6 SET NODE=$GET(^HLD(779.3,IEN,0))
+7 if NODE=""
QUIT 0
+8 SET PROCESS("NAME")=$PIECE(NODE,"^")
+9 SET PROCESS("IEN")=IEN
+10 SET PROCESS("ACTIVE")=$PIECE(NODE,"^",2)
+11 SET PROCESS("MINIMUM")=+$PIECE(NODE,"^",3)
+12 SET PROCESS("MAXIMUM")=+$PIECE(NODE,"^",4)
+13 SET PROCESS("WAIT SECONDS")=+($PIECE(NODE,"^",5))*60
+14 IF 'PROCESS("WAIT SECONDS")
SET PROCESS("WAIT SECONDS")=1000
+15 SET PROCESS("LAST DT/TM")=$PIECE(NODE,"^",6)
+16 SET PROCESS("VMS SERVICE")=$PIECE(NODE,"^",15)
+17 SET PROCESS("NODE")=$PIECE(NODE,"^",16)
+18 IF PROCESS("NODE")
Begin DoDot:1
+19 SET PROCESS("NODE")=$PIECE($GET(^%ZIS(14.7,PROCESS("NODE"),0)),"^")
End DoDot:1
+20 IF '$TEST
SET PROCESS("NODE")=""
+21 IF '$LENGTH(PROCESS("NODE"))
SET PROCESS("NODE")=$$GETNODE^HLOSITE
+22 QUIT 1
+23 ;
STOPHL7 ;shut down HLO HL7
+1 NEW ZTSK,DOLLARJ
+2 ;let other processes know that starting/stopping is underway
+3 SET $PIECE(^HLD(779.1,1,0),"^",9)=0
+4 SET ZTSK=""
+5 FOR
SET ZTSK=$ORDER(^HLTMP("HL7 QUEUED PROCESSES",ZTSK))
if ZTSK=""
QUIT
DO DQ^%ZTLOAD
+6 SET DOLLARJ=""
+7 FOR
SET DOLLARJ=$ORDER(^HLTMP("HL7 RUNNING PROCESSES",DOLLARJ))
if DOLLARJ=""
QUIT
SET ZTSK=$PIECE($GET(^HLTMP("HL7 RUNNING PROCESSES",DOLLARJ)),"^",2)
IF ZTSK]""
DO PCLEAR^%ZTLOAD(ZTSK)
IF $$ASKSTOP^%ZTLOAD(ZTSK)
+8 DO CHKQUED
+9 QUIT
+10 ;
STARTHL7 ;
+1 ;start HL7 system
+2 ;
+3 NEW PROCESS
+4 SET $PIECE(^HLD(779.1,1,0),"^",9)=1
+5 DO RECOUNT()
+6 DO RESET
+7 ;
+8 LOCK +^HLTMP("PROCESS MANAGER"):20
+9 ;if the lock was obtained then the Process Manager isn't running
+10 IF $TEST
Begin DoDot:1
+11 LOCK -^HLTMP("PROCESS MANAGER")
+12 SET PROCESS("IEN")=$ORDER(^HLD(779.3,"B","PROCESS MANAGER",0))
+13 DO GETPROC(PROCESS("IEN"),.PROCESS)
+14 DO DOWORK(.PROCESS)
End DoDot:1
+15 QUIT
+16 ;
QUIT1(COUNT) ;just returns 1 as function value first time around,then 0, insuring that the DO WORK function is called just once
+1 IF '$GET(COUNT)
SET COUNT=1
QUIT 1
+2 QUIT 0
+3 ;
CHKDEAD(WORK) ;
+1 ;did any process terminate without erasing itself?
+2 ;WORK (pass by reference, not required) by the Process Manager that is not used and not required
+3 NEW DOLLARJ
SET DOLLARJ=""
+4 LOCK +HL7("COUNTING PROCESSES"):20
+5 if '$TEST
QUIT
+6 FOR
SET DOLLARJ=$ORDER(^HLTMP("HL7 RUNNING PROCESSES",DOLLARJ))
if DOLLARJ=""
QUIT
IF DOLLARJ'=$JOB
LOCK +^HLTMP("HL7 RUNNING PROCESSES",DOLLARJ):1
if $TEST
Begin DoDot:1
+7 LOCK -^HLTMP("HL7 RUNNING PROCESSES",DOLLARJ)
+8 NEW PROC
+9 SET PROC=$PIECE($GET(^HLTMP("HL7 RUNNING PROCESSES",DOLLARJ)),"^",3)
+10 KILL ^HLTMP("HL7 RUNNING PROCESSES",DOLLARJ)
+11 if PROC=""
QUIT
+12 IF $$INC^HLOSITE($NAME(^HLC("HL7 PROCESS COUNTS","RUNNING",PROC)),-1)<0
IF $$INC^HLOSITE($NAME(^HLC("HL7 PROCESS COUNTS","RUNNING",PROC)),1)
End DoDot:1
+13 LOCK -HL7("COUNTING PROCESSES")
+14 QUIT
CHKQUED ;did any queued task get dequeued without being erased?
+1 NEW PROC,JOB
+2 LOCK +HL7("COUNTING PROCESSES"):20
+3 if '$TEST
QUIT
+4 SET JOB=""
+5 FOR
SET JOB=$ORDER(^HLTMP("HL7 QUEUED PROCESSES",JOB))
if JOB=""
QUIT
IF '$$QUEUED(JOB)
Begin DoDot:1
+6 NEW PROC
+7 SET PROC=$PIECE($GET(^HLTMP("HL7 QUEUED PROCESSES",JOB)),"^",2)
+8 IF PROC]""
IF $$INC^HLOSITE($NAME(^HLC("HL7 PROCESS COUNTS","QUEUED",PROC)),-1)<0
IF $$INC^HLOSITE($NAME(^HLC("HL7 PROCESS COUNTS","QUEUED",PROC)),1)
+9 KILL ^HLTMP("HL7 QUEUED PROCESSES",JOB)
End DoDot:1
+10 LOCK -HL7("COUNTING PROCESSES")
+11 QUIT
+12 ;
QUEUED(TASK) ;
+1 ;function returns 0 if ZTSK is not queued to run, 1 if it is
+2 NEW ZTSK
+3 SET ZTSK=TASK
+4 DO ISQED^%ZTLOAD
+5 if ZTSK(0)
QUIT 1
+6 QUIT 0
+7 ;
CNTLIVE ;count the running processes
+1 NEW JOB,COUNTS,PROC
+2 LOCK +HL7("COUNTING PROCESSES"):20
+3 if '$TEST
QUIT
+4 SET JOB=""
+5 FOR
SET JOB=$ORDER(^HLTMP("HL7 RUNNING PROCESSES",JOB))
if JOB=""
QUIT
SET PROC=$PIECE($GET(^HLTMP("HL7 RUNNING PROCESSES",JOB)),"^",3)
IF PROC]""
SET COUNTS(PROC)=$GET(COUNTS(PROC))+1
+6 SET PROC=""
FOR
SET PROC=$ORDER(COUNTS(PROC))
if PROC=""
QUIT
SET ^HLC("HL7 PROCESS COUNTS","RUNNING",PROC)=COUNTS(PROC)
+7 SET PROC=""
FOR
SET PROC=$ORDER(^HLC("HL7 PROCESS COUNTS","RUNNING",PROC))
if PROC=""
QUIT
SET ^HLC("HL7 PROCESS COUNTS","RUNNING",PROC)=+$GET(COUNTS(PROC))
+8 LOCK -HL7("COUNTING PROCESSES")
+9 QUIT
+10 ;
CNTQUED ;count the queued tasks
+1 NEW JOB,COUNTS,PROC
+2 LOCK +HL7("COUNTING PROCESSES"):20
+3 if '$TEST
QUIT
+4 SET JOB=""
+5 FOR
SET JOB=$ORDER(^HLTMP("HL7 QUEUED PROCESSES",JOB))
if JOB=""
QUIT
SET PROC=$PIECE($GET(^HLTMP("HL7 QUEUED PROCESSES",JOB)),"^",2)
IF PROC]""
SET COUNTS(PROC)=$GET(COUNTS(PROC))+1
+6 SET PROC=""
FOR
SET PROC=$ORDER(COUNTS(PROC))
if PROC=""
QUIT
SET ^HLC("HL7 PROCESS COUNTS","QUEUED",PROC)=COUNTS(PROC)
+7 SET PROC=""
FOR
SET PROC=$ORDER(^HLC("HL7 PROCESS COUNTS","QUEUED",PROC))
if PROC=""
QUIT
SET ^HLC("HL7 PROCESS COUNTS","QUEUED",PROC)=+$GET(COUNTS(PROC))
+8 LOCK -HL7("COUNTING PROCESSES")
+9 QUIT
+10 ;
RECOUNT(RECOUNT) ;check that the processes that are supposed to be running actually are, same for the queued processes
+1 ;Input:
+2 ; RECOUNT (pass by reference, optional) not used, but passed in by the process manager
+3 ;
+4 ;
+5 ;check for processes that are supposed to be running or queued but aren't
+6 DO CHKDEAD()
DO CHKQUED
+7 ;
+8 ;recount the processes
+9 DO CNTLIVE
DO CNTQUED
+10 QUIT
+11 ;
RESET ;
+1 NEW CTR,DT,LINK,QUEUE,MSGIEN
+2 KILL ^HLTMP("FAILING LINKS")
+3 SET LINK=""
+4 FOR
SET LINK=$ORDER(^HLB("QUEUE","OUT",LINK))
if LINK=""
QUIT
Begin DoDot:1
+5 SET DT=$GET(^HLB("QUEUE","OUT",LINK))
+6 ;; down link (has a DT/TM)
IF DT'=""
SET ^HLTMP("FAILING LINKS",LINK)=DT
End DoDot:1
+7 QUIT
+8 ;
ERROR ;
+1 ;cleanup if the error occurred during queue recount
+2 LOCK -^HLTMP("PROCESS MANAGER")
+3 if $GET(HLON)
DO STARTHL7
+4 DO RCNT^HLOSITE("U")
+5 IF $LENGTH($GET(LOCK))
LOCK -@LOCK
+6 DO ^%ZTER
+7 DO UNWIND^%ZTER
+8 QUIT
+9 ;*****End HL*1.6*138
QCOUNT(WORK) ;count messages pending on all the queues
+1 NEW LOCK,FROM,LINK,QUEUE
+2 ; Set RECOUNT FLAG on
DO RCNT^HLOSITE("S")
+3 ;
+4 ; recount each OUT queue
+5 ;first delete counters for non-existent queues
+6 SET LINK=""
+7 FOR
SET LINK=$ORDER(^HLC("QUEUECOUNT","OUT",LINK))
if LINK=""
QUIT
Begin DoDot:1
+8 SET QUEUE=""
+9 FOR
SET QUEUE=$ORDER(^HLC("QUEUECOUNT","OUT",LINK,QUEUE))
if QUEUE=""
QUIT
IF '$ORDER(^HLB("QUEUE","OUT",LINK,QUEUE,0))
Begin DoDot:2
+10 SET LOCK=$NAME(RECOUNT("OUT",LINK,QUEUE))
+11 ;If lock not obtained skip recount for this queue
LOCK +@LOCK:1
if '$TEST
QUIT
+12 IF '$ORDER(^HLB("QUEUE","OUT",LINK,QUEUE,0))
SET ^HLC("QUEUECOUNT","OUT",LINK,QUEUE)=0
+13 LOCK -@LOCK
End DoDot:2
End DoDot:1
+14 ;
+15 ;now count the queues
+16 SET LINK=""
+17 FOR
SET LINK=$ORDER(^HLB("QUEUE","OUT",LINK))
if LINK=""
QUIT
Begin DoDot:1
+18 SET QUEUE=""
+19 FOR
SET QUEUE=$ORDER(^HLB("QUEUE","OUT",LINK,QUEUE))
if QUEUE=""
QUIT
Begin DoDot:2
+20 SET LOCK=$NAME(RECOUNT("OUT",LINK,QUEUE))
+21 ;If lock not obtained skip recount for this queue
LOCK +@LOCK:1
if '$TEST
QUIT
+22 SET (MSGIEN,CTR)=0
+23 FOR
SET MSGIEN=$ORDER(^HLB("QUEUE","OUT",LINK,QUEUE,MSGIEN))
if MSGIEN=""
QUIT
SET CTR=CTR+1
+24 SET ^HLC("QUEUECOUNT","OUT",LINK,QUEUE)=CTR
+25 LOCK -@LOCK
End DoDot:2
End DoDot:1
+26 ;
+27 ; recount each sequence queue
+28 ;first delete counts for non-existent queues
+29 SET QUEUE=""
+30 FOR
SET QUEUE=$ORDER(^HLC("QUEUECOUNT","SEQUENCE",QUEUE))
if QUEUE=""
QUIT
Begin DoDot:1
+31 if $GET(^HLB("QUEUE","SEQUENCE",QUEUE))!$ORDER(^HLB("QUEUE","SEQUENCE",QUEUE,0))
QUIT
+32 SET LOCK=$NAME(RECOUNT("SEQUENCE",QUEUE))
+33 LOCK +@LOCK:1
if '$TEST
QUIT
+34 IF '$GET(^HLB("QUEUE","SEQUENCE",QUEUE))
IF '$ORDER(^HLB("QUEUE","SEQUENCE",QUEUE,0))
SET ^HLC("QUEUECOUNT","SEQUENCE",QUEUE)=0
+35 LOCK -@LOCK
End DoDot:1
+36 ;
+37 ;now count the queues
+38 SET QUEUE=""
+39 FOR
SET QUEUE=$ORDER(^HLB("QUEUE","SEQUENCE",QUEUE))
if QUEUE=""
QUIT
Begin DoDot:1
+40 SET LOCK=$NAME(RECOUNT("SEQUENCE",QUEUE))
+41 ;should not fail, but if it does, skip the recount of this queue
LOCK +@LOCK:1
if '$TEST
QUIT
+42 ;
+43 SET (MSGIEN,CTR)=0
+44 ;count msg even if not on the queue if the queue is waiting on it
+45 IF +$GET(^HLB("QUEUE","SEQUENCE",QUEUE))
SET CTR=1
+46 ;
+47 FOR
SET MSGIEN=$ORDER(^HLB("QUEUE","SEQUENCE",QUEUE,MSGIEN))
if MSGIEN=""
QUIT
SET CTR=CTR+1
+48 SET ^HLC("QUEUECOUNT","SEQUENCE",QUEUE)=CTR
+49 LOCK -@LOCK
End DoDot:1
+50 ;
+51 ;
+52 ; now caculate the all-inclusive counter
+53 SET QUEUE=""
+54 SET CTR=0
+55 FOR
SET QUEUE=$ORDER(^HLC("QUEUECOUNT","SEQUENCE",QUEUE))
if QUEUE=""
QUIT
SET CTR=CTR+$GET(^HLC("QUEUECOUNT","SEQUENCE",QUEUE))
+56 SET ^HLC("QUEUECOUNT","SEQUENCE")=CTR
+57 ;
+58 ;
+59 ; recount IN queues
+60 ;
+61 ;first delete counts for non-existent queues
+62 SET FROM=""
+63 FOR
SET FROM=$ORDER(^HLC("QUEUECOUNT","IN",FROM))
if FROM=""
QUIT
Begin DoDot:1
+64 SET QUEUE=""
+65 FOR
SET QUEUE=$ORDER(^HLC("QUEUECOUNT","IN",FROM,QUEUE))
if QUEUE=""
QUIT
IF '$ORDER(^HLB("QUEUE","IN",FROM,QUEUE,0))
Begin DoDot:2
+66 SET LOCK=$NAME(RECOUNT("IN","FROM",QUEUE))
+67 ;If lock not obtained skip recount for this queue
LOCK +@LOCK:1
if '$TEST
QUIT
+68 IF '$ORDER(^HLB("QUEUE","IN",FROM,QUEUE,0))
SET ^HLC("QUEUECOUNT","IN",FROM,QUEUE)=0
+69 LOCK -@LOCK
End DoDot:2
End DoDot:1
+70 ;
+71 ;now count the queues
+72 SET FROM=""
+73 FOR
SET FROM=$ORDER(^HLB("QUEUE","IN",FROM))
if FROM=""
QUIT
Begin DoDot:1
+74 SET QUEUE=""
+75 FOR
SET QUEUE=$ORDER(^HLB("QUEUE","IN",FROM,QUEUE))
if QUEUE=""
QUIT
Begin DoDot:2
+76 SET LOCK=$NAME(RECOUNT("IN","FROM",QUEUE))
+77 ;If lock not obtained skip recount for this queue
LOCK +@LOCK:1
if '$TEST
QUIT
+78 SET (MSGIEN,CTR)=0
+79 FOR
SET MSGIEN=$ORDER(^HLB("QUEUE","IN",FROM,QUEUE,MSGIEN))
if MSGIEN=""
QUIT
Begin DoDot:3
+80 SET CTR=CTR+1
End DoDot:3
+81 SET ^HLC("QUEUECOUNT","IN",FROM,QUEUE)=CTR
+82 LOCK -@LOCK
End DoDot:2
End DoDot:1
+83 ;
+84 ;recount flag not needed anymore
+85 DO RCNT^HLOSITE("U")
+86 QUIT
