HLCSMON1 ;SF-Utilities for Driver Program ;06/26/2008 15:30
;;1.6;HEALTH LEVEL SEVEN;**15,40,49,65,109,122,142**;Oct 13, 1995;Build 17
;Per VHA Directive 2004-038, this routine should not be modified.
;
;This routine contains several entry points called from HLCSMON
;no input parameters are required. All variables used which are
;not newed here are newed in HLCSMON
;
DISPLAY ;display link info
;turn of line wrap
S HLXX=0,X=0 X ^%ZOSF("RM")
F S HLXX=$O(HLARYD(HLXX)) Q:(HLXX'>0) D WLINE(HLXX)
;DISPLAY INCOMING FILER STATUS
; patch HL*1.6*142 start
; call STAT^%ZTLOAD for each display in CNTFLR^HLCSUTL2.
; patch HL*1.6*122
; S HLXX=$P(HLRUNCNT,"^",1)
; I (+HLXX)=-1 S HLXX=$$CNTFLR^HLCSUTL2("IN")
S HLXX=$$CNTFLR^HLCSUTL2("IN")
; patch HL*1.6*142 end
;
;ONLY UPDATE SCREEN IF COUNT HAS CHANGED
I (HLXX'=+HLRUNCNT) D
.D WDATA(5,17,"","",$J(" ",31)),WDATA^HLCSMON1(5,17,"","","Incoming filers running => ",35)
.I (HLXX) D WDATA(32,17,"","",HLXX)
.I ('HLXX) D WDATA(32,17,IOINHI,IOINORM,"Zero")
.S $P(HLRUNCNT,"^",1)=HLXX
;DISPLAY OUTGOING FILER STATUS
; patch HL*1.6*142 start
; call STAT^%ZTLOAD for each display in CNTFLR^HLCSUTL2.
; patch HL*1.6*122
; S HLXX=$P(HLRUNCNT,"^",2)
; I (+HLXX)=-1 S HLXX=$$CNTFLR^HLCSUTL2("OUT")
S HLXX=$$CNTFLR^HLCSUTL2("OUT")
; patch HL*1.6*142 end
;
;ONLY UPDATE SCREEN IF COUNT HAS CHANGED
I (HLXX'=+$P(HLRUNCNT,"^",2)) D
.D WDATA(5,18,"","",$J(" ",31)),WDATA^HLCSMON1(5,18,"","","Outgoing filers running => ",35)
.I (HLXX) D WDATA(32,18,"","",HLXX)
.I ('HLXX) D WDATA(32,18,IOINHI,IOINORM,"Zero")
.S $P(HLRUNCNT,"^",2)=HLXX
S X=$$TM^%ZTLOAD
I X'=$G(HLTMSTAT) D
.S HLTMSTAT=X
.S HLXX=$S('HLTMSTAT:"***TASKMAN NOT RUNNING!!!***",1:"")
.I 'HLTMSTAT D WDATA^HLCSMON1(45,17,IOELEOL_IOBON_IORVON,IOBOFF_IORVOFF,HLXX) I 1
.E D WDATA(45,17,IOELEOL,"",$J("TaskMan running ",16)) ;D WDATA(5,19,IOELALL,"","")
S X=$$STAT^HLCSLM
I X'=$G(HLLMSTAT) D
.S HLLMSTAT=X Q:HLLMSTAT=3
.S HLXX=$S('HLLMSTAT:"***LINK MANAGER NOT RUNNING!!!***",1:"")
.I 'HLLMSTAT D WDATA^HLCSMON1(45,18,IOELEOL_IOBON_IORVON,IOBOFF_IORVOFF,HLXX) I 1
.E D WDATA^HLCSMON1(45,18,IOELEOL,"",$J("Link Manager running",18))
;Turn terminal line wrap back on
D WDATA(45,19,IOELEOL,"",$$SLM^HLEVUTIL) ; HL*1.6*109
S X=IOM X ^%ZOSF("RM")
Q
;
WLINE(HLXX) ;write line from HLARYD=current values, HLARYO=old values
;if values haven't changed, don't do anything
I HLARYD(HLXX)]"",HLARYD(HLXX)=$G(HLARYO(HLXX)) Q
S HLARYO(HLXX)=HLARYD(HLXX),HLERR=$P(HLARYD(HLXX),U,8),DX=1
; patch HL*1.6*122
; F X=1:1:7 S @$P("HLNODE^HLREC^HLPROC^HLSEND^HLSENT^HLDEV^HLSTAT",U,X)=$E($P(HLARYD(HLXX),U,X)_" ",1,8)
F X=1,7 S @$P("HLNODE^HLREC^HLPROC^HLSEND^HLSENT^HLDEV^HLSTAT",U,X)=$E($P(HLARYD(HLXX),U,X)_" ",1,10)
F X=2:1:5 S @$P("HLNODE^HLREC^HLPROC^HLSEND^HLSENT^HLDEV^HLSTAT",U,X)=$E($P(HLARYD(HLXX),U,X)_" ",1,8)
; patch HL*1.6*142
; if the link in-queue is set to 1 (stop), display it from HLDEV
; S X=6,@$P("HLNODE^HLREC^HLPROC^HLSEND^HLSENT^HLDEV^HLSTAT",U,X)=$E($P(HLARYD(HLXX),U,X)_" ",1,7)
I $P(HLARYD(HLXX),U,6)["/I-off" D
. S X=6,@$P("HLNODE^HLREC^HLPROC^HLSEND^HLSENT^HLDEV^HLSTAT",U,X)=$E($P(HLARYD(HLXX),U,X)_" ",1,8)
E S X=6,@$P("HLNODE^HLREC^HLPROC^HLSEND^HLSENT^HLDEV^HLSTAT",U,X)=$E($P(HLARYD(HLXX),U,X)_" ",1,7)
;
;if link is in error, write node in rev. video
I HLERR]"" D WDATA(5,HLXX,IOBON_IORVON,IOBOFF_IORVOFF,HLNODE,8) S DX=14
;Turn off terminal line wrap & inform O/S where cursor is located
S DY=HLXX X IOXY,^%ZOSF("XY")
; patch HL*1.6*122
W:HLERR="" ?4,HLNODE
; patch HL*1.6*142
; if the link in-queue is set to 1 (stop), display it
; W ?16,HLREC,?26,HLPROC,?37,HLSEND,?47,HLSENT,?58,HLDEV,?63,HLSTAT
I HLDEV["/I-off" D
. W ?16,HLREC,?26,HLPROC,?37,HLSEND,?47,HLSENT,?56,HLDEV,?65,HLSTAT
E W ?16,HLREC,?26,HLPROC,?37,HLSEND,?47,HLSENT,?58,HLDEV,?63,HLSTAT
;
Q
;
WDATA(DX,DY,IO1,IO2,HLDATA,HLENGTH) ;
;
;First erase the data block then write to it. Attributes are
;contained in IO1 & IO2
;
N X S X=0 X ^%ZOSF("RM") X ^%ZOSF("XY")
;Turn off terminal line wrap & inform O/S where cursor is located
I '$D(HLENGTH) S HLENGTH=$L(HLDATA)
X IOXY W IOSC,$E($J(" ",79),1,HLENGTH),IORC W IO1,$E(HLDATA,1,HLENGTH),IO2
S X=IOM X ^%ZOSF("RM")
;Turn terminal line wrap back on
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLCSMON1 4411 printed Jan 18, 2025@02:58:01 Page 2
HLCSMON1 ;SF-Utilities for Driver Program ;06/26/2008 15:30
+1 ;;1.6;HEALTH LEVEL SEVEN;**15,40,49,65,109,122,142**;Oct 13, 1995;Build 17
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;This routine contains several entry points called from HLCSMON
+5 ;no input parameters are required. All variables used which are
+6 ;not newed here are newed in HLCSMON
+7 ;
DISPLAY ;display link info
+1 ;turn of line wrap
+2 SET HLXX=0
SET X=0
XECUTE ^%ZOSF("RM")
+3 FOR
SET HLXX=$ORDER(HLARYD(HLXX))
if (HLXX'>0)
QUIT
DO WLINE(HLXX)
+4 ;DISPLAY INCOMING FILER STATUS
+5 ; patch HL*1.6*142 start
+6 ; call STAT^%ZTLOAD for each display in CNTFLR^HLCSUTL2.
+7 ; patch HL*1.6*122
+8 ; S HLXX=$P(HLRUNCNT,"^",1)
+9 ; I (+HLXX)=-1 S HLXX=$$CNTFLR^HLCSUTL2("IN")
+10 SET HLXX=$$CNTFLR^HLCSUTL2("IN")
+11 ; patch HL*1.6*142 end
+12 ;
+13 ;ONLY UPDATE SCREEN IF COUNT HAS CHANGED
+14 IF (HLXX'=+HLRUNCNT)
Begin DoDot:1
+15 DO WDATA(5,17,"","",$JUSTIFY(" ",31))
DO WDATA^HLCSMON1(5,17,"","","Incoming filers running => ",35)
+16 IF (HLXX)
DO WDATA(32,17,"","",HLXX)
+17 IF ('HLXX)
DO WDATA(32,17,IOINHI,IOINORM,"Zero")
+18 SET $PIECE(HLRUNCNT,"^",1)=HLXX
End DoDot:1
+19 ;DISPLAY OUTGOING FILER STATUS
+20 ; patch HL*1.6*142 start
+21 ; call STAT^%ZTLOAD for each display in CNTFLR^HLCSUTL2.
+22 ; patch HL*1.6*122
+23 ; S HLXX=$P(HLRUNCNT,"^",2)
+24 ; I (+HLXX)=-1 S HLXX=$$CNTFLR^HLCSUTL2("OUT")
+25 SET HLXX=$$CNTFLR^HLCSUTL2("OUT")
+26 ; patch HL*1.6*142 end
+27 ;
+28 ;ONLY UPDATE SCREEN IF COUNT HAS CHANGED
+29 IF (HLXX'=+$PIECE(HLRUNCNT,"^",2))
Begin DoDot:1
+30 DO WDATA(5,18,"","",$JUSTIFY(" ",31))
DO WDATA^HLCSMON1(5,18,"","","Outgoing filers running => ",35)
+31 IF (HLXX)
DO WDATA(32,18,"","",HLXX)
+32 IF ('HLXX)
DO WDATA(32,18,IOINHI,IOINORM,"Zero")
+33 SET $PIECE(HLRUNCNT,"^",2)=HLXX
End DoDot:1
+34 SET X=$$TM^%ZTLOAD
+35 IF X'=$GET(HLTMSTAT)
Begin DoDot:1
+36 SET HLTMSTAT=X
+37 SET HLXX=$SELECT('HLTMSTAT:"***TASKMAN NOT RUNNING!!!***",1:"")
+38 IF 'HLTMSTAT
DO WDATA^HLCSMON1(45,17,IOELEOL_IOBON_IORVON,IOBOFF_IORVOFF,HLXX)
IF 1
+39 ;D WDATA(5,19,IOELALL,"","")
IF '$TEST
DO WDATA(45,17,IOELEOL,"",$JUSTIFY("TaskMan running ",16))
End DoDot:1
+40 SET X=$$STAT^HLCSLM
+41 IF X'=$GET(HLLMSTAT)
Begin DoDot:1
+42 SET HLLMSTAT=X
if HLLMSTAT=3
QUIT
+43 SET HLXX=$SELECT('HLLMSTAT:"***LINK MANAGER NOT RUNNING!!!***",1:"")
+44 IF 'HLLMSTAT
DO WDATA^HLCSMON1(45,18,IOELEOL_IOBON_IORVON,IOBOFF_IORVOFF,HLXX)
IF 1
+45 IF '$TEST
DO WDATA^HLCSMON1(45,18,IOELEOL,"",$JUSTIFY("Link Manager running",18))
End DoDot:1
+46 ;Turn terminal line wrap back on
+47 ; HL*1.6*109
DO WDATA(45,19,IOELEOL,"",$$SLM^HLEVUTIL)
+48 SET X=IOM
XECUTE ^%ZOSF("RM")
+49 QUIT
+50 ;
WLINE(HLXX) ;write line from HLARYD=current values, HLARYO=old values
+1 ;if values haven't changed, don't do anything
+2 IF HLARYD(HLXX)]""
IF HLARYD(HLXX)=$GET(HLARYO(HLXX))
QUIT
+3 SET HLARYO(HLXX)=HLARYD(HLXX)
SET HLERR=$PIECE(HLARYD(HLXX),U,8)
SET DX=1
+4 ; patch HL*1.6*122
+5 ; F X=1:1:7 S @$P("HLNODE^HLREC^HLPROC^HLSEND^HLSENT^HLDEV^HLSTAT",U,X)=$E($P(HLARYD(HLXX),U,X)_" ",1,8)
+6 FOR X=1,7
SET @$PIECE("HLNODE^HLREC^HLPROC^HLSEND^HLSENT^HLDEV^HLSTAT",U,X)=$EXTRACT($PIECE(HLARYD(HLXX),U,X)_" ",1,10)
+7 FOR X=2:1:5
SET @$PIECE("HLNODE^HLREC^HLPROC^HLSEND^HLSENT^HLDEV^HLSTAT",U,X)=$EXTRACT($PIECE(HLARYD(HLXX),U,X)_" ",1,8)
+8 ; patch HL*1.6*142
+9 ; if the link in-queue is set to 1 (stop), display it from HLDEV
+10 ; S X=6,@$P("HLNODE^HLREC^HLPROC^HLSEND^HLSENT^HLDEV^HLSTAT",U,X)=$E($P(HLARYD(HLXX),U,X)_" ",1,7)
+11 IF $PIECE(HLARYD(HLXX),U,6)["/I-off"
Begin DoDot:1
+12 SET X=6
SET @$PIECE("HLNODE^HLREC^HLPROC^HLSEND^HLSENT^HLDEV^HLSTAT",U,X)=$EXTRACT($PIECE(HLARYD(HLXX),U,X)_" ",1,8)
End DoDot:1
+13 IF '$TEST
SET X=6
SET @$PIECE("HLNODE^HLREC^HLPROC^HLSEND^HLSENT^HLDEV^HLSTAT",U,X)=$EXTRACT($PIECE(HLARYD(HLXX),U,X)_" ",1,7)
+14 ;
+15 ;if link is in error, write node in rev. video
+16 IF HLERR]""
DO WDATA(5,HLXX,IOBON_IORVON,IOBOFF_IORVOFF,HLNODE,8)
SET DX=14
+17 ;Turn off terminal line wrap & inform O/S where cursor is located
+18 SET DY=HLXX
XECUTE IOXY
XECUTE ^%ZOSF("XY")
+19 ; patch HL*1.6*122
+20 if HLERR=""
WRITE ?4,HLNODE
+21 ; patch HL*1.6*142
+22 ; if the link in-queue is set to 1 (stop), display it
+23 ; W ?16,HLREC,?26,HLPROC,?37,HLSEND,?47,HLSENT,?58,HLDEV,?63,HLSTAT
+24 IF HLDEV["/I-off"
Begin DoDot:1
+25 WRITE ?16,HLREC,?26,HLPROC,?37,HLSEND,?47,HLSENT,?56,HLDEV,?65,HLSTAT
End DoDot:1
+26 IF '$TEST
WRITE ?16,HLREC,?26,HLPROC,?37,HLSEND,?47,HLSENT,?58,HLDEV,?63,HLSTAT
+27 ;
+28 QUIT
+29 ;
WDATA(DX,DY,IO1,IO2,HLDATA,HLENGTH) ;
+1 ;
+2 ;First erase the data block then write to it. Attributes are
+3 ;contained in IO1 & IO2
+4 ;
+5 NEW X
SET X=0
XECUTE ^%ZOSF("RM")
XECUTE ^%ZOSF("XY")
+6 ;Turn off terminal line wrap & inform O/S where cursor is located
+7 IF '$DATA(HLENGTH)
SET HLENGTH=$LENGTH(HLDATA)
+8 XECUTE IOXY
WRITE IOSC,$EXTRACT($JUSTIFY(" ",79),1,HLENGTH),IORC
WRITE IO1,$EXTRACT(HLDATA,1,HLENGTH),IO2
+9 SET X=IOM
XECUTE ^%ZOSF("RM")
+10 ;Turn terminal line wrap back on
+11 QUIT
