Changeset 623 for WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSTCP3.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSTCP3.m
r613 r623 1 HLCSTCP3 ;SFIRMFO/RSD - BI-DIRECTIONAL TCP ; 09/13/2006 15:36 2 ;;1.6;HEALTH LEVEL SEVEN;**76,77,133,122**;OCT 13, 1995;Build 14 3 ;Per VHA Directive 2004-038, this routine should not be modified. 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) 9 S POP=1 10 ; 11 ; patch HL*1.6*122 start 12 ; variable HLDRETR=re-transmit attemps (#870,200.02) 13 ; variable HLTCPLNK("TIMEOUT")=timeout for 3rd parameter of CALL^%ZISTCP() 14 ; defined in HLCSTCP routine 15 ; 16 I '$G(HLDRETR("COUNT")) S HLDRETR("COUNT")=1 17 I '$G(HLTCPLNK("TIMEOUT")) S HLTCPLNK("TIMEOUT")=5 18 S HLDRETR("COUNT-2")=HLDRETR("COUNT")+HLDRETR 19 ; patch 133 20 ; I $G(HLDIRECT("OPEN TIMEOUT")) D 21 ; .S HLI=1 22 ; .D CALL^%ZISTCP(HLTCPADD,HLTCPORT,HLDIRECT("OPEN TIMEOUT")) 23 ; E D 24 ; .F HLI=1:1:HLDRETR D CALL^%ZISTCP(HLTCPADD,HLTCPORT) Q:'POP 25 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")) 31 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 ; 48 ;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 ; 53 ;device open 54 I 'POP S HLPORT=IO D Q $S($G(HLERROR)]"":0,1:1) 55 . N $ETRAP,$ESTACK S $ETRAP="D ERROR^HLCSTCP2" ;HL*1.6*77 56 . ;if address came from DNS, set back into LL 57 . I $D(HLIP) S $P(^HLCS(870,HLDP,400),U)=HLTCPADD 58 . ; write and read to check if still open 59 . Q:HLOS'["OpenM" X "U IO:(::""-M"")" ; must be Cache/NT + use packet mode 60 . Q:$P(^HLCS(870,HLDP,400),U,7)'="Y" ; must want to SAY HELO 61 . U IO W "HELO "_$$KSP^XUPARAM("WHERE"),! R X:1 62 ;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 72 ;HLIP=ip add. from DNS call, get first one and try open again 73 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 77 I $G(HLDIRECT("OPEN TIMEOUT")) D 78 . D MON^HLCSTCP("Openfail") 79 . I $D(HLPORT) D CLOSE^%ZISTCP K HLPORT 80 E D 81 . D CC^HLCSTCP2("Openfail") 82 Q 0 83 ; patch HL*1.6*122 end 84 ; 85 ; 86 ;following code was removed, site's complained of to many alerts 87 ;couldn't open, send 1 alert 88 ;I '$G(HLPORTA) D 89 ;. ;send alert 90 ;. N XQA,XQAMSG,XQAOPT,XQAROU,XQAID,Z 91 ;. ;get mailgroup from file 869.3 92 ;. S Z=$P($$PARAM^HLCS2,U,8),HLPORTA="" Q:Z="" 93 ;. S XQA("G."_Z)="",XQAMSG=$$HTE^XLFDT($H,2)_" Logical Link "_$P(^HLCS(870,HLDP,0),U)_" exceeded Open Retries." 94 ;. D SETUP^XQALERT 95 ;open error 96 ;D CC("Openfail") H 3 97 ;Q 0 98 ; 99 ; 100 DNS ;VA domains must have "med" inserted. 101 ;All domains must use port 5000 and are prepended with "HL7" 102 ;non-VA DNS lookups will succeed if site uses port 5000 and 103 ;configure their local DNS with "HL7.yourdomain.com" and entries 104 ;are created in the logical link file and domain file. 105 D MON^HLCSTCP("DNS Lkup") 106 I HLDOM["VA.GOV"&(HLDOM'[".MED.") S HLDOM=$P(HLDOM,".VA.GOV")_".MED.VA.GOV" 107 I HLTCPORT=5000 S HLDOM="HL7."_HLDOM 108 I HLTCPORT=5500 S HLDOM="MPI."_HLDOM 109 ; 110 ; patch HL*1.6*122 start 111 I $L($G(HLDOM("DNS")),".")>2 D 112 . S HLDOM=HLDOM("DNS") 113 ; patch HL*1.6*122 end 114 ; 115 S HLIP=$$ADDRESS^XLFNSLK(HLDOM) 116 K:HLIP="" HLIP 117 Q 118 ; 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 ;
Note:
See TracChangeset
for help on using the changeset viewer.
