HLCSMON ;SF-DISPLAY DRIVER PROGRAM ;07/10/2000 12:18
;;1.6;HEALTH LEVEL SEVEN;**34,40,48,49,65,66,73,109**;Oct 13, 1995
;
;This Program drives a real-time display monitor for the HL7
;Package. All the data used by this display is stored in file
;# 870. Several callable entry points were broken
;out of this routine and placed into HLCSMON1
;
;This routine has no required input parameters other than require that
;U be defined, it does not instantiate any parameters either.
;
;
;HLARY=array of all,HLARYD=array of display,HLARYO=array of old values
;HLPTR1=top of display,HLPTR2=bottom of display,HLPTR3=last in HLVARY
INIT N HLARY,HLARYD,HLARYO,HLCOFF,HLCON,HLDISP,HLPTR1,HLPTR2,HLPTR3,HLRESP
N HLDEV,HLERR,HLEVL,HLHDR,HLNODE,HLOCK
N HLPARAM,HLPROC,HLPROD,HLSEND,HLSENT,HLSITE
N HLI,HLREC,HLRUNCNT,HLSTAT,HLTMSTAT,HLLMSTAT,HLVIEW,HLXX,HLYY,X,Y,DX,DY
;
D ^HLCSTERM ;Sets up variables to control display attributes
INIT1 ;
; Next 4 lines copied here from top of START by patch 73...
;HLRUNCNT=number of in filers^out filers, HLDISP=display mode
S HLRUNCNT="-1^-1",HLPTR1=1 S:'$D(HLDISP) HLDISP="S"
D BUILDARY ;Build an array for display
QUIT:$$LOCKED(.HLOCK) ;-> Anything locked?
;
W HLCOFF ;Shut Cursor off
D HEADER^HLCSTERM ;Write header
D WDATA^HLCSMON1(5,17,"","","Incoming filers running => ")
D WDATA^HLCSMON1(5,18,"","","Outgoing filers running => ")
D WDATA^HLCSMON1(5,20,"","","Select a Command:")
D WDATA^HLCSMON1(1,21,"","","(N)EXT (B)ACKUP (A)LL LINKS (S)CREENED (V)IEWS (Q)UIT (?) HELP: ")
;HLRUNCNT=number of in filers^out filers, HLDISP=display mode
S HLRUNCNT="-1^-1",HLPTR1=1 S:'$D(HLDISP) HLDISP="S"
START ;
D BUILDARY ;Build an array for display
D DISPLAY^HLCSMON1 ;Display the array just built
D READ
;HLRESP=user response
I '$L(HLRESP) G START
G:HLRESP="Q" EXIT
;any of following commands, kill old values
K HLARYO,HLTMSTAT,HLLMSTAT
I HLRESP="?" D HELP G INIT1
I HLRESP="V" D VIEW G INIT1
I "AS"[HLRESP K HLARY,HLEVL S HLDISP=HLRESP G INIT1
I "NB"[HLRESP D NEXT
G START
;
READ ;Prompt the user for the next action
D WDATA^HLCSMON1(71,21,"","","",1)
W HLCON
R X#1:3
W HLCOFF
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:"")
Q
;
VIEW ;select new view
W HLCON,!!
N DIC
S DIC="^HLCS(869.3,1,6,",DIC(0)="QEA"
D ^DIC Q:Y<0
S HLVIEW=+Y,HLDISP="V"
W HLCOFF
Q
;
NEXT ;
;Next page
I HLRESP="N" D
. ;no more
. I HLPTR2=HLPTR3 D EOB Q
. S Y=HLPTR2+10,HLEVL(HLPTR1)=""
. ;exceed list, get last 10
. I Y>HLPTR3 S HLPTR2=HLPTR3,HLPTR1=HLPTR2-9 Q
. S HLPTR1=HLPTR2,HLPTR2=Y
;
;Backup a page
I HLRESP="B" D
. ;top of list
. I HLPTR1=1 D EOB Q
. I HLDISP="S" S HLPTR1=$O(HLEVL(HLPTR1),-1) Q
. S Y=HLPTR1-9
. ;can't go back 10, reset to top
. I Y'>0 S HLPTR1=1,HLPTR2=10 Q
. S HLPTR2=HLPTR1,HLPTR1=Y
;
;Erase what might be displayed on line 22
D WDATA^HLCSMON1(1,22,IOELALL,"","")
Q
EOB D WDATA^HLCSMON1(5,22,IORVON,IORVOFF,"CANNOT "_$S(HLRESP="N":"ADVANCE",1:"BACKUP")_" BEYOND END OF BUFFER")
W $C(7) H 2
Q
;
BUILDARY ;
K HLARYD
;
;if view is defined, get links
I $G(HLVIEW) D S HLVIEW=0,HLDISP="V"
. N HLTMP
. K HLARY,HLEVL S HLI=0
. F S HLI=$O(^HLCS(869.3,1,6,HLVIEW,1,HLI)) Q:'HLI S HLYY=+$P($G(^(HLI,0)),U,2) D
.. S Y=$P($G(^HLCS(870,HLI,0)),U) Q:Y=""
.. ;build array by DISPLAY ORDER and then by NAME
.. I HLYY S HLTMP(HLYY,HLI)="" Q
.. S HLTMP(Y,HLI)=""
. S (HLI,HLYY)=0
. ;rebuild array to put in proper order
. F S HLI=$O(HLTMP(HLI)),HLXX=0 Q:HLI="" D
.. F S HLXX=$O(HLTMP(HLI,HLXX)) Q:'HLXX S HLYY=HLYY+1,HLARY(HLYY,HLXX)=""
. S HLPTR3=HLYY
;
I '$D(HLARY) S HLYY=0,HLXX="" D
. ;build array in alphabetical order
. F S HLXX=$O(^HLCS(870,"B",HLXX)) Q:HLXX="" S Y=$O(^(HLXX,0)),HLYY=HLYY+1,HLARY(HLYY,Y)=""
. S HLPTR3=HLYY
;
S HLI=HLPTR1,HLYY=6 ;HLYY=6TH Line of display
;HLARYD(6) through HLARYD(15) with 6 through 15 also representing line
;numbers on the display
F HLI=HLI:1 S HLXX=$O(HLARY(HLI,0)) Q:HLYY=16!'HLXX D COPY
S HLPTR2=HLI-1
;Set all HLARY elements not defined on this pass to null
F HLYY=HLYY:1:15 S HLARYD(HLYY)=""
Q
COPY ;
Q:'$D(^HLCS(870,HLXX))
;
;These lock tags lock nodes in the global so that the screen is
;refreshed in real-time. The lock forces the buffer to be refreshed,
;so that the display is up to date.
;
;**109**
;L +^HLCS(870,HLXX,0):0 L -^HLCS(870,HLXX,0) D CHKLOCK
;
; Set, even if not able to lock...
S Y=$G(^HLCS(870,HLXX,0))
;
;name^rec^proc^send^sent^device^state^error
S HLARYD(HLYY)=$P(Y,U)_"^^^^^"_$P(Y,U,4)_"^"_$P(Y,U,5)_"^"_$P(Y,U,19)
;
;**109**
;L +^HLCS(870,HLXX,"IN QUEUE BACK POINTER"):0 D CHKLOCK
;L -^HLCS(870,HLXX,"IN QUEUE BACK POINTER")
;
S $P(HLARYD(HLYY),U,2)=$G(^HLCS(870,HLXX,"IN QUEUE BACK POINTER"))
;
;**109**
;L +^HLCS(870,HLXX,"IN QUEUE FRONT POINTER"):0 D CHKLOCK
;L -^HLCS(870,HLXX,"IN QUEUE FRONT POINTER")
;
S $P(HLARYD(HLYY),U,3)=$G(^HLCS(870,HLXX,"IN QUEUE FRONT POINTER"))
;
;**109**
;L +^HLCS(870,HLXX,"OUT QUEUE BACK POINTER"):0 D CHKLOCK
;L -^HLCS(870,HLXX,"OUT QUEUE BACK POINTER")
;
S $P(HLARYD(HLYY),U,4)=$G(^HLCS(870,HLXX,"OUT QUEUE BACK POINTER"))
;
;**109**
;L +^HLCS(870,HLXX,"OUT QUEUE FRONT POINTER"):0 D CHKLOCK
;L -^HLCS(870,HLXX,"OUT QUEUE FRONT POINTER")
;
S $P(HLARYD(HLYY),U,5)=$G(^HLCS(870,HLXX,"OUT QUEUE FRONT POINTER"))
;
S X=HLARYD(HLYY),Y=$P(X,U,2)+$P(X,U,3)+$P(X,U,4)+$P(X,U,5)
;if Select and the Y=0, nothing to report
I 'Y,HLDISP="S" S HLARYD(HLYY)="" Q
S HLYY=HLYY+1
Q
;
CHKLOCK ; Call here immediately after trying to lock. And, BE SURE that
; nothing might occur that would change $T after the lock attempt!!
; $T,HLXX -- req
N NM870
QUIT:$T ;-> Lock obtained...
S NM870=$P($G(^HLCS(870,+HLXX,0)),U)
S NM870=$S(NM870]"":NM870_" (IEN #"_HLXX_")",1:"IEN #"_HLXX)
S HLOCK(NM870)=""
QUIT
;
HELP ;
W HLCON,@IOF
W !,"You have the following options when monitoring the Messaging System:"
W !,"Enter the command letter parentheses: N,B,Q,A,S,V or ?"
W !!,"(N) takes you to the next page of the display of Logical Links."
W !!,"(B) takes you back one page."
W !!,"(Q) terminates the monitor."
W !!,"(A) provides a display of all links defined on your system."
W !!,"(S) displays only those links that have had message traffic."
W !!,"(V) prompts for a view name and displays links defined in view."
W !!," Note that (S) is the default display at startup."
W !!,"**PRESS <RET> TO CONTINUE**"
R X:DTIME
W @IOF
W !,?25,"Device Types and corresponding prefixes:"
W !!,?30,"PC -- Persistent TCP/IP Client"
W !!,?30,"NC -- Non-Persistent TCP/IP Client"
W !!,?30,"SS -- Single-threaded TCP/IP Server"
W !!,?30,"MS -- Multi-threaded TCP/IP Server"
W !!,?30,"SH -- Serial HLLP"
W !!,?30,"SX -- Serial X3.28"
W !!,?30,"MM -- MailMan"
W !!,"**PRESS <RET> TO CONTINUE**"
R X:DTIME
W HLCOFF
Q
EXIT ;
;Turn Cursor back on
W HLCON
D KVAR^HLCSTERM
Q
;
LOCKED(HLOCK) ; Anything locked?
;
;
; Nothing locked...
I '$D(HLOCK) QUIT "" ;->
;
W !!,"Editing of logical link data is occurring right now. For this reason, some of"
W !,"the information on the 'System Link Monitor' report might not be accurate for"
W !,"the following node(s)..."
W !
;
S HLOCK=""
F S HLOCK=$O(HLOCK(HLOCK)) Q:HLOCK']"" D
. W !,?5,HLOCK
;
S ACTION=$$BTE("Press RETURN to print report or '^' to exit... ",1)
;
QUIT $S(ACTION=1:1,1:"")
;
BTE(PMT,FF) ;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
F X=1:1:$G(FF) W !
S DIR(0)="EA",DIR("A")=PMT
D ^DIR
QUIT $S(Y=1:"",1:1)
;
HLCSMON ;SF-DISPLAY DRIVER PROGRAM ;07/10/2000 12:18
+1 ;;1.6;HEALTH LEVEL SEVEN;**34,40,48,49,65,66,73,109**;Oct 13, 1995
+2 ;
+3 ;This Program drives a real-time display monitor for the HL7
+4 ;Package. All the data used by this display is stored in file
+5 ;# 870. Several callable entry points were broken
+6 ;out of this routine and placed into HLCSMON1
+7 ;
+8 ;This routine has no required input parameters other than require that
+9 ;U be defined, it does not instantiate any parameters either.
+10 ;
+11 ;
+12 ;HLARY=array of all,HLARYD=array of display,HLARYO=array of old values
+13 ;HLPTR1=top of display,HLPTR2=bottom of display,HLPTR3=last in HLVARY
INIT NEW HLARY,HLARYD,HLARYO,HLCOFF,HLCON,HLDISP,HLPTR1,HLPTR2,HLPTR3,HLRESP
+1 NEW HLDEV,HLERR,HLEVL,HLHDR,HLNODE,HLOCK
+2 NEW HLPARAM,HLPROC,HLPROD,HLSEND,HLSENT,HLSITE
+3 NEW HLI,HLREC,HLRUNCNT,HLSTAT,HLTMSTAT,HLLMSTAT,HLVIEW,HLXX,HLYY,X,Y,DX,DY
+4 ;
+5 ;Sets up variables to control display attributes
DO ^HLCSTERM
INIT1 ;
+1 ; Next 4 lines copied here from top of START by patch 73...
+2 ;HLRUNCNT=number of in filers^out filers, HLDISP=display mode
+3 SET HLRUNCNT="-1^-1"
SET HLPTR1=1
IF '$DATA(HLDISP)
SET HLDISP="S"
+4 ;Build an array for display
DO BUILDARY
+5 ;-> Anything locked?
IF $$LOCKED(.HLOCK)
QUIT
+6 ;
+7 ;Shut Cursor off
WRITE HLCOFF
+8 ;Write header
DO HEADER^HLCSTERM
+9 DO WDATA^HLCSMON1(5,17,"","","Incoming filers running => ")
+10 DO WDATA^HLCSMON1(5,18,"","","Outgoing filers running => ")
+11 DO WDATA^HLCSMON1(5,20,"","","Select a Command:")
+12 DO WDATA^HLCSMON1(1,21,"","","(N)EXT (B)ACKUP (A)LL LINKS (S)CREENED (V)IEWS (Q)UIT (?) HELP: ")
+13 ;HLRUNCNT=number of in filers^out filers, HLDISP=display mode
+14 SET HLRUNCNT="-1^-1"
SET HLPTR1=1
IF '$DATA(HLDISP)
SET HLDISP="S"
START ;
+1 ;Build an array for display
DO BUILDARY
+2 ;Display the array just built
DO DISPLAY^HLCSMON1
+3 DO READ
+4 ;HLRESP=user response
+5 IF '$LENGTH(HLRESP)
GOTO START
+6 IF HLRESP="Q"
GOTO EXIT
+7 ;any of following commands, kill old values
+8 KILL HLARYO,HLTMSTAT,HLLMSTAT
+9 IF HLRESP="?"
DO HELP
GOTO INIT1
+10 IF HLRESP="V"
DO VIEW
GOTO INIT1
+11 IF "AS"[HLRESP
KILL HLARY,HLEVL
SET HLDISP=HLRESP
GOTO INIT1
+12 IF "NB"[HLRESP
DO NEXT
+13 GOTO START
+14 ;
READ ;Prompt the user for the next action
+1 DO WDATA^HLCSMON1(71,21,"","","",1)
+2 WRITE HLCON
+3 READ X#1:3
+4 WRITE HLCOFF
+5 SET HLRESP=$SELECT(X="":X,"Qq^"[X:"Q","Bb"[X:"B","Nn"[X:"N","Aa"[X:"A","Vv"[X:"V",X="?":"?","Ss"[X:"S",1:"")
+6 QUIT
+7 ;
VIEW ;select new view
+1 WRITE HLCON,!!
+2 NEW DIC
+3 SET DIC="^HLCS(869.3,1,6,"
SET DIC(0)="QEA"
+4 DO ^DIC
IF Y<0
QUIT
+5 SET HLVIEW=+Y
SET HLDISP="V"
+6 WRITE HLCOFF
+7 QUIT
+8 ;
NEXT ;
+1 ;Next page
+2 IF HLRESP="N"
Begin DoDot:1
+3 ;no more
+4 IF HLPTR2=HLPTR3
DO EOB
QUIT
+5 SET Y=HLPTR2+10
SET HLEVL(HLPTR1)=""
+6 ;exceed list, get last 10
+7 IF Y>HLPTR3
SET HLPTR2=HLPTR3
SET HLPTR1=HLPTR2-9
QUIT
+8 SET HLPTR1=HLPTR2
SET HLPTR2=Y
End DoDot:1
+9 ;
+10 ;Backup a page
+11 IF HLRESP="B"
Begin DoDot:1
+12 ;top of list
+13 IF HLPTR1=1
DO EOB
QUIT
+14 IF HLDISP="S"
SET HLPTR1=$ORDER(HLEVL(HLPTR1),-1)
QUIT
+15 SET Y=HLPTR1-9
+16 ;can't go back 10, reset to top
+17 IF Y'>0
SET HLPTR1=1
SET HLPTR2=10
QUIT
+18 SET HLPTR2=HLPTR1
SET HLPTR1=Y
End DoDot:1
+19 ;
+20 ;Erase what might be displayed on line 22
+21 DO WDATA^HLCSMON1(1,22,IOELALL,"","")
+22 QUIT
EOB DO WDATA^HLCSMON1(5,22,IORVON,IORVOFF,"CANNOT "_$SELECT(HLRESP="N":"ADVANCE",1:"BACKUP")_" BEYOND END OF BUFFER")
+1 WRITE $CHAR(7)
HANG 2
+2 QUIT
+3 ;
BUILDARY ;
+1 KILL HLARYD
+2 ;
+3 ;if view is defined, get links
+4 IF $GET(HLVIEW)
Begin DoDot:1
+5 NEW HLTMP
+6 KILL HLARY,HLEVL
SET HLI=0
+7 FOR
SET HLI=$ORDER(^HLCS(869.3,1,6,HLVIEW,1,HLI))
IF 'HLI
QUIT
SET HLYY=+$PIECE($GET(^(HLI,0)),U,2)
Begin DoDot:2
+8 SET Y=$PIECE($GET(^HLCS(870,HLI,0)),U)
IF Y=""
QUIT
+9 ;build array by DISPLAY ORDER and then by NAME
+10 IF HLYY
SET HLTMP(HLYY,HLI)=""
QUIT
+11 SET HLTMP(Y,HLI)=""
End DoDot:2
+12 SET (HLI,HLYY)=0
+13 ;rebuild array to put in proper order
+14 FOR
SET HLI=$ORDER(HLTMP(HLI))
SET HLXX=0
IF HLI=""
QUIT
Begin DoDot:2
+15 FOR
SET HLXX=$ORDER(HLTMP(HLI,HLXX))
IF 'HLXX
QUIT
SET HLYY=HLYY+1
SET HLARY(HLYY,HLXX)=""
End DoDot:2
+16 SET HLPTR3=HLYY
End DoDot:1
SET HLVIEW=0
SET HLDISP="V"
+17 ;
+18 IF '$DATA(HLARY)
SET HLYY=0
SET HLXX=""
Begin DoDot:1
+19 ;build array in alphabetical order
+20 FOR
SET HLXX=$ORDER(^HLCS(870,"B",HLXX))
IF HLXX=""
QUIT
SET Y=$ORDER(^(HLXX,0))
SET HLYY=HLYY+1
SET HLARY(HLYY,Y)=""
+21 SET HLPTR3=HLYY
End DoDot:1
+22 ;
+23 ;HLYY=6TH Line of display
SET HLI=HLPTR1
SET HLYY=6
+24 ;HLARYD(6) through HLARYD(15) with 6 through 15 also representing line
+25 ;numbers on the display
+26 FOR HLI=HLI:1
SET HLXX=$ORDER(HLARY(HLI,0))
IF HLYY=16!'HLXX
QUIT
DO COPY
+27 SET HLPTR2=HLI-1
+28 ;Set all HLARY elements not defined on this pass to null
+29 FOR HLYY=HLYY:1:15
SET HLARYD(HLYY)=""
+30 QUIT
COPY ;
+1 IF '$DATA(^HLCS(870,HLXX))
QUIT
+2 ;
+3 ;These lock tags lock nodes in the global so that the screen is
+4 ;refreshed in real-time. The lock forces the buffer to be refreshed,
+5 ;so that the display is up to date.
+6 ;
+7 ;**109**
+8 ;L +^HLCS(870,HLXX,0):0 L -^HLCS(870,HLXX,0) D CHKLOCK
+9 ;
+10 ; Set, even if not able to lock...
+11 SET Y=$GET(^HLCS(870,HLXX,0))
+12 ;
+13 ;name^rec^proc^send^sent^device^state^error
+14 SET HLARYD(HLYY)=$PIECE(Y,U)_"^^^^^"_$PIECE(Y,U,4)_"^"_$PIECE(Y,U,5)_"^"_$PIECE(Y,U,19)
+15 ;
+16 ;**109**
+17 ;L +^HLCS(870,HLXX,"IN QUEUE BACK POINTER"):0 D CHKLOCK
+18 ;L -^HLCS(870,HLXX,"IN QUEUE BACK POINTER")
+19 ;
+20 SET $PIECE(HLARYD(HLYY),U,2)=$GET(^HLCS(870,HLXX,"IN QUEUE BACK POINTER"))
+21 ;
+22 ;**109**
+23 ;L +^HLCS(870,HLXX,"IN QUEUE FRONT POINTER"):0 D CHKLOCK
+24 ;L -^HLCS(870,HLXX,"IN QUEUE FRONT POINTER")
+25 ;
+26 SET $PIECE(HLARYD(HLYY),U,3)=$GET(^HLCS(870,HLXX,"IN QUEUE FRONT POINTER"))
+27 ;
+28 ;**109**
+29 ;L +^HLCS(870,HLXX,"OUT QUEUE BACK POINTER"):0 D CHKLOCK
+30 ;L -^HLCS(870,HLXX,"OUT QUEUE BACK POINTER")
+31 ;
+32 SET $PIECE(HLARYD(HLYY),U,4)=$GET(^HLCS(870,HLXX,"OUT QUEUE BACK POINTER"))
+33 ;
+34 ;**109**
+35 ;L +^HLCS(870,HLXX,"OUT QUEUE FRONT POINTER"):0 D CHKLOCK
+36 ;L -^HLCS(870,HLXX,"OUT QUEUE FRONT POINTER")
+37 ;
+38 SET $PIECE(HLARYD(HLYY),U,5)=$GET(^HLCS(870,HLXX,"OUT QUEUE FRONT POINTER"))
+39 ;
+40 SET X=HLARYD(HLYY)
SET Y=$PIECE(X,U,2)+$PIECE(X,U,3)+$PIECE(X,U,4)+$PIECE(X,U,5)
+41 ;if Select and the Y=0, nothing to report
+42 IF 'Y
IF HLDISP="S"
SET HLARYD(HLYY)=""
QUIT
+43 SET HLYY=HLYY+1
+44 QUIT
+45 ;
CHKLOCK ; Call here immediately after trying to lock. And, BE SURE that
+1 ; nothing might occur that would change $T after the lock attempt!!
+2 ; $T,HLXX -- req
+3 NEW NM870
+4 ;-> Lock obtained...
IF $TEST
QUIT
+5 SET NM870=$PIECE($GET(^HLCS(870,+HLXX,0)),U)
+6 SET NM870=$SELECT(NM870]"":NM870_" (IEN #"_HLXX_")",1:"IEN #"_HLXX)
+7 SET HLOCK(NM870)=""
+8 QUIT
+9 ;
HELP ;
+1 WRITE HLCON,@IOF
+2 WRITE !,"You have the following options when monitoring the Messaging System:"
+3 WRITE !,"Enter the command letter parentheses: N,B,Q,A,S,V or ?"
+4 WRITE !!,"(N) takes you to the next page of the display of Logical Links."
+5 WRITE !!,"(B) takes you back one page."
+6 WRITE !!,"(Q) terminates the monitor."
+7 WRITE !!,"(A) provides a display of all links defined on your system."
+8 WRITE !!,"(S) displays only those links that have had message traffic."
+9 WRITE !!,"(V) prompts for a view name and displays links defined in view."
+10 WRITE !!," Note that (S) is the default display at startup."
+11 WRITE !!,"**PRESS <RET> TO CONTINUE**"
+12 READ X:DTIME
+13 WRITE @IOF
+14 WRITE !,?25,"Device Types and corresponding prefixes:"
+15 WRITE !!,?30,"PC -- Persistent TCP/IP Client"
+16 WRITE !!,?30,"NC -- Non-Persistent TCP/IP Client"
+17 WRITE !!,?30,"SS -- Single-threaded TCP/IP Server"
+18 WRITE !!,?30,"MS -- Multi-threaded TCP/IP Server"
+19 WRITE !!,?30,"SH -- Serial HLLP"
+20 WRITE !!,?30,"SX -- Serial X3.28"
+21 WRITE !!,?30,"MM -- MailMan"
+22 WRITE !!,"**PRESS <RET> TO CONTINUE**"
+23 READ X:DTIME
+24 WRITE HLCOFF
+25 QUIT
EXIT ;
+1 ;Turn Cursor back on
+2 WRITE HLCON
+3 DO KVAR^HLCSTERM
+4 QUIT
+5 ;
LOCKED(HLOCK) ; Anything locked?
+1 ;
+2 ;
+3 ; Nothing locked...
+4 ;->
IF '$DATA(HLOCK)
QUIT ""
+5 ;
+6 WRITE !!,"Editing of logical link data is occurring right now. For this reason, some of"
+7 WRITE !,"the information on the 'System Link Monitor' report might not be accurate for"
+8 WRITE !,"the following node(s)..."
+9 WRITE !
+10 ;
+11 SET HLOCK=""
+12 FOR
SET HLOCK=$ORDER(HLOCK(HLOCK))
IF HLOCK']""
QUIT
Begin DoDot:1
+13 WRITE !,?5,HLOCK
End DoDot:1
+14 ;
+15 SET ACTION=$$BTE("Press RETURN to print report or '^' to exit... ",1)
+16 ;
+17 QUIT $SELECT(ACTION=1:1,1:"")
+18 ;
BTE(PMT,FF) ;
+1 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+2 FOR X=1:1:$GET(FF)
WRITE !
+3 SET DIR(0)="EA"
SET DIR("A")=PMT
+4 DO ^DIR
+5 QUIT $SELECT(Y=1:"",1:1)
+6 ;
