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 ---[H[J[2J[HXOBVTLS 1650 printed Dec 13, 2024@02:44:59 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 ;
