1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
XOBVLL ;; mjk/alb MSC/JDA - VistALink Listen and Spawn Code ;13APR2009
;;1.5;VistALink;**MSC**;Sep 09, 2005
;;Foundations Toolbox Release v1.5 [Build: 1.5.0.026]
;
QUIT
;
; ***deprecated*** tag ; Use START^XOBVTCP instead
START(SOCKET) ; -- start listener
DO START^XOBVTCP(SOCKET)
QUIT
;
; ***deprecated*** tag ; Use UCX^XOBVTCP instead
UCX ; -- VMS TCPIP (UCX) multi-thread entry point
; -- Called from VistALink .com files
GOTO UCX^XOBVTCP
;
SPAWN ; -- spawned process
NEW X,XOBSTOP,XOBPORT,XOBHDLR,XOBLASTR
;
SET XOBSTOP=0
SET XOBPORT=IO
SET U="^"
;
; -- initialize timestamp for last time request made (used for debugging)
SET XOBLASTR=0
;
; -- set error trap
;Set up the error trap
SET $ETRAP="DO ^%ZTER HALT"
;
; -- attempt to share the license; must have TCP port open first
USE XOBPORT IF $TEXT(SHARELIC^%ZOSV)'="" DO SHARELIC^%ZOSV(1)
;
; -- start RUM for VistALink Handler
DO LOGRSRC^%ZOSV("$VISTALINK HANDLER$",2,1)
;
SET:^%ZOSF("OS")["GT.M" X=$$GTM^XOBVRH(.XOBHDLR)
; -- cache/initialize startup request handlers
SET:^%ZOSF("OS")["OpenM" X=$$CACHE^XOBVRH(.XOBHDLR)
IF 'X DO RMERR^XOBVRM(184001,$PIECE(X,U,2)) QUIT
;
; -- initialize tcp processing variables
DO INIT^XOBVSKT
;
; -- change job name if possible
DO SETNM^%ZOSV("VLink_"_$$CNV^XLFUTL($J,16))
;
; -- loop until told to stop
FOR DO NXTCALL QUIT:XOBSTOP
;
; -- final/clean tcp processing variables
DO FINAL^XOBVSKT
;
; -- stop RUM for VistALink Handler
DO LOGRSRC^%ZOSV("$VISTALINK HANDLER$",2,2)
;
QUIT
;
NXTCALL ; -- do next call
NEW X,XOBROOT,XOBREAD,XOBTO,XOBFIRST,XOBOK,XOBRL,XOBDATA
;
; -- set up error trap
NEW $ESTACK SET $ETRAP="DO SYSERR^XOBVLL"
;
; -- setup environment variables
NEW DIQUIET SET DIQUIET=1
SET U="^",DTIME=$GET(DTIME,900),DT=$$DT^XLFDT()
;
; -- initialize 'current' request handler to empty string
SET XOBHDLR=""
;
; -- # of chars to get on first read / read 11 for Broker initial read
SET XOBREAD=11
;
; -- get J2SE heartbet rate for timeout plus network latency factor
SET XOBTO=$$GETRATE^XOBVLIB()+$$GETDELTA^XOBVLIB()
;
; -- get J2EE timeout value for app serv environment
IF $GET(XOBSYS("ENV"))="j2ee" SET XOBTO=$$GETASTO^XOBVLIB()
;
; -- set first read flag
SET XOBFIRST=1
;
; -- setup intake global
SET XOBROOT=$NAME(^TMP("XOBVLL",$JOB))
KILL @XOBROOT
;
; -- read from socket port
USE XOBPORT
SET XOBOK=$$READ^XOBVSKT(XOBROOT,.XOBREAD,.XOBTO,.XOBFIRST,.XOBSTOP,.XOBDATA,.XOBHDLR)
;
; -- timed out ; cleanup user and exit
IF 'XOBOK!(XOBSTOP) DO GOTO NXTCALLQ
. IF $GET(DUZ) DO CLEAN^XOBSCAV1
. SET XOBSTOP=1
;
; -- need null device
IF '$DATA(XOBNULL) DO ERROR(181002,$$EZBLD^DIALOG(181002),XOBPORT) SET XOBSTOP=1 GOTO NXTCALLQ
;
; -- call request manager
SET XOBOK=$$EN^XOBVRM(XOBROOT,.XOBDATA,.XOBHDLR)
; -- timestamp last time request made
SET XOBLASTR=$$NOW^XLFDT()
; -- cleanup intake global
KILL @XOBROOT
;
NXTCALLQ ; -- exit
QUIT
;
; ----------------------------------------------------------------------------------
; System Error Handler
; ----------------------------------------------------------------------------------
SYSERR ; -- send system error message
; -- If we get an error in the error handler just Halt
SET $ETRAP="D ^%ZTER HALT"
;
DO ERROR(181001,$$EZBLD^DIALOG(181001,$$EC^%ZOSV),XOBPORT) ; -- Get the error code
QUIT
;
ERROR(XOBEC,XOBMSG,XOBPORT) ; -- send error message
NEW XOBDAT
;
; -- If we get an error in the error handler just Halt
SET $ETRAP="D ^%ZTER HALT"
;
; -- set up error info
SET XOBDAT("MESSAGE TYPE")=3
SET XOBDAT("ERRORS",1,"CODE")=XOBEC
SET XOBDAT("ERRORS",1,"ERROR TYPE")="system"
SET XOBDAT("ERRORS",1,"FAULT STRING")="System Error"
SET XOBDAT("ERRORS",1,"CDATA")=1
SET XOBDAT("ERRORS",1,"MESSAGE",1)=XOBMSG
;
; -- if serious error, save error info, logout, and halt
IF XOBMSG["<READ>"!(XOBMSG["<WRITE>")!(XOBMSG["<SYSTEM>")!(XOBMSG["READERR")!(XOBMSG["WRITERR")!(XOBMSG["SYSERR") DO HALT
. DO ^%ZTER
. IF $GET(DUZ) DO CLEAN^XOBSCAV1
;
; -- send error back to client
USE XOBPORT
DO ERROR^XOBVLIB(.XOBDAT)
;
; -- just quit if no slots are available or logins are disabled
IF (XOBEC=181003)!(XOBEC=181004) QUIT
;
; -- need to make sure any locks are released since code aborted ungracefully
LOCK
;
; -- Save off the error
DO ^%ZTER
;
; -- go back to listening
SET $ETRAP="Q:($ESTACK&'$QUIT) Q:$ESTACK -9 S $ECODE="""" DO KILL^XOBVLL G NXTCALLQ^XOBVLL",$ECODE=",U99,"
QUIT
;
KILL ; -- new VistALink variables and then do big KILL
NEW XOBPORT,XOBSTOP,XOBNULL,XOBOS,XOBSYS,XOBHDLR,XOBOK
DO KILL^XUSCLEAN
QUIT
;
|