XOBVLL ;; mjk/alb - VistALink Listen and Spawn Code ; 07/27/2002 13:00
;;1.5;VistALink;;Sep 09, 2005
;;Foundations Toolbox Release v1.5 [Build: 1.5.0.026]
;
QUIT
;
; ***deprecated*** tag ; Use START^XOBVTCP instead
START(SOCKET) ; -- start listener
DO START^XOBVTCP(SOCKET)
QUIT
;
; ***deprecated*** tag ; Use UCX^XOBVTCP instead
UCX ; -- VMS TCPIP (UCX) multi-thread entry point
; -- Called from VistALink .com files
GOTO UCX^XOBVTCP
;
SPAWN ; -- spawned process
NEW X,XOBSTOP,XOBPORT,XOBHDLR,XOBLASTR
;
SET XOBSTOP=0
SET XOBPORT=IO
SET U="^"
;
; -- initialize timestamp for last time request made (used for debugging)
SET XOBLASTR=0
;
; -- set error trap
;Set up the error trap
SET $ETRAP="DO ^%ZTER HALT"
;
; -- attempt to share the license; must have TCP port open first
USE XOBPORT IF $TEXT(SHARELIC^%ZOSV)'="" DO SHARELIC^%ZOSV(1)
;
; -- start RUM for VistALink Handler
DO LOGRSRC^%ZOSV("$VISTALINK HANDLER$",2,1)
;
; -- cache/initialize startup request handlers
SET X=$$CACHE^XOBVRH(.XOBHDLR)
IF 'X DO RMERR^XOBVRM(184001,$PIECE(X,U,2)) QUIT
;
; -- initialize tcp processing variables
DO INIT^XOBVSKT
;
; -- change job name if possible
DO SETNM^%ZOSV("VLink_"_$$CNV^XLFUTL($J,16))
;
; -- loop until told to stop
FOR DO NXTCALL QUIT:XOBSTOP
;
; -- final/clean tcp processing variables
DO FINAL^XOBVSKT
;
; -- stop RUM for VistALink Handler
DO LOGRSRC^%ZOSV("$VISTALINK HANDLER$",2,2)
;
QUIT
;
NXTCALL ; -- do next call
NEW X,XOBROOT,XOBREAD,XOBTO,XOBFIRST,XOBOK,XOBRL,XOBDATA
;
; -- set up error trap
NEW $ESTACK SET $ETRAP="DO SYSERR^XOBVLL"
;
; -- setup environment variables
NEW DIQUIET SET DIQUIET=1
SET U="^",DTIME=$GET(DTIME,900),DT=$$DT^XLFDT()
;
; -- initialize 'current' request handler to empty string
SET XOBHDLR=""
;
; -- # of chars to get on first read / read 11 for Broker initial read
SET XOBREAD=11
;
; -- get J2SE heartbet rate for timeout plus network latency factor
SET XOBTO=$$GETRATE^XOBVLIB()+$$GETDELTA^XOBVLIB()
;
; -- get J2EE timeout value for app serv environment
IF $GET(XOBSYS("ENV"))="j2ee" SET XOBTO=$$GETASTO^XOBVLIB()
;
; -- set first read flag
SET XOBFIRST=1
;
; -- setup intake global
SET XOBROOT=$NAME(^TMP("XOBVLL",$JOB))
KILL @XOBROOT
;
; -- read from socket port
USE XOBPORT
SET XOBOK=$$READ^XOBVSKT(XOBROOT,.XOBREAD,.XOBTO,.XOBFIRST,.XOBSTOP,.XOBDATA,.XOBHDLR)
;
; -- timed out ; cleanup user and exit
IF 'XOBOK!(XOBSTOP) DO GOTO NXTCALLQ
. IF $GET(DUZ) DO CLEAN^XOBSCAV1
. SET XOBSTOP=1
;
; -- need null device
IF '$DATA(XOBNULL) DO ERROR(181002,$$EZBLD^DIALOG(181002),XOBPORT) SET XOBSTOP=1 GOTO NXTCALLQ
;
; -- call request manager
SET XOBOK=$$EN^XOBVRM(XOBROOT,.XOBDATA,.XOBHDLR)
; -- timestamp last time request made
SET XOBLASTR=$$NOW^XLFDT()
; -- cleanup intake global
KILL @XOBROOT
;
NXTCALLQ ; -- exit
QUIT
;
; ----------------------------------------------------------------------------------
; System Error Handler
; ----------------------------------------------------------------------------------
SYSERR ; -- send system error message
; -- If we get an error in the error handler just Halt
SET $ETRAP="D ^%ZTER HALT"
;
DO ERROR(181001,$$EZBLD^DIALOG(181001,$$EC^%ZOSV),XOBPORT) ; -- Get the error code
QUIT
;
ERROR(XOBEC,XOBMSG,XOBPORT) ; -- send error message
NEW XOBDAT
;
; -- If we get an error in the error handler just Halt
SET $ETRAP="D ^%ZTER HALT"
;
; -- set up error info
SET XOBDAT("MESSAGE TYPE")=3
SET XOBDAT("ERRORS",1,"CODE")=XOBEC
SET XOBDAT("ERRORS",1,"ERROR TYPE")="system"
SET XOBDAT("ERRORS",1,"FAULT STRING")="System Error"
SET XOBDAT("ERRORS",1,"CDATA")=1
SET XOBDAT("ERRORS",1,"MESSAGE",1)=XOBMSG
;
; -- if serious error, save error info, logout, and halt
IF XOBMSG["<READ>"!(XOBMSG["<WRITE>")!(XOBMSG["<SYSTEM>")!(XOBMSG["READERR")!(XOBMSG["WRITERR")!(XOBMSG["SYSERR") DO HALT
. DO ^%ZTER
. IF $GET(DUZ) DO CLEAN^XOBSCAV1
;
; -- send error back to client
USE XOBPORT
DO ERROR^XOBVLIB(.XOBDAT)
;
; -- just quit if no slots are available or logins are disabled
IF (XOBEC=181003)!(XOBEC=181004) QUIT
;
; -- need to make sure any locks are released since code aborted ungracefully
LOCK
;
; -- Save off the error
DO ^%ZTER
;
; -- go back to listening
SET $ETRAP="Q:($ESTACK&'$QUIT) Q:$ESTACK -9 S $ECODE="""" DO KILL^XOBVLL G NXTCALLQ^XOBVLL",$ECODE=",U99,"
QUIT
;
KILL ; -- new VistALink variables and then do big KILL
NEW XOBPORT,XOBSTOP,XOBNULL,XOBOS,XOBSYS,XOBHDLR,XOBOK
DO KILL^XUSCLEAN
QUIT
;
XOBVLL ;; mjk/alb - VistALink Listen and Spawn Code ; 07/27/2002 13:00
+1 ;;1.5;VistALink;;Sep 09, 2005
+2 ;;Foundations Toolbox Release v1.5 [Build: 1.5.0.026]
+3 ;
+4 QUIT
+5 ;
+6 ; ***deprecated*** tag ; Use START^XOBVTCP instead
START(SOCKET) ; -- start listener
+1 DO START^XOBVTCP(SOCKET)
+2 QUIT
+3 ;
+4 ; ***deprecated*** tag ; Use UCX^XOBVTCP instead
UCX ; -- VMS TCPIP (UCX) multi-thread entry point
+1 ; -- Called from VistALink .com files
+2 GOTO UCX^XOBVTCP
+3 ;
SPAWN ; -- spawned process
+1 NEW X,XOBSTOP,XOBPORT,XOBHDLR,XOBLASTR
+2 ;
+3 SET XOBSTOP=0
+4 SET XOBPORT=IO
+5 SET U="^"
+6 ;
+7 ; -- initialize timestamp for last time request made (used for debugging)
+8 SET XOBLASTR=0
+9 ;
+10 ; -- set error trap
+11 ;Set up the error trap
+12 SET $ETRAP="DO ^%ZTER HALT"
+13 ;
+14 ; -- attempt to share the license; must have TCP port open first
+15 USE XOBPORT
IF $TEXT(SHARELIC^%ZOSV)'=""
DO SHARELIC^%ZOSV(1)
+16 ;
+17 ; -- start RUM for VistALink Handler
+18 DO LOGRSRC^%ZOSV("$VISTALINK HANDLER$",2,1)
+19 ;
+20 ; -- cache/initialize startup request handlers
+21 SET X=$$CACHE^XOBVRH(.XOBHDLR)
+22 IF 'X
DO RMERR^XOBVRM(184001,$PIECE(X,U,2))
QUIT
+23 ;
+24 ; -- initialize tcp processing variables
+25 DO INIT^XOBVSKT
+26 ;
+27 ; -- change job name if possible
+28 DO SETNM^%ZOSV("VLink_"_$$CNV^XLFUTL($JOB,16))
+29 ;
+30 ; -- loop until told to stop
+31 FOR
DO NXTCALL
IF XOBSTOP
QUIT
+32 ;
+33 ; -- final/clean tcp processing variables
+34 DO FINAL^XOBVSKT
+35 ;
+36 ; -- stop RUM for VistALink Handler
+37 DO LOGRSRC^%ZOSV("$VISTALINK HANDLER$",2,2)
+38 ;
+39 QUIT
+40 ;
NXTCALL ; -- do next call
+1 NEW X,XOBROOT,XOBREAD,XOBTO,XOBFIRST,XOBOK,XOBRL,XOBDATA
+2 ;
+3 ; -- set up error trap
+4 NEW $ESTACK
SET $ETRAP="DO SYSERR^XOBVLL"
+5 ;
+6 ; -- setup environment variables
+7 NEW DIQUIET
SET DIQUIET=1
+8 SET U="^"
SET DTIME=$GET(DTIME,900)
SET DT=$$DT^XLFDT()
+9 ;
+10 ; -- initialize 'current' request handler to empty string
+11 SET XOBHDLR=""
+12 ;
+13 ; -- # of chars to get on first read / read 11 for Broker initial read
+14 SET XOBREAD=11
+15 ;
+16 ; -- get J2SE heartbet rate for timeout plus network latency factor
+17 SET XOBTO=$$GETRATE^XOBVLIB()+$$GETDELTA^XOBVLIB()
+18 ;
+19 ; -- get J2EE timeout value for app serv environment
+20 IF $GET(XOBSYS("ENV"))="j2ee"
SET XOBTO=$$GETASTO^XOBVLIB()
+21 ;
+22 ; -- set first read flag
+23 SET XOBFIRST=1
+24 ;
+25 ; -- setup intake global
+26 SET XOBROOT=$NAME(^TMP("XOBVLL",$JOB))
+27 KILL @XOBROOT
+28 ;
+29 ; -- read from socket port
+30 USE XOBPORT
+31 SET XOBOK=$$READ^XOBVSKT(XOBROOT,.XOBREAD,.XOBTO,.XOBFIRST,.XOBSTOP,.XOBDATA,.XOBHDLR)
+32 ;
+33 ; -- timed out ; cleanup user and exit
+34 IF 'XOBOK!(XOBSTOP)
Begin DoDot:1
+35 IF $GET(DUZ)
DO CLEAN^XOBSCAV1
+36 SET XOBSTOP=1
End DoDot:1
GOTO NXTCALLQ
+37 ;
+38 ; -- need null device
+39 IF '$DATA(XOBNULL)
DO ERROR(181002,$$EZBLD^DIALOG(181002),XOBPORT)
SET XOBSTOP=1
GOTO NXTCALLQ
+40 ;
+41 ; -- call request manager
+42 SET XOBOK=$$EN^XOBVRM(XOBROOT,.XOBDATA,.XOBHDLR)
+43 ; -- timestamp last time request made
+44 SET XOBLASTR=$$NOW^XLFDT()
+45 ; -- cleanup intake global
+46 KILL @XOBROOT
+47 ;
NXTCALLQ ; -- exit
+1 QUIT
+2 ;
+3 ; ----------------------------------------------------------------------------------
+4 ; System Error Handler
+5 ; ----------------------------------------------------------------------------------
SYSERR ; -- send system error message
+1 ; -- If we get an error in the error handler just Halt
+2 SET $ETRAP="D ^%ZTER HALT"
+3 ;
+4 ; -- Get the error code
DO ERROR(181001,$$EZBLD^DIALOG(181001,$$EC^%ZOSV),XOBPORT)
+5 QUIT
+6 ;
ERROR(XOBEC,XOBMSG,XOBPORT) ; -- send error message
+1 NEW XOBDAT
+2 ;
+3 ; -- If we get an error in the error handler just Halt
+4 SET $ETRAP="D ^%ZTER HALT"
+5 ;
+6 ; -- set up error info
+7 SET XOBDAT("MESSAGE TYPE")=3
+8 SET XOBDAT("ERRORS",1,"CODE")=XOBEC
+9 SET XOBDAT("ERRORS",1,"ERROR TYPE")="system"
+10 SET XOBDAT("ERRORS",1,"FAULT STRING")="System Error"
+11 SET XOBDAT("ERRORS",1,"CDATA")=1
+12 SET XOBDAT("ERRORS",1,"MESSAGE",1)=XOBMSG
+13 ;
+14 ; -- if serious error, save error info, logout, and halt
+15 IF XOBMSG["<READ>"!(XOBMSG["<WRITE>")!(XOBMSG["<SYSTEM>")!(XOBMSG["READERR")!(XOBMSG["WRITERR")!(XOBMSG["SYSERR")
Begin DoDot:1
+16 DO ^%ZTER
+17 IF $GET(DUZ)
DO CLEAN^XOBSCAV1
End DoDot:1
HALT
+18 ;
+19 ; -- send error back to client
+20 USE XOBPORT
+21 DO ERROR^XOBVLIB(.XOBDAT)
+22 ;
+23 ; -- just quit if no slots are available or logins are disabled
+24 IF (XOBEC=181003)!(XOBEC=181004)
QUIT
+25 ;
+26 ; -- need to make sure any locks are released since code aborted ungracefully
+27 LOCK
+28 ;
+29 ; -- Save off the error
+30 DO ^%ZTER
+31 ;
+32 ; -- go back to listening
+33 SET $ETRAP="Q:($ESTACK&'$QUIT) Q:$ESTACK -9 S $ECODE="""" DO KILL^XOBVLL G NXTCALLQ^XOBVLL"
SET $ECODE=",U99,"
+34 QUIT
+35 ;
KILL ; -- new VistALink variables and then do big KILL
+1 NEW XOBPORT,XOBSTOP,XOBNULL,XOBOS,XOBSYS,XOBHDLR,XOBOK
+2 DO KILL^XUSCLEAN
+3 QUIT
+4 ;
