source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSTCP3.m@ 701

Last change on this file since 701 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 2.3 KB
Line 
1HLCSTCP3 ;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 ;
5OPENA 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 ;
50DNS ;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 ;
Note: See TracBrowser for help on using the repository browser.