- 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 ;
