Changeset 636 for FOIAVistA/tag/r/HEALTH_LEVEL_SEVEN-HL/HLCSTCP3.m
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/HEALTH_LEVEL_SEVEN-HL/HLCSTCP3.m
r628 r636 1 HLCSTCP3 ;SFIRMFO/RSD - BI-DIRECTIONAL TCP ; 09/13/2006 15:362 ;;1.6;HEALTH LEVEL SEVEN;**76,77,133 ,122**;OCT 13, 1995;Build 141 HLCSTCP3 ;SFIRMFO/RSD - BI-DIRECTIONAL TCP ;09/13/2006 2 ;;1.6;HEALTH LEVEL SEVEN;**76,77,133**;OCT 13, 1995;Build 13 3 3 ;Per VHA Directive 2004-038, this routine should not be modified. 4 4 ; 5 OPENA ; 6 ; called from $$OPEN^HLCSTCP2 and this sub-routine OPENA 7 ; 8 I $G(HLMSG),$D(^HLMA(HLMSG,"P")) S HLPORTA=+$P(^("P"),U,6) 5 OPENA I $G(HLMSG),$D(^HLMA(HLMSG,"P")) S HLPORTA=+$P(^("P"),U,6) 6 D MON^HLCSTCP("Open") 9 7 S POP=1 10 ;11 ; patch HL*1.6*122 start12 ; variable HLDRETR=re-transmit attemps (#870,200.02)13 ; variable HLTCPLNK("TIMEOUT")=timeout for 3rd parameter of CALL^%ZISTCP()14 ; defined in HLCSTCP routine15 ;16 I '$G(HLDRETR("COUNT")) S HLDRETR("COUNT")=117 I '$G(HLTCPLNK("TIMEOUT")) S HLTCPLNK("TIMEOUT")=518 S HLDRETR("COUNT-2")=HLDRETR("COUNT")+HLDRETR19 ; patch 13320 ; I $G(HLDIRECT("OPEN TIMEOUT")) D21 ; .S HLI=122 ; .D CALL^%ZISTCP(HLTCPADD,HLTCPORT,HLDIRECT("OPEN TIMEOUT"))23 ; E D24 ; .F HLI=1:1:HLDRETR D CALL^%ZISTCP(HLTCPADD,HLTCPORT) Q:'POP25 8 I $G(HLDIRECT("OPEN TIMEOUT")) D 26 . D MON^HLCSTCP("Open") 27 . D CALL^%ZISTCP(HLTCPADD,HLTCPORT,HLDIRECT("OPEN TIMEOUT")) 28 . ; give site one more chance to override the application setup 29 . I $G(POP),(HLTCPLNK("TIMEOUT")>HLDIRECT("OPEN TIMEOUT")) D 30 .. D CALL^%ZISTCP(HLTCPADD,HLTCPORT,HLTCPLNK("TIMEOUT")) 9 .S HLI=1 10 .D CALL^%ZISTCP(HLTCPADD,HLTCPORT,HLDIRECT("OPEN TIMEOUT")) 31 11 E D 32 . N COUNT 33 . ; try to connect HLDRETR times 34 . F HLDRETR("COUNT")=HLDRETR("COUNT"):1:HLDRETR("COUNT-2") D Q:('POP)!($$STOP^HLCSTCP) 35 .. D MON^HLCSTCP("Open") 36 .. ; D CALL^%ZISTCP(HLTCPADD,HLTCPORT) 37 .. D CALL^%ZISTCP(HLTCPADD,HLTCPORT,HLTCPLNK("TIMEOUT")) 38 .. ;open error 39 .. I POP D 40 ... D CC^HLCSTCP2("Openfail") 41 ... H $S(HLDRETR("COUNT")=1:0,HLDRETR("COUNT")<10:1,1:8) 42 ... I '$D(^XTMP("HL7-Openfail",$J)) D 43 .... S ^XTMP("HL7-Openfail",0)=$$FMADD^XLFDT($$NOW^XLFDT,3)_"^"_$$NOW^XLFDT 44 .... S ^XTMP("HL7-Openfail",$J,"COUNT","FIRST")=HLDRETR("COUNT")_"^"_$$NOW^XLFDT 45 ... S COUNT=$P($G(^XTMP("HL7-Openfail",$J,"COUNT","LAST")),"^")+1 46 ... S ^XTMP("HL7-Openfail",$J,"COUNT","LAST")=COUNT_"^"_$$NOW^XLFDT 47 ; 12 .F HLI=1:1:HLDRETR D CALL^%ZISTCP(HLTCPADD,HLTCPORT) Q:'POP 48 13 ;set # of opens back in msg 49 ; I $G(HLMSG),$D(^HLMA(HLMSG,"P")) S $P(^("P"),U,6)=HLPORTA+HLI 50 I $G(HLMSG),$D(^HLMA(HLMSG,"P")) S $P(^("P"),U,6)=HLDRETR("COUNT") 51 ; patch HL*1.6*122 end 52 ; 14 I $G(HLMSG),$D(^HLMA(HLMSG,"P")) S $P(^("P"),U,6)=HLPORTA+HLI 53 15 ;device open 54 16 I 'POP S HLPORT=IO D Q $S($G(HLERROR)]"":0,1:1) … … 61 23 . U IO W "HELO "_$$KSP^XUPARAM("WHERE"),! R X:1 62 24 ;openfail-try DNS lookup 63 ; 64 ; patch HL*1.6*122 start 65 ;I '$D(HLDOM) S HLDOM=+$P(^HLCS(870,HLDP,0),U,7),HLDOM=$P($G(^DIC(4.2,HLDOM,0)),U) D:HLDOM]"" DNS 66 I '$D(HLDOM) D 67 . S HLDOM=+$P(^HLCS(870,HLDP,0),U,7),HLDOM=$P($G(^DIC(4.2,HLDOM,0)),U) 68 . S HLDOM("DNS")=$P($G(^HLCS(870,+$G(HLDP),0)),"^",8) 69 . D:HLDOM]""!($L(HLDOM("DNS"),".")>2) DNS 70 ; 71 Q:$$STOP^HLCSTCP 0 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 72 26 ;HLIP=ip add. from DNS call, get first one and try open again 73 27 I $D(HLIP) S HLTCPADD=$P(HLIP,","),HLIP=$P(HLIP,",",2,99) G:HLTCPADD OPENA 74 ; open error 75 ;cleanup and close 76 ; patch 133 28 ;open error 77 29 I $G(HLDIRECT("OPEN TIMEOUT")) D 78 . 79 . 30 .D MON^HLCSTCP("Openfail") 31 .I $D(HLPORT) D CLOSE^%ZISTCP K HLPORT 80 32 E D 81 . D CC^HLCSTCP2("Openfail")33 .D CC^HLCSTCP2("Openfail") H 3 82 34 Q 0 83 ; patch HL*1.6*122 end84 ;85 35 ; 86 36 ;following code was removed, site's complained of to many alerts … … 107 57 I HLTCPORT=5000 S HLDOM="HL7."_HLDOM 108 58 I HLTCPORT=5500 S HLDOM="MPI."_HLDOM 109 ;110 ; patch HL*1.6*122 start111 I $L($G(HLDOM("DNS")),".")>2 D112 . S HLDOM=HLDOM("DNS")113 ; patch HL*1.6*122 end114 ;115 59 S HLIP=$$ADDRESS^XLFNSLK(HLDOM) 116 60 K:HLIP="" HLIP
Note:
See TracChangeset
for help on using the changeset viewer.