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
HLOSRVR2 ;ALB/CJM-HL7 - Sends an application ack over an open connection, for original mode ;02/04/2004
+1 ;;1.6;HEALTH LEVEL SEVEN;**131**;Oct 13, 1995;Build 10
+2 ;
NEWMSG(HLCSTATE,HLMSTATE,HDR) ;
+1 ;initialize the HLMSTATE array after reading the header
+2 ;Inputs:
+3 ; HLCSTATE (pass by reference)
+4 ; HDR (pass by reference) parsed header
+5 ;Output:
+6 ; HLMSTATE (pass by reference)
+7 ;
+8 KILL HLMSTATE
+9 SET HLMSTATE("IEN")=""
+10 SET HLMSTATE("BODY")=""
+11 SET HLMSTATE("DIRECTION")="IN"
+12 ;no segments in cache
SET HLMSTATE("CURRENT SEGMENT")=0
+13 ;just the header in cache so far
SET HLMSTATE("UNSTORED LINES")=1
+14 ;no lines within message stored to disk
SET HLMSTATE("LINE COUNT")=0
+15 IF HDR("SEGMENT TYPE")="BHS"
Begin DoDot:1
+16 SET HLMSTATE("BATCH")=1
+17 SET HLMSTATE("ID")=HDR("BATCH CONTROL ID")
+18 ;no messages in batch
SET HLMSTATE("BATCH","CURRENT MESSAGE")=0
+19 SET HLMSTATE("UNSTORED MSH")=0
End DoDot:1
+20 IF '$TEST
Begin DoDot:1
+21 SET HLMSTATE("BATCH")=0
+22 SET HLMSTATE("ID")=HDR("MESSAGE CONTROL ID")
End DoDot:1
+23 MERGE HLMSTATE("HDR")=HDR
+24 MERGE HLMSTATE("SYSTEM")=HLCSTATE("SYSTEM")
+25 SET HLMSTATE("STATUS")=""
+26 SET HLMSTATE("STATUS","QUEUE")=""
+27 SET HLMSTATE("STATUS","ACTION")=""
+28 SET HLMSTATE("STATUS","LINK NAME")=HLCSTATE("LINK","NAME")
+29 SET HLMSTATE("STATUS","PORT")=$PIECE(HDR("SENDING FACILITY",2),":",2)
+30 ;
+31 ;if this is a batch, and it references another batch, assume it is a b.
+32 IF HLMSTATE("BATCH")
IF HLMSTATE("ID")]""
Begin DoDot:1
+33 NEW IEN
+34 SET HLMSTATE("ACK TO")=HLMSTATE("ID")
+35 SET HLMSTATE("ACK TO","STATUS")="SU"
+36 SET IEN=$ORDER(^HLB("B",HLMSTATE("ID"),0))
+37 IF IEN
SET HLMSTATE("ACK TO","IEN")=IEN_"^"
End DoDot:1
+38 IF '$TEST
SET HLMSTATE("ACK TO")=""
+39 IF 'HLMSTATE("BATCH")
IF HDR("ACCEPT ACK TYPE")=""
IF HDR("APP ACK TYPE")=""
Begin DoDot:1
+40 SET HLMSTATE("ORIGINAL MODE")=1
End DoDot:1
+41 IF '$TEST
Begin DoDot:1
+42 SET HLMSTATE("ORIGINAL MODE")=0
End DoDot:1
+43 NEW I
FOR I=1,3
SET HLMSTATE("MSA",I)=""
+44 SET HLMSTATE("MSA",2)=HLMSTATE("ID")
+45 QUIT
+46 ;
ACKNOW(MSG,ERROR) ;
+1 ;Sends the messge immediately if there is an open connection, otherwise
+2 ;will return an error.
+3 ;
+4 NEW $ETRAP,$ESTACK
SET $ETRAP="G ERROR^HLOSRVR2"
+5 NEW SENT
+6 SET SENT=0
SET ERROR=""
+7 IF '$GET(HLCSTATE("CONNECTED"))
Begin DoDot:1
+8 SET ERROR="NOT CONNECTED"
+9 SET MSG("STATUS")="TF"
End DoDot:1
+10 IF '$TEST
SET MSG("STATUS")="SU"
+11 IF '$GET(MSG("DT/TM CREATED"))
SET MSG("DT/TM CREATED")=$$NOW^XLFDT
+12 SET MSG("STATUS","PURGE")=$$FMADD^XLFDT(MSG("DT/TM CREATED"),$SELECT($GET(HLCSTATE("ERROR PURGE")):HLCSTATE("ERROR PURGE"),1:7))
+13 Begin DoDot:1
+14 IF $GET(MSG("UNSTORED LINES"))
IF '$$SAVEMSG^HLOF777(.MSG)
SET ERROR="$$SAVE^HLOF777 FAILED!"
QUIT
+15 IF '$$SAVEMSG^HLOF778(.MSG)
SET ERROR="$$SAVE^HLOF778 FAILED!"
QUIT
+16 IF MSG("STATUS")'="SU"
QUIT
+17 IF '$$WRITEMSG^HLOCLNT1(.HLCSTATE,.MSG)
SET ERROR="TRANSMISSION FAILURE"
QUIT
+18 SET SENT=1
+19 DO COUNT^HLOSTAT(.HLCSTATE,ACK("HDR","RECEIVING APPLICATION"),ACK("HDR","SENDING APPLICATION"),ACK("HDR","MESSAGE TYPE")_"~"_ACK("HDR","EVENT"))
End DoDot:1
+20 ;
END ;
+1 IF 'SENT
IF MSG("STATUS")="SU"
IF $GET(MSG("IEN"))
Begin DoDot:1
+2 IF '$DATA(^HLB(MSG("IEN"),0))
QUIT
+3 SET MSG("STATUS")="TF"
+4 SET MSG("STATUS","ERROR TEXT")=ERROR
+5 SET $PIECE(^HLB(MSG("IEN"),0),"^",20)=MSG("STATUS")
+6 SET $PIECE(^HLB(MSG("IEN"),0),"^",21)=MSG("STATUS","ERROR TEXT")
+7 SET ^HLB("ERRORS","TF",$SELECT($LENGTH($GET(MSG("HDR","RECEIVING APPLICATION"))):MSG("HDR","RECEIVING APPLICATION"),1:"UNKNOWN"),MSG("DT/TM CREATED"),IEN)=""
End DoDot:1
+8 ;
+9 QUIT SENT
+10 ;
ERROR ;error trap for ACKNOW
+1 SET SENT=0
SET ERROR="TRANSMISSION FAILURE:"_$PIECE($ECODE,",",1,2)
+2 SET $ETRAP="D UNWIND^%ZTER"
+3 ;
+4 ;don't log some common errors
+5 IF ($ECODE["READ")!($ECODE["NOTOPEN")!($ECODE["DEVNOTOPN")!($ECODE["WRITE")!($ECODE["OPENERR")
Begin DoDot:1
+6 ;nothing!
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 DO ^%ZTER
End DoDot:1
+9 GOTO END^HLOSRVR2
+10 QUIT
