source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSMON.m@ 1552

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

initial load of FOIAVistA 6/30/08 version

File size: 7.5 KB
Line 
1HLCSMON ;SF-DISPLAY DRIVER PROGRAM ;12/11/2007 17:07
2 ;;1.6;HEALTH LEVEL SEVEN;**34,40,48,49,65,66,73,109,122**;Oct 13, 1995;Build 14
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;This Program drives a real-time display monitor for the HL7
6 ;Package. All the data used by this display is stored in file
7 ;# 870. Several callable entry points were broken
8 ;out of this routine and placed into HLCSMON1
9 ;
10 ;This routine has no required input parameters other than require that
11 ;U be defined, it does not instantiate any parameters either.
12 ;
13 ;
14 ;HLARY=array of all,HLARYD=array of display,HLARYO=array of old values
15 ;HLPTR1=top of display,HLPTR2=bottom of display,HLPTR3=last in HLVARY
16INIT N HLARY,HLARYD,HLARYO,HLCOFF,HLCON,HLDISP,HLPTR1,HLPTR2,HLPTR3,HLRESP
17 N HLDEV,HLERR,HLEVL,HLHDR,HLNODE,HLOCK
18 N HLPARAM,HLPROC,HLPROD,HLSEND,HLSENT,HLSITE
19 N HLI,HLREC,HLRUNCNT,HLSTAT,HLTMSTAT,HLLMSTAT,HLVIEW,HLXX,HLYY,X,Y,DX,DY
20 ;
21 ; patch HL*1.6*122 start
22 D HOME^%ZIS
23 W @IOF
24 ; patch HL*1.6*122 end
25 ;
26 D ^HLCSTERM ;Sets up variables to control display attributes
27INIT1 ;
28 ; Next 4 lines copied here from top of START by patch 73...
29 ;HLRUNCNT=number of in filers^out filers, HLDISP=display mode
30 S HLRUNCNT="-1^-1",HLPTR1=1 S:'$D(HLDISP) HLDISP="S"
31 D BUILDARY ;Build an array for display
32 QUIT:$$LOCKED(.HLOCK) ;-> Anything locked?
33 ;
34 W HLCOFF ;Shut Cursor off
35 D HEADER^HLCSTERM ;Write header
36 D WDATA^HLCSMON1(5,17,"","","Incoming filers running => ")
37 D WDATA^HLCSMON1(5,18,"","","Outgoing filers running => ")
38 D WDATA^HLCSMON1(5,20,"","","Select a Command:")
39 D WDATA^HLCSMON1(1,21,"","","(N)EXT (B)ACKUP (A)LL LINKS (S)CREENED (V)IEWS (Q)UIT (?) HELP: ")
40 ;HLRUNCNT=number of in filers^out filers, HLDISP=display mode
41 S HLRUNCNT="-1^-1",HLPTR1=1 S:'$D(HLDISP) HLDISP="S"
42START ;
43 D BUILDARY ;Build an array for display
44 D DISPLAY^HLCSMON1 ;Display the array just built
45 D READ
46 ;HLRESP=user response
47 I '$L(HLRESP) G START
48 G:HLRESP="Q" EXIT
49 ;any of following commands, kill old values
50 K HLARYO,HLTMSTAT,HLLMSTAT
51 I HLRESP="?" D HELP G INIT1
52 I HLRESP="V" D VIEW G INIT1
53 I "AS"[HLRESP K HLARY,HLEVL S HLDISP=HLRESP G INIT1
54 I "NB"[HLRESP D NEXT
55 G START
56 ;
57READ ;Prompt the user for the next action
58 D WDATA^HLCSMON1(71,21,"","","",1)
59 W HLCON
60 R X#1:3
61 W HLCOFF
62 S HLRESP=$S(X="":X,"Qq^"[X:"Q","Bb"[X:"B","Nn"[X:"N","Aa"[X:"A","Vv"[X:"V",X="?":"?","Ss"[X:"S",1:"")
63 Q
64 ;
65VIEW ;select new view
66 W HLCON,!!
67 N DIC
68 S DIC="^HLCS(869.3,1,6,",DIC(0)="QEA"
69 D ^DIC Q:Y<0
70 S HLVIEW=+Y,HLDISP="V"
71 W HLCOFF
72 Q
73 ;
74NEXT ;
75 ;Next page
76 I HLRESP="N" D
77 . ;no more
78 . I HLPTR2=HLPTR3 D EOB Q
79 . S Y=HLPTR2+10,HLEVL(HLPTR1)=""
80 . ;exceed list, get last 10
81 . I Y>HLPTR3 S HLPTR2=HLPTR3,HLPTR1=HLPTR2-9 Q
82 . S HLPTR1=HLPTR2,HLPTR2=Y
83 ;
84 ;Backup a page
85 I HLRESP="B" D
86 . ;top of list
87 . I HLPTR1=1 D EOB Q
88 . I HLDISP="S" S HLPTR1=$O(HLEVL(HLPTR1),-1) Q
89 . S Y=HLPTR1-9
90 . ;can't go back 10, reset to top
91 . I Y'>0 S HLPTR1=1,HLPTR2=10 Q
92 . S HLPTR2=HLPTR1,HLPTR1=Y
93 ;
94 ;Erase what might be displayed on line 22
95 D WDATA^HLCSMON1(1,22,IOELALL,"","")
96 Q
97EOB D WDATA^HLCSMON1(5,22,IORVON,IORVOFF,"CANNOT "_$S(HLRESP="N":"ADVANCE",1:"BACKUP")_" BEYOND END OF BUFFER")
98 W $C(7) H 2
99 Q
100 ;
101BUILDARY ;
102 K HLARYD
103 ;
104 ;if view is defined, get links
105 I $G(HLVIEW) D S HLVIEW=0,HLDISP="V"
106 . N HLTMP
107 . K HLARY,HLEVL S HLI=0
108 . F S HLI=$O(^HLCS(869.3,1,6,HLVIEW,1,HLI)) Q:'HLI S HLYY=+$P($G(^(HLI,0)),U,2) D
109 .. S Y=$P($G(^HLCS(870,HLI,0)),U) Q:Y=""
110 .. ;build array by DISPLAY ORDER and then by NAME
111 .. I HLYY S HLTMP(HLYY,HLI)="" Q
112 .. S HLTMP(Y,HLI)=""
113 . S (HLI,HLYY)=0
114 . ;rebuild array to put in proper order
115 . F S HLI=$O(HLTMP(HLI)),HLXX=0 Q:HLI="" D
116 .. F S HLXX=$O(HLTMP(HLI,HLXX)) Q:'HLXX S HLYY=HLYY+1,HLARY(HLYY,HLXX)=""
117 . S HLPTR3=HLYY
118 ;
119 I '$D(HLARY) S HLYY=0,HLXX="" D
120 . ;build array in alphabetical order
121 . F S HLXX=$O(^HLCS(870,"B",HLXX)) Q:HLXX="" S Y=$O(^(HLXX,0)),HLYY=HLYY+1,HLARY(HLYY,Y)=""
122 . S HLPTR3=HLYY
123 ;
124 S HLI=HLPTR1,HLYY=6 ;HLYY=6TH Line of display
125 ;HLARYD(6) through HLARYD(15) with 6 through 15 also representing line
126 ;numbers on the display
127 F HLI=HLI:1 S HLXX=$O(HLARY(HLI,0)) Q:HLYY=16!'HLXX D COPY
128 S HLPTR2=HLI-1
129 ;Set all HLARY elements not defined on this pass to null
130 F HLYY=HLYY:1:15 S HLARYD(HLYY)=""
131 Q
132COPY ;
133 Q:'$D(^HLCS(870,HLXX))
134 ;
135 ;These lock tags lock nodes in the global so that the screen is
136 ;refreshed in real-time. The lock forces the buffer to be refreshed,
137 ;so that the display is up to date.
138 ;
139 ;**109**
140 ;L +^HLCS(870,HLXX,0):0 L -^HLCS(870,HLXX,0) D CHKLOCK
141 ;
142 ; Set, even if not able to lock...
143 S Y=$G(^HLCS(870,HLXX,0))
144 ;
145 ;name^rec^proc^send^sent^device^state^error
146 S HLARYD(HLYY)=$P(Y,U)_"^^^^^"_$P(Y,U,4)_"^"_$P(Y,U,5)_"^"_$P(Y,U,19)
147 ;
148 ;**109**
149 ;L +^HLCS(870,HLXX,"IN QUEUE BACK POINTER"):0 D CHKLOCK
150 ;L -^HLCS(870,HLXX,"IN QUEUE BACK POINTER")
151 ;
152 S $P(HLARYD(HLYY),U,2)=$G(^HLCS(870,HLXX,"IN QUEUE BACK POINTER"))
153 ;
154 ;**109**
155 ;L +^HLCS(870,HLXX,"IN QUEUE FRONT POINTER"):0 D CHKLOCK
156 ;L -^HLCS(870,HLXX,"IN QUEUE FRONT POINTER")
157 ;
158 S $P(HLARYD(HLYY),U,3)=$G(^HLCS(870,HLXX,"IN QUEUE FRONT POINTER"))
159 ;
160 ;**109**
161 ;L +^HLCS(870,HLXX,"OUT QUEUE BACK POINTER"):0 D CHKLOCK
162 ;L -^HLCS(870,HLXX,"OUT QUEUE BACK POINTER")
163 ;
164 S $P(HLARYD(HLYY),U,4)=$G(^HLCS(870,HLXX,"OUT QUEUE BACK POINTER"))
165 ;
166 ;**109**
167 ;L +^HLCS(870,HLXX,"OUT QUEUE FRONT POINTER"):0 D CHKLOCK
168 ;L -^HLCS(870,HLXX,"OUT QUEUE FRONT POINTER")
169 ;
170 S $P(HLARYD(HLYY),U,5)=$G(^HLCS(870,HLXX,"OUT QUEUE FRONT POINTER"))
171 ;
172 S X=HLARYD(HLYY),Y=$P(X,U,2)+$P(X,U,3)+$P(X,U,4)+$P(X,U,5)
173 ;if Select and the Y=0, nothing to report
174 I 'Y,HLDISP="S" S HLARYD(HLYY)="" Q
175 S HLYY=HLYY+1
176 Q
177 ;
178CHKLOCK ; Call here immediately after trying to lock. And, BE SURE that
179 ; nothing might occur that would change $T after the lock attempt!!
180 ; $T,HLXX -- req
181 N NM870
182 QUIT:$T ;-> Lock obtained...
183 S NM870=$P($G(^HLCS(870,+HLXX,0)),U)
184 S NM870=$S(NM870]"":NM870_" (IEN #"_HLXX_")",1:"IEN #"_HLXX)
185 S HLOCK(NM870)=""
186 QUIT
187 ;
188HELP ;
189 W HLCON,@IOF
190 W !,"You have the following options when monitoring the Messaging System:"
191 W !,"Enter the command letter parentheses: N,B,Q,A,S,V or ?"
192 W !!,"(N) takes you to the next page of the display of Logical Links."
193 W !!,"(B) takes you back one page."
194 W !!,"(Q) terminates the monitor."
195 W !!,"(A) provides a display of all links defined on your system."
196 W !!,"(S) displays only those links that have had message traffic."
197 W !!,"(V) prompts for a view name and displays links defined in view."
198 W !!," Note that (S) is the default display at startup."
199 W !!,"**PRESS <RET> TO CONTINUE**"
200 R X:DTIME
201 W @IOF
202 W !,?25,"Device Types and corresponding prefixes:"
203 W !!,?30,"PC -- Persistent TCP/IP Client"
204 W !!,?30,"NC -- Non-Persistent TCP/IP Client"
205 W !!,?30,"SS -- Single-threaded TCP/IP Server"
206 W !!,?30,"MS -- Multi-threaded TCP/IP Server"
207 W !!,?30,"SH -- Serial HLLP"
208 W !!,?30,"SX -- Serial X3.28"
209 W !!,?30,"MM -- MailMan"
210 W !!,"**PRESS <RET> TO CONTINUE**"
211 R X:DTIME
212 W HLCOFF
213 Q
214EXIT ;
215 ;Turn Cursor back on
216 W HLCON
217 D KVAR^HLCSTERM
218 Q
219 ;
220LOCKED(HLOCK) ; Anything locked?
221 ;
222 ;
223 ; Nothing locked...
224 I '$D(HLOCK) QUIT "" ;->
225 ;
226 W !!,"Editing of logical link data is occurring right now. For this reason, some of"
227 W !,"the information on the 'System Link Monitor' report might not be accurate for"
228 W !,"the following node(s)..."
229 W !
230 ;
231 S HLOCK=""
232 F S HLOCK=$O(HLOCK(HLOCK)) Q:HLOCK']"" D
233 . W !,?5,HLOCK
234 ;
235 S ACTION=$$BTE("Press RETURN to print report or '^' to exit... ",1)
236 ;
237 QUIT $S(ACTION=1:1,1:"")
238 ;
239BTE(PMT,FF) ;
240 N DIR,DIRUT,DTOUT,DUOUT,X,Y
241 F X=1:1:$G(FF) W !
242 S DIR(0)="EA",DIR("A")=PMT
243 D ^DIR
244 QUIT $S(Y=1:"",1:1)
245 ;
Note: See TracBrowser for help on using the repository browser.