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

XWBVLL.m

Go to the documentation of this file.
  1. XWBVLL ;OIFO-Oakland/REM - M2M Broker Listener ;12/29/2010
  1. ;;1.1;RPC BROKER;**28,41,34,62,63**;Mar 28, 1997;Build 4
  1. ;Per VHA Directive 6402, this routine should not be modified
  1. ;
  1. QUIT
  1. ;
  1. ;p41 - fixed infinite loop bug in SYSERR.
  1. ; - new Cache/VMS tcpip entry point, called from XWBSERVER_START.COM file.
  1. ;p34 - added "BrokerM2M" in message type - SYSERR.
  1. ; - removed the quotes (") after 'M:' - SYSERRS.
  1. ; - new entry point to job off the listener for Cashe- STRT^XWBVLL(PORT).
  1. ; - clear locks when error occurs - SYSERR.
  1. ; - halt for read/write errors - SYSERR
  1. ;
  1. START(SOCKET) ;Entry point for Cache/NT
  1. ;May be called directly to start the listener.
  1. ;SOCKET -is the port# to start the listener on.
  1. I ^%ZOSF("OS")'["OpenM" Q ;Quits if not a Cache OS.
  1. D LISTEN^%ZISTCPS(SOCKET,"SPAWN^XWBVLL")
  1. Q
  1. ;
  1. UCX ;Old entry point NOT used anymore. *p55*
  1. ;DMS/VMS UCX entry point, called from XWBSERVER_START.COM file,
  1. ;listener, % = <input variable>
  1. ;IF $G(%)="" DO ^%ZTER QUIT
  1. SET (IO,IO(0))="SYS$NET"
  1. ; **VMS specific code, need to share device**
  1. OPEN IO:(TCPDEV):60 ELSE SET ^TMP("XWB DSM CONNECT FAILURE",$H)="" QUIT
  1. USE IO
  1. DO SPAWN
  1. QUIT
  1. ;
  1. STRT(PORT) ;*p34-This entry is called from option "XWB M2M CACHE LISTENER" and jobs off the listener for Cashe/NT. Will call START.
  1. ;PORT -is the port# to start the listener on.
  1. J START^XWBVLL(PORT)::5 ;Used in place of TaskMan
  1. Q
  1. ;
  1. CACHEVMS ;Cache/VMS tcpip entry point, called from XWBSERVER_START.COM fLle *p41*
  1. ;Update the SET (IO)="SYS$NET" *p55*
  1. SET (IO,IO(0))=$S($ZV["VMS":"SYS$NET",1:$P) ;Support for both VMS/TCPIP and Linux/xinetd *p55*
  1. ; **CACHE/VMS specific code**
  1. OPEN IO::60 ELSE SET ^TMP("XWB DSM CONNECT FAILURE",$H)="" QUIT
  1. X "U IO:(::""-M"")" ;Packet mode like DSM
  1. DO SPAWN
  1. QUIT
  1. ;
  1. SPAWN ; -- spawned process
  1. NEW U,DTIME,XWBROOT,XWBAVC,XWBSTOP
  1. SET U="^",DUZ=0,DUZ(0)="",DTIME=900,XWBROOT=$NA(^TMP("XWBVLL",$J)),XWBSTOP=0
  1. ;
  1. ; -- initialize tcp processing variables
  1. DO INIT^XWBRL
  1. ;
  1. ; -- set error trap
  1. NEW $ESTACK,$ETRAP S $ETRAP="D SYSERR^XWBVLL"
  1. ;Get IP from client
  1. S IO("IP")=$$GETPEER^%ZOSV()
  1. ; -- change job name if possible
  1. ;DO SETNM^%ZOSV("XWBSERVER: Server") ;**M2M - comment out for now
  1. DO SAVDEV^%ZISUTL("XWBM2M SERVER") ;**M2M save off server IO
  1. S XWBDEBUG=$$GET^XPAR("SYS","XWBDEBUG",,"Q")
  1. I XWBDEBUG D LOG^XWBRPC("Server Start @ "_$$NOW^XLFDT)
  1. ;check that XUS AV CODE is the 1st or 2nd RPC call P62
  1. I '$$GET^XPAR("SYS","XWB62",1,"Q") F XWBAVC=1:1:2 D NXTCALL Q:DUZ
  1. S XWBAVC=0
  1. ; process rest of messages; loop until told to stop
  1. D
  1. .I '$$GET^XPAR("SYS","XWB62",1,"Q") Q:'DUZ
  1. .F DO NXTCALL QUIT:XWBSTOP
  1. ;
  1. ; -- final/clean tcp processing variables
  1. D RMDEV^%ZISUTL("XWBM2M SERVER") ;**M2M remove server IO
  1. Q
  1. ;
  1. NXTCALL ; -- do next call
  1. NEW DT,X,XWBREAD,XWBTO,XWBFIRST,XWBOK,XWBRL,BUG
  1. ;
  1. ; -- setup environment variables
  1. SET DT=$$DT^XLFDT(),XWBREAD=20,XWBTO=36000,XWBFIRST=1 ;p63
  1. ;
  1. ; -- clean intake global - root is request data
  1. KILL @XWBROOT
  1. ;
  1. ; -- set parameters for RawLink
  1. SET XWBRL("TIME OUT")=36000
  1. SET XWBRL("READ CHARACTERS")=20
  1. SET XWBRL("FIRST READ")=1
  1. SET XWBRL("STORE")=XWBROOT
  1. SET XWBRL("STOP FLAG")=XWBSTOP
  1. ;
  1. ; -- read from socket
  1. SET XWBOK=$$READ^XWBRL(XWBROOT,.XWBREAD,.XWBTO,.XWBFIRST,.XWBSTOP)
  1. ;
  1. ;**TESTING **REM
  1. ;For debugging - hard set ^TMP(..."DEBUG") and ^TMP(..."CNT") to 1
  1. I $G(^TMP("XWBM2M","DEBUG")) D
  1. . S XWBCNT=(^TMP("XWBM2M","CNT"))+1
  1. . M ^TMP("XWBM2MSV","REQUEST",XWBCNT)=^TMP("XWBVLL",$J)
  1. . S ^TMP("XWBM2M","CNT")=XWBCNT
  1. . Q
  1. ;
  1. ;**TESING **RWF
  1. I $G(XWBDEBUG) D
  1. . N CNT
  1. . S CNT=$G(^TMP("XWBM2ML",$J))+1,^($J)=CNT
  1. . M ^TMP("XWBM2ML",$J,CNT)=^TMP("XWBVLL",$J)
  1. . Q
  1. ;
  1. IF 'XWBOK GOTO NXTCALLQ
  1. ;
  1. ; -- call request manager
  1. SET XWBOK=$$EN^XWBRM(XWBROOT)
  1. ;
  1. NXTCALLQ ; -- exit
  1. ;
  1. QUIT
  1. ;
  1. ; ---------------------------------------------------------------------
  1. ; System Error Handler
  1. ; ---------------------------------------------------------------------
  1. SYSERR ; -- send system error message
  1. ;p41-don't new $Etrap, it was causing infinite loop.
  1. ;p34-added "BrokerM2M" in message type in SYSERR.
  1. ; -halt for read/write errors
  1. NEW XWBDAT,XWBMSG ;,$ETRAP ;*p41
  1. S $ETRAP="D ^%ZTER HALT" ;If we get an error in the error handler just Halt
  1. SET XWBMSG=$$EC^%ZOSV ;Get the error code
  1. D ^%ZTER ;Save off the error
  1. SET XWBDAT("MESSAGE TYPE")="Gov.VA.Med.BrokerM2M.Errors" ;*34
  1. SET XWBDAT("ERRORS",1,"CODE")=1
  1. SET XWBDAT("ERRORS",1,"ERROR TYPE")="system"
  1. SET XWBDAT("ERRORS",1,"CDATA")=1
  1. SET XWBDAT("ERRORS",1,"MESSAGE",1)=$P($TEXT(SYSERRS+1),";;",2)_XWBMSG
  1. ;*p34-will halt for read/write errors
  1. I XWBMSG["<READ>" HALT
  1. DO ERROR^XWBUTL(.XWBDAT)
  1. D UNWIND^%ZTER ;Return to NXTCALL loop
  1. L ;Clear locks *p34
  1. Q
  1. ;
  1. SYSERRS ; -- application errors
  1. ;*p34-removed the quotes (") after 'M:'
  1. ;;A system error occurred in M: