Changeset 636 for FOIAVistA/tag/r/HEALTH_LEVEL_SEVEN-HL/HLCSTCP2.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• HEALTH_LEVEL_SEVEN-HL/HLCSTCP2.m (modified) (10 diffs)

FOIAVistA/tag/r/HEALTH_LEVEL_SEVEN-HL/HLCSTCP2.m

@@ -1 @@
-HLCSTCP2 ;SFIRMFO/RSD - BI-DIRECTIONAL TCP ;10/17/2007  09:37
- ;;1.6;HEALTH LEVEL SEVEN;**19,43,49,57,63,64,66,67,76,77,87,109,133,122**;Oct 13,1995;Build 14
+HLCSTCP2 ;SFIRMFO/RSD - BI-DIRECTIONAL TCP ;09/13/2006
+ ;;1.6;HEALTH LEVEL SEVEN;**19,43,49,57,63,64,66,67,76,77,87,109,133**;Oct 13,1995;Build 13
  ;Per VHA Directive 2004-038, this routine should not be modified.
  ;Sender 
@@ -11 +11 @@
  S HLTCPO=HLDP,HLMSG="",(HLRETRY,HLRETMG)=0
  ;
- ; patch 122
- ; patch 133
- ; set IO(0) to the null device
- I $G(^%ZOSF("OS"))]"",^%ZOSF("OS")'["GT.M" D
- . S IO(0)=$S(^%ZOSF("OS")["OpenM":$S($$OS^%ZOSV()["VMS":"_NLA0:",$$OS^%ZOSV()["UNIX":"/dev/null",1:$P),^%ZOSF("OS")["DSM":"_NLA0:",1:$P)
- . O IO(0) U IO(0)
+ ;set IO(0) to the null device
+ S IO(0)=$S(^%ZOSF("OS")["OpenM":$S($$OS^%ZOSV()["VMS":"_NLA0:",$$OS^%ZOSV()["UNIX":"/dev/null",1:$P),^%ZOSF("OS")["DSM":"_NLA0:",1:$P)
+ O IO(0) U IO(0)
  ;
  ;persistent conection, open connection first, HLPORT=open port
@@ -39 +36 @@
  ; and then check the link if it open or not
  N HL,HLN,HLARR,HLHDR,HLI,HLJ,HLMSA,HLRESP,HLRESLT,HLRETRM,HLTCP,HLTCPI,X,Z,HLREREAD
- N HLTMBUF
- D MON^HLCSTCP("CheckOut")
+ D MON^HLCSTCP("Check out")
  ;HLMSG=next msg, set at tag DONE
  I 'HLMSG S HLMSG=+$O(^HLMA("AC","O",HLDP,0)),HLRETRY=0 Q:'HLMSG
  ;
+ ;**109**
+ ;Temporarily lock ^HLMA to flush buffer and ensure edits are complete
+ ;L +^HLMA(HLMSG):1 I '$T S HLMSG=0 Q
+ ;L -^HLMA(HLMSG)
+ ;
  S HLI=+$G(^HLMA(HLMSG,0)),HLJ=$O(^("MSH",0)),HLTCP=""
  ;don't have message text or MSH, kill x-ref and decrement 'to send'
- ;
- ; patch HL*1.6*122: MPI-client/server
- ; I 'HLI!'HLJ K ^HLMA("AC","O",HLDP,HLMSG) D LLCNT^HLCSTCP(HLDP,3,1) S HLMSG=0 Q
- I 'HLI!'HLJ D  Q
- . F  L +^HLMA("AC","O",HLDP,HLMSG):10 Q:$T  H 1
- . K ^HLMA("AC","O",HLDP,HLMSG)
- . L -^HLMA("AC","O",HLDP,HLMSG)
- . D LLCNT^HLCSTCP(HLDP,3,1)
- . S HLMSG=0
- ;
+ I 'HLI!'HLJ K ^HLMA("AC","O",HLDP,HLMSG) D LLCNT^HLCSTCP(HLDP,3,1) S HLMSG=0 Q
  ;update msg status to 'being transmitted'; if cancelled decrement link and quit
  I '$$CHKMSG(1.5) D LLCNT^HLCSTCP(HLDP,3,1) S HLMSG=0 Q
@@ -153 +145 @@
  ; Set up error trap
  N $ETRAP,$ESTACK S $ETRAP="D ERROR^HLCSTCP2"
- ; patch HL*1.6*122
- N HLTMBUF
  ;override ack timeout
  I $G(HLP("ACKTIME")) N HLDBACK S HLDBACK=HLP("ACKTIME")
@@ -179 +169 @@
  D STATUS^HLTF0(HLMSG,ST,$G(ERR),$G(ERRMSG),1)
  ;
+ ;**109**
  D DEQUE^HLCSREP(HLDP,"O",HLMSG)
  ;
@@ -189 +180 @@
  ;returns 1=msg was updated, 0=msg has been canceled
  N X
+ ;
+ ;**109**
+ ;F  L +^HLMA(HLMSG,"P"):1 Q:$T  H 1
+ ;
  ;
  ; New HL*1.6*77 code starting here...
@@ -195 +190 @@
  .  D STATUS^HLTF0(HLMSG,4,$P(HLERROR,U),$P(HLERROR,U,2),1)
  .;
+ .;**109**
  . D DEQUE^HLCSREP(HLDP,"O",HLMSG)
- ;
- ; End of HL*1.6*77
+ .;L -^HLMA(HLMSG,"P")
+ ;**end 109**
+ ;
+ ; End of HL*1.6*77 modifications
  ;
  ;get status, quit if msg was cancelled
  ;
+ ;**109**
+ ;S X=+^HLMA(HLMSG,"P") I X=3 L -^HLMA(HLMSG,"P") Q 0
  S X=+^HLMA(HLMSG,"P") Q:X=3 0
  ;
  ;update status if it is different
  I $G(HLI),HLI'=X D STATUS^HLTF0(HLMSG,HLI)
+ ;
+ ;**109**
+ ;L -^HLMA(HLMSG,"P")
  ;
  Q 1
@@ -216 +219 @@
  ;           -1 - Unsuccessful
  ;
- N HLDA2,HLAR,HLI,LINENO,X,CRCOUNT
- S CRCOUNT=0
+ N HLDA2,HLAR,HLI,LINENO,X
  ;set error trap, used when called from HLTP3
  ;
@@ -235 +237 @@
  .. ;first line, need start block char.
  .. S:LINENO=1 X=$C(11)_X
- .. ; HL*1.6*122
- .. ; I X]"" W X,!
- .. N LENGTH
- .. S LENGTH=$L(X)
- .. ; buffer should be limited to 512
- .. I LENGTH>512 D
- ... N X1
- ... F  Q:LENGTH<512  D
- .... S X1=$E(X,1,512),X=$E(X,513,999999)
- .... S LENGTH=$L(X)
- .... W X1,@IOF
- .. ;
- .. ; @IOF (! or #) for flush character
- .. I X]"" W X,@IOF S CRCOUNT=0
- .. ;send CR
- .. I X="" W $C(13) S CRCOUNT=CRCOUNT+1
- .. ; prevent from maxstring error
- .. I CRCOUNT>200 W @IOF S CRCOUNT=0
+ .. I X]"" W X,!
+ .. ;send CR for blank lines
+ .. I X="" W $C(13)
  .. S LINENO=LINENO+1
  ; Sends end block for this message
  S X=$C(28)_$C(13)
- ; U IO W X,!
- U IO W X,@IOF
- ;switch to null device
- I $G(IO(0))'="",$G(IO(0))'=IO U IO(0)
+ U IO W X,!
+ I $G(IO(0))'="",$G(IO(0))'=IO U IO(0) ;switch to null device if opened to prevent 'leakage'
  Q 1
  ;
@@ -271 +256 @@
  G OPENA^HLCSTCP3
  ;
-RDERR D RDERR^HLCSTCP4 Q
-ERROR D ERROR^HLCSTCP4 Q
+RDERR D RDERR^HLCSTCP4 Q  ; Exceeded 10,000 bytes, so split on 12/2/03-LJA
+ERROR D ERROR^HLCSTCP4 Q  ; Exceeded 10,000 bytes, so split on 12/2/03-LJA
  ;
 CC(X) ;cleanup and close