HLCSUTL2 ;ALB/JRP - COMMUNICATION SERVER UTILITIES;15-MAY-95 ;11/06/2000 06:39
;;1.6;HEALTH LEVEL SEVEN;**18,28,62**;Oct 13, 1995
CHK4STOP(PTRSUB,FLRTYPE,HLEXIT) ;DETERMINE IF FILER SHOULD STOP
;INPUT : PTRSUB - Pointer to incoming or outgoing filer subentry
; FLRTYPE - Indicates type of filer
; IN = Incoming (default)
; OUT = Outgoing
; HLEXIT - =0 (must be set by calling routine)
; HLEXIT("LASTCHK") - The last time the check was done. (Set by
; this routine for input to the next call to this routine
;OUTPUT : HLEXIT - Indicates whether Filer/task has been asked to stop
; 0 = no; 1 = yes
; HLEXIT("LASTCHK") - The last time the check was done.
;NOTES : This checks the STOP FILER field (#.02) of the INCOMING
; FILER TASK NUMBER and OUTGOING FILER TASK NUMBER multiples
; (fields 20 & 30) of the HL COMMUNICATION SERVER PARAMETER
; file (#869.3). If this field is set to YES, the filer
; has been asked to stop. After checking this, TaskMan
; will be asked if the task has been asked to stop [by
; calling $$S^%ZTLOAD].
; : FileMan is not used when determining if the STOP FILER field
; has been set to YES
Q:$$HDIFF^XLFDT($H,$G(HLEXIT("LASTCHK")),2)<60
;Check input
S PTRSUB=+$G(PTRSUB)
S FLRTYPE=$G(FLRTYPE)
;Declare variables
N PTRMAIN,NODE
S NODE=$S(FLRTYPE="OUT":3,1:2)
;Get entry in parameter file
S PTRMAIN=+$O(^HLCS(869.3,0))
I PTRMAIN D Q:HLEXIT
.;Lock/unlock zero node of multiple - force buffer update
.L +^HLCS(869.3,PTRMAIN,NODE,0):1
.L -^HLCS(869.3,PTRMAIN,NODE,0)
.;If subentry doesn't exist, filer won't die off
.I '$D(^HLCS(869.3,PTRMAIN,NODE,PTRSUB)) S HLEXIT=1 Q
.N NODE1
.;Get subentry zero node
.S NODE1=$G(^HLCS(869.3,PTRMAIN,NODE,PTRSUB,0))
.I NODE1="" S HLEXIT=1 Q
.;no record of task
.I $P(NODE1,"^")="" S HLEXIT=1 Q
.;STOP FILER field is piece 2
.I +$P(NODE1,"^",2) S HLEXIT=1
;Filer asked to stop
;Check if filer asked to stop via TaskMan
I +$$S^%ZTLOAD S HLEXIT=1
S HLEXIT("LASTCHK")=$H
Q
CNTFLR(FLRTYPE) ;RETURN NUMBER OF INCOMING/OUTGOING FILERS CURRENTLY RUNNING
;INPUT : FLRTYPE - Indicates type of filer
; IN = Incoming (default)
; OUT = Outgoing
;OUTPUT : X - Number of incoming/outgoing filers that are currently
; running. This will typically be the number of entries
; in the INCOMING FILER TASK NUMBER or OUTGOING FILER
; TASK NUMBER multiples (fields 20 & 30) of the HL
; COMMUNICATION SERVER PARAMETER file (#869.3). The
; tasks associated with the entries will be checked to
; determine if they have errored out - if so, they will
; not be included in the count.
; -1 - Error
;
;Check input
S FLRTYPE=$G(FLRTYPE)
;Declare variables
N PTRMAIN,NODE,COUNT,PTRSUB,ZTSK
S NODE=$S(FLRTYPE="OUT":3,1:2)
;Get entry in parameter file
S PTRMAIN=+$O(^HLCS(869.3,0))
Q:('PTRMAIN) -1
;Lock/unlock zero node of multiple - force buffer update
L +^HLCS(869.3,PTRMAIN,NODE,0):1
L -^HLCS(869.3,PTRMAIN,NODE,0)
;Count number of subentries
S PTRSUB=0
S COUNT=0
F S PTRSUB=+$O(^HLCS(869.3,PTRMAIN,NODE,PTRSUB)) Q:('PTRSUB) D
.;Get task number
.K ZTSK
.S ZTSK=+$G(^HLCS(869.3,PTRMAIN,NODE,PTRSUB,0))
.Q:('ZTSK)
.;Check status of task
.D STAT^%ZTLOAD
.;Task not defined, is inactive, or errored out
.Q:("12"'[ZTSK(1))
.;Increment count
.S COUNT=COUNT+1
Q COUNT
GETFLRS(FLRTYPE,ARRAY) ;RETURN LIST OF FILERS
;INPUT : FLRTYPE - Indicates type of filer
; IN = Incoming (default)
; OUT = Outgoing
; ARRAY - Array to return list of filers in (full global ref)
;OUTPUT : ARRAY will have the following format
; ARRAY(PtrSubEntry)=TaskNumber ^ LastKnown$H ^ Stop
; PtrSubEntry - Pointer to subentry in HL COMMUNICATION
; SERVER PARAMETER file (#869.3)
; TaskNumber - Task number of filer
; LastKnown$H - Value of LAST KNOWN $H (field #.03) for
; subentry
; Stop - Flag indicating if filer was asked to stop
; (field #.02 for subentry)
; 1 = YES
; 0 = NO
;NOTES : ARRAY will be initialized (KILLed) upon entry. If no
; entries are found in ARRAY() then no filers are running.
; : ARRAY() will not be defined on bad input
;
;Check input
Q:($G(ARRAY)="")
S FLRTYPE=$G(FLRTYPE)
;Declare variables
N PTRMAIN,NODE,PTRSUB,ZERONODE,TASKNUM,LASTDH,STOP
S NODE=$S(FLRTYPE="OUT":3,1:2)
;Initialize output array
K @ARRAY
;Get entry in parameter file
S PTRMAIN=+$O(^HLCS(869.3,0))
Q:('PTRMAIN)
;Lock/unlock zero node of multiple - force buffer update
L +^HLCS(869.3,PTRMAIN,NODE,0):1
L -^HLCS(869.3,PTRMAIN,NODE,0)
;Get list of filers
S PTRSUB=0
F S PTRSUB=+$O(^HLCS(869.3,PTRMAIN,NODE,PTRSUB)) Q:('PTRSUB) D
.;Get filer information
.S ZERONODE=$G(^HLCS(869.3,PTRMAIN,NODE,PTRSUB,0))
.S TASKNUM=+ZERONODE
.S STOP=+$P(ZERONODE,"^",2)
.S LASTDH=$P(ZERONODE,"^",3)
.;Put info into output array
.S @ARRAY@(PTRSUB)=TASKNUM_"^"_LASTDH_"^"_STOP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLCSUTL2 5440 printed Dec 13, 2024@01:57:14 Page 2
HLCSUTL2 ;ALB/JRP - COMMUNICATION SERVER UTILITIES;15-MAY-95 ;11/06/2000 06:39
+1 ;;1.6;HEALTH LEVEL SEVEN;**18,28,62**;Oct 13, 1995
CHK4STOP(PTRSUB,FLRTYPE,HLEXIT) ;DETERMINE IF FILER SHOULD STOP
+1 ;INPUT : PTRSUB - Pointer to incoming or outgoing filer subentry
+2 ; FLRTYPE - Indicates type of filer
+3 ; IN = Incoming (default)
+4 ; OUT = Outgoing
+5 ; HLEXIT - =0 (must be set by calling routine)
+6 ; HLEXIT("LASTCHK") - The last time the check was done. (Set by
+7 ; this routine for input to the next call to this routine
+8 ;OUTPUT : HLEXIT - Indicates whether Filer/task has been asked to stop
+9 ; 0 = no; 1 = yes
+10 ; HLEXIT("LASTCHK") - The last time the check was done.
+11 ;NOTES : This checks the STOP FILER field (#.02) of the INCOMING
+12 ; FILER TASK NUMBER and OUTGOING FILER TASK NUMBER multiples
+13 ; (fields 20 & 30) of the HL COMMUNICATION SERVER PARAMETER
+14 ; file (#869.3). If this field is set to YES, the filer
+15 ; has been asked to stop. After checking this, TaskMan
+16 ; will be asked if the task has been asked to stop [by
+17 ; calling $$S^%ZTLOAD].
+18 ; : FileMan is not used when determining if the STOP FILER field
+19 ; has been set to YES
+20 if $$HDIFF^XLFDT($HOROLOG,$GET(HLEXIT("LASTCHK")),2)<60
QUIT
+21 ;Check input
+22 SET PTRSUB=+$GET(PTRSUB)
+23 SET FLRTYPE=$GET(FLRTYPE)
+24 ;Declare variables
+25 NEW PTRMAIN,NODE
+26 SET NODE=$SELECT(FLRTYPE="OUT":3,1:2)
+27 ;Get entry in parameter file
+28 SET PTRMAIN=+$ORDER(^HLCS(869.3,0))
+29 IF PTRMAIN
Begin DoDot:1
+30 ;Lock/unlock zero node of multiple - force buffer update
+31 LOCK +^HLCS(869.3,PTRMAIN,NODE,0):1
+32 LOCK -^HLCS(869.3,PTRMAIN,NODE,0)
+33 ;If subentry doesn't exist, filer won't die off
+34 IF '$DATA(^HLCS(869.3,PTRMAIN,NODE,PTRSUB))
SET HLEXIT=1
QUIT
+35 NEW NODE1
+36 ;Get subentry zero node
+37 SET NODE1=$GET(^HLCS(869.3,PTRMAIN,NODE,PTRSUB,0))
+38 IF NODE1=""
SET HLEXIT=1
QUIT
+39 ;no record of task
+40 IF $PIECE(NODE1,"^")=""
SET HLEXIT=1
QUIT
+41 ;STOP FILER field is piece 2
+42 IF +$PIECE(NODE1,"^",2)
SET HLEXIT=1
End DoDot:1
if HLEXIT
QUIT
+43 ;Filer asked to stop
+44 ;Check if filer asked to stop via TaskMan
+45 IF +$$S^%ZTLOAD
SET HLEXIT=1
+46 SET HLEXIT("LASTCHK")=$HOROLOG
+47 QUIT
CNTFLR(FLRTYPE) ;RETURN NUMBER OF INCOMING/OUTGOING FILERS CURRENTLY RUNNING
+1 ;INPUT : FLRTYPE - Indicates type of filer
+2 ; IN = Incoming (default)
+3 ; OUT = Outgoing
+4 ;OUTPUT : X - Number of incoming/outgoing filers that are currently
+5 ; running. This will typically be the number of entries
+6 ; in the INCOMING FILER TASK NUMBER or OUTGOING FILER
+7 ; TASK NUMBER multiples (fields 20 & 30) of the HL
+8 ; COMMUNICATION SERVER PARAMETER file (#869.3). The
+9 ; tasks associated with the entries will be checked to
+10 ; determine if they have errored out - if so, they will
+11 ; not be included in the count.
+12 ; -1 - Error
+13 ;
+14 ;Check input
+15 SET FLRTYPE=$GET(FLRTYPE)
+16 ;Declare variables
+17 NEW PTRMAIN,NODE,COUNT,PTRSUB,ZTSK
+18 SET NODE=$SELECT(FLRTYPE="OUT":3,1:2)
+19 ;Get entry in parameter file
+20 SET PTRMAIN=+$ORDER(^HLCS(869.3,0))
+21 if ('PTRMAIN)
QUIT -1
+22 ;Lock/unlock zero node of multiple - force buffer update
+23 LOCK +^HLCS(869.3,PTRMAIN,NODE,0):1
+24 LOCK -^HLCS(869.3,PTRMAIN,NODE,0)
+25 ;Count number of subentries
+26 SET PTRSUB=0
+27 SET COUNT=0
+28 FOR
SET PTRSUB=+$ORDER(^HLCS(869.3,PTRMAIN,NODE,PTRSUB))
if ('PTRSUB)
QUIT
Begin DoDot:1
+29 ;Get task number
+30 KILL ZTSK
+31 SET ZTSK=+$GET(^HLCS(869.3,PTRMAIN,NODE,PTRSUB,0))
+32 if ('ZTSK)
QUIT
+33 ;Check status of task
+34 DO STAT^%ZTLOAD
+35 ;Task not defined, is inactive, or errored out
+36 if ("12"'[ZTSK(1))
QUIT
+37 ;Increment count
+38 SET COUNT=COUNT+1
End DoDot:1
+39 QUIT COUNT
GETFLRS(FLRTYPE,ARRAY) ;RETURN LIST OF FILERS
+1 ;INPUT : FLRTYPE - Indicates type of filer
+2 ; IN = Incoming (default)
+3 ; OUT = Outgoing
+4 ; ARRAY - Array to return list of filers in (full global ref)
+5 ;OUTPUT : ARRAY will have the following format
+6 ; ARRAY(PtrSubEntry)=TaskNumber ^ LastKnown$H ^ Stop
+7 ; PtrSubEntry - Pointer to subentry in HL COMMUNICATION
+8 ; SERVER PARAMETER file (#869.3)
+9 ; TaskNumber - Task number of filer
+10 ; LastKnown$H - Value of LAST KNOWN $H (field #.03) for
+11 ; subentry
+12 ; Stop - Flag indicating if filer was asked to stop
+13 ; (field #.02 for subentry)
+14 ; 1 = YES
+15 ; 0 = NO
+16 ;NOTES : ARRAY will be initialized (KILLed) upon entry. If no
+17 ; entries are found in ARRAY() then no filers are running.
+18 ; : ARRAY() will not be defined on bad input
+19 ;
+20 ;Check input
+21 if ($GET(ARRAY)="")
QUIT
+22 SET FLRTYPE=$GET(FLRTYPE)
+23 ;Declare variables
+24 NEW PTRMAIN,NODE,PTRSUB,ZERONODE,TASKNUM,LASTDH,STOP
+25 SET NODE=$SELECT(FLRTYPE="OUT":3,1:2)
+26 ;Initialize output array
+27 KILL @ARRAY
+28 ;Get entry in parameter file
+29 SET PTRMAIN=+$ORDER(^HLCS(869.3,0))
+30 if ('PTRMAIN)
QUIT
+31 ;Lock/unlock zero node of multiple - force buffer update
+32 LOCK +^HLCS(869.3,PTRMAIN,NODE,0):1
+33 LOCK -^HLCS(869.3,PTRMAIN,NODE,0)
+34 ;Get list of filers
+35 SET PTRSUB=0
+36 FOR
SET PTRSUB=+$ORDER(^HLCS(869.3,PTRMAIN,NODE,PTRSUB))
if ('PTRSUB)
QUIT
Begin DoDot:1
+37 ;Get filer information
+38 SET ZERONODE=$GET(^HLCS(869.3,PTRMAIN,NODE,PTRSUB,0))
+39 SET TASKNUM=+ZERONODE
+40 SET STOP=+$PIECE(ZERONODE,"^",2)
+41 SET LASTDH=$PIECE(ZERONODE,"^",3)
+42 ;Put info into output array
+43 SET @ARRAY@(PTRSUB)=TASKNUM_"^"_LASTDH_"^"_STOP
End DoDot:1
+44 QUIT
