HLCSTCP3 ;SFIRMFO/RSD - BI-DIRECTIONAL TCP ;09/13/2006
;;1.6;HEALTH LEVEL SEVEN;**76,77,133**;OCT 13, 1995;Build 13
;Per VHA Directive 2004-038, this routine should not be modified.
;
OPENA I $G(HLMSG),$D(^HLMA(HLMSG,"P")) S HLPORTA=+$P(^("P"),U,6)
D MON^HLCSTCP("Open")
S POP=1
I $G(HLDIRECT("OPEN TIMEOUT")) D
.S HLI=1
.D CALL^%ZISTCP(HLTCPADD,HLTCPORT,HLDIRECT("OPEN TIMEOUT"))
E D
.F HLI=1:1:HLDRETR D CALL^%ZISTCP(HLTCPADD,HLTCPORT) Q:'POP
;set # of opens back in msg
I $G(HLMSG),$D(^HLMA(HLMSG,"P")) S $P(^("P"),U,6)=HLPORTA+HLI
;device open
I 'POP S HLPORT=IO D Q $S($G(HLERROR)]"":0,1:1)
. N $ETRAP,$ESTACK S $ETRAP="D ERROR^HLCSTCP2" ;HL*1.6*77
. ;if address came from DNS, set back into LL
. I $D(HLIP) S $P(^HLCS(870,HLDP,400),U)=HLTCPADD
. ; write and read to check if still open
. Q:HLOS'["OpenM" X "U IO:(::""-M"")" ; must be Cache/NT + use packet mode
. Q:$P(^HLCS(870,HLDP,400),U,7)'="Y" ; must want to SAY HELO
. U IO W "HELO "_$$KSP^XUPARAM("WHERE"),! R X:1
;openfail-try DNS lookup
I '$D(HLDOM) S HLDOM=+$P(^HLCS(870,HLDP,0),U,7),HLDOM=$P($G(^DIC(4.2,HLDOM,0)),U) D:HLDOM]"" DNS
;HLIP=ip add. from DNS call, get first one and try open again
I $D(HLIP) S HLTCPADD=$P(HLIP,","),HLIP=$P(HLIP,",",2,99) G:HLTCPADD OPENA
;open error
I $G(HLDIRECT("OPEN TIMEOUT")) D
.D MON^HLCSTCP("Openfail")
.I $D(HLPORT) D CLOSE^%ZISTCP K HLPORT
E D
.D CC^HLCSTCP2("Openfail") H 3
Q 0
;
;following code was removed, site's complained of to many alerts
;couldn't open, send 1 alert
;I '$G(HLPORTA) D
;. ;send alert
;. N XQA,XQAMSG,XQAOPT,XQAROU,XQAID,Z
;. ;get mailgroup from file 869.3
;. S Z=$P($$PARAM^HLCS2,U,8),HLPORTA="" Q:Z=""
;. S XQA("G."_Z)="",XQAMSG=$$HTE^XLFDT($H,2)_" Logical Link "_$P(^HLCS(870,HLDP,0),U)_" exceeded Open Retries."
;. D SETUP^XQALERT
;open error
;D CC("Openfail") H 3
;Q 0
;
;
DNS ;VA domains must have "med" inserted.
;All domains must use port 5000 and are prepended with "HL7"
;non-VA DNS lookups will succeed if site uses port 5000 and
;configure their local DNS with "HL7.yourdomain.com" and entries
;are created in the logical link file and domain file.
D MON^HLCSTCP("DNS Lkup")
I HLDOM["VA.GOV"&(HLDOM'[".MED.") S HLDOM=$P(HLDOM,".VA.GOV")_".MED.VA.GOV"
I HLTCPORT=5000 S HLDOM="HL7."_HLDOM
I HLTCPORT=5500 S HLDOM="MPI."_HLDOM
S HLIP=$$ADDRESS^XLFNSLK(HLDOM)
K:HLIP="" HLIP
Q
;
HLCSTCP3 ;SFIRMFO/RSD - BI-DIRECTIONAL TCP ;09/13/2006
+1 ;;1.6;HEALTH LEVEL SEVEN;**76,77,133**;OCT 13, 1995;Build 13
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
OPENA IF $GET(HLMSG)
IF $DATA(^HLMA(HLMSG,"P"))
SET HLPORTA=+$PIECE(^("P"),U,6)
+1 DO MON^HLCSTCP("Open")
+2 SET POP=1
+3 IF $GET(HLDIRECT("OPEN TIMEOUT"))
Begin DoDot:1
+4 SET HLI=1
+5 DO CALL^%ZISTCP(HLTCPADD,HLTCPORT,HLDIRECT("OPEN TIMEOUT"))
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 FOR HLI=1:1:HLDRETR
DO CALL^%ZISTCP(HLTCPADD,HLTCPORT)
IF 'POP
QUIT
End DoDot:1
+8 ;set # of opens back in msg
+9 IF $GET(HLMSG)
IF $DATA(^HLMA(HLMSG,"P"))
SET $PIECE(^("P"),U,6)=HLPORTA+HLI
+10 ;device open
+11 IF 'POP
SET HLPORT=IO
Begin DoDot:1
+12 ;HL*1.6*77
NEW $ETRAP,$ESTACK
SET $ETRAP="D ERROR^HLCSTCP2"
+13 ;if address came from DNS, set back into LL
+14 IF $DATA(HLIP)
SET $PIECE(^HLCS(870,HLDP,400),U)=HLTCPADD
+15 ; write and read to check if still open
+16 ; must be Cache/NT + use packet mode
IF HLOS'["OpenM"
QUIT
XECUTE "U IO:(::""-M"")"
+17 ; must want to SAY HELO
IF $PIECE(^HLCS(870,HLDP,400),U,7)'="Y"
QUIT
+18 USE IO
WRITE "HELO "_$$KSP^XUPARAM("WHERE"),!
READ X:1
End DoDot:1
QUIT $SELECT($GET(HLERROR)]"":0,1:1)
+19 ;openfail-try DNS lookup
+20 IF '$DATA(HLDOM)
SET HLDOM=+$PIECE(^HLCS(870,HLDP,0),U,7)
SET HLDOM=$PIECE($GET(^DIC(4.2,HLDOM,0)),U)
IF HLDOM]""
DO DNS
+21 ;HLIP=ip add. from DNS call, get first one and try open again
+22 IF $DATA(HLIP)
SET HLTCPADD=$PIECE(HLIP,",")
SET HLIP=$PIECE(HLIP,",",2,99)
IF HLTCPADD
GOTO OPENA
+23 ;open error
+24 IF $GET(HLDIRECT("OPEN TIMEOUT"))
Begin DoDot:1
+25 DO MON^HLCSTCP("Openfail")
+26 IF $DATA(HLPORT)
DO CLOSE^%ZISTCP
KILL HLPORT
End DoDot:1
+27 IF '$TEST
Begin DoDot:1
+28 DO CC^HLCSTCP2("Openfail")
HANG 3
End DoDot:1
+29 QUIT 0
+30 ;
+31 ;following code was removed, site's complained of to many alerts
+32 ;couldn't open, send 1 alert
+33 ;I '$G(HLPORTA) D
+34 ;. ;send alert
+35 ;. N XQA,XQAMSG,XQAOPT,XQAROU,XQAID,Z
+36 ;. ;get mailgroup from file 869.3
+37 ;. S Z=$P($$PARAM^HLCS2,U,8),HLPORTA="" Q:Z=""
+38 ;. S XQA("G."_Z)="",XQAMSG=$$HTE^XLFDT($H,2)_" Logical Link "_$P(^HLCS(870,HLDP,0),U)_" exceeded Open Retries."
+39 ;. D SETUP^XQALERT
+40 ;open error
+41 ;D CC("Openfail") H 3
+42 ;Q 0
+43 ;
+44 ;
DNS ;VA domains must have "med" inserted.
+1 ;All domains must use port 5000 and are prepended with "HL7"
+2 ;non-VA DNS lookups will succeed if site uses port 5000 and
+3 ;configure their local DNS with "HL7.yourdomain.com" and entries
+4 ;are created in the logical link file and domain file.
+5 DO MON^HLCSTCP("DNS Lkup")
+6 IF HLDOM["VA.GOV"&(HLDOM'[".MED.")
SET HLDOM=$PIECE(HLDOM,".VA.GOV")_".MED.VA.GOV"
+7 IF HLTCPORT=5000
SET HLDOM="HL7."_HLDOM
+8 IF HLTCPORT=5500
SET HLDOM="MPI."_HLDOM
+9 SET HLIP=$$ADDRESS^XLFNSLK(HLDOM)
+10 IF HLIP=""
KILL HLIP
+11 QUIT
+12 ;
