source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOSRVR2.m@ 648

Last change on this file since 648 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 3.3 KB
Line 
1HLOSRVR2 ;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 ;
4NEWMSG(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 ;
51ACKNOW(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 ;
72END ;
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 ;
83ERROR ;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
Note: See TracBrowser for help on using the repository browser.