Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLCSMON

HLCSMON.m

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