[623] | 1 | HLOSRVR2 ;ALB/CJM-HL7 - Sends an application ack over an open connection, for original mode ;02/04/2004
|
---|
| 2 | ;;1.6;HEALTH LEVEL SEVEN;**131**;Oct 13, 1995;Build 10
|
---|
| 3 | ;
|
---|
| 4 | NEWMSG(HLCSTATE,HLMSTATE,HDR) ;
|
---|
| 5 | ;initialize the HLMSTATE array after reading the header
|
---|
| 6 | ;Inputs:
|
---|
| 7 | ; HLCSTATE (pass by reference)
|
---|
| 8 | ; HDR (pass by reference) parsed header
|
---|
| 9 | ;Output:
|
---|
| 10 | ; HLMSTATE (pass by reference)
|
---|
| 11 | ;
|
---|
| 12 | K HLMSTATE
|
---|
| 13 | S HLMSTATE("IEN")=""
|
---|
| 14 | S HLMSTATE("BODY")=""
|
---|
| 15 | S HLMSTATE("DIRECTION")="IN"
|
---|
| 16 | S HLMSTATE("CURRENT SEGMENT")=0 ;no segments in cache
|
---|
| 17 | S HLMSTATE("UNSTORED LINES")=1 ;just the header in cache so far
|
---|
| 18 | S HLMSTATE("LINE COUNT")=0 ;no lines within message stored to disk
|
---|
| 19 | I HDR("SEGMENT TYPE")="BHS" D
|
---|
| 20 | .S HLMSTATE("BATCH")=1
|
---|
| 21 | .S HLMSTATE("ID")=HDR("BATCH CONTROL ID")
|
---|
| 22 | .S HLMSTATE("BATCH","CURRENT MESSAGE")=0 ;no messages in batch
|
---|
| 23 | .S HLMSTATE("UNSTORED MSH")=0
|
---|
| 24 | E D
|
---|
| 25 | .S HLMSTATE("BATCH")=0
|
---|
| 26 | .S HLMSTATE("ID")=HDR("MESSAGE CONTROL ID")
|
---|
| 27 | M HLMSTATE("HDR")=HDR
|
---|
| 28 | M HLMSTATE("SYSTEM")=HLCSTATE("SYSTEM")
|
---|
| 29 | S HLMSTATE("STATUS")=""
|
---|
| 30 | S HLMSTATE("STATUS","QUEUE")=""
|
---|
| 31 | S HLMSTATE("STATUS","ACTION")=""
|
---|
| 32 | S HLMSTATE("STATUS","LINK NAME")=HLCSTATE("LINK","NAME")
|
---|
| 33 | S HLMSTATE("STATUS","PORT")=$P(HDR("SENDING FACILITY",2),":",2)
|
---|
| 34 | ;
|
---|
| 35 | ;if this is a batch, and it references another batch, assume it is a b.
|
---|
| 36 | I HLMSTATE("BATCH"),HLMSTATE("ID")]"" D
|
---|
| 37 | .N IEN
|
---|
| 38 | .S HLMSTATE("ACK TO")=HLMSTATE("ID")
|
---|
| 39 | .S HLMSTATE("ACK TO","STATUS")="SU"
|
---|
| 40 | .S IEN=$O(^HLB("B",HLMSTATE("ID"),0))
|
---|
| 41 | .I IEN S HLMSTATE("ACK TO","IEN")=IEN_"^"
|
---|
| 42 | E S HLMSTATE("ACK TO")=""
|
---|
| 43 | I 'HLMSTATE("BATCH"),HDR("ACCEPT ACK TYPE")="",HDR("APP ACK TYPE")="" D
|
---|
| 44 | .S HLMSTATE("ORIGINAL MODE")=1
|
---|
| 45 | E D
|
---|
| 46 | .S HLMSTATE("ORIGINAL MODE")=0
|
---|
| 47 | N I F I=1,3 S HLMSTATE("MSA",I)=""
|
---|
| 48 | S HLMSTATE("MSA",2)=HLMSTATE("ID")
|
---|
| 49 | Q
|
---|
| 50 | ;
|
---|
| 51 | ACKNOW(MSG,ERROR) ;
|
---|
| 52 | ;Sends the messge immediately if there is an open connection, otherwise
|
---|
| 53 | ;will return an error.
|
---|
| 54 | ;
|
---|
| 55 | N $ETRAP,$ESTACK S $ETRAP="G ERROR^HLOSRVR2"
|
---|
| 56 | N SENT
|
---|
| 57 | S SENT=0,ERROR=""
|
---|
| 58 | I '$G(HLCSTATE("CONNECTED")) D
|
---|
| 59 | .S ERROR="NOT CONNECTED"
|
---|
| 60 | .S MSG("STATUS")="TF"
|
---|
| 61 | E S MSG("STATUS")="SU"
|
---|
| 62 | S:'$G(MSG("DT/TM CREATED")) MSG("DT/TM CREATED")=$$NOW^XLFDT
|
---|
| 63 | S MSG("STATUS","PURGE")=$$FMADD^XLFDT(MSG("DT/TM CREATED"),$S($G(HLCSTATE("ERROR PURGE")):HLCSTATE("ERROR PURGE"),1:7))
|
---|
| 64 | D
|
---|
| 65 | .I $G(MSG("UNSTORED LINES")),'$$SAVEMSG^HLOF777(.MSG) S ERROR="$$SAVE^HLOF777 FAILED!" Q
|
---|
| 66 | .I '$$SAVEMSG^HLOF778(.MSG) S ERROR="$$SAVE^HLOF778 FAILED!" Q
|
---|
| 67 | .Q:MSG("STATUS")'="SU"
|
---|
| 68 | .I '$$WRITEMSG^HLOCLNT1(.HLCSTATE,.MSG) S ERROR="TRANSMISSION FAILURE" Q
|
---|
| 69 | .S SENT=1
|
---|
| 70 | .D COUNT^HLOSTAT(.HLCSTATE,ACK("HDR","RECEIVING APPLICATION"),ACK("HDR","SENDING APPLICATION"),ACK("HDR","MESSAGE TYPE")_"~"_ACK("HDR","EVENT"))
|
---|
| 71 | ;
|
---|
| 72 | END ;
|
---|
| 73 | I 'SENT,MSG("STATUS")="SU",$G(MSG("IEN")) D
|
---|
| 74 | .Q:'$D(^HLB(MSG("IEN"),0))
|
---|
| 75 | .S MSG("STATUS")="TF"
|
---|
| 76 | .S MSG("STATUS","ERROR TEXT")=ERROR
|
---|
| 77 | .S $P(^HLB(MSG("IEN"),0),"^",20)=MSG("STATUS")
|
---|
| 78 | .S $P(^HLB(MSG("IEN"),0),"^",21)=MSG("STATUS","ERROR TEXT")
|
---|
| 79 | .S ^HLB("ERRORS","TF",$S($L($G(MSG("HDR","RECEIVING APPLICATION"))):MSG("HDR","RECEIVING APPLICATION"),1:"UNKNOWN"),MSG("DT/TM CREATED"),IEN)=""
|
---|
| 80 | ;
|
---|
| 81 | Q SENT
|
---|
| 82 | ;
|
---|
| 83 | ERROR ;error trap for ACKNOW
|
---|
| 84 | S SENT=0,ERROR="TRANSMISSION FAILURE:"_$P($ECODE,",",1,2)
|
---|
| 85 | S $ETRAP="D UNWIND^%ZTER"
|
---|
| 86 | ;
|
---|
| 87 | ;don't log some common errors
|
---|
| 88 | I ($ECODE["READ")!($ECODE["NOTOPEN")!($ECODE["DEVNOTOPN")!($ECODE["WRITE")!($ECODE["OPENERR") D
|
---|
| 89 | .;nothing!
|
---|
| 90 | E D
|
---|
| 91 | .D ^%ZTER
|
---|
| 92 | G END^HLOSRVR2
|
---|
| 93 | Q
|
---|