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