source: WorldVistAEHR/trunk/r/RPC_BROKER-XWB/XWBVLL.m@ 1076

Last change on this file since 1076 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1XWBVLL ;OIFO-Oakland/REM - M2M Broker Listener ;06/08/2005 10:48
2 ;;1.1;RPC BROKER;**28,41,34**;Mar 28, 1997
3 ;
4 QUIT
5 ;
6 ;p41 - fixed infinite loop bug in SYSERR.
7 ; - new Cache/VMS tcpip entry point, called from XWBSERVER_START.COM file.
8 ;p34 - added "BrokerM2M" in message type - SYSERR.
9 ; - removed the quotes (") after 'M:' - SYSERRS.
10 ; - new entry point to job off the listener for Cashe- STRT^XWBVLL(PORT).
11 ; - clear locks when error occurs - SYSERR.
12 ; - halt for read/write errors - SYSERR
13 ;
14START(SOCKET) ;Entry point for Cache/NT
15 ;May be called directly to start the listener.
16 ;SOCKET -is the port# to start the listener on.
17 I ^%ZOSF("OS")'["OpenM" Q ;Quits if not a Cache OS.
18 D LISTEN^%ZISTCPS(SOCKET,"SPAWN^XWBVLL")
19 Q
20 ;
21UCX ;DMS/VMS UCX entry point, called from XWBSERVER_START.COM file,
22 ;listener, % = <input variable>
23 ;IF $G(%)="" DO ^%ZTER QUIT
24 SET (IO,IO(0))="SYS$NET"
25 ; **VMS specific code, need to share device**
26 OPEN IO:(TCPDEV):60 ELSE SET ^TMP("XWB DSM CONNECT FAILURE",$H)="" QUIT
27 USE IO
28 DO SPAWN
29 QUIT
30 ;
31STRT(PORT) ;*p34-This entry is called from option "XWB M2M CACHE LISTENER" and jobs off the listener for Cashe/NT. Will call START.
32 ;PORT -is the port# to start the listener on.
33 J START^XWBVLL(PORT)::5 ;Used in place of TaskMan
34 Q
35 ;
36CACHEVMS ;Cache/VMS tcpip entry point, called from XWBSERVER_START.COM fLle *p41*
37 SET (IO,IO(0))="SYS$NET"
38 ; **CACHE/VMS specific code**
39 OPEN IO::60 ELSE SET ^TMP("XWB DSM CONNECT FAILURE",$H)="" QUIT
40 X "U IO:(::""-M"")" ;Packet mode like DSM
41 DO SPAWN
42 QUIT
43 ;
44SPAWN ; -- spawned process
45 NEW XWBSTOP
46 SET XWBSTOP=0
47 ;
48 ; -- initialize tcp processing variables
49 DO INIT^XWBRL
50 ;
51 ; -- set error trap
52 NEW $ESTACK,$ETRAP S $ETRAP="D ^%ZTER HALT"
53 ;
54 ; -- change job name if possible
55 ;DO SETNM^%ZOSV("XWBSERVER: Server") ;**M2M - comment out for now
56 DO SAVDEV^%ZISUTL("XWBM2M SERVER") ;**M2M save off server IO
57 S XWBDEBUG=$$GET^XPAR("SYS","XWBDEBUG",,"Q")
58 I XWBDEBUG D LOG^XWBRPC("Server Start @ "_$$NOW^XLFDT)
59 ; -- loop until told to stop
60 FOR DO NXTCALL QUIT:XWBSTOP
61 ;
62 ; -- final/clean tcp processing variables
63 D RMDEV^%ZISUTL("XWBM2M SERVER") ;**M2M remove server IO
64 Q
65 ;
66NXTCALL ; -- do next call
67 NEW U,DTIME,DT,X,XWBROOT,XWBREAD,XWBTO,XWBFIRST,XWBOK,XWBRL,BUG
68 ;
69 ; -- set error trap
70 NEW $ESTACK,$ETRAP S $ETRAP="D SYSERR^XWBVLL"
71 ;
72 ; -- setup environment variables
73 SET U="^",DTIME=900,DT=$$DT^XLFDT()
74 SET XWBREAD=20,XWBTO=36000,XWBFIRST=1
75 ;
76 ; -- setup intake global - root is request data
77 SET XWBROOT=$NA(^TMP("XWBVLL",$J))
78 KILL @XWBROOT
79 ;
80 ; -- set parameters for RawLink
81 SET XWBRL("TIME OUT")=36000
82 SET XWBRL("READ CHARACTERS")=20
83 SET XWBRL("FIRST READ")=1
84 SET XWBRL("STORE")=XWBROOT
85 SET XWBRL("STOP FLAG")=XWBSTOP
86 ;
87 ; -- read from socket
88 SET XWBOK=$$READ^XWBRL(XWBROOT,.XWBREAD,.XWBTO,.XWBFIRST,.XWBSTOP)
89 ;
90 ;**TESTING **REM
91 ;For debugging - hard set ^TMP(..."DEBUG") and ^TMP(..."CNT") to 1
92 I $G(^TMP("XWBM2M","DEBUG")) D
93 . S XWBCNT=(^TMP("XWBM2M","CNT"))+1
94 . M ^TMP("XWBM2MSV","REQUEST",XWBCNT)=^TMP("XWBVLL",$J)
95 . S ^TMP("XWBM2M","CNT")=XWBCNT
96 . Q
97 ;
98 ;**TESING **RWF
99 I $G(XWBDEBUG) D
100 . N CNT
101 . S CNT=$G(^TMP("XWBM2ML",$J))+1,^($J)=CNT
102 . M ^TMP("XWBM2ML",$J,CNT)=^TMP("XWBVLL",$J)
103 . Q
104 ;
105 IF 'XWBOK GOTO NXTCALLQ
106 ;
107 ; -- call request manager
108 SET XWBOK=$$EN^XWBRM(XWBROOT)
109 ;
110NXTCALLQ ; -- exit
111 ;
112 QUIT
113 ;
114 ; ---------------------------------------------------------------------
115 ; System Error Handler
116 ; ---------------------------------------------------------------------
117SYSERR ; -- send system error message
118 ;p41-don't new $Etrap, it was causing infinite loop.
119 ;p34-added "BrokerM2M" in message type in SYSERR.
120 ; -halt for read/write errors
121 NEW XWBDAT,XWBMSG ;,$ETRAP ;*p41
122 S $ETRAP="D ^%ZTER HALT" ;If we get an error in the error handler just Halt
123 SET XWBMSG=$$EC^%ZOSV ;Get the error code
124 D ^%ZTER ;Save off the error
125 SET XWBDAT("MESSAGE TYPE")="Gov.VA.Med.BrokerM2M.Errors" ;*34
126 SET XWBDAT("ERRORS",1,"CODE")=1
127 SET XWBDAT("ERRORS",1,"ERROR TYPE")="system"
128 SET XWBDAT("ERRORS",1,"CDATA")=1
129 SET XWBDAT("ERRORS",1,"MESSAGE",1)=$P($TEXT(SYSERRS+1),";;",2)_XWBMSG
130 ;*p34-will halt for read/write errors
131 I XWBMSG["<READ>" HALT
132 DO ERROR^XWBUTL(.XWBDAT)
133 D UNWIND^%ZTER ;Return to NXTCALL loop
134 L ;Clear locks *p34
135 Q
136 ;
137SYSERRS ; -- application errors
138 ;*p34-removed the quotes (") after 'M:'
139 ;;A system error occurred in M:
Note: See TracBrowser for help on using the repository browser.