XOBUM ;; ld,mjk/alb - Foundations Manager ; 07/27/2002 13:00
;;1.6;Foundations;;May 08, 2009;Build 15
;Per VHA directive 2004-038, this routine should not be modified.
;
EN ; -- main entry point for XOBU FOUNDATIONS MAIN ListMan Template
; Option: XOBU SITE SETUP MENU on Operations Management menu [XUSITEMGR]
;
DO EN^VALM("XOBU FOUNDATIONS MAIN")
QUIT
;
HDR ; -- header code
NEW Y,X
SET Y=$GET(^XOB(18.01,1,0))
SET VALMHDR(1)=" <<< VistALink Parameters >>>"
SET VALMHDR(2)=""
SET X=" "
SET X=X_"VistALink Version: "_$PIECE($TEXT(XOBUM+1),";",3)
SET X=X_" "
SET X=X_"Heartbeat Rate: "_$PIECE(Y,U,2)
SET X=X_" "
SET X=X_"Latency Delta: "_$PIECE(Y,U,3)
SET VALMHDR(3)=X
SET VALMHDR(4)=""
SET VALMHDR(5)=" <<< VistALink Listener Status Log >>>"
QUIT
;
INIT ; -- init variables and list array
DO CLEAR
QUIT
;
BUILD ; -- init variables and list array
NEW I,XOBI,XOB0,X,XOBDATA,XOBOS,XOBROOT,XOBTXT
DO KILL
;
SET VALMCNT=0
SET XOBROOT=$NAME(XOBDATA("DILIST","ID"))
DO LIST^DIC(18.04,"",".01;.02;.03;.04;.05;.06","","","","","","","",$NAME(XOBDATA))
SET XOBI=0
FOR SET XOBI=$ORDER(@XOBROOT@(XOBI)) QUIT:'XOBI DO
. SET VALMCNT=VALMCNT+1
. SET X=""
. SET X=$$SETFLD^VALM1(VALMCNT,X,"ID")
. SET X=$$SETFLD^VALM1($GET(@XOBROOT@(XOBI,.01)),X,"BOX")
. SET X=$$SETFLD^VALM1($GET(@XOBROOT@(XOBI,.02)),X,"PORT")
. SET X=$$SETFLD^VALM1($GET(@XOBROOT@(XOBI,.03)),X,"STATUS")
. SET X=$$SETFLD^VALM1($GET(@XOBROOT@(XOBI,.05)),X,"DATE")
. SET X=$$SETFLD^VALM1($GET(@XOBROOT@(XOBI,.06)),X,"CONFIG")
. DO SET^VALM10(VALMCNT,X,VALMCNT)
. SET ^TMP("XOB LISTENERS","IDX",$JOB,VALMCNT)=VALMCNT_"^"_+$GET(XOBDATA("DILIST",2,XOBI))
;
QUIT:VALMCNT
;
;-- supported Kernel API to get OS version
SET XOBOS=$$VERSION^%ZOSV(1)
QUIT:XOBOS'["VMS"&(XOBOS'["DSM")
SET XOBOS=$SELECT(XOBOS["VMS":"VMS",1:"DSM")
;
;-- display text for VistaLink TCPIP enabled (Cache/VMS or DSM)
FOR I=1:1 SET XOBTXT=$PIECE($TEXT(@XOBOS+I),";;",2) QUIT:XOBTXT="$END$" DO
. SET VALMCNT=VALMCNT+1
. DO SET^VALM10(VALMCNT,$$SETSTR^VALM1(XOBTXT,"",12,65))
QUIT
;
HELP ; -- help code
SET X="?" DO DISP^XQORM1 WRITE !!
QUIT
;
EXIT ; -- exit code
DO KILL
QUIT
;
KILL ; -- kill off list location
KILL ^TMP("XOB LISTENERS",$JOB)
QUIT
;
EXPND ; -- expand code
QUIT
;
START ; -- start a listener
; -- Protocol: XOBV LISTENER START
NEW XOBOK
DO FULL^VALM1
IF $$START^XOBUM1() DO
. SET VALMSG="Refresh to see 'RUNNING' status"
ELSE DO
. DO PAUSE^VALM1
DO REFRESH
QUIT
;
BOX ; -- start this BOX-VOl default configuration
; -- Protocol: XOBV LISTENER BOX-VOL
IF $$BOX^XOBUM1() SET VALMSG="Refresh to see 'RUNNING' status"
DO REFRESH
QUIT
;
STOP ; -- stop a listener
; -- Protocol: XOBV LISTENER STOP
NEW Y,X,DATA,ENTRY,LOGDA,XOBOK
DO FULL^VALM1
DO EN^VALM2(XQORNOD(0),"S")
SET ENTRY=+$ORDER(VALMY(""))
IF 'ENTRY GOTO STOPQ
;
SET DATA=$GET(^TMP("XOB LISTENERS","IDX",$JOB,ENTRY))
DO SELECT^VALM10(+DATA,1)
;
SET LOGDA=+$PIECE(DATA,U,2)
SET XOBOK=$$STOP^XOBUM1(LOGDA)
IF XOBOK SET VALMSG=">>> Listener may take up to 60 seconds to stop <<<"
IF 'XOBOK DO ERROR(XOBOK)
DO SELECT^VALM10(+DATA,0)
;
STOPQ ;
DO REFRESH
QUIT
;
PARMS ; -- maintain site parameters
; -- Protocol: XOBU SITE PARAMETERS
NEW XOBOK
DO FULL^VALM1
SET XOBOK=$$PARMS^XOBUM1()
IF 'XOBOK DO ERROR(XOBOK)
;
; -- Add users to VISTALINK PERSON file (#18.09)
; SET XOBOK=$$ADDPERS^XOBUM1()
; IF 'XOBOK DO ERROR(XOBOK)
;
DO HDR
DO REFRESH
QUIT
;
CFG ; -- maintain listener configurations
; -- Protocol: XOBV LISTENER CONFIG
NEW XOBOK
DO FULL^VALM1
SET XOBOK=$$CFG^XOBUM1()
IF 'XOBOK DO ERROR(XOBOK)
DO REFRESH
QUIT
;
CP ; -- add connector proxy
; -- Protocol: XOBV LISTENER CONNECTOR PROXY
NEW XOBOK
DO FULL^VALM1
SET XOBOK=$$CP^XOBUM1()
IF 'XOBOK DO ERROR(XOBOK)
DO REFRESH
QUIT
;
CLEAR ; -- clean up log entries of non-listeners
; -- Protocol: XOBV LISTENER LOG CLEAR
DO WAIT^DICD WRITE !
DO CLEARLOG^XOBVTCP
DO REFRESH
QUIT
;
REFRESH ; -- refresh display
; -- Protocol: XOBU FOUNDATIONS MAIN REFRESH
DO BUILD
SET VALMBCK="R"
QUIT
;
SS ; -- display M os system status
; -- Protocol: XOBU FOUNDATIONS SYSTEM STATUS
DO FULL^VALM1
IF $DATA(^%ZOSF("SS")) DO
. XECUTE ^%ZOSF("SS")
ELSE DO
. WRITE !,"Error: ^%ZOSF(""SS"") node is not defined."
DO PAUSE^VALM1
DO REFRESH
QUIT
;
ERROR(XOBOK) ;
WRITE !,$PIECE(XOBOK,U,2)
DO PAUSE^VALM1
QUIT
;
NOYET ; -- not yet available
WRITE !!,"Action is under construction.",!
DO PAUSE^VALM1
SET VALMBCK="R"
QUIT
;
VMS ; -- text for Cache/VMS TCPIP listener
;;
;;If this screen shows no running listener(s), it is likely that
;;the VistALink listener(s) for this system are managed by the
;;TCP/IP utility at the VMS system level and are already running.
;;
;;The following TCP/IP command will show the status of all
;;listener services with names starting with vlink:
;; $ tcpip show service vlink*
;;Please contact IRM site staff for additional information
;;regarding the VistALink listener(s) such as port number(s).
;;$END$
DSM ; -- text for VMS/DSM TCPIP disclaimer
;;
;;This Foundations Manager screen cannot be used to manage
;;VistALink listeners under DSM.
;;
;;For DSM, use the VMS TCP/IP utility to manage VistALink
;;listeners. For example, the following TCP/IP command will
;;show the status of all listener services with names
;;starting with vlink:
;;
;; $ tcpip show service vlink*
;;$END$
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXOBUM 5689 printed Sep 23, 2025@19:31:05 Page 2
XOBUM ;; ld,mjk/alb - Foundations Manager ; 07/27/2002 13:00
+1 ;;1.6;Foundations;;May 08, 2009;Build 15
+2 ;Per VHA directive 2004-038, this routine should not be modified.
+3 ;
EN ; -- main entry point for XOBU FOUNDATIONS MAIN ListMan Template
+1 ; Option: XOBU SITE SETUP MENU on Operations Management menu [XUSITEMGR]
+2 ;
+3 DO EN^VALM("XOBU FOUNDATIONS MAIN")
+4 QUIT
+5 ;
HDR ; -- header code
+1 NEW Y,X
+2 SET Y=$GET(^XOB(18.01,1,0))
+3 SET VALMHDR(1)=" <<< VistALink Parameters >>>"
+4 SET VALMHDR(2)=""
+5 SET X=" "
+6 SET X=X_"VistALink Version: "_$PIECE($TEXT(XOBUM+1),";",3)
+7 SET X=X_" "
+8 SET X=X_"Heartbeat Rate: "_$PIECE(Y,U,2)
+9 SET X=X_" "
+10 SET X=X_"Latency Delta: "_$PIECE(Y,U,3)
+11 SET VALMHDR(3)=X
+12 SET VALMHDR(4)=""
+13 SET VALMHDR(5)=" <<< VistALink Listener Status Log >>>"
+14 QUIT
+15 ;
INIT ; -- init variables and list array
+1 DO CLEAR
+2 QUIT
+3 ;
BUILD ; -- init variables and list array
+1 NEW I,XOBI,XOB0,X,XOBDATA,XOBOS,XOBROOT,XOBTXT
+2 DO KILL
+3 ;
+4 SET VALMCNT=0
+5 SET XOBROOT=$NAME(XOBDATA("DILIST","ID"))
+6 DO LIST^DIC(18.04,"",".01;.02;.03;.04;.05;.06","","","","","","","",$NAME(XOBDATA))
+7 SET XOBI=0
+8 FOR
SET XOBI=$ORDER(@XOBROOT@(XOBI))
if 'XOBI
QUIT
Begin DoDot:1
+9 SET VALMCNT=VALMCNT+1
+10 SET X=""
+11 SET X=$$SETFLD^VALM1(VALMCNT,X,"ID")
+12 SET X=$$SETFLD^VALM1($GET(@XOBROOT@(XOBI,.01)),X,"BOX")
+13 SET X=$$SETFLD^VALM1($GET(@XOBROOT@(XOBI,.02)),X,"PORT")
+14 SET X=$$SETFLD^VALM1($GET(@XOBROOT@(XOBI,.03)),X,"STATUS")
+15 SET X=$$SETFLD^VALM1($GET(@XOBROOT@(XOBI,.05)),X,"DATE")
+16 SET X=$$SETFLD^VALM1($GET(@XOBROOT@(XOBI,.06)),X,"CONFIG")
+17 DO SET^VALM10(VALMCNT,X,VALMCNT)
+18 SET ^TMP("XOB LISTENERS","IDX",$JOB,VALMCNT)=VALMCNT_"^"_+$GET(XOBDATA("DILIST",2,XOBI))
End DoDot:1
+19 ;
+20 if VALMCNT
QUIT
+21 ;
+22 ;-- supported Kernel API to get OS version
+23 SET XOBOS=$$VERSION^%ZOSV(1)
+24 if XOBOS'["VMS"&(XOBOS'["DSM")
QUIT
+25 SET XOBOS=$SELECT(XOBOS["VMS":"VMS",1:"DSM")
+26 ;
+27 ;-- display text for VistaLink TCPIP enabled (Cache/VMS or DSM)
+28 FOR I=1:1
SET XOBTXT=$PIECE($TEXT(@XOBOS+I),";;",2)
if XOBTXT="$END$"
QUIT
Begin DoDot:1
+29 SET VALMCNT=VALMCNT+1
+30 DO SET^VALM10(VALMCNT,$$SETSTR^VALM1(XOBTXT,"",12,65))
End DoDot:1
+31 QUIT
+32 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 DO KILL
+2 QUIT
+3 ;
KILL ; -- kill off list location
+1 KILL ^TMP("XOB LISTENERS",$JOB)
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
START ; -- start a listener
+1 ; -- Protocol: XOBV LISTENER START
+2 NEW XOBOK
+3 DO FULL^VALM1
+4 IF $$START^XOBUM1()
Begin DoDot:1
+5 SET VALMSG="Refresh to see 'RUNNING' status"
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 DO PAUSE^VALM1
End DoDot:1
+8 DO REFRESH
+9 QUIT
+10 ;
BOX ; -- start this BOX-VOl default configuration
+1 ; -- Protocol: XOBV LISTENER BOX-VOL
+2 IF $$BOX^XOBUM1()
SET VALMSG="Refresh to see 'RUNNING' status"
+3 DO REFRESH
+4 QUIT
+5 ;
STOP ; -- stop a listener
+1 ; -- Protocol: XOBV LISTENER STOP
+2 NEW Y,X,DATA,ENTRY,LOGDA,XOBOK
+3 DO FULL^VALM1
+4 DO EN^VALM2(XQORNOD(0),"S")
+5 SET ENTRY=+$ORDER(VALMY(""))
+6 IF 'ENTRY
GOTO STOPQ
+7 ;
+8 SET DATA=$GET(^TMP("XOB LISTENERS","IDX",$JOB,ENTRY))
+9 DO SELECT^VALM10(+DATA,1)
+10 ;
+11 SET LOGDA=+$PIECE(DATA,U,2)
+12 SET XOBOK=$$STOP^XOBUM1(LOGDA)
+13 IF XOBOK
SET VALMSG=">>> Listener may take up to 60 seconds to stop <<<"
+14 IF 'XOBOK
DO ERROR(XOBOK)
+15 DO SELECT^VALM10(+DATA,0)
+16 ;
STOPQ ;
+1 DO REFRESH
+2 QUIT
+3 ;
PARMS ; -- maintain site parameters
+1 ; -- Protocol: XOBU SITE PARAMETERS
+2 NEW XOBOK
+3 DO FULL^VALM1
+4 SET XOBOK=$$PARMS^XOBUM1()
+5 IF 'XOBOK
DO ERROR(XOBOK)
+6 ;
+7 ; -- Add users to VISTALINK PERSON file (#18.09)
+8 ; SET XOBOK=$$ADDPERS^XOBUM1()
+9 ; IF 'XOBOK DO ERROR(XOBOK)
+10 ;
+11 DO HDR
+12 DO REFRESH
+13 QUIT
+14 ;
CFG ; -- maintain listener configurations
+1 ; -- Protocol: XOBV LISTENER CONFIG
+2 NEW XOBOK
+3 DO FULL^VALM1
+4 SET XOBOK=$$CFG^XOBUM1()
+5 IF 'XOBOK
DO ERROR(XOBOK)
+6 DO REFRESH
+7 QUIT
+8 ;
CP ; -- add connector proxy
+1 ; -- Protocol: XOBV LISTENER CONNECTOR PROXY
+2 NEW XOBOK
+3 DO FULL^VALM1
+4 SET XOBOK=$$CP^XOBUM1()
+5 IF 'XOBOK
DO ERROR(XOBOK)
+6 DO REFRESH
+7 QUIT
+8 ;
CLEAR ; -- clean up log entries of non-listeners
+1 ; -- Protocol: XOBV LISTENER LOG CLEAR
+2 DO WAIT^DICD
WRITE !
+3 DO CLEARLOG^XOBVTCP
+4 DO REFRESH
+5 QUIT
+6 ;
REFRESH ; -- refresh display
+1 ; -- Protocol: XOBU FOUNDATIONS MAIN REFRESH
+2 DO BUILD
+3 SET VALMBCK="R"
+4 QUIT
+5 ;
SS ; -- display M os system status
+1 ; -- Protocol: XOBU FOUNDATIONS SYSTEM STATUS
+2 DO FULL^VALM1
+3 IF $DATA(^%ZOSF("SS"))
Begin DoDot:1
+4 XECUTE ^%ZOSF("SS")
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 WRITE !,"Error: ^%ZOSF(""SS"") node is not defined."
End DoDot:1
+7 DO PAUSE^VALM1
+8 DO REFRESH
+9 QUIT
+10 ;
ERROR(XOBOK) ;
+1 WRITE !,$PIECE(XOBOK,U,2)
+2 DO PAUSE^VALM1
+3 QUIT
+4 ;
NOYET ; -- not yet available
+1 WRITE !!,"Action is under construction.",!
+2 DO PAUSE^VALM1
+3 SET VALMBCK="R"
+4 QUIT
+5 ;
VMS ; -- text for Cache/VMS TCPIP listener
+1 ;;
+2 ;;If this screen shows no running listener(s), it is likely that
+3 ;;the VistALink listener(s) for this system are managed by the
+4 ;;TCP/IP utility at the VMS system level and are already running.
+5 ;;
+6 ;;The following TCP/IP command will show the status of all
+7 ;;listener services with names starting with vlink:
+8 ;; $ tcpip show service vlink*
+9 ;;Please contact IRM site staff for additional information
+10 ;;regarding the VistALink listener(s) such as port number(s).
+11 ;;$END$
DSM ; -- text for VMS/DSM TCPIP disclaimer
+1 ;;
+2 ;;This Foundations Manager screen cannot be used to manage
+3 ;;VistALink listeners under DSM.
+4 ;;
+5 ;;For DSM, use the VMS TCP/IP utility to manage VistALink
+6 ;;listeners. For example, the following TCP/IP command will
+7 ;;show the status of all listener services with names
+8 ;;starting with vlink:
+9 ;;
+10 ;; $ tcpip show service vlink*
+11 ;;$END$
