source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSTCP.m@ 1800

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

revised back to 6/30/08 version
File size: 6.5 KB
Line 
1HLCSTCP ;SFIRMFO/TNV-ALB/JFP,PKE - (TCP/IP) MLLP ;09/13/2006
2 ;;1.6;HEALTH LEVEL SEVEN;**19,43,49,57,58,64,84,109,133**;Oct 13, 1995;Build 13
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ; This is an implementation of the HL7 Minimal Lower Layer Protocol
6 ;
7 ;taskman entry/startup option, HLDP defined in menu entry,
8 Q:'$D(HLDP)
9 N HLCSOUT,HLDBACK,HLDBSIZE,HLDREAD,HLDRETR,HLRETRA,HLDWAIT,HLOS,HLTCPADD,HLTCPCS,HLTCPLNK,HLTCPORT,HLTCPRET,HLCSFAIL
10 ;HLCSOUT= 1-error
11 I '$$INIT D EXITS("Init Error") Q
12 ; Start the client
13 I $G(HLTCPCS)="C" D Q
14 . ; identify process for ^%SY
15 . D SETNM^%ZOSV($E("HLClnt:"_HLDP,1,15))
16 . D ST1
17 . F D ^HLCSTCP2 Q:$$STOP!$G(HLCSOUT)
18 . I $G(HLCSOUT)=1 D MON("Error") H 1 Q
19 . I $G(HLCSOUT)=2 D EXITS("Inactive") Q
20 . D EXITS("Shutdown")
21 ;
22 ; identify process for ^%SY
23 D SETNM^%ZOSV($E("HLSrv:"_HLDP,1,15))
24 ;HLCSFAIL=1 port failed to open
25 S HLCSFAIL=1
26 ;single threaded listener
27 I $G(HLTCPCS)="S" D Q
28 . D ST1,MON("Listen"),LISTEN^%ZISTCP(HLTCPORT,"SERVER^HLCSTCP("""_HLDP_""")")
29 . ;couldn't open listener port
30 . I HLCSFAIL D EXITS("Openfail") Q
31 ;
32 ;multi-threaded listener (OpenM)
33 I $G(HLTCPCS)="M",^%ZOSF("OS")["OpenM" D Q
34 . D ST1,MON("Listen"),LISTEN^%ZISTCPS(HLTCPORT,"SERVERS^HLCSTCP("""_HLDP_""")")
35 Q
36 ;
37SERVER(HLDP) ; single server using Taskman
38 S HLCSFAIL=0
39 I '$$INIT D EXITS("Init error") Q
40 D ^HLCSTCP1
41 I $$STOP D CLOSE^%ZISTCP,EXITS("Shutdown") S IO("C")="" Q
42 Q:$G(HLCSOUT)=1
43 D MON("Idle")
44 Q
45 ;
46SERVERS(HLDP) ; Multi-threaded server using Taskman
47 I '$$INIT D EXITS("Init error") Q
48 G LISTEN
49 ;
50 ;multiple process servers, called from an external utility
51MSM ;MSM entry point, called from User-Defined Services
52 ;HLDP=ien in the HL LOWER LEVEL PROTOCOL PARAMETER file for the
53 ;HL7 Multi-Threaded SERVER
54 S (IO,IO(0))=$P
55 G LISTEN
56 ;
57CACHEVMS(%) ;Cache'/VMS tcpip/ucx entry point, called from HLSEVEN.COM file,
58 ;listener, % = HLDP
59 I $G(%)="" D ^%ZTER Q
60 S IO="SYS$NET",HLDP=%
61 S IO(0)="_NLA0:" O IO(0) ;Setup null device
62 ; **Cache'/VMS specific code**
63 O IO::5 E D MON("Openfail") Q
64 X "U IO:(::""-M"")" ;Packet mode like DSM
65 D LISTEN C IO Q
66 ;
67EN ;vms ucx entry point, called from HLSEVEN.COM file,
68 ;listener, % = device^HLDP
69 I $G(%)="" D ^%ZTER Q
70 S IO="SYS$NET",U="^",HLDP=$P(%,U,2)
71 S IO(0)="_NLA0:" O IO(0) ;Setup null device
72 ; **VMS specific code, need to share device**
73 O IO:(TCPDEV):60 E D MON("Openfail") Q
74LISTEN ;
75 N HLLSTN,HLCSOUT,HLDBACK,HLDBSIZE,HLDREAD,HLDRETR,HLRETRA,HLDWAIT,HLOS,HLTCPADD,HLTCPCS,HLTCPLNK,HLTCPORT,HLTCPRET,HLCSFAIL
76 I '$$INIT D ^%ZTER Q
77 ; identify process for ^%SY
78 D SETNM^%ZOSV($E("HLSrv:"_HLDP,1,15))
79 ;HLLSTN used to identify a listener to tag MON
80 S HLLSTN=1
81 ;increment job count, run server
82 D UPDT(1),^HLCSTCP1,EXITM
83 Q
84 ;
85DCOPEN(HLDP) ;open direct connect - called from HLMA2
86 Q:'$$INIT 0
87 Q:HLTCPADD=""!(HLTCPORT="") 0
88 Q:'$$OPEN^HLCSTCP2 0
89 Q 1
90 ;
91INIT() ; Initialize Variables
92 ; HLDP should be set to the IEN or name of Logical Link, file 870
93 S HLOS=$P($G(^%ZOSF("OS")),"^")
94 N DA,DIQUIET,DR,TMP,X,Y
95 S DIQUIET=1
96 D DT^DICRW
97 I 'HLDP S HLDP=$O(^HLCS(870,"B",HLDP,0)) I 'HLDP Q 0
98 S DA=HLDP
99 S DR="200.02;200.021;200.022;200.03;200.04;200.05;200.09;400.01;400.02;400.03;400.04;400.05"
100 D GETS^DIQ(870,DA,DR,"IN","TMP","TMP")
101 ;
102 I $D(TMP("DIERR")) QUIT 0
103 ; -- re-transmit attempts
104 S HLDRETR=+$G(TMP(870,DA_",",200.02,"I"))
105 S HLDRETR("CLOSE")=+$G(TMP(870,DA_",",200.022,"I"))
106 ; -- exceed re-transmit action
107 S HLRETRA=$G(TMP(870,DA_",",200.021,"I"))
108 ; -- block size
109 S HLDBSIZE=+$G(TMP(870,DA_",",200.03,"I"))
110 ; -- read timeout
111 S HLDREAD=+$G(TMP(870,DA_",",200.04,"I"))
112 ; -- ack timeout
113 S HLDBACK=+$G(TMP(870,DA_",",200.05,"I"))
114 ; -- uni-directional wait
115 S HLDWAIT=$G(TMP(870,DA_",",200.09,"I"))
116 ; -- tcp address
117 S HLTCPADD=$G(TMP(870,DA_",",400.01,"I"))
118 ; -- tcp port
119 S HLTCPORT=$G(TMP(870,DA_",",400.02,"I"))
120 ; -- tcp/ip service type
121 S HLTCPCS=$G(TMP(870,DA_",",400.03,"I"))
122 ; -- link persistence
123 S HLTCPLNK=$G(TMP(870,DA_",",400.04,"I"))
124 ; -- retention
125 S HLTCPRET=$G(TMP(870,DA_",",400.05,"I"))
126 ;
127 ; -- set defaults in case something's not set
128 S:HLDREAD=0 HLDREAD=10
129 S:HLDBACK=0 HLDBACK=60
130 S:HLDBSIZE=0 HLDBSIZE=245
131 S:HLDRETR=0 HLDRETR=5
132 S:HLTCPRET="" X=$P($$PARAM^HLCS2,U,12),HLTCPRET=$S(X:X,1:15)
133 ;
134 Q 1
135 ;
136ST1 ;record startup in 870 for single server
137 ;4=status 9=Time Started, 10=Time Stopped, 11=Task Number
138 ;14=Shutdown LLP, 3=LLP Online, 18=Gross Errors
139 N HLJ,X
140 F L +^HLCS(870,HLDP,0):2 Q:$T
141 S X="HLJ(870,"""_HLDP_","")"
142 S @X@(4)="Init",(@X@(10),@X@(18))="@",@X@(14)=0
143 I HLTCPCS["C" S @X@(3)=$S(HLTCPLNK["Y":"PC",1:"NC")
144 E S @X@(3)=$S(HLTCPCS["S":"SS",HLTCPCS["M":"MS",1:"")
145 I @X@(3)'="NC" S @X@(9)=$$NOW^XLFDT
146 S:$G(ZTSK) @X@(11)=ZTSK
147 D FILE^HLDIE("","HLJ","","ST1","HLCSTCP") ;HL*1.6*109
148 L -^HLCS(870,HLDP,0)
149 Q
150 ;
151MON(Y) ;Display current state & check for shutdown
152 ;don't display for multiple server
153 Q:$G(HLLSTN)
154 F L +^HLCS(870,HLDP,0):2 Q:$T
155 S $P(^HLCS(870,HLDP,0),U,5)=Y
156 L -^HLCS(870,HLDP,0)
157 Q:'$D(HLTRACE)
158 N X U IO(0)
159 W !,"IN State: ",Y
160 I '$$STOP D
161 . R !,"Type Q to Quit: ",X#1:1
162 . I $L(X),"Qq"[X S $P(^HLCS(870,HLDP,0),U,15)=1
163 U IO
164 Q
165UPDT(Y) ;update job count for multiple servers,X=1 increment
166 N HLJ,X
167 F L +^HLCS(870,HLDP,0):2 Q:$T
168 S X=+$P(^HLCS(870,HLDP,0),U,5),$P(^(0),U,5)=$S(Y:X+1,1:X-1)_" server"
169 ;if incrementing, set the Device Type field to Multi-Server
170 I X S HLJ(870,HLDP_",",3)="MS" D FILE^HLDIE("","HLJ","","UPDT","HLCSTCP") ;HL*1.6*109
171 L -^HLCS(870,HLDP,0)
172 Q
173STOP() ;stop flag set
174 N X
175 F L +^HLCS(870,HLDP,0):2 Q:$T
176 S X=+$P(^HLCS(870,HLDP,0),U,15)
177 L -^HLCS(870,HLDP,0)
178 Q X
179 ;
180LLCNT(DP,Y,Z) ;update Logical Link counters
181 ;DP=ien of Logical Link in file 870
182 ;Y: 1=msg rec, 2=msg proc, 3=msg to send, 4=msg sent
183 ;Z: ""=add to counter, 1=subtract from counter
184 Q:'$D(^HLCS(870,+$G(DP),0))!('$G(Y))
185 N P,X
186 S P=$S(Y<3:"IN",1:"OUT")_" QUEUE "_$S(Y#2:"BACK",1:"FRONT")_" POINTER"
187 F L +^HLCS(870,DP,P):2 Q:$T
188 S X=+$G(^HLCS(870,DP,P)),^(P)=X+$S($G(Z):-1,1:1)
189 L -^HLCS(870,DP,P)
190 Q
191SDFLD ; set Shutdown? field to yes
192 Q:'$G(HLDP)
193 N HLJ,X
194 F L +^HLCS(870,HLDP,0):2 Q:$T
195 ;14=Shutdown LLP?
196 S HLJ(870,HLDP_",",14)=1
197 D FILE^HLDIE("","HLJ","","SDFLD","HLCSTCP") ;HL*1.6*109
198 L -^HLCS(870,HLDP,0)
199 Q
200 ;
201EXITS(Y) ; Single service shutdown and cleans up
202 N HLJ,X
203 F L +^HLCS(870,HLDP,0):2 Q:$T
204 ;4=status,10=Time Stopped,9=Time Started,11=Task Number
205 S X="HLJ(870,"""_HLDP_","")"
206 S @X@(4)=Y,@X@(11)="@"
207 S:$G(HLCSOUT)'=2 @X@(10)=$$NOW^XLFDT,@X@(9)="@"
208 D FILE^HLDIE("","HLJ","","EXITS","HLCSTCP") ; HL*1.6*109
209 L -^HLCS(870,HLDP,0)
210 I $D(ZTQUEUED) S ZTREQ="@"
211 Q
212 ;
213EXITM ;Multiple service shutdown and clean up
214 D UPDT(0)
215 I $D(ZTQUEUED) S ZTREQ="@"
216 Q
Note: See TracBrowser for help on using the repository browser.