Changeset 623 for WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSTCP.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSTCP.m
r613 r623 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 1 HLCSTCP ;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 ; 37 SERVER(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 ; 46 SERVERS(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 51 MSM ;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 ; 57 CACHEVMS(%) ;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 ; 67 EN ;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 74 LISTEN ; 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 ; 85 DCOPEN(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 ; 91 INIT() ; 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 ; 136 ST1 ;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 ; 151 MON(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 165 UPDT(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 173 STOP() ;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 ; 180 LLCNT(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 191 SDFLD ; 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 ; 201 EXITS(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 ; 213 EXITM ;Multiple service shutdown and clean up 214 D UPDT(0) 215 I $D(ZTQUEUED) S ZTREQ="@" 216 Q
Note:
See TracChangeset
for help on using the changeset viewer.
