- 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 Feb 18, 2025@23:23:38 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