Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XOBVLL

XOBVLL.m

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