XOBVLL ;MJK/ALB - VistALink Listen and Spawn Code ; 07/27/2002 13:00
;;1.6;VistALink;**4,6**;Apr 5,2017;Build 33
;Per VA Directive 6402, this routine should not be modified.
Q
;
; ***deprecated*** tag ; Use START^XOBVTCP instead
START(SOCKET) ; -- start listener
D START^XOBVTCP(SOCKET)
Q
;
; ***deprecated*** tag ; Use UCX^XOBVTCP instead
UCX ; -- VMS TCPIP (UCX) multi-thread entry point
; -- Called from VistALink .com files
G UCX^XOBVTCP
;
SPAWN ; -- spawned process
N X,XOBSTOP,XOBPORT,XOBHDLR,XOBLASTR,XOBCMREF
;
S XOBSTOP=0
S XOBPORT=IO
S U="^"
;
; -- initialize timestamp for last time request made (used for debugging)
S XOBLASTR=0
;
; -- set error trap
;Set up the error trap
; * * *
;S $ET="D APPERROR^%ZTER(""VistALink Error $P(XOBMSG,"": "",2 "") HALT" ;*4
S $ET="D APPERROR^%ZTER(""VistALink Error ""_$P(XOBMSG,"": "",2)) HALT" ;*6
; * * *
;
; -- attempt to share the license; must have TCP port open first
U XOBPORT I $T(SHARELIC^%ZOSV)'="" D SHARELIC^%ZOSV(1)
;
; -- start RUM for VistALink Handler
D LOGRSRC^%ZOSV("$VISTALINK HANDLER$",2,1)
;
; -- cache/initialize startup request handlers
S X=$$CACHE^XOBVRH(.XOBHDLR)
I 'X D RMERR^XOBVRM(184001,$P(X,U,2)) Q
;
; -- initialize tcp processing variables
D INIT^XOBVSKT
;
; -- change job name if possible
D SETNM^%ZOSV("VLink_"_$$CNV^XLFUTL($J,16))
;
; -- setup for Connection Mgr: get ref; kill data @ ref
S XOBCMREF=$$GETREF^XOBUZAP1()
D KILL^XOBUZAP0(XOBCMREF)
;
; -- loop until told to stop
F D NXTCALL Q:XOBSTOP
;
; -- kill ^XTMP ref node
D KILL^XOBUZAP0(XOBCMREF)
;
; -- final/clean tcp processing variables
D FINAL^XOBVSKT
;
; -- stop RUM for VistALink Handler
D LOGRSRC^%ZOSV("$VISTALINK HANDLER$",2,2)
;
Q
;
NXTCALL ; -- do next call
N X,XOBROOT,XOBREAD,XOBTO,XOBFIRST,XOBOK,XOBRL,XOBDATA
;
; -- set up error trap
N $ES S $ET="DO SYSERR^XOBVLL"
;
; -- setup environment variables
N DIQUIET S DIQUIET=1
S U="^",DTIME=$G(DTIME,900),DT=$$DT^XLFDT()
;
; -- set ^XTMP for Connection Mgr usage if DUZ not 1st piece
I '$$GETDUZ^XOBUZAP0(XOBCMREF) D
. N XOBDUZ,XOBIP
. S XOBDUZ=$G(XOBSYS("DUZ"),$G(DUZ))
. S XOBIP=$G(IO("IP"))
. D SETVI^XOBUZAP0(XOBCMREF,XOBDUZ,XOBIP,$$GETDESC^XOBUZAP1())
;
; -- initialize 'current' request handler to empty string
S XOBHDLR=""
;
; -- # of chars to get on first read / read 11 for Broker initial read
S XOBREAD=11
;
; -- get J2SE heartbeat rate for timeout plus network latency factor
S XOBTO=$$GETRATE^XOBVLIB()+$$GETDELTA^XOBVLIB()
;
; -- get J2EE timeout value for app serv environment
I $G(XOBSYS("ENV"))="j2ee" S XOBTO=$$GETASTO^XOBVLIB()
;
; -- set first read flag
S XOBFIRST=1
;
; -- setup intake global
S XOBROOT=$NA(^TMP("XOBVLL",$J))
K @XOBROOT
;
; -- read from socket port
U XOBPORT
S XOBOK=$$READ^XOBVSKT(XOBROOT,.XOBREAD,.XOBTO,.XOBFIRST,.XOBSTOP,.XOBDATA,.XOBHDLR)
;
; -- timed out ; cleanup user and exit
I 'XOBOK!(XOBSTOP) D G NXTCALLQ
. I $G(DUZ) D CLEAN^XOBSCAV1
. S XOBSTOP=1
;
; -- need null device
; * * *
;I '$D(XOBNULL) D ERROR(181002,$$EZBLD^DIALOG(181002),XOBPORT) S XOBSTOP=1 G NXTCALLQ
I '$D(XOBNULL) D ERROR(181002,$$EZBLD^DIALOG(181002,$$EC^%ZOSV),XOBPORT) S XOBSTOP=1 G NXTCALLQ ;*6
; * * *
;
; -- call request manager
S XOBOK=$$EN^XOBVRM(XOBROOT,.XOBDATA,.XOBHDLR)
; -- timestamp last time request made
S XOBLASTR=$$NOW^XLFDT()
; -- cleanup intake global
K @XOBROOT
;
NXTCALLQ ; -- exit
Q
;
; ----------------------------------------------------------------------------------
; System Error Handler
; ----------------------------------------------------------------------------------
SYSERR ; -- send system error message
; -- If we get an error in the error handler just Halt
S $ET="D APPERROR^%ZTER(""VistALink Error 181001"") HALT" ;*4
D ERROR(181001,$$EZBLD^DIALOG(181001,$$EC^%ZOSV),XOBPORT) ; -- Get the error code
Q
;
ERROR(XOBEC,XOBMSG,XOBPORT) ; -- send error message
N XOBDAT
;
; -- If we get an error in the error handler just Halt
;
; * * *
;S $ET="D APPERROR^%ZTER(""VistALink Error_$G(XOBDAT(""ERRORS"_",1,"_"""CODE"""_"),180000)"_") HALT" ;*4
S $ET="D APPERROR^%ZTER(""VistALink Error ""_$G(XOBDAT(""ERRORS"""_",1,"_"""CODE"")"_",180000)) HALT" ;*6
; * * *
; -- set up error info
S XOBDAT("MESSAGE TYPE")=3
S XOBDAT("ERRORS",1,"CODE")=XOBEC
S XOBDAT("ERRORS",1,"ERROR TYPE")="system"
S XOBDAT("ERRORS",1,"FAULT STRING")="System Error"
S XOBDAT("ERRORS",1,"CDATA")=1
S XOBDAT("ERRORS",1,"MESSAGE",1)=XOBMSG
;
; -- if serious error, save error info, logout, and halt
I (XOBMSG["<DSCON>")!(XOBMSG["<READ>")!(XOBMSG["<WRITE>")!(XOBMSG["<SYSTEM>")!(XOBMSG["READERR")!(XOBMSG["WRITERR")!(XOBMSG["SYSERR") D H
. D APPERROR^%ZTER($S(XOBMSG["<DSCON>":$P(XOBMSG,":",2),1:"VistALink Error "_XOBEC)) ;*4
. I $G(DUZ) D CLEAN^XOBSCAV1
.Q
;
; -- send error back to client
U XOBPORT
D ERROR^XOBVLIB(.XOBDAT)
;
; -- just quit if no slots are available or logins are disabled
I (XOBEC=181003)!(XOBEC=181004) Q
;
; -- need to make sure any locks are released since code aborted ungracefully
L
;
; -- Save off the error
D APPERROR^%ZTER($P(XOBMSG,": ",2)) ;*4
;
; -- go back to listening
S $ET="Q:($ESTACK&'$QUIT) Q:$ESTACK -9 S $ECODE="""" DO KILL^XOBVLL G NXTCALLQ^XOBVLL",$EC=",U99,"
Q
;
KILL ; -- new VistALink variables and then do big KILL
N XOBPORT,XOBSTOP,XOBNULL,XOBOS,XOBSYS,XOBHDLR,XOBOK,XOBLASTR,XOBCMREF
D KILL^XUSCLEAN
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXOBVLL 5677 printed Apr 09, 2024@21:46:52 Page 2
XOBVLL ;MJK/ALB - VistALink Listen and Spawn Code ; 07/27/2002 13:00
+1 ;;1.6;VistALink;**4,6**;Apr 5,2017;Build 33
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ; ***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,XOBCMREF
+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 ; * * *
+13 ;S $ET="D APPERROR^%ZTER(""VistALink Error $P(XOBMSG,"": "",2 "") HALT" ;*4
+14 ;*6
SET $ETRAP="D APPERROR^%ZTER(""VistALink Error ""_$P(XOBMSG,"": "",2)) HALT"
+15 ; * * *
+16 ;
+17 ; -- attempt to share the license; must have TCP port open first
+18 USE XOBPORT
IF $TEXT(SHARELIC^%ZOSV)'=""
DO SHARELIC^%ZOSV(1)
+19 ;
+20 ; -- start RUM for VistALink Handler
+21 DO LOGRSRC^%ZOSV("$VISTALINK HANDLER$",2,1)
+22 ;
+23 ; -- cache/initialize startup request handlers
+24 SET X=$$CACHE^XOBVRH(.XOBHDLR)
+25 IF 'X
DO RMERR^XOBVRM(184001,$PIECE(X,U,2))
QUIT
+26 ;
+27 ; -- initialize tcp processing variables
+28 DO INIT^XOBVSKT
+29 ;
+30 ; -- change job name if possible
+31 DO SETNM^%ZOSV("VLink_"_$$CNV^XLFUTL($JOB,16))
+32 ;
+33 ; -- setup for Connection Mgr: get ref; kill data @ ref
+34 SET XOBCMREF=$$GETREF^XOBUZAP1()
+35 DO KILL^XOBUZAP0(XOBCMREF)
+36 ;
+37 ; -- loop until told to stop
+38 FOR
DO NXTCALL
if XOBSTOP
QUIT
+39 ;
+40 ; -- kill ^XTMP ref node
+41 DO KILL^XOBUZAP0(XOBCMREF)
+42 ;
+43 ; -- final/clean tcp processing variables
+44 DO FINAL^XOBVSKT
+45 ;
+46 ; -- stop RUM for VistALink Handler
+47 DO LOGRSRC^%ZOSV("$VISTALINK HANDLER$",2,2)
+48 ;
+49 QUIT
+50 ;
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 ; -- set ^XTMP for Connection Mgr usage if DUZ not 1st piece
+11 IF '$$GETDUZ^XOBUZAP0(XOBCMREF)
Begin DoDot:1
+12 NEW XOBDUZ,XOBIP
+13 SET XOBDUZ=$GET(XOBSYS("DUZ"),$GET(DUZ))
+14 SET XOBIP=$GET(IO("IP"))
+15 DO SETVI^XOBUZAP0(XOBCMREF,XOBDUZ,XOBIP,$$GETDESC^XOBUZAP1())
End DoDot:1
+16 ;
+17 ; -- initialize 'current' request handler to empty string
+18 SET XOBHDLR=""
+19 ;
+20 ; -- # of chars to get on first read / read 11 for Broker initial read
+21 SET XOBREAD=11
+22 ;
+23 ; -- get J2SE heartbeat rate for timeout plus network latency factor
+24 SET XOBTO=$$GETRATE^XOBVLIB()+$$GETDELTA^XOBVLIB()
+25 ;
+26 ; -- get J2EE timeout value for app serv environment
+27 IF $GET(XOBSYS("ENV"))="j2ee"
SET XOBTO=$$GETASTO^XOBVLIB()
+28 ;
+29 ; -- set first read flag
+30 SET XOBFIRST=1
+31 ;
+32 ; -- setup intake global
+33 SET XOBROOT=$NAME(^TMP("XOBVLL",$JOB))
+34 KILL @XOBROOT
+35 ;
+36 ; -- read from socket port
+37 USE XOBPORT
+38 SET XOBOK=$$READ^XOBVSKT(XOBROOT,.XOBREAD,.XOBTO,.XOBFIRST,.XOBSTOP,.XOBDATA,.XOBHDLR)
+39 ;
+40 ; -- timed out ; cleanup user and exit
+41 IF 'XOBOK!(XOBSTOP)
Begin DoDot:1
+42 IF $GET(DUZ)
DO CLEAN^XOBSCAV1
+43 SET XOBSTOP=1
End DoDot:1
GOTO NXTCALLQ
+44 ;
+45 ; -- need null device
+46 ; * * *
+47 ;I '$D(XOBNULL) D ERROR(181002,$$EZBLD^DIALOG(181002),XOBPORT) S XOBSTOP=1 G NXTCALLQ
+48 ;*6
IF '$DATA(XOBNULL)
DO ERROR(181002,$$EZBLD^DIALOG(181002,$$EC^%ZOSV),XOBPORT)
SET XOBSTOP=1
GOTO NXTCALLQ
+49 ; * * *
+50 ;
+51 ; -- call request manager
+52 SET XOBOK=$$EN^XOBVRM(XOBROOT,.XOBDATA,.XOBHDLR)
+53 ; -- timestamp last time request made
+54 SET XOBLASTR=$$NOW^XLFDT()
+55 ; -- cleanup intake global
+56 KILL @XOBROOT
+57 ;
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 ;*4
SET $ETRAP="D APPERROR^%ZTER(""VistALink Error 181001"") HALT"
+3 ; -- Get the error code
DO ERROR(181001,$$EZBLD^DIALOG(181001,$$EC^%ZOSV),XOBPORT)
+4 QUIT
+5 ;
ERROR(XOBEC,XOBMSG,XOBPORT) ; -- send error message
+1 NEW XOBDAT
+2 ;
+3 ; -- If we get an error in the error handler just Halt
+4 ;
+5 ; * * *
+6 ;S $ET="D APPERROR^%ZTER(""VistALink Error_$G(XOBDAT(""ERRORS"_",1,"_"""CODE"""_"),180000)"_") HALT" ;*4
+7 ;*6
SET $ETRAP="D APPERROR^%ZTER(""VistALink Error ""_$G(XOBDAT(""ERRORS"""_",1,"_"""CODE"")"_",180000)) HALT"
+8 ; * * *
+9 ; -- set up error info
+10 SET XOBDAT("MESSAGE TYPE")=3
+11 SET XOBDAT("ERRORS",1,"CODE")=XOBEC
+12 SET XOBDAT("ERRORS",1,"ERROR TYPE")="system"
+13 SET XOBDAT("ERRORS",1,"FAULT STRING")="System Error"
+14 SET XOBDAT("ERRORS",1,"CDATA")=1
+15 SET XOBDAT("ERRORS",1,"MESSAGE",1)=XOBMSG
+16 ;
+17 ; -- if serious error, save error info, logout, and halt
+18 IF (XOBMSG["<DSCON>")!(XOBMSG["<READ>")!(XOBMSG["<WRITE>")!(XOBMSG["<SYSTEM>")!(XOBMSG["READERR")!(XOBMSG["WRITERR")!(XOBMSG["SYSERR")
Begin DoDot:1
+19 ;*4
DO APPERROR^%ZTER($SELECT(XOBMSG["<DSCON>":$PIECE(XOBMSG,":",2),1:"VistALink Error "_XOBEC))
+20 IF $GET(DUZ)
DO CLEAN^XOBSCAV1
+21 QUIT
End DoDot:1
HANG
+22 ;
+23 ; -- send error back to client
+24 USE XOBPORT
+25 DO ERROR^XOBVLIB(.XOBDAT)
+26 ;
+27 ; -- just quit if no slots are available or logins are disabled
+28 IF (XOBEC=181003)!(XOBEC=181004)
QUIT
+29 ;
+30 ; -- need to make sure any locks are released since code aborted ungracefully
+31 LOCK
+32 ;
+33 ; -- Save off the error
+34 ;*4
DO APPERROR^%ZTER($PIECE(XOBMSG,": ",2))
+35 ;
+36 ; -- go back to listening
+37 SET $ETRAP="Q:($ESTACK&'$QUIT) Q:$ESTACK -9 S $ECODE="""" DO KILL^XOBVLL G NXTCALLQ^XOBVLL"
SET $ECODE=",U99,"
+38 QUIT
+39 ;
KILL ; -- new VistALink variables and then do big KILL
+1 NEW XOBPORT,XOBSTOP,XOBNULL,XOBOS,XOBSYS,XOBHDLR,XOBOK,XOBLASTR,XOBCMREF
+2 DO KILL^XUSCLEAN
+3 QUIT
+4 ;
