[613] | 1 | HLCSTCP ;SFIRMFO/TNV-ALB/JFP,PKE - (TCP/IP) MLLP ;04/15/2008 10:58
|
---|
| 2 | ;;1.6;HEALTH LEVEL SEVEN;**19,43,49,57,58,64,84,109,133,122,140**;Oct 13, 1995;Build 5
|
---|
| 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 | ; taskman entry/startup option, HLDP defined in menu entry.
|
---|
| 7 | ;
|
---|
| 8 | Q:'$D(HLDP)
|
---|
| 9 | ; patch HL*1.6*122 start
|
---|
| 10 | L +^HLCS("HLTCPLINK",HLDP):5 I '$T D Q
|
---|
| 11 | . D MON^HLCSTCP("TskLcked")
|
---|
| 12 | N HLCSOUT,HLDBACK,HLDBSIZE,HLDREAD,HLDRETR,HLRETRA,HLDWAIT,HLOS,HLTCPADD,HLTCPCS,HLTCPLNK,HLTCPORT,HLTCPRET
|
---|
| 13 | N HLZRULE
|
---|
| 14 | ;HLCSOUT= 1-error
|
---|
| 15 | I '$$INIT D EXITS("Init Error") Q
|
---|
| 16 | S HLDP("$J")=$J
|
---|
| 17 | S HLDP("$J",0,"LENGTH")=$L(HLDP("$J"))
|
---|
| 18 | ; Start the client
|
---|
| 19 | I $G(HLTCPCS)="C" D Q
|
---|
| 20 | . S HLDP("$J",0,"START")=HLDP("$J",0,"LENGTH")-8+$L(HLTCPORT)+$L(HLDP)
|
---|
| 21 | . I HLDP("$J",0,"START")<1 S HLDP("$J",0,"START")=1
|
---|
| 22 | . S HLDP("$J",0)=$E(HLDP("$J"),HLDP("$J",0,"START"),HLDP("$J",0,"LENGTH"))
|
---|
| 23 | . ; identify process for ^%SY
|
---|
| 24 | . ; D SETNM^%ZOSV($E("HLClnt:"_HLDP,1,15))
|
---|
| 25 | . D SETNM^%ZOSV($E("HLc:"_HLTCPORT_"-"_HLDP_"-"_HLDP("$J",0),1,15))
|
---|
| 26 | . K HLDP("$J",0)
|
---|
| 27 | . D ST1
|
---|
| 28 | . F D ^HLCSTCP2 Q:$$STOP!$G(HLCSOUT)
|
---|
| 29 | . ; I $G(HLCSOUT)=1 D MON("Error") H 1 Q
|
---|
| 30 | . I $G(HLCSOUT)=1 D Q
|
---|
| 31 | .. D MON("Error") H 1
|
---|
| 32 | .. L -^HLCS("HLTCPLINK",HLDP)
|
---|
| 33 | . I $G(HLCSOUT)=2 D EXITS("Inactive") Q
|
---|
| 34 | . D EXITS("Shutdown")
|
---|
| 35 | ;
|
---|
| 36 | S HLDP("$J",0,"START")=HLDP("$J",0,"LENGTH")-9+$L(HLTCPORT)
|
---|
| 37 | I HLDP("$J",0,"START")<1 S HLDP("$J",0,"START")=1
|
---|
| 38 | S HLDP("$J",0)=$E(HLDP("$J"),HLDP("$J",0,"START"),HLDP("$J",0,"LENGTH"))
|
---|
| 39 | ; identify process for ^%SY
|
---|
| 40 | ; D SETNM^%ZOSV($E("HLSrv:"_HLDP,1,15))
|
---|
| 41 | D SETNM^%ZOSV($E("HLs:"_HLTCPORT_"-"_HLDP("$J",0),1,15))
|
---|
| 42 | K HLDP("$J",0)
|
---|
| 43 | ; to stop the listener via updated Kernel API, need to pass the
|
---|
| 44 | ; listener logical link (HLDP)
|
---|
| 45 | S HLZRULE="S HLDP="_HLDP_" S ZISQUIT=$$STOP^HLCSTCP"
|
---|
| 46 | ;single threaded listener
|
---|
| 47 | I $G(HLTCPCS)="S" D Q
|
---|
| 48 | . D ST1,MON("Listen"),LISTEN^%ZISTCP(HLTCPORT,"SERVER^HLCSTCP("""_HLDP_""")",HLZRULE)
|
---|
| 49 | . I $$STOP D EXITS("Shutdown") Q
|
---|
| 50 | . D EXITS("Openfail")
|
---|
| 51 | ;
|
---|
| 52 | ;multi-threaded listener (for OpenM/NT)
|
---|
| 53 | I ($G(HLTCPCS)'="M")!(^%ZOSF("OS")'["OpenM") D Q
|
---|
| 54 | . L -^HLCS("HLTCPLINK",HLDP)
|
---|
| 55 | I $$OS^%ZOSV["VMS" L -^HLCS("HLTCPLINK",HLDP) Q
|
---|
| 56 | D ST1,MON("Listen"),LISTEN^%ZISTCPS(HLTCPORT,"SERVERS^HLCSTCP("""_HLDP_""")",HLZRULE)
|
---|
| 57 | ; update status of listener
|
---|
| 58 | I $$STOP D EXITS("Shutdown") Q
|
---|
| 59 | D EXITS("Openfail")
|
---|
| 60 | ; HL*1.6*122 end
|
---|
| 61 | Q
|
---|
| 62 | ;
|
---|
| 63 | SERVER(HLDP) ; single server using Taskman
|
---|
| 64 | I '$$INIT D EXITS("Init error") Q
|
---|
| 65 | D ^HLCSTCP1
|
---|
| 66 | I $$STOP D CLOSE^%ZISTCP,EXITS("Shutdown") S IO("C")="" Q
|
---|
| 67 | Q:$G(HLCSOUT)=1
|
---|
| 68 | D MON("Idle")
|
---|
| 69 | Q
|
---|
| 70 | ;
|
---|
| 71 | SERVERS(HLDP) ; Multi-threaded server using Taskman
|
---|
| 72 | I '$$INIT D EXITS("Init error") Q
|
---|
| 73 | G LISTEN
|
---|
| 74 | ;
|
---|
| 75 | ;multiple process servers, called from an external utility
|
---|
| 76 | MSM ;MSM entry point, called from User-Defined Services
|
---|
| 77 | ;HLDP=ien in the HL LOWER LEVEL PROTOCOL PARAMETER file for the
|
---|
| 78 | ;HL7 Multi-Threaded SERVER
|
---|
| 79 | S (IO,IO(0))=$P
|
---|
| 80 | G LISTEN
|
---|
| 81 | ;
|
---|
| 82 | LISTEN ;
|
---|
| 83 | N HLLSTN,HLCSOUT,HLDBACK,HLDBSIZE,HLDREAD,HLDRETR,HLRETRA,HLDWAIT,HLOS,HLTCPADD,HLTCPCS,HLTCPLNK,HLTCPORT,HLTCPRET
|
---|
| 84 | I '$$INIT D ^%ZTER Q
|
---|
| 85 | ; patch HL*1.6*122 start
|
---|
| 86 | S HLDP("$J")=$J
|
---|
| 87 | S HLDP("$J",0,"LENGTH")=$L(HLDP("$J"))
|
---|
| 88 | S HLDP("$J",0,"START")=HLDP("$J",0,"LENGTH")-9+$L(HLTCPORT)
|
---|
| 89 | I HLDP("$J",0,"START")<1 S HLDP("$J",0,"START")=1
|
---|
| 90 | S HLDP("$J",0)=$E(HLDP("$J"),HLDP("$J",0,"START"),HLDP("$J",0,"LENGTH"))
|
---|
| 91 | ; identify process for ^%SY
|
---|
| 92 | ; D SETNM^%ZOSV($E("HLSrv:"_HLDP,1,15))
|
---|
| 93 | D SETNM^%ZOSV($E("HLs:"_HLTCPORT_"-"_HLDP("$J",0),1,15))
|
---|
| 94 | K HLDP("$J",0)
|
---|
| 95 | ; patch HL*1.6*122 end
|
---|
| 96 | ;HLLSTN used to identify a listener to tag MON
|
---|
| 97 | S HLLSTN=1
|
---|
| 98 | ;increment job count, run server
|
---|
| 99 | D UPDT(1),^HLCSTCP1,EXITM
|
---|
| 100 | Q
|
---|
| 101 | ;
|
---|
| 102 | DCOPEN(HLDP) ;open direct connect - called from HLMA2
|
---|
| 103 | Q:'$$INIT 0
|
---|
| 104 | Q:HLTCPADD=""!(HLTCPORT="") 0
|
---|
| 105 | Q:'$$OPEN^HLCSTCP2 0
|
---|
| 106 | Q 1
|
---|
| 107 | ;
|
---|
| 108 | INIT() ; Initialize Variables
|
---|
| 109 | ; HLDP should be set to the IEN or name of Logical Link, file 870
|
---|
| 110 | S HLOS=$P($G(^%ZOSF("OS")),"^")
|
---|
| 111 | N DA,DIQUIET,DR,TMP,X,Y
|
---|
| 112 | ; patch HL*1.6*140
|
---|
| 113 | ; S IOF=$$FLUSHCHR^%ZISTCP ; HL*1.6*122 set device flush character
|
---|
| 114 | S HLTCPLNK("IOF")=$$FLUSHCHR^%ZISTCP
|
---|
| 115 | S DIQUIET=1
|
---|
| 116 | D DT^DICRW
|
---|
| 117 | I 'HLDP S HLDP=$O(^HLCS(870,"B",HLDP,0)) I 'HLDP Q 0
|
---|
| 118 | S DA=HLDP
|
---|
| 119 | ; patch HL*1.6*122 for field 400.09
|
---|
| 120 | 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;400.09"
|
---|
| 121 | D GETS^DIQ(870,DA,DR,"IN","TMP","TMP")
|
---|
| 122 | ;
|
---|
| 123 | I $D(TMP("DIERR")) QUIT 0
|
---|
| 124 | ; -- re-transmit attempts
|
---|
| 125 | S HLDRETR=+$G(TMP(870,DA_",",200.02,"I"))
|
---|
| 126 | S HLDRETR("CLOSE")=+$G(TMP(870,DA_",",200.022,"I"))
|
---|
| 127 | ; -- exceed re-transmit action
|
---|
| 128 | S HLRETRA=$G(TMP(870,DA_",",200.021,"I"))
|
---|
| 129 | ; -- block size
|
---|
| 130 | S HLDBSIZE=+$G(TMP(870,DA_",",200.03,"I"))
|
---|
| 131 | ; -- read timeout
|
---|
| 132 | S HLDREAD=+$G(TMP(870,DA_",",200.04,"I"))
|
---|
| 133 | ; -- ack timeout
|
---|
| 134 | S HLDBACK=+$G(TMP(870,DA_",",200.05,"I"))
|
---|
| 135 | ; -- uni-directional wait
|
---|
| 136 | S HLDWAIT=$G(TMP(870,DA_",",200.09,"I"))
|
---|
| 137 | ; -- tcp address
|
---|
| 138 | S HLTCPADD=$G(TMP(870,DA_",",400.01,"I"))
|
---|
| 139 | ; -- tcp port
|
---|
| 140 | S HLTCPORT=$G(TMP(870,DA_",",400.02,"I"))
|
---|
| 141 | ; -- tcp/ip service type
|
---|
| 142 | S HLTCPCS=$G(TMP(870,DA_",",400.03,"I"))
|
---|
| 143 | ; -- link persistence
|
---|
| 144 | S HLTCPLNK=$G(TMP(870,DA_",",400.04,"I"))
|
---|
| 145 | ; -- retention
|
---|
| 146 | S HLTCPRET=$G(TMP(870,DA_",",400.05,"I"))
|
---|
| 147 | ;
|
---|
| 148 | ; patch HL*1.6*140
|
---|
| 149 | ; patch HL*1.6*122 for field 400.09
|
---|
| 150 | ; -- tcp/ip openfail timeout
|
---|
| 151 | ; S HLTCPLNK("TIMEOUT")=$G(TMP(870,DA_",",400.09,"I"))
|
---|
| 152 | S HLTCPLNK("TIMEOUT")=+$G(TMP(870,DA_",",400.09,"I"))
|
---|
| 153 | ;
|
---|
| 154 | ; -- set defaults in case something's not set
|
---|
| 155 | S:HLDREAD=0 HLDREAD=10
|
---|
| 156 | S:HLDBACK=0 HLDBACK=60
|
---|
| 157 | ; patch HL*1.6*122
|
---|
| 158 | ; S:HLDBSIZE=0 HLDBSIZE=245
|
---|
| 159 | S:HLDBSIZE<245 HLDBSIZE=245
|
---|
| 160 | S:HLDRETR=0 HLDRETR=5
|
---|
| 161 | S:HLTCPRET="" X=$P($$PARAM^HLCS2,U,12),HLTCPRET=$S(X:X,1:15)
|
---|
| 162 | ;
|
---|
| 163 | ; patch HL*1.6*140, the defaut is 30
|
---|
| 164 | ; patch HL*1.6*122 for field 400.09
|
---|
| 165 | ; S:HLTCPLNK("TIMEOUT")=0 HLTCPLNK("TIMEOUT")=5
|
---|
| 166 | S:(HLTCPLNK("TIMEOUT")<1) HLTCPLNK("TIMEOUT")=30
|
---|
| 167 | ;
|
---|
| 168 | Q 1
|
---|
| 169 | ;
|
---|
| 170 | ST1 ;record startup in 870 for single server
|
---|
| 171 | ;4=status 9=Time Started, 10=Time Stopped, 11=Task Number
|
---|
| 172 | ;14=Shutdown LLP, 3=LLP Online, 18=Gross Errors
|
---|
| 173 | N HLJ,X
|
---|
| 174 | ; HL*1.6*122 remove unnecessary locks
|
---|
| 175 | ;F L +^HLCS(870,HLDP,0):2 Q:$T
|
---|
| 176 | S X="HLJ(870,"""_HLDP_","")"
|
---|
| 177 | S @X@(4)="Init",(@X@(10),@X@(18))="@",@X@(14)=0
|
---|
| 178 | I HLTCPCS["C" S @X@(3)=$S(HLTCPLNK["Y":"PC",1:"NC")
|
---|
| 179 | E S @X@(3)=$S(HLTCPCS["S":"SS",HLTCPCS["M":"MS",1:"")
|
---|
| 180 | I @X@(3)'="NC" S @X@(9)=$$NOW^XLFDT
|
---|
| 181 | S:$G(ZTSK) @X@(11)=ZTSK
|
---|
| 182 | D FILE^HLDIE("","HLJ","","ST1","HLCSTCP") ;HL*1.6*109
|
---|
| 183 | ;L -^HLCS(870,HLDP,0)
|
---|
| 184 | Q
|
---|
| 185 | ;
|
---|
| 186 | MON(Y) ;Display current state & check for shutdown
|
---|
| 187 | ;don't display for multiple server
|
---|
| 188 | Q:$G(HLLSTN)
|
---|
| 189 | ; HL*1.6*122 remove unnecessary locks
|
---|
| 190 | ;F L +^HLCS(870,HLDP,0):2 Q:$T
|
---|
| 191 | S $P(^HLCS(870,HLDP,0),U,5)=Y
|
---|
| 192 | ;L -^HLCS(870,HLDP,0)
|
---|
| 193 | Q:'$D(HLTRACE)
|
---|
| 194 | N X U IO(0)
|
---|
| 195 | W !,"IN State: ",Y
|
---|
| 196 | I '$$STOP D
|
---|
| 197 | . ; patch HL*1.6*122
|
---|
| 198 | . ; R !,"Type Q to Quit: ",X#1:1
|
---|
| 199 | . R !,"Type Q to Quit: ",X:1
|
---|
| 200 | . ; I $L(X),"Qq"[X S $P(^HLCS(870,HLDP,0),U,15)=1
|
---|
| 201 | . I $L(X),"Qq"[$E(X) S $P(^HLCS(870,HLDP,0),U,15)=1
|
---|
| 202 | . ; patch HL*1.6*122 end
|
---|
| 203 | U IO
|
---|
| 204 | Q
|
---|
| 205 | UPDT(Y) ;update job count for multiple servers,X=1 increment
|
---|
| 206 | N HLJ,X
|
---|
| 207 | ;
|
---|
| 208 | ; HL*1.6*122 start
|
---|
| 209 | ; F L +^HLCS(870,HLDP,0):2 Q:$T
|
---|
| 210 | Q:'$G(HLDP)
|
---|
| 211 | Q:'$D(^HLCS(870,"E","M",HLDP))
|
---|
| 212 | F L +^HLCS(870,HLDP,0):10 Q:$T H 1
|
---|
| 213 | ; S X=+$P(^HLCS(870,HLDP,0),U,5),$P(^(0),U,5)=$S(Y:X+1,1:X-1)_" server"
|
---|
| 214 | S X=+$P(^HLCS(870,HLDP,0),U,5)
|
---|
| 215 | I X<0 S X=0
|
---|
| 216 | S $P(^HLCS(870,HLDP,0),U,5)=$S(Y:(X+1),X<1:0,1:X-1)_" server"
|
---|
| 217 | ;if incrementing, set the Device Type field to Multi-Server
|
---|
| 218 | ; I X S HLJ(870,HLDP_",",3)="MS" D FILE^HLDIE("","HLJ","","UPDT","HLCSTCP")
|
---|
| 219 | I $P(^HLCS(870,HLDP,0),"^",4)']"" S $P(^HLCS(870,HLDP,0),"^",4)="MS"
|
---|
| 220 | ; HL*1.6*122 end
|
---|
| 221 | ;
|
---|
| 222 | L -^HLCS(870,HLDP,0)
|
---|
| 223 | Q
|
---|
| 224 | STOP() ;stop flag set
|
---|
| 225 | N X
|
---|
| 226 | F L +^HLCS(870,HLDP,0):2 Q:$T
|
---|
| 227 | S X=+$P(^HLCS(870,HLDP,0),U,15)
|
---|
| 228 | L -^HLCS(870,HLDP,0)
|
---|
| 229 | Q X
|
---|
| 230 | ;
|
---|
| 231 | LLCNT(DP,Y,Z) ;update Logical Link counters
|
---|
| 232 | ;DP=ien of Logical Link in file 870
|
---|
| 233 | ;Y: 1=msg rec, 2=msg proc, 3=msg to send, 4=msg sent
|
---|
| 234 | ;Z: ""=add to counter, 1=subtract from counter
|
---|
| 235 | Q:'$D(^HLCS(870,+$G(DP),0))!('$G(Y))
|
---|
| 236 | N P,X
|
---|
| 237 | S P=$S(Y<3:"IN",1:"OUT")_" QUEUE "_$S(Y#2:"BACK",1:"FRONT")_" POINTER"
|
---|
| 238 | ; patch HL*1.6*122 start
|
---|
| 239 | ; F L +^HLCS(870,DP,P):2 Q:$T
|
---|
| 240 | ; S X=+$G(^HLCS(870,DP,P)),^(P)=X+$S($G(Z):-1,1:1)
|
---|
| 241 | I '$L($G(OS)) N OS S OS=$G(^%ZOSF("OS"))
|
---|
| 242 | I OS'["DSM",OS'["OpenM" D
|
---|
| 243 | . F L +^HLCS(870,DP,P):10 Q:$T H 1
|
---|
| 244 | . S X=+$G(^HLCS(870,DP,P)),^(P)=X+$S($G(Z):-1,1:1)
|
---|
| 245 | . L -^HLCS(870,DP,P)
|
---|
| 246 | E D
|
---|
| 247 | . S X=$I(^HLCS(870,DP,P),$S($G(Z):-1,1:1))
|
---|
| 248 | ; L -^HLCS(870,DP,P)
|
---|
| 249 | ; patch HL*1.6*122 end
|
---|
| 250 | Q
|
---|
| 251 | SDFLD ; set Shutdown? field to yes
|
---|
| 252 | Q:'$G(HLDP)
|
---|
| 253 | ; HL*1.6*122 remove unnecessary lock and call to FM
|
---|
| 254 | S $P(^HLCS(870,HLDP,0),U,15)=1
|
---|
| 255 | ;N HLJ,X
|
---|
| 256 | ;F L +^HLCS(870,HLDP,0):2 Q:$T
|
---|
| 257 | ;14=Shutdown LLP?
|
---|
| 258 | ;S HLJ(870,HLDP_",",14)=1
|
---|
| 259 | ;D FILE^HLDIE("","HLJ","","SDFLD","HLCSTCP") ;HL*1.6*109
|
---|
| 260 | ;L -^HLCS(870,HLDP,0)
|
---|
| 261 | Q
|
---|
| 262 | ;
|
---|
| 263 | EXITS(Y) ; shutdown and clean up the listener process for either
|
---|
| 264 | ; single-threaded or multi-threaded
|
---|
| 265 | N HLJ,X
|
---|
| 266 | F L +^HLCS(870,HLDP,0):2 Q:$T
|
---|
| 267 | ;4=status,10=Time Stopped,9=Time Started,11=Task Number
|
---|
| 268 | S X="HLJ(870,"""_HLDP_","")"
|
---|
| 269 | S @X@(4)=Y,@X@(11)="@"
|
---|
| 270 | S:$G(HLCSOUT)'=2 @X@(10)=$$NOW^XLFDT,@X@(9)="@"
|
---|
| 271 | D FILE^HLDIE("","HLJ","","EXITS","HLCSTCP") ; HL*1.6*109
|
---|
| 272 | L -^HLCS(870,HLDP,0)
|
---|
| 273 | I $D(ZTQUEUED) S ZTREQ="@"
|
---|
| 274 | ; HL*1.6*122
|
---|
| 275 | L -^HLCS("HLTCPLINK",HLDP)
|
---|
| 276 | Q
|
---|
| 277 | ;
|
---|
| 278 | EXITM ;Multiple service shutdown and clean up
|
---|
| 279 | ; shutdown and clean up a connection spawned by the listener
|
---|
| 280 | ; process for a multi-threaded listener
|
---|
| 281 | D UPDT(0)
|
---|
| 282 | I $D(ZTQUEUED) S ZTREQ="@"
|
---|
| 283 | Q
|
---|