| 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
 | 
|---|