Changeset 636 for FOIAVistA/tag/r/HEALTH_LEVEL_SEVEN-HL/HLTP3.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/HLTP3.m (modified) (14 diffs)

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

@@ -1 @@
-HLTP3 ;SFIRMFO/RSD - Transaction Processor for TCP ;10/05/2007  15:17
- ;;1.6;HEALTH LEVEL SEVEN;**19,43,57,58,59,66,69,109,115,108,116,117,125,120,133,122**;Oct 13, 1995;Build 14
+HLTP3 ;SFIRMFO/RSD - Transaction Processor for TCP ;09/13/2006
+ ;;1.6;HEALTH LEVEL SEVEN;**19,43,57,58,59,66,69,109,115,108,116,117,125,120,133**;Oct 13, 1995;Build 13
  ;Per VHA Directive 2004-038, this routine should not be modified.
  ;
  Q
-NEW(X) ;process new msg. ien in 773^ien in 772
- ;HLMTIENS=ien in #773; HLMTIEN=ien in #772
+NEW(X) ;process new msg. ien in 773^msg. ien in 772
+ ;HLMTIENS=ien in #773, msg header; HLMTIEN=ien in #772, msg text
  ;HLHDRO=original header;  HLHDR=response header
  ;set error trap
@@ -21 +21 @@
  . ;HLTCP=ien of acknowledgment msg. from ACK^HLTP4
  . D ACK^HLTP4(X,$P(HLRESLT,U,2)) Q:'$G(HLTCP)
- . ;write ack back
+ . ;write ack back over connection
  . S X=$$WRITE^HLCSTCP2(HLTCP)
  . ;update counter to sent
  . D LLCNT^HLCSTCP(HLDP,4)
- . ;update status of ack
+ . ;update status of ack to complete
  . D STATUS^HLTF0(HLTCP,3,,,1)
  ;
  ;check for duplicate msg., use rec. app and msg. id x-ref
  ; patch HL*1.6*120
+ ; I $L($G(HL("MID"))),$G(HL("RAP")) S X=$O(^HLMA("AH",HL("RAP"),HL("MID"),0)) D  Q:'$D(HLMTIENS)
  I $G(HL("MID"))]"",$G(HL("RAP")) S X=$O(^HLMA("AH",HL("RAP"),HL("MID"),0)) D  Q:'$D(HLMTIENS)
  . ;HLASTMSG=last ien received during this connection
@@ -41 +42 @@
  .I MSH(HLMTIENS)'=MSH(OIENS) S HLASTMSG=HLMTIENS Q
  .;
- . ;msg is duplicate, set status
+ . ;msg is duplicate, set status as duplicate
  . D STATUS^HLTF0(HLMTIENS,4,109,"Duplicate with ien "_OIENS,1),EXIT
- . ;msg was resent, ignore it.
+ . ;msg was resent during this connection, ignore it.
  . I HLASTMSG=HLMTIENS K HLMTIENS Q
  . ;find original response and send back
  . S HLASTRSP=$O(^HLMA("AF",OIENS,OIENS))
  ;
- ;Quit if this is ack to ack
+ ;Quit if this is acknowledgment to acknowledgement message
  I $G(HL("ACK")) D  Q
- . ;Update status of original ack message
+ . ;Update status of original acknowledgment message to successfully
  . D STATUS^HLTF0(HL("MTIENS"),3,,,1),STATUS^HLTF0(HLMTIENS,3,,,1)
  . ;unlock record
@@ -76 +77 @@
  ; patch HL*1.6*120 start
  ;resending old response, msg is a resend
- ; do not re-send duplicate when $G(HL("ACAT"))="AL"
+ ; I $G(HLASTRSP) S HLTCP=HLASTRSP G ACK
+ ; do not re-send duplicate message when $G(HL("ACAT"))="AL"
  I $G(HLASTRSP),$G(HL("ACAT"))'="AL" S HLTCP=HLASTRSP G ACK
  ; quit if duplicate
@@ -90 +92 @@
  . ;X=1 if ack ok, 0=reject of error
  . S X=$E(HLMSA,2)="A"
- . ;Update status of original message and remove it from the queue
+ . ;Update status of original subscriber message and remove it from the out-going queue
  . D STATUS^HLTF0(HL("MTIENS"),$S(X:3,1:4),"",$S(X:"",1:$P(HLMSA,HL("FS"),3)),1)
  . D DEQUE^HLCSREP($P($G(^HLMA(HL("MTIENS"),0)),"^",7),"O",HL("MTIENS"))
  . D
- .. N HLTCP ;variable to update status in file #772.
+ .. N HLTCP ;New variable to update status in file #772.
  ..;
  ..;**108**
@@ -104 +106 @@
  ..;
  .. D PROCACK^HLTP2(HLMTIEN,HL("EID"),.HLRESLT,.HL)
- . ;update status of incoming & unlock
+ . ;update status of incoming to complete & unlock
  . D STATUS^HLTF0(HLMTIENS,$S($G(HLRESLT):4,1:3),$S($G(HLRESLT):+$G(HLRESLT),1:""),$S($G(HLRESLT):$P(HLRESLT,U,2),1:""),1),EXIT
  ;
@@ -123 +125 @@
  ;update status of incoming to complete & unlock
  D STATUS^HLTF0(HLMTIENS,$S(HLRESLT:4,1:3),$S(HLRESLT:+HLRESLT,1:""),$S(HLRESLT:$P(HLRESLT,U,2),1:""),1,$S($G(HLERR("SKIP_EVENT"))=1:1,1:0)),EXIT
- ;HLTCPO=link open, HLTCP=ien of ack msg. from GENACK
+ ;HLTCPO=link open, HLTCP=ien of acknowledgment msg. from GENACK
 ACK I $G(HLTCPO),$G(HLTCP) D  Q
  . D LLCNT^HLCSTCP(HLDP,3)
@@ -137 +139 @@
  ;
  ; patch HL*1.6*120 start
- ; clean non-Kernel variables
+ ; clean variables except Kernel related variables
  D
  . ; protect variables defined in STARTIN^HLCSIN
@@ -152 +154 @@
  N HLERR     ;patch HL*1.6*109
  Q:'$G(HLDP)!'$G(X)  Q:'$G(^HLMA(X,0))
+ ;**109 START**
  Q:'$D(^HLMA("AC","I",HLDP,X))
+ ;**109 END**
  ;
  N HL,HLA,HLD0,HLEID,HLEIDS,HLHDR,HLHDRO,HLMTIEN,HLMTIENS,HLJ,HLMSA,HLN,HLQUIT,HLNODE,HLNEXT,HLRESLT,HLRESLTA,HLTCP,HLXX,Z,HLDONE1
+ ;setup variables
  S HLMTIENS=X,X=^HLMA(HLMTIENS,0),HLMTIEN=+$P(X,U),HL("MID")=$P(X,U,2),HL("MTIENS")=$P(X,U,10),HL("LL")=$P(X,U,7),HLTCP="",HL("Q")=""""""
  S HL("EIDS")=$P(X,U,8),HL("SAP")=$P(X,U,11),HL("RAP")=$P(X,U,12),HL("MTP")=$P(X,U,13),HL("ETP")=$P(X,U,14)
@@ -164 +169 @@
  M HLHDRO=^HLMA(HLMTIENS,"MSH")
  ; if no header quit
+ ;**109**
+ ;I '$O(HLHDRO(0)) L -^HLMA(HLMTIENS) Q
  Q:'$O(HLHDRO(0))
  ;
  S HL("FS")=$E(HLHDRO(1,0),4),HL("ECH")=$$P^HLTPCK2(.HLHDRO,2),HL("SFN")=$$P^HLTPCK2(.HLHDRO,4),HL("RFN")=$$P^HLTPCK2(.HLHDRO,6),HL("DTM")=$$P^HLTPCK2(.HLHDRO,7)
  ;
+ ; patch HL*1.6*109 start
  ; quit if ien of #772 is not defined
  Q:'HLMTIEN
  ; quit if field separator is not defined
  Q:HL("FS")=""
+ ; patch HL*1.6*109 end
  ;
  S X=$$P^HLTPCK2(.HLHDRO,1)
@@ -187 +196 @@
  . S X=$$P^HLTPCK2(.HLHDRO,9),Z=$E(HL("ECH")),HL("PID")=$P(X,Z,2),HL("VER")=$P(X,Z,4)
  . ;
- . ; original code incorrectly treats repetition separator as
+ . ; original implementation incorrectly treats repetition separator as
  . ; subcomponent separator
  . I $E(HL("ECH"),2)]"",X[$E(HL("ECH"),2) D
@@ -206 +215 @@
  . S HLMSA=$P($$P^HLTPCK2(.HLHDRO,10),$E(HL("ECH")),1),$P(HLMSA,HL("FS"),2)=$$P^HLTPCK2(.HLHDRO,12),$P(HLMSA,HL("FS"),3)=$P($$P^HLTPCK2(.HLHDRO,10),$E(HL("ECH")),2),HL("MSAID")=$P(HLMSA,HL("FS"),2)
  ;
+ ; HL*1.6*108
  ; quit if this is a commit ack
  I $P($G(^HL(772,HLMTIEN,"IN",1,0)),HL("FS"),1)="MSA",$E($P($G(^HL(772,HLMTIEN,"IN",1,0)),HL("FS"),2))="C" Q
+ ; ** 
  ;
  ;**  HL*1.6*117 **
  K HLL("SET FOR APP ACK"),HLL("LINKS")
+ ;** END HL*1.6*117 **
  ;
  D CONT
@@ -217 +229 @@
 MSA(Y) ;Y=ien in 772, returns MSA segment
  ;ack code^msg being ack id^text
- ; patch HL*1.6*122
- ; for HL7 v2.5 and beyond with MSA as 3rd segment
- N X,SUBIEN,DATA,DONE
+ N X
  S X=$G(^HL(772,Y,"IN",1,0)),X=$S($E(X,1,3)="MSA":$E(X,5,999),1:"")
- Q:X]"" X
- ;
- S DONE=0
- S SUBIEN=1
- F  S SUBIEN=$O(^HL(772,Y,"IN",SUBIEN)) Q:'SUBIEN  D  Q:DONE
- . S DATA=$G(^HL(772,Y,"IN",SUBIEN,0)) I DATA="" D
- .. S DONE=1
- .. S SUBIEN=$O(^HL(772,Y,"IN",SUBIEN)) Q:'SUBIEN
- .. S X=$G(^HL(772,Y,"IN",SUBIEN,0)),X=$S($E(X,1,3)="MSA":$E(X,5,999),1:"")
- ; patch HL*1.6*122 end
- ;
  Q X
  ;
@@ -237 +236 @@
  D ^%ZTER
  I $G(HLMTIENS),$D(^HLMA(HLMTIENS,0)) D STATUS^HLTF0(HLMTIENS,4,,,1),EXIT
- ; release locks created by inbound filer
+ ;*109* release all locks created by inbound filer
  L -^HLMA("AC","I",+$G(HLXX))
  G UNWIND^%ZTER