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