- 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
