source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSUTL2.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.2 KB
Line 
1HLCSUTL2 ;ALB/JRP - COMMUNICATION SERVER UTILITIES;15-MAY-95 ;11/06/2000 06:39
2 ;;1.6;HEALTH LEVEL SEVEN;**18,28,62**;Oct 13, 1995
3CHK4STOP(PTRSUB,FLRTYPE,HLEXIT) ;DETERMINE IF FILER SHOULD STOP
4 ;INPUT : PTRSUB - Pointer to incoming or outgoing filer subentry
5 ; FLRTYPE - Indicates type of filer
6 ; IN = Incoming (default)
7 ; OUT = Outgoing
8 ; HLEXIT - =0 (must be set by calling routine)
9 ; HLEXIT("LASTCHK") - The last time the check was done. (Set by
10 ; this routine for input to the next call to this routine
11 ;OUTPUT : HLEXIT - Indicates whether Filer/task has been asked to stop
12 ; 0 = no; 1 = yes
13 ; HLEXIT("LASTCHK") - The last time the check was done.
14 ;NOTES : This checks the STOP FILER field (#.02) of the INCOMING
15 ; FILER TASK NUMBER and OUTGOING FILER TASK NUMBER multiples
16 ; (fields 20 & 30) of the HL COMMUNICATION SERVER PARAMETER
17 ; file (#869.3). If this field is set to YES, the filer
18 ; has been asked to stop. After checking this, TaskMan
19 ; will be asked if the task has been asked to stop [by
20 ; calling $$S^%ZTLOAD].
21 ; : FileMan is not used when determining if the STOP FILER field
22 ; has been set to YES
23 Q:$$HDIFF^XLFDT($H,$G(HLEXIT("LASTCHK")),2)<60
24 ;Check input
25 S PTRSUB=+$G(PTRSUB)
26 S FLRTYPE=$G(FLRTYPE)
27 ;Declare variables
28 N PTRMAIN,NODE
29 S NODE=$S(FLRTYPE="OUT":3,1:2)
30 ;Get entry in parameter file
31 S PTRMAIN=+$O(^HLCS(869.3,0))
32 I PTRMAIN D Q:HLEXIT
33 .;Lock/unlock zero node of multiple - force buffer update
34 .L +^HLCS(869.3,PTRMAIN,NODE,0):1
35 .L -^HLCS(869.3,PTRMAIN,NODE,0)
36 .;If subentry doesn't exist, filer won't die off
37 .I '$D(^HLCS(869.3,PTRMAIN,NODE,PTRSUB)) S HLEXIT=1 Q
38 .N NODE1
39 .;Get subentry zero node
40 .S NODE1=$G(^HLCS(869.3,PTRMAIN,NODE,PTRSUB,0))
41 .I NODE1="" S HLEXIT=1 Q
42 .;no record of task
43 .I $P(NODE1,"^")="" S HLEXIT=1 Q
44 .;STOP FILER field is piece 2
45 .I +$P(NODE1,"^",2) S HLEXIT=1
46 ;Filer asked to stop
47 ;Check if filer asked to stop via TaskMan
48 I +$$S^%ZTLOAD S HLEXIT=1
49 S HLEXIT("LASTCHK")=$H
50 Q
51CNTFLR(FLRTYPE) ;RETURN NUMBER OF INCOMING/OUTGOING FILERS CURRENTLY RUNNING
52 ;INPUT : FLRTYPE - Indicates type of filer
53 ; IN = Incoming (default)
54 ; OUT = Outgoing
55 ;OUTPUT : X - Number of incoming/outgoing filers that are currently
56 ; running. This will typically be the number of entries
57 ; in the INCOMING FILER TASK NUMBER or OUTGOING FILER
58 ; TASK NUMBER multiples (fields 20 & 30) of the HL
59 ; COMMUNICATION SERVER PARAMETER file (#869.3). The
60 ; tasks associated with the entries will be checked to
61 ; determine if they have errored out - if so, they will
62 ; not be included in the count.
63 ; -1 - Error
64 ;
65 ;Check input
66 S FLRTYPE=$G(FLRTYPE)
67 ;Declare variables
68 N PTRMAIN,NODE,COUNT,PTRSUB,ZTSK
69 S NODE=$S(FLRTYPE="OUT":3,1:2)
70 ;Get entry in parameter file
71 S PTRMAIN=+$O(^HLCS(869.3,0))
72 Q:('PTRMAIN) -1
73 ;Lock/unlock zero node of multiple - force buffer update
74 L +^HLCS(869.3,PTRMAIN,NODE,0):1
75 L -^HLCS(869.3,PTRMAIN,NODE,0)
76 ;Count number of subentries
77 S PTRSUB=0
78 S COUNT=0
79 F S PTRSUB=+$O(^HLCS(869.3,PTRMAIN,NODE,PTRSUB)) Q:('PTRSUB) D
80 .;Get task number
81 .K ZTSK
82 .S ZTSK=+$G(^HLCS(869.3,PTRMAIN,NODE,PTRSUB,0))
83 .Q:('ZTSK)
84 .;Check status of task
85 .D STAT^%ZTLOAD
86 .;Task not defined, is inactive, or errored out
87 .Q:("12"'[ZTSK(1))
88 .;Increment count
89 .S COUNT=COUNT+1
90 Q COUNT
91GETFLRS(FLRTYPE,ARRAY) ;RETURN LIST OF FILERS
92 ;INPUT : FLRTYPE - Indicates type of filer
93 ; IN = Incoming (default)
94 ; OUT = Outgoing
95 ; ARRAY - Array to return list of filers in (full global ref)
96 ;OUTPUT : ARRAY will have the following format
97 ; ARRAY(PtrSubEntry)=TaskNumber ^ LastKnown$H ^ Stop
98 ; PtrSubEntry - Pointer to subentry in HL COMMUNICATION
99 ; SERVER PARAMETER file (#869.3)
100 ; TaskNumber - Task number of filer
101 ; LastKnown$H - Value of LAST KNOWN $H (field #.03) for
102 ; subentry
103 ; Stop - Flag indicating if filer was asked to stop
104 ; (field #.02 for subentry)
105 ; 1 = YES
106 ; 0 = NO
107 ;NOTES : ARRAY will be initialized (KILLed) upon entry. If no
108 ; entries are found in ARRAY() then no filers are running.
109 ; : ARRAY() will not be defined on bad input
110 ;
111 ;Check input
112 Q:($G(ARRAY)="")
113 S FLRTYPE=$G(FLRTYPE)
114 ;Declare variables
115 N PTRMAIN,NODE,PTRSUB,ZERONODE,TASKNUM,LASTDH,STOP
116 S NODE=$S(FLRTYPE="OUT":3,1:2)
117 ;Initialize output array
118 K @ARRAY
119 ;Get entry in parameter file
120 S PTRMAIN=+$O(^HLCS(869.3,0))
121 Q:('PTRMAIN)
122 ;Lock/unlock zero node of multiple - force buffer update
123 L +^HLCS(869.3,PTRMAIN,NODE,0):1
124 L -^HLCS(869.3,PTRMAIN,NODE,0)
125 ;Get list of filers
126 S PTRSUB=0
127 F S PTRSUB=+$O(^HLCS(869.3,PTRMAIN,NODE,PTRSUB)) Q:('PTRSUB) D
128 .;Get filer information
129 .S ZERONODE=$G(^HLCS(869.3,PTRMAIN,NODE,PTRSUB,0))
130 .S TASKNUM=+ZERONODE
131 .S STOP=+$P(ZERONODE,"^",2)
132 .S LASTDH=$P(ZERONODE,"^",3)
133 .;Put info into output array
134 .S @ARRAY@(PTRSUB)=TASKNUM_"^"_LASTDH_"^"_STOP
135 Q
Note: See TracBrowser for help on using the repository browser.