Changeset 636 for FOIAVistA/tag/r/HEALTH_LEVEL_SEVEN-HL/HLCSTCP4.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• HEALTH_LEVEL_SEVEN-HL/HLCSTCP4.m (modified) (4 diffs)

FOIAVistA/tag/r/HEALTH_LEVEL_SEVEN-HL/HLCSTCP4.m

@@ -1 @@
-HLCSTCP4 ;SFIRMFO/RSD - BI-DIRECTIONAL TCP ;10/18/2007  09:56
- ;;1.6;HEALTH LEVEL SEVEN;**109,122**;Oct 13,1995;Build 14
+HLCSTCP4 ;SFIRMFO/RSD - BI-DIRECTIONAL TCP ;11/03/2006  13:31
+ ;;1.6;HEALTH LEVEL SEVEN;**109,122**;Oct 13,1995;Build 4
  ;Per VHA Directive 2004-038, this routine should not be modified.
  ;
@@ -15 +15 @@
  ;I $G(HLMSG) L -^HLMA(HLMSG)
  ;
- ; patch HL*1.6*122 start
- N STOP
- S STOP=0
- I $G(HLDP) S STOP=$$STOP^HLCSTCP
  S $ETRAP="D UNWIND^%ZTER"
- S HLTCP("$ZA\8192#2")=""
- I (^%ZOSF("OS")["OpenM") D
- . S HLTCP("$ZA")=$ZA
- . ; For TCP devices $ZA\8192#2: the device is currently in the
- . ; Connected state talking to a remote host.
- . S HLTCP("$ZA\8192#2")=$ZA\8192#2
- ;
+ ; patch HL*1.6*122
+ S HLTCPERR("$P")=$P
  S HLTCPERR("ERR-$ZE")=$$EC^%ZOSV
  ; I $$EC^%ZOSV["OPENERR"!($$EC^%ZOSV["NOTOPEN")!($$EC^%ZOSV["DEVNOTOPN") D CC^HLCSTCP2("Op-err") S:$G(HLPRIO)="I" HLERROR="15^Open Related Error" D UNWIND^%ZTER Q
- I $$EC^%ZOSV["OPENERR"!($$EC^%ZOSV["NOTOPEN")!($$EC^%ZOSV["DEVNOTOPN") D  G:STOP H2^XUSCLEAN Q
- . D CC^HLCSTCP2("Op-err") H 1
+ I $$EC^%ZOSV["OPENERR"!($$EC^%ZOSV["NOTOPEN")!($$EC^%ZOSV["DEVNOTOPN") D  Q
+ . D CC^HLCSTCP2("Op-err")
  . S:$G(HLPRIO)="I" HLERROR="15^Open Related Error"
- . I STOP D  Q
- .. D CC^HLCSTCP2("Shutdown: (with 'Op-err')")
- . I 'STOP D UNWIND^%ZTER
- I $$EC^%ZOSV["WRITE" D  G:STOP!(HLTCP("$ZA\8192#2")=0) H2^XUSCLEAN Q
- . D CC^HLCSTCP2("Wr-err") H 1
- . S:$G(HLPRIO)="I" HLERROR="108^Write Error"
- . I STOP D  Q
- .. D CC^HLCSTCP2("Shutdown: (with 'Wr-err')")
- . I HLTCP("$ZA\8192#2")=0 D  Q
- .. D CC^HLCSTCP2("Halt (Wr): (Disconnected with 'Wr-err')")
- . I 'STOP,HLTCP("$ZA\8192#2") D UNWIND^%ZTER
+ . D UNWIND^%ZTER
+ I $$EC^%ZOSV["WRITE" D  Q  ;HL*1.6*77 modifications start here
+ .  D CC^HLCSTCP2("Wr-err")
+ .  S:$G(HLPRIO)="I" HLERROR="108^Write Error"
+ .  D UNWIND^%ZTER ;HL*1.6*77 modifications end here
  ; I $$EC^%ZOSV["READ" D CC^HLCSTCP2("Rd-err") S:$G(HLPRIO)="I" HLERROR="108^Read Error" D UNWIND^%ZTER Q
- I $$EC^%ZOSV["READ" D  G:STOP!(HLTCP("$ZA\8192#2")=0) H2^XUSCLEAN Q
- . D CC^HLCSTCP2("Rd-err") H 1
+ I $$EC^%ZOSV["READ" D  Q
+ . D CC^HLCSTCP2("Rd-err")
  . S:$G(HLPRIO)="I" HLERROR="108^Read Error"
- . I STOP D  Q
- .. D CC^HLCSTCP2("Shutdown: (with 'Rd-err')")
- . I HLTCP("$ZA\8192#2")=0 D  Q
- .. D CC^HLCSTCP2("Halt (Rd): (Disconnected with 'Rd-err')")
- . I 'STOP,HLTCP("$ZA\8192#2") D UNWIND^%ZTER
+ . D UNWIND^%ZTER
  S HLCSOUT=1 D ^%ZTER,CC^HLCSTCP2("Error"),SDFLD^HLCSTCP
  S:$G(HLPRIO)="I" HLERROR="9^Error"
- I STOP D CC^HLCSTCP2("Shutdown: (with 'Error')")
- I HLTCP("$ZA\8192#2")=0 D
- . D CC^HLCSTCP2("Halt (Er): (Disconnected with 'Error')")
- G:STOP!(HLTCP("$ZA\8192#2")=0) H2^XUSCLEAN
- ; patch HL*1.6*122 end
  D UNWIND^%ZTER
  Q
  ;
 PROXY ; set DUZ for application proxy user
- ;
- ; removed the execcution: patch 122 TEST v2
+ S HLDUZ=+$$APFIND^XUSAP("HLSEVEN,APPLICATION PROXY")
+ S DUZ=HLDUZ
+ D DUZ^XUP(DUZ)
  Q
  ;
- ;; S HLDUZ=+$$APFIND^XUSAP("HLSEVEN,APPLICATION PROXY")
- ;; S DUZ=HLDUZ
- ;; D DUZ^XUP(DUZ)
- ;; Q
- ;
 HLDUZ ; compare DUZ and set DUZ to application proxy user
- ;
- ; removed the execcution: patch 122 TEST v2
- Q
- ;
- ;; I '$G(HLDUZ) D PROXY
- ;
-HLDUZ2 ; compare DUZ and HLDUZ
+ I '$G(HLDUZ) D PROXY
  I $G(DUZ)'=HLDUZ D
  . S DUZ=HLDUZ
@@ -121 +87 @@
  I HLIND1 D  Q
  . ;get pointer to 772, kill header
- . ;
- . ; patch HL*1.6*122: MPI-client/server
- . F  L +^HLMA(+HLIND1):10 Q:$T  H 1
  . K ^HLMA(+HLIND1,"MSH")
- . L -^HLMA(+HLIND1)
- . ;
  . I $D(^HL(772,+$P(HLIND1,U,2),"IN")) K ^("IN")
  . S X=$$MAID^HLTF(+HLIND1,HLMID)
@@ -155 +116 @@
  Q X
  ;
-ERROR1 ;
- ; moved from ERROR^HLCSTCP1
- ; Error trap for disconnect error and return back to the read loop.
- ; patch HL*1.6*122 start
- I (^%ZOSF("OS")["OpenM") D
- . S HLTCP("$ZA")=$ZA
- . ; For TCP devices $ZA\8192#2: the device is currently in the
- . ; Connected state talking to a remote host.
- . S HLTCP("$ZA\8192#2")=$ZA\8192#2
- . I HLTCP("$ZA\8192#2")=0 D
- .. ; decrement counter of multi-listener
- .. I $D(^HLCS(870,"E","M",+$G(HLDP))) D EXITM^HLCSTCP
- .. ; process terminated
- .. D H2^XUSCLEAN
- S $ETRAP="D UNWIND^%ZTER"
- ; I $$EC^%ZOSV["READ"!($$EC^%ZOSV["NOTOPEN")!($$EC^%ZOSV["DEVNOTOPN") D UNWIND^%ZTER Q
- I ($$EC^%ZOSV["NOTOPEN")!($$EC^%ZOSV["DEVNOTOPN") D  Q
- . ; if it is not a multi-listener
- . I '$D(^HLCS(870,"E","M",+$G(HLDP))) D CC^HLCSTCP1("Open-err")
- . D UNWIND^%ZTER
- I $$EC^%ZOSV["READ" D  Q
- . ; if it is not a multi-listener
- . I '$D(^HLCS(870,"E","M",+$G(HLDP))) D CC^HLCSTCP1("Rd-err")
- . D UNWIND^%ZTER
- ;
- ; I $$EC^%ZOSV["WRITE" D CC("Wr-err") D UNWIND^%ZTER Q
- I $$EC^%ZOSV["WRITE" D  Q
- . ; if it is not a multi-listener
- . I '$D(^HLCS(870,"E","M",+$G(HLDP))) D CC^HLCSTCP1("Wr-err")
- . D UNWIND^%ZTER
- ;
- ; for GT.M
- I $ECODE["UREAD" D  Q
- . ; if it is not a multi-listener
- . I '$D(^HLCS(870,"E","M",+$G(HLDP))) D CC^HLCSTCP1("Rd-err")
- . D UNWIND^%ZTER
- ;
- ; S HLCSOUT=1 D ^%ZTER,CC("Error")
- S HLCSOUT=1
- D ^%ZTER
- ; if it is not a multi-listener
- I '$D(^HLCS(870,"E","M",+$G(HLDP))) D CC^HLCSTCP1("Error")
- ; patch HL*1.6*122 end
- ;
- D UNWIND^%ZTER
- Q
- ;
-CLRMCNTR ;
- ; clear the counter to set as "0 server" for multi-listener
- ; HL*1.6*122 start
- Q:'$G(HLDP)
- Q:'$D(^HLCS(870,"E","M",HLDP))
- S $P(^HLCS(870,HLDP,0),"^",4)="MS"
- S $P(^HLCS(870,HLDP,0),U,5)="0 server"
- Q
- ;
-CREATUSR ;
- ; patch HL*1.6*122 TEST v2: DUZ code removed
- ; create application proxy users for listeners and incoming filer
- ;; N HLTEMP
- ;; S HLTEMP=$$CREATE^XUSAP("HLSEVEN,APPLICATION PROXY","#")
- Q