Changeset 623 for WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOSRVR2.m

Timestamp:

Dec 4, 2009, 12:11:15 AM (14 years ago)

Author:

George Lilly

Message:

revised back to 6/30/08 version

File:

• WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOSRVR2.m (modified) (1 diff)

WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOSRVR2.m

@@ -1 @@
-HLOSRVR2        ;ALB/CJM-HL7 - HLO Server ;07/20/2007
-        ;;1.6;HEALTH LEVEL SEVEN;**131,137**;Oct 13, 1995;Build 21
-        ;Per VHA Directive 2004-038, this routine should not be modified.
-        ;
-NEWMSG(HLCSTATE,HLMSTATE,HDR)   ;
-        ;initialize the HLMSTATE array after reading the header
-        ;Inputs:
-        ;  HLCSTATE (pass by reference)
-        ;  HDR (pass by reference) parsed header
-        ;Output:
-        ;  HLMSTATE (pass by reference)
-        ;
-        K HLMSTATE
-        S HLMSTATE("IEN")=""
-        S HLMSTATE("BODY")=""
-        S HLMSTATE("DIRECTION")="IN"
-        S HLMSTATE("CURRENT SEGMENT")=0 ;no segments in cache
-        S HLMSTATE("UNSTORED LINES")=1 ;just the header in cache so far
-        S HLMSTATE("LINE COUNT")=0 ;no lines within message stored to disk
-        I HDR("SEGMENT TYPE")="BHS" D
-        .S HLMSTATE("BATCH")=1
-        .S HLMSTATE("ID")=HDR("BATCH CONTROL ID")
-        .S HLMSTATE("BATCH","CURRENT MESSAGE")=0 ;no messages in batch
-        .S HLMSTATE("UNSTORED MSH")=0
-        E  D
-        .S HLMSTATE("BATCH")=0
-        .S HLMSTATE("ID")=HDR("MESSAGE CONTROL ID")
-        M HLMSTATE("HDR")=HDR
-        M HLMSTATE("SYSTEM")=HLCSTATE("SYSTEM")
-        S HLMSTATE("STATUS")=""
-        S HLMSTATE("STATUS","QUEUE")=""
-        S HLMSTATE("STATUS","ACTION")=""
-        S HLMSTATE("STATUS","LINK NAME")=HLCSTATE("LINK","NAME")
-        S HLMSTATE("STATUS","PORT")=$P(HDR("SENDING FACILITY",2),":",2)
-        ;
-        ;if this is a batch, and it references another batch, assume it is a b.
-        I HLMSTATE("BATCH"),HLMSTATE("ID")]"" D
-        .N IEN
-        .S HLMSTATE("ACK TO")=HLMSTATE("ID")
-        .S HLMSTATE("ACK TO","STATUS")="SU"
-        .S IEN=$O(^HLB("B",HLMSTATE("ID"),0))
-        .I IEN S HLMSTATE("ACK TO","IEN")=IEN_"^"
-        E  S HLMSTATE("ACK TO")=""
-        I 'HLMSTATE("BATCH"),HDR("ACCEPT ACK TYPE")="",HDR("APP ACK TYPE")="" D
-        .S HLMSTATE("ORIGINAL MODE")=1
-        E  D
-        .S HLMSTATE("ORIGINAL MODE")=0
-        N I F I=1,3 S HLMSTATE("MSA",I)=""
-        S HLMSTATE("MSA",2)=HLMSTATE("ID")
-        Q
+HLOSRVR2 ;ALB/CJM-HL7 - Sends an application ack over an open connection, for original mode ;02/04/2004
+ ;;1.6;HEALTH LEVEL SEVEN;**131**;Oct 13, 1995;Build 10
+ ;
+NEWMSG(HLCSTATE,HLMSTATE,HDR) ;
+ ;initialize the HLMSTATE array after reading the header
+ ;Inputs:
+ ;  HLCSTATE (pass by reference)
+ ;  HDR (pass by reference) parsed header
+ ;Output:
+ ;  HLMSTATE (pass by reference)
+ ;
+ K HLMSTATE
+ S HLMSTATE("IEN")=""
+ S HLMSTATE("BODY")=""
+ S HLMSTATE("DIRECTION")="IN"
+ S HLMSTATE("CURRENT SEGMENT")=0 ;no segments in cache
+ S HLMSTATE("UNSTORED LINES")=1 ;just the header in cache so far
+ S HLMSTATE("LINE COUNT")=0 ;no lines within message stored to disk
+ I HDR("SEGMENT TYPE")="BHS" D
+ .S HLMSTATE("BATCH")=1
+ .S HLMSTATE("ID")=HDR("BATCH CONTROL ID")
+ .S HLMSTATE("BATCH","CURRENT MESSAGE")=0 ;no messages in batch
+ .S HLMSTATE("UNSTORED MSH")=0
+ E  D
+ .S HLMSTATE("BATCH")=0
+ .S HLMSTATE("ID")=HDR("MESSAGE CONTROL ID")
+ M HLMSTATE("HDR")=HDR
+ M HLMSTATE("SYSTEM")=HLCSTATE("SYSTEM")
+ S HLMSTATE("STATUS")=""
+ S HLMSTATE("STATUS","QUEUE")=""
+ S HLMSTATE("STATUS","ACTION")=""
+ S HLMSTATE("STATUS","LINK NAME")=HLCSTATE("LINK","NAME")
+ S HLMSTATE("STATUS","PORT")=$P(HDR("SENDING FACILITY",2),":",2)
+ ;
+ ;if this is a batch, and it references another batch, assume it is a b.
+ I HLMSTATE("BATCH"),HLMSTATE("ID")]"" D
+ .N IEN
+ .S HLMSTATE("ACK TO")=HLMSTATE("ID")
+ .S HLMSTATE("ACK TO","STATUS")="SU"
+ .S IEN=$O(^HLB("B",HLMSTATE("ID"),0))
+ .I IEN S HLMSTATE("ACK TO","IEN")=IEN_"^"
+ E  S HLMSTATE("ACK TO")=""
+ I 'HLMSTATE("BATCH"),HDR("ACCEPT ACK TYPE")="",HDR("APP ACK TYPE")="" D
+ .S HLMSTATE("ORIGINAL MODE")=1
+ E  D
+ .S HLMSTATE("ORIGINAL MODE")=0
+ N I F I=1,3 S HLMSTATE("MSA",I)=""
+ S HLMSTATE("MSA",2)=HLMSTATE("ID")
+ Q
+ ;
+ACKNOW(MSG,ERROR) ;
+ ;Sends the messge immediately if there is an open connection, otherwise
+ ;will return an error.
+ ;
+ N $ETRAP,$ESTACK S $ETRAP="G ERROR^HLOSRVR2"
+ N SENT
+ S SENT=0,ERROR=""
+ I '$G(HLCSTATE("CONNECTED")) D
+ .S ERROR="NOT CONNECTED"
+ .S MSG("STATUS")="TF"
+ E  S MSG("STATUS")="SU"
+ S:'$G(MSG("DT/TM CREATED")) MSG("DT/TM CREATED")=$$NOW^XLFDT
+ S MSG("STATUS","PURGE")=$$FMADD^XLFDT(MSG("DT/TM CREATED"),$S($G(HLCSTATE("ERROR PURGE")):HLCSTATE("ERROR PURGE"),1:7))
+ D
+ .I $G(MSG("UNSTORED LINES")),'$$SAVEMSG^HLOF777(.MSG) S ERROR="$$SAVE^HLOF777 FAILED!" Q
+ .I '$$SAVEMSG^HLOF778(.MSG) S ERROR="$$SAVE^HLOF778 FAILED!" Q
+ .Q:MSG("STATUS")'="SU"
+ .I '$$WRITEMSG^HLOCLNT1(.HLCSTATE,.MSG) S ERROR="TRANSMISSION FAILURE" Q
+ .S SENT=1
+ .D COUNT^HLOSTAT(.HLCSTATE,ACK("HDR","RECEIVING APPLICATION"),ACK("HDR","SENDING APPLICATION"),ACK("HDR","MESSAGE TYPE")_"~"_ACK("HDR","EVENT"))
+ ;
+END ;
+ I 'SENT,MSG("STATUS")="SU",$G(MSG("IEN")) D
+ .Q:'$D(^HLB(MSG("IEN"),0))
+ .S MSG("STATUS")="TF"
+ .S MSG("STATUS","ERROR TEXT")=ERROR
+ .S $P(^HLB(MSG("IEN"),0),"^",20)=MSG("STATUS")
+ .S $P(^HLB(MSG("IEN"),0),"^",21)=MSG("STATUS","ERROR TEXT")
+ .S ^HLB("ERRORS","TF",$S($L($G(MSG("HDR","RECEIVING APPLICATION"))):MSG("HDR","RECEIVING APPLICATION"),1:"UNKNOWN"),MSG("DT/TM CREATED"),IEN)=""
+ ;
+ Q SENT
+ ;
+ERROR ;error trap for ACKNOW
+ S SENT=0,ERROR="TRANSMISSION FAILURE:"_$P($ECODE,",",1,2)
+ S $ETRAP="D UNWIND^%ZTER"
+ ;
+ ;don't log some common errors
+ I ($ECODE["READ")!($ECODE["NOTOPEN")!($ECODE["DEVNOTOPN")!($ECODE["WRITE")!($ECODE["OPENERR") D
+ .;nothing!
+ E  D
+ .D ^%ZTER
+ G END^HLOSRVR2
+ Q