XOBUM.m

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 ---XOBUM   5689     printed  Feb 18, 2025@23:21:25                                                                                                                                                                                                       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$