HLVSM ;BAY/JML - HL7 Read-Only Calls for the VistA System Monitor;7/1/2025
;;1.6;HEALTH LEVEL SEVEN;**177**;10/13/1995;Build 6
; SACC Exemption ID 202503211314-03 is in place for the close command at LSTAT+16
; This routine provides read-only callables to populate the VSM Operational Dashboard
;
; Direct routine calls
GETFILERS(DIR,INFOARR) ; returns filer counts and list
Q $$GETINFO^HLCSFMN1(DIR,INFOARR)
;
FILERCFG() ; returns # of filers configured
Q $G(^HLCS(869.3,1,1))
;
LMSTAT() ; returns Link Manager Status
Q $$STAT^HLCSLM()
;
CHKSTOP() ; returns HLO System Status
Q $$CHKSTOP^HLOPROC
;
PROCMAN() ; returns HLO Process Manager Status
Q $$RUNNING^HLOUSR
;
MPOQ(MPOQARR) ; returns # of messages pending on out queuess
Q $$OUT^HLOQUE(.MPOQARR)
;
MPSQ(MPSQARR) ; returns # of messages pending on sequence queues
Q $$SEQ^HLOQUE(.MPSQARR)
;
MPAQ(MPAQARR) ; returns # of messages pending on application queues
Q $$IN^HLOQUE(.MPAQARR)
;
ADD(DIR) ; returns message sent/rec'd/error today
N TODAY
S TODAY=$$DT^XLFDT
Q $$ADD^HLOUSR(DIR)
;
;
; Global Reads
CLPROC(DIRECTION) ; returns # of client link processes
Q +$G(^HLC("HL7 PROCESS COUNTS","RUNNING",DIRECTION))
;
FILE777() ; returns count/date of File 777
Q $G(^HLTMP("FILE 777 RECORD COUNT"))
;
FILE778() ; returns count/date of File 778
Q $G(^HLTMP("FILE 778 RECORD COUNT"))
;
;
;
; Code Snippets from HL routines
SLM() ; returns currency of Link Manager - FROM SLM^HLEVUTIL
N BAD,DATA,DATE,DAY,DIFF,DOWN,FIEN,HR,IEN,IOBON,IOBOFF,LASTDT,MIN,SEC,X,NOW
;
S DOWN="Monitor DOWN",U="^"
;
I $P($G(^HLEV(776.999,1,0)),U,2)'="A" D QUIT DOWN ; NEED ICR
.S DOWN="Monitor STOPPED"
;
S LASTDT=":",FIEN=0
F S LASTDT=$O(^HLEV(776.2,"B",LASTDT),-1) Q:'LASTDT!(FIEN) D
.S IEN=":"
.F S IEN=$O(^HLEV(776.2,"B",+LASTDT,IEN),-1) Q:'IEN!(FIEN) D
..S DATA=$G(^HLEV(776.2,+IEN,0)) QUIT:$P(DATA,U,4)'="Q" ;->
..S FIEN=IEN
I 'FIEN QUIT DOWN ;->
S DATA=$G(^HLEV(776.2,+FIEN,0))
S DATE=$P(DATA,U,6) QUIT:DATE'?7N1"."1.N DOWN ;->
S DATE=$$FMTH^XLFDT(DATE),DATE(1)=$$SEC^HLEVMST0(DATE)
S NOW=$H,NOW(1)=$$SEC^HLEVMST0(NOW)
I DATE(1)<NOW(1) D QUIT $S(BAD:DOWN,1:"Monitor current") ;->
.S BAD=0
.QUIT:(NOW(1)-DATE(1))<(5*60) ;-> OK if less than 5 minutes old
.S BAD=1,DOWN="Monitor OVERDUE"
S DIFF=$$DIFFDH^HLCSFMN1(NOW,DATE)
S DAY=+DIFF,DIFF=$TR($P(DIFF,U,2),":",U)
S HR=+DIFF+(DAY*24),MIN=+$P(DIFF,U,2),SEC=+$P(DIFF,U,3)
S:SEC>30 MIN=MIN+1
S HR=HR+MIN/60,HR=$J(HR,"",1)
Q "Monitor current [next job "_HR_" hr]"
;
LSTAT() ; returns HLO Standard Listener Status - Adapted from HLOUSR
N HLSTAT,HLOS,HLIP,HLLINK
S HLSTAT=$$KLISTEN^HLOUSR
;
;if the Kernel listner is NOT running, might check the listener via the OPEN command. With loadbalancing, the IP address of the listener link sometimes fails, so also try 'loopback'.
S HLOS=$$OS^%ZOSV
I 'HLSTAT,(HLOS["VMS")!('$$CHKSTOP^HLOPROC) D
.N HLIP,HLLINK
.S HLLINK=$P($G(^HLD(779.1,1,0)),"^",10)
.I HLLINK,$$GET^HLOTLNK(HLLINK,.HLLINK) D
..;ADD LOOPBACK FOR IPV6 - HL*1.6*163
..;$$CONVERT^XLFIPV(IP) API (ICR #5844)
..F HLIP=$$CONVERT^XLFIPV("127.0.0.1"),$$CONVERT^XLFIPV("0.0.0.0"),HLLINK("IP") D Q:HLSTAT
...N POP,IO,IOF,IOST
...D CALL^%ZISTCP(HLIP,HLLINK("PORT"),5)
...S HLSTAT='POP
...C:HLSTAT IO
Q HLSTAT
;
DLINKS() ; returns list of down links - Adapted from ^HLOUSR
N HLLIST,HLLINK
S (HLLIST,HLLINK)=""
F S HLLINK=$O(^HLTMP("FAILING LINKS",HLLINK)) Q:HLLINK="" D I $L(HLLIST)>60 S HLLIST=HLLIST_",..." Q
.N HLTIME,HLQUE,HLLARY
.S HLTIME=$G(^HLTMP("FAILING LINKS",HLLINK)) Q:HLTIME=""
.I '$G(HLLARY("SHUTDOWN")),HLTIME="" Q
.I '$G(HLLARY("SHUTDOWN")),($$HDIFF^XLFDT($H,HLTIME,2)<300) Q
.S HLLIST=HLLIST_$S($L(HLLIST):", ",1:"")_HLLINK
Q HLLIST
;
STQUES(HLDIR) ; returns up to 4 stopped in/out queues - adapted from ^HLOUSR
N HLTEMP,HLCOUNT,HLQUE
S HLTEMP="",HLCOUNT=0,HLQUE=""
F S HLQUE=$O(^HLTMP("STOPPED QUEUES",HLDIR,HLQUE)) Q:HLQUE="" D
.S HLCOUNT=HLCOUNT+1
.Q:HLCOUNT>4
.S:HLCOUNT=1 HLTEMP=HLTEMP_HLQUE
.S:"23"[HLCOUNT HLTEMP=HLTEMP_"; "_HLQUE
.S:HLCOUNT=4 HLTEMP=HLTEMP_" ..."
Q HLTEMP
;
GETVIEWS(HLVARR) ; returns an array with the site's Logical LInk Views
N HLVIEN,HLVIEW,HLVIDX,HLVDAT,HLLINK,HLLIEN,HLORD,HLVCNT
S HLVCNT=0
S HLVIEN=0
F S HLVIEN=$O(^HLCS(869.3,1,6,HLVIEN)) Q:+HLVIEN=0 D
.S HLVIEW=$G(^HLCS(869.3,1,6,HLVIEN,0))
.I HLVIEW="" S HLVIEW=HLVIEN
.S HLVIDX=0
.F S HLVIDX=$O(^HLCS(869.3,1,6,HLVIEN,1,HLVIDX)) Q:+HLVIDX=0 D
..S HLVDAT=$G(^HLCS(869.3,1,6,HLVIEN,1,HLVIDX,0))
..S HLLIEN=$P(HLVDAT,"^"),HLORD=+$P(HLVDAT,"^",2)
..S HLLINK=$$GET1^DIQ(870,HLLIEN,.01)
..I HLLINK="" S HLLINK=HLLIEN
..S HLVARR(HLVIEW,HLORD,HLLINK)=""
..S HLVCNT=HLVCNT+1
S HLVARR=HLVCNT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLVSM 4843 printed Apr 22, 2026@13:57:28 Page 2
HLVSM ;BAY/JML - HL7 Read-Only Calls for the VistA System Monitor;7/1/2025
+1 ;;1.6;HEALTH LEVEL SEVEN;**177**;10/13/1995;Build 6
+2 ; SACC Exemption ID 202503211314-03 is in place for the close command at LSTAT+16
+3 ; This routine provides read-only callables to populate the VSM Operational Dashboard
+4 ;
+5 ; Direct routine calls
GETFILERS(DIR,INFOARR) ; returns filer counts and list
+1 QUIT $$GETINFO^HLCSFMN1(DIR,INFOARR)
+2 ;
FILERCFG() ; returns # of filers configured
+1 QUIT $GET(^HLCS(869.3,1,1))
+2 ;
LMSTAT() ; returns Link Manager Status
+1 QUIT $$STAT^HLCSLM()
+2 ;
CHKSTOP() ; returns HLO System Status
+1 QUIT $$CHKSTOP^HLOPROC
+2 ;
PROCMAN() ; returns HLO Process Manager Status
+1 QUIT $$RUNNING^HLOUSR
+2 ;
MPOQ(MPOQARR) ; returns # of messages pending on out queuess
+1 QUIT $$OUT^HLOQUE(.MPOQARR)
+2 ;
MPSQ(MPSQARR) ; returns # of messages pending on sequence queues
+1 QUIT $$SEQ^HLOQUE(.MPSQARR)
+2 ;
MPAQ(MPAQARR) ; returns # of messages pending on application queues
+1 QUIT $$IN^HLOQUE(.MPAQARR)
+2 ;
ADD(DIR) ; returns message sent/rec'd/error today
+1 NEW TODAY
+2 SET TODAY=$$DT^XLFDT
+3 QUIT $$ADD^HLOUSR(DIR)
+4 ;
+5 ;
+6 ; Global Reads
CLPROC(DIRECTION) ; returns # of client link processes
+1 QUIT +$GET(^HLC("HL7 PROCESS COUNTS","RUNNING",DIRECTION))
+2 ;
FILE777() ; returns count/date of File 777
+1 QUIT $GET(^HLTMP("FILE 777 RECORD COUNT"))
+2 ;
FILE778() ; returns count/date of File 778
+1 QUIT $GET(^HLTMP("FILE 778 RECORD COUNT"))
+2 ;
+3 ;
+4 ;
+5 ; Code Snippets from HL routines
SLM() ; returns currency of Link Manager - FROM SLM^HLEVUTIL
+1 NEW BAD,DATA,DATE,DAY,DIFF,DOWN,FIEN,HR,IEN,IOBON,IOBOFF,LASTDT,MIN,SEC,X,NOW
+2 ;
+3 SET DOWN="Monitor DOWN"
SET U="^"
+4 ;
+5 ; NEED ICR
IF $PIECE($GET(^HLEV(776.999,1,0)),U,2)'="A"
Begin DoDot:1
+6 SET DOWN="Monitor STOPPED"
End DoDot:1
QUIT DOWN
+7 ;
+8 SET LASTDT=":"
SET FIEN=0
+9 FOR
SET LASTDT=$ORDER(^HLEV(776.2,"B",LASTDT),-1)
if 'LASTDT!(FIEN)
QUIT
Begin DoDot:1
+10 SET IEN=":"
+11 FOR
SET IEN=$ORDER(^HLEV(776.2,"B",+LASTDT,IEN),-1)
if 'IEN!(FIEN)
QUIT
Begin DoDot:2
+12 ;->
SET DATA=$GET(^HLEV(776.2,+IEN,0))
if $PIECE(DATA,U,4)'="Q"
QUIT
+13 SET FIEN=IEN
End DoDot:2
End DoDot:1
+14 ;->
IF 'FIEN
QUIT DOWN
+15 SET DATA=$GET(^HLEV(776.2,+FIEN,0))
+16 ;->
SET DATE=$PIECE(DATA,U,6)
if DATE'?7N1"."1.N
QUIT DOWN
+17 SET DATE=$$FMTH^XLFDT(DATE)
SET DATE(1)=$$SEC^HLEVMST0(DATE)
+18 SET NOW=$HOROLOG
SET NOW(1)=$$SEC^HLEVMST0(NOW)
+19 ;->
IF DATE(1)<NOW(1)
Begin DoDot:1
+20 SET BAD=0
+21 ;-> OK if less than 5 minutes old
if (NOW(1)-DATE(1))<(5*60)
QUIT
+22 SET BAD=1
SET DOWN="Monitor OVERDUE"
End DoDot:1
QUIT $SELECT(BAD:DOWN,1:"Monitor current")
+23 SET DIFF=$$DIFFDH^HLCSFMN1(NOW,DATE)
+24 SET DAY=+DIFF
SET DIFF=$TRANSLATE($PIECE(DIFF,U,2),":",U)
+25 SET HR=+DIFF+(DAY*24)
SET MIN=+$PIECE(DIFF,U,2)
SET SEC=+$PIECE(DIFF,U,3)
+26 if SEC>30
SET MIN=MIN+1
+27 SET HR=HR+MIN/60
SET HR=$JUSTIFY(HR,"",1)
+28 QUIT "Monitor current [next job "_HR_" hr]"
+29 ;
LSTAT() ; returns HLO Standard Listener Status - Adapted from HLOUSR
+1 NEW HLSTAT,HLOS,HLIP,HLLINK
+2 SET HLSTAT=$$KLISTEN^HLOUSR
+3 ;
+4 ;if the Kernel listner is NOT running, might check the listener via the OPEN command. With loadbalancing, the IP address of the listener link sometimes fails, so also try 'loopback'.
+5 SET HLOS=$$OS^%ZOSV
+6 IF 'HLSTAT
IF (HLOS["VMS")!('$$CHKSTOP^HLOPROC)
Begin DoDot:1
+7 NEW HLIP,HLLINK
+8 SET HLLINK=$PIECE($GET(^HLD(779.1,1,0)),"^",10)
+9 IF HLLINK
IF $$GET^HLOTLNK(HLLINK,.HLLINK)
Begin DoDot:2
+10 ;ADD LOOPBACK FOR IPV6 - HL*1.6*163
+11 ;$$CONVERT^XLFIPV(IP) API (ICR #5844)
+12 FOR HLIP=$$CONVERT^XLFIPV("127.0.0.1"),$$CONVERT^XLFIPV("0.0.0.0"),HLLINK("IP")
Begin DoDot:3
+13 NEW POP,IO,IOF,IOST
+14 DO CALL^%ZISTCP(HLIP,HLLINK("PORT"),5)
+15 SET HLSTAT='POP
+16 if HLSTAT
CLOSE IO
End DoDot:3
if HLSTAT
QUIT
End DoDot:2
End DoDot:1
+17 QUIT HLSTAT
+18 ;
DLINKS() ; returns list of down links - Adapted from ^HLOUSR
+1 NEW HLLIST,HLLINK
+2 SET (HLLIST,HLLINK)=""
+3 FOR
SET HLLINK=$ORDER(^HLTMP("FAILING LINKS",HLLINK))
if HLLINK=""
QUIT
Begin DoDot:1
+4 NEW HLTIME,HLQUE,HLLARY
+5 SET HLTIME=$GET(^HLTMP("FAILING LINKS",HLLINK))
if HLTIME=""
QUIT
+6 IF '$GET(HLLARY("SHUTDOWN"))
IF HLTIME=""
QUIT
+7 IF '$GET(HLLARY("SHUTDOWN"))
IF ($$HDIFF^XLFDT($HOROLOG,HLTIME,2)<300)
QUIT
+8 SET HLLIST=HLLIST_$SELECT($LENGTH(HLLIST):", ",1:"")_HLLINK
End DoDot:1
IF $LENGTH(HLLIST)>60
SET HLLIST=HLLIST_",..."
QUIT
+9 QUIT HLLIST
+10 ;
STQUES(HLDIR) ; returns up to 4 stopped in/out queues - adapted from ^HLOUSR
+1 NEW HLTEMP,HLCOUNT,HLQUE
+2 SET HLTEMP=""
SET HLCOUNT=0
SET HLQUE=""
+3 FOR
SET HLQUE=$ORDER(^HLTMP("STOPPED QUEUES",HLDIR,HLQUE))
if HLQUE=""
QUIT
Begin DoDot:1
+4 SET HLCOUNT=HLCOUNT+1
+5 if HLCOUNT>4
QUIT
+6 if HLCOUNT=1
SET HLTEMP=HLTEMP_HLQUE
+7 if "23"[HLCOUNT
SET HLTEMP=HLTEMP_"; "_HLQUE
+8 if HLCOUNT=4
SET HLTEMP=HLTEMP_" ..."
End DoDot:1
+9 QUIT HLTEMP
+10 ;
GETVIEWS(HLVARR) ; returns an array with the site's Logical LInk Views
+1 NEW HLVIEN,HLVIEW,HLVIDX,HLVDAT,HLLINK,HLLIEN,HLORD,HLVCNT
+2 SET HLVCNT=0
+3 SET HLVIEN=0
+4 FOR
SET HLVIEN=$ORDER(^HLCS(869.3,1,6,HLVIEN))
if +HLVIEN=0
QUIT
Begin DoDot:1
+5 SET HLVIEW=$GET(^HLCS(869.3,1,6,HLVIEN,0))
+6 IF HLVIEW=""
SET HLVIEW=HLVIEN
+7 SET HLVIDX=0
+8 FOR
SET HLVIDX=$ORDER(^HLCS(869.3,1,6,HLVIEN,1,HLVIDX))
if +HLVIDX=0
QUIT
Begin DoDot:2
+9 SET HLVDAT=$GET(^HLCS(869.3,1,6,HLVIEN,1,HLVIDX,0))
+10 SET HLLIEN=$PIECE(HLVDAT,"^")
SET HLORD=+$PIECE(HLVDAT,"^",2)
+11 SET HLLINK=$$GET1^DIQ(870,HLLIEN,.01)
+12 IF HLLINK=""
SET HLLINK=HLLIEN
+13 SET HLVARR(HLVIEW,HLORD,HLLINK)=""
+14 SET HLVCNT=HLVCNT+1
End DoDot:2
End DoDot:1
+15 SET HLVARR=HLVCNT
+16 QUIT
