XOBVTLS.m

XOBVTLS ;; mjk/alb - VistALink Programmer Mode Support Tools ; 07/27/2002  13:00

 ;;1.6;VistALink;;May 08, 2009;Build 15

 ;Per VHA directive 2004-038, this routine should not be modified.

 QUIT

 ;

DEBUG ; -- entry point for debugging

 NEW XOBDSKT

 ;

 WRITE !,"Before running this entry point set your debugger"

 WRITE !,"to stop at the place you want to debug."

 WRITE !!,"Some possible spots to use:"

 WRITE !,"     o  SERV+1^XOBVTLS  => where debugging starts"

 WRITE !,"     o  SPAWN+1^XOBVLL  => where VistALink spawn starts"

 WRITE !,"     o  or location of your choice.",!

 ;

 WRITE !,"IP Socket to Listen on ('^' to quit): "

 READ XOBDSKT:300

 ;

 ; -- quit if read timed out or up-arrow or number not entered

 IF '$TEST!(XOBDSKT["^")!(+XOBDSKT=0) DO  GOTO DEBUGQ

 . WRITE !,"Socket number not entered...debug listener not started.",!

 ;

 WRITE !!,"================================================"

 WRITE !,"Starting listener at port ",XOBDSKT," [Job: ",$JOB,"]..."

 ;

 ; -- use %ZISTCP to do a single server

 DO LISTEN^%ZISTCP(XOBDSKT,"SERV^XOBVTLS")

 ;

 USE $PRINCIPAL

 WRITE !!,"Listener stopped on port ",XOBDSKT,"."

 WRITE !,"Done."

 WRITE !,"================================================"

DEBUGQ QUIT

 ;

SERV ; -- service debug session

 NEW XOBDEBUG,XOBEC

 ;

 ; -- set a debug mode flag for reference

 SET XOBDEBUG=1

 ;

 USE $PRINCIPAL WRITE !!,"Debug mode started...",!

 USE IO

 ;

 ; -- do basic checks and then real spawn

 SET XOBEC=$$NEWOK^XOBVTCPL()

 IF XOBEC DO LOGINERR^XOBVTCPL(XOBEC,IO)

 IF 'XOBEC DO SPAWN^XOBVLL

 ;

 ; -- cause the listener to stop

 SET IO("C")=1

 QUIT

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XOBVTLS   1650     printed  Apr 09, 2024@21:46:53                                                                                                                                                                                                     Page 2

XOBVTLS   ;; mjk/alb - VistALink Programmer Mode Support Tools ; 07/27/2002  13:00

 +1       ;;1.6;VistALink;;May 08, 2009;Build 15

 +2       ;Per VHA directive 2004-038, this routine should not be modified.

 +3        QUIT 

 +4       ;

DEBUG     ; -- entry point for debugging

 +1        NEW XOBDSKT

 +2       ;

 +3        WRITE !,"Before running this entry point set your debugger"

 +4        WRITE !,"to stop at the place you want to debug."

 +5        WRITE !!,"Some possible spots to use:"

 +6        WRITE !,"     o  SERV+1^XOBVTLS  => where debugging starts"

 +7        WRITE !,"     o  SPAWN+1^XOBVLL  => where VistALink spawn starts"

 +8        WRITE !,"     o  or location of your choice.",!

 +9       ;

 +10       WRITE !,"IP Socket to Listen on ('^' to quit): "

 +11       READ XOBDSKT:300

 +12      ;

 +13      ; -- quit if read timed out or up-arrow or number not entered

 +14       IF '$TEST!(XOBDSKT["^")!(+XOBDSKT=0)

               Begin DoDot:1

 +15               WRITE !,"Socket number not entered...debug listener not started.",!

               End DoDot:1

               GOTO DEBUGQ

 +16      ;

 +17       WRITE !!,"================================================"

 +18       WRITE !,"Starting listener at port ",XOBDSKT," [Job: ",$JOB,"]..."

 +19      ;

 +20      ; -- use %ZISTCP to do a single server

 +21       DO LISTEN^%ZISTCP(XOBDSKT,"SERV^XOBVTLS")

 +22      ;

 +23       USE $PRINCIPAL

 +24       WRITE !!,"Listener stopped on port ",XOBDSKT,"."

 +25       WRITE !,"Done."

 +26       WRITE !,"================================================"

DEBUGQ     QUIT 

 +1       ;

SERV      ; -- service debug session

 +1        NEW XOBDEBUG,XOBEC

 +2       ;

 +3       ; -- set a debug mode flag for reference

 +4        SET XOBDEBUG=1

 +5       ;

 +6        USE $PRINCIPAL

           WRITE !!,"Debug mode started...",!

 +7        USE IO

 +8       ;

 +9       ; -- do basic checks and then real spawn

 +10       SET XOBEC=$$NEWOK^XOBVTCPL()

 +11       IF XOBEC

               DO LOGINERR^XOBVTCPL(XOBEC,IO)

 +12       IF 'XOBEC

               DO SPAWN^XOBVLL

 +13      ;

 +14      ; -- cause the listener to stop

 +15       SET IO("C")=1

 +16       QUIT 

 +17      ;