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

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

@@ -1 @@
-HLOSRVR1 ;IRMFO-ALB/CJM - Reading messages, sending acks;03/24/2004  14:43 ;07/17/2007
- ;;1.6;HEALTH LEVEL SEVEN;**126,130,131,133,134,137**;Oct 13, 1995;Build 21
+HLOSRVR1 ;IRMFO-ALB/CJM - Reading messages, sending acks;03/24/2004  14:43 ;03/26/2007
+ ;;1.6;HEALTH LEVEL SEVEN;**126,130,131,133,134**;Oct 13, 1995;Build 30
  ;Per VHA Directive 2004-038, this routine should not be modified.
  ;
@@ -52 +52 @@
  ....S HLMSTATE("ACK TO")=OLDMSGID
  ....S HLMSTATE("ACK TO","ACK BY")=HLMSTATE("ID")
- ....S HLMSTATE("ACK TO","STATUS")=$S(CODE="AA":"SU",1:"ER")
- ....I $G(IEN) D
- .....S HLMSTATE("ACK TO","IEN")=IEN
- .....S HLMSTATE("ACK TO","SEQUENCE QUEUE")=$P($G(^HLB(+IEN,5)),"^")
+ ....S HLMSTATE("ACK TO","STATUS")=$S(CODE="AA":"SU",1:"AE")
+ ....S:$D(IEN) HLMSTATE("ACK TO","IEN")=IEN
  ....S HLMSTATE("ACK TO","ERROR TEXT")=TEXT
  ...D ADDSEG^HLOMSG(.HLMSTATE,.SEG)
@@ -68 +66 @@
  .....S HLMSTATE("BATCH","ACK TO",SUBIEN)=OLDMSGID
  .....S HLMSTATE("BATCH","ACK TO",SUBIEN,"ACK BY")=NEWMSGID
- .....S HLMSTATE("BATCH","ACK TO",SUBIEN,"STATUS")=$S(CODE="AA":"SU",1:"ER")
+ .....S HLMSTATE("BATCH","ACK TO",SUBIEN,"STATUS")=$S(CODE="AA":"SU",1:"AE")
  .....S:$D(IEN) HLMSTATE("BATCH","ACK TO",SUBIEN,"IEN")=IEN
  ....D ADDSEG^HLOMSG(.HLMSTATE,.SEG)
@@ -127 +125 @@
  ;  HLMSTATE("HDR") - the parsed header segment
  ;Output:
- ;  HLMSTATE("STATUS")="ER" if an error is detected
+ ;  HLMSTATE("STATUS")="SE" if an error is detected
  ;  HLMSTATE("STATUS","QUEUE") queue to put the message on
  ;  HLMSTATE("STATUS","ACTION")  <tag^rtn> that is the processing routine for the receiving application
@@ -139 +137 @@
  E  D
  .S WANTACK=1
- I HLMSTATE("ORIGINAL MODE") S HLMSTATE("MSA",1)="AE",HLMSTATE("MSA",3)="THIS INTERFACE DOES NOT IMPLEMENT ORIGINAL MODE APPLICATION ACKOWLEDGMENTS",HLMSTATE("STATUS")="ER" Q
+ I HLMSTATE("ORIGINAL MODE") S HLMSTATE("MSA",1)="AE",HLMSTATE("MSA",3)="THIS INTERFACE DOES NOT IMPLEMENT ORIGINAL MODE APPLICATION ACKOWLEDGMENTS",HLMSTATE("STATUS")="SE" Q
  I $G(HLMSTATE("ACK TO"))="" D  Q:ERROR
- .I '$$ACTION^HLOAPP(.HDR,.ACTION,.QUEUE) S ERROR=1 S:WANTACK HLMSTATE("MSA",1)="CR" S HLMSTATE("MSA",3)="RECEIVING APPLICATION NOT DEFINED",HLMSTATE("STATUS")="ER" Q
+ .I '$$ACTION^HLOAPP(.HDR,.ACTION,.QUEUE) S ERROR=1 S:WANTACK HLMSTATE("MSA",1)="CR" S HLMSTATE("MSA",3)="RECEIVING APPLICATION NOT DEFINED",HLMSTATE("STATUS")="SE" Q
  .S HLMSTATE("STATUS","ACTION")=$G(ACTION),HLMSTATE("STATUS","QUEUE")=$G(QUEUE)
  E  D  Q:ERROR  ;this is an app ack
@@ -147 +145 @@
  .N NODE
  .S:+$G(HLMSTATE("ACK TO","IEN")) NODE=$G(^HLB(+HLMSTATE("ACK TO","IEN"),0))
- .I $G(NODE)="" S ERROR=1,HLMSTATE("STATUS")="ER",HLMSTATE("ACK TO","IEN")="" S:WANTACK HLMSTATE("MSA",1)="CE" S HLMSTATE("MSA",3)="INITIAL MESSAGE TO APPLICATION ACKNOWLEDGMENT NOT FOUND" Q
- .I $P(NODE,"^",7)'="",$P(NODE,"^",7)'=HLMSTATE("ID") S ERROR=1,HLMSTATE("STATUS")="ER",HLMSTATE("ACK TO","IEN")="" S:WANTACK HLMSTATE("MSA",1)="CE" S HLMSTATE("MSA",3)="INITIAL MESSAGE WAS ALREADY ACKED" Q
+ .I $G(NODE)="" S ERROR=1,HLMSTATE("STATUS")="SE",HLMSTATE("ACK TO","IEN")="" S:WANTACK HLMSTATE("MSA",1)="CE" S HLMSTATE("MSA",3)="INITIAL MESSAGE TO APPLICATION ACKNOWLEDGMENT NOT FOUND" Q
+ .I $P(NODE,"^",7)'="",$P(NODE,"^",7)'=HLMSTATE("ID") S ERROR=1,HLMSTATE("STATUS")="SE",HLMSTATE("ACK TO","IEN")="" S:WANTACK HLMSTATE("MSA",1)="CE" S HLMSTATE("MSA",3)="INITIAL MESSAGE WAS ALREADY ACKED" Q
  .I ($P(NODE,"^",11)]"") S HLMSTATE("STATUS","ACTION")=$P(NODE,"^",10,11),HLMSTATE("STATUS","QUEUE")=$S($P(NODE,"^",6)]"":$P(NODE,"^",6),1:"DEFAULT")  Q
  .;processing routine for the app ack wasn't found with the original message, look in the HLO Application Registry
@@ -154 +152 @@
  .I $$ACTION^HLOAPP(.HDR,.ACTION,.QUEUE) S HLMSTATE("STATUS","ACTION")=$G(ACTION),HLMSTATE("STATUS","QUEUE")=$G(QUEUE)
  ;
- I HDR("PROCESSING ID")'=HLCSTATE("SYSTEM","PROCESSING ID") S:WANTACK HLMSTATE("MSA",1)="CR" S HLMSTATE("STATUS")="ER",HLMSTATE("MSA",3)="SYSTEM PROCESSING ID="_HLCSTATE("SYSTEM","PROCESSING ID") Q
+ I HDR("PROCESSING ID")'=HLCSTATE("SYSTEM","PROCESSING ID") S:WANTACK HLMSTATE("MSA",1)="CR" S HLMSTATE("STATUS")="SE",HLMSTATE("MSA",3)="SYSTEM PROCESSING ID="_HLCSTATE("SYSTEM","PROCESSING ID") Q
  ;
  ;wrong receiving facility?  This is hard to check if the sender is not VistA, because the HL7 standard permits different coding systems to be used. This check is only for DNS or station number.
@@ -166 +164 @@
  .I $P(HDR("RECEIVING FACILITY",2),":")[HLCSTATE("SYSTEM","DOMAIN") S PASS=1 Q
  .I HLCSTATE("SYSTEM","DOMAIN")[$P(HDR("RECEIVING FACILITY",2),":") S PASS=1 Q
- I 'PASS S HLMSTATE("STATUS")="ER",HLMSTATE("MSA",3)="RECEIVING FACILITY IS "_HLCSTATE("SYSTEM","DOMAIN") S:WANTACK HLMSTATE("MSA",1)="CE"
+ I 'PASS S HLMSTATE("STATUS")="SE",HLMSTATE("MSA",3)="RECEIVING FACILITY IS "_HLCSTATE("SYSTEM","DOMAIN") S:WANTACK HLMSTATE("MSA",1)="CE"
  I PASS,WANTACK S HLMSTATE("MSA",1)="CA"
  Q
@@ -215 +213 @@
  D END^HLOSRVR
  ;
- ;multi-listener should stop execution, only a single server may continue
+ ;concurrent server connections (multi-listener) should stop execution, only a single server may continue
  I $P($G(HLCSTATE("LINK","SERVER")),"^",2)'="S" D  Q:$QUIT "" Q
- .;don't log these errors
+ .;don't log these common errors
  .I ($ECODE["READ")!($ECODE["NOTOPEN")!($ECODE["DEVNOTOPN")!($ECODE["WRITE")!($ECODE["OPENERR") D
  ..;
@@ -223 +221 @@
  ..D ^%ZTER
  ;
- ;debugging?
+ ;while debugging quit on all errors
  I $G(^HLTMP("LOG ALL ERRORS"))!($ECODE["EDITED") Q:$QUIT "" Q
  ;
- ;possibly an endless loop?
+ ;a lot of errors of the same time may indicate an endless loop, so keep a count and quit if large count
  N HOUR
  S HOUR=$E($$NOW^XLFDT,1,10)
+ ;
  I ($G(^TMP("HL7 ERRORS",$J,HOUR,$P($ECODE,",",2)))>30) Q:$QUIT "" Q
  ;