source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOF778.m@ 1608

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

revised back to 6/30/08 version

File size: 6.2 KB
RevLine 
[623]1HLOF778 ;ALB/CJM-HL7 - Saving messages to file 778 ;03/15/2007
2 ;;1.6;HEALTH LEVEL SEVEN;**126,134**;Oct 13, 1995;Build 30
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;
6SAVEMSG(HLMSTATE) ;
7 ;If a record has not yet been created in file 778, then it will be created. Will file any segments into 777 not yet stored. For batch messages, will store the MSH segments in 778 as the individual messages are stored in 777.
8 ;Input:
9 ; HLMSTATE (pass by reference) - contains information about the message
10 ; These subscripts must be defined:
11 ; ("BATCH")=1 if batch, 0 otherwise
12 ; ("BATCH","BTS")=BTS segment if end of batch reached
13 ; ("BODY")=ien file 777 if stored
14 ; ("DIRECTION")=<"IN" or "OUT">
15 ; ("IEN")=ien,file 778 if stored
16 ; ("UNSTORED LINES") - count of lines to be stored. The lines are at the a lower subscript level <msg>,<segment>,<line>=<line to be stored>
17 ; ("UNSTORED MSH") For batch messages, set to 1 if there are MSH in cache. Cached MSH at ("UNSTORED MSH",<subfile ien>,<1 & 2>)
18 ;
19 ;Output:
20 ; Function - returns the ien of the msg (file 778)
21 ; HLMSTATE
22 ; ("BODY") - set to ien, file 777 if newly created
23 ; ("IEN") - set to ien, file 778 if newly created
24 ; ("UNSTORED LINES")-set to 0 as this function will store them
25 ; ("UNSTORED MSH")- set to 0 as this function will store it
26 ;
27 ;
28 I '$D(HLMSTATE("DT/TM")) S HLMSTATE("DT/TM")=$S(HLMSTATE("DIRECTION")="IN":$$NOW^XLFDT,1:"")
29 ;
30 ;insure that 777 entry created & all segments stored
31 I ('HLMSTATE("BODY"))!($G(HLMSTATE("UNSTORED LINES")))!($L($G(HLMSTATE("BATCH","BTS")))),'$$SAVEMSG^HLOF777(.HLMSTATE) Q 0
32 ;
33 ;insure 778 entry created
34 I 'HLMSTATE("IEN") Q:'$$NEW^HLOF778A(.HLMSTATE) 0
35 ;
36 ;for batch messages, store MSH segments in 778
37 I HLMSTATE("BATCH") D
38 .N IEN S IEN=HLMSTATE("IEN")
39 .;
40 .;incoming messages cache the MSH segments in memory
41 .I HLMSTATE("DIRECTION")="IN",HLMSTATE("UNSTORED MSH") D
42 ..N ORDER S ORDER=0
43 ..F S ORDER=$O(HLMSTATE("UNSTORED MSH",ORDER)) Q:'ORDER D
44 ...N FS,MSGID
45 ...S FS=$E(HLMSTATE("UNSTORED MSH",ORDER,1),4)
46 ...S MSGID=$P(HLMSTATE("UNSTORED MSH",ORDER,2),FS,5)
47 ...S ^HLB(IEN,3,ORDER,0)=ORDER_"^"_MSGID_"^"_$G(HLMSTATE("BATCH","ACK TO",ORDER))
48 ...S ^HLB(IEN,3,ORDER,1)=HLMSTATE("UNSTORED MSH",ORDER,1)
49 ...S ^HLB(IEN,3,ORDER,2)=HLMSTATE("UNSTORED MSH",ORDER,2)
50 ...S ^HLB(IEN,3,"B",ORDER,ORDER)=""
51 ...I MSGID]"" S ^HLB("AE",MSGID,IEN_"^"_ORDER)="" ;whole file index for individual message id
52 ..K HLMSTATE("UNSTORED MSH") S HLMSTATE("UNSTORED MSH")=0
53 .;
54 .;
55 .I HLMSTATE("DIRECTION")="OUT" D
56 ..;must build the MSH segments!
57 ..N HDR,FS,MSG,CS
58 ..S FS=HLMSTATE("HDR","FIELD SEPARATOR")
59 ..S CS=$E(HLMSTATE("HDR","ENCODING CHARACTERS"),1)
60 ..S HLMSTATE("HDR","MESSAGE TYPE")=" "
61 ..S HLMSTATE("HDR","EVENT")=" "
62 ..D BUILDHDR^HLOPBLD1(.HLMSTATE,"MSH",.HDR)
63 ..S HLMSTATE("BATCH","CURRENT MESSAGE")=$O(^HLB(HLMSTATE("IEN"),3,"B",";"),-1)
64 ..F Q:'$$NEXTMSG(.HLMSTATE,.MSG) D
65 ...N MSGID,CUR
66 ...S CUR=HLMSTATE("BATCH","CURRENT MESSAGE")
67 ...S MSGID=HLMSTATE("HDR","BATCH CONTROL ID")_"-"_CUR
68 ...S $P(HDR(2),FS,4)=MSG("MESSAGE TYPE")_CS_MSG("EVENT")
69 ...S $P(HDR(2),FS,5)=MSGID
70 ...S ^HLB(IEN,3,CUR,0)=CUR_"^"_MSGID_"^"_$G(HLMSTATE("BATCH","ACK TO",CUR))
71 ...S ^HLB(IEN,3,CUR,1)=HDR(1)
72 ...S ^HLB(IEN,3,CUR,2)=HDR(2)
73 ...S ^HLB(IEN,3,"B",CUR,CUR)=""
74 ...S ^HLB("AE",MSGID,IEN_"^"_CUR)="" ;whole file index for individual message id
75 ..;
76 .;if the messages are application acks, then update the original message
77 .N SUBIEN S SUBIEN=0
78 .F S SUBIEN=$O(HLMSTATE("BATCH","ACK TO",SUBIEN)) Q:'SUBIEN I $G(HLMSTATE("BATCH","ACK TO",SUBIEN,"IEN"))]"" D
79 ..N ACKTO
80 ..M ACKTO=HLMSTATE("BATCH","ACK TO",SUBIEN)
81 ..;
82 ..;for outgoing msgs, we just created the msgid, for incoming msgs we already had it
83 ..S:HLMSTATE("DIRECTION")="OUT" ACKTO("ACK BY")=HLMSTATE("HDR","BATCH CONTROL ID")_"-"_SUBIEN
84 ..;
85 ..D ACKTO(.HLMSTATE,.ACKTO)
86 .K HLMSTATE("BATCH","ACK TO")
87 ;
88 ;if the msg is an app ack, update the original if not done already
89 I $G(HLMSTATE("ACK TO","IEN"))]"",'$G(HLMSTATE("ACK TO","DONE")) D
90 .N ACKTO
91 .M ACKTO=HLMSTATE("ACK TO")
92 .S ACKTO("ACK BY")=$S(HLMSTATE("BATCH"):HLMSTATE("HDR","BATCH CONTROL ID"),1:HLMSTATE("HDR","MESSAGE CONTROL ID"))
93 .D ACKTO(.HLMSTATE,.ACKTO)
94 .S HLMSTATE("ACK TO","DONE")=1 ;so the update isn't done again
95 ;
96 Q HLMSTATE("IEN")
97 ;
98NEXTMSG(HLMSTATE,MSG) ;
99 ;Traverses file 777 to return the next message in the batch - as
100 ;indicated by HLMSTATE("BATCH","CURRENT MESSAGE") Set to 0 to start,
101 ;returns 0 when there are no more messages
102 ;
103 ;Input: HLMSTATE (pass by reference,required)
104 ;Output:
105 ; HLMSTATE
106 ; ("BATCH","CURRENT MESSAGE")
107 ; MSG -pass by reference:
108 ; ("EVENT")
109 ; ("MESSAGE TYPE")
110 ;
111 ;
112 N SUBIEN,NODE
113 K MSG
114 Q:'$G(HLMSTATE("BODY")) 0
115 S SUBIEN=$O(^HLA(HLMSTATE("BODY"),2,HLMSTATE("BATCH","CURRENT MESSAGE")))
116 Q:'SUBIEN 0
117 S NODE=$G(^HLA(HLMSTATE("BODY"),2,SUBIEN,0))
118 S MSG("MESSAGE TYPE")=$P(NODE,"^",2)
119 S MSG("EVENT")=$P(NODE,"^",3)
120 S HLMSTATE("BATCH","CURRENT MESSAGE")=SUBIEN
121 Q SUBIEN
122 ;
123ACKTO(HLMSTATE,ACKTO) ;if this is an application ack, update the original message - but do not overlay if already valued
124 ;ACKTO = (msgid of msg being ack'd)
125 ; uses these subscripts ("IEN"=ien^subien),("ACK BY"=msgid of acking msg),("STATUS"=status for the initial msg determined by the ack)
126 ;
127 N STATUS,IEN,SUBIEN,NODE,SKIP
128 S SKIP=0
129 S STATUS=$G(ACKTO("STATUS"))
130 S IEN=+ACKTO("IEN"),SUBIEN=$P(ACKTO("IEN"),"^",2)
131 S NODE=$G(^HLB(IEN,0))
132 I 'SUBIEN D
133 .;ack is to a message NOT in a batch
134 .I $P(NODE,"^",7)'="",$P(NODE,"^",7)'=ACKTO("ACK BY") S SKIP=1 Q
135 .I STATUS="" S STATUS="SU"
136 .S $P(NODE,"^",7)=ACKTO("ACK BY")
137 .S $P(NODE,"^",20)=STATUS
138 .S $P(NODE,"^",21)=$G(ACKTO("ERROR TEXT"))
139 .S ^HLB(IEN,0)=NODE
140 E D
141 .;ack is to a message that IS in a batch
142 .S $P(^HLB(IEN,3,SUBIEN,0),"^",4)=$G(ACKTO("ACK BY"))
143 .S $P(^HLB(IEN,3,SUBIEN,0),"^",5)=STATUS
144 I (STATUS="AE"),'SKIP D
145 .N APP
146 .S APP=HLMSTATE("HDR","SENDING APPLICATION")
147 .I APP="" S APP="UNKNOWN"
148 .S ^HLB("ERRORS","AE",APP,$$NOW^XLFDT,ACKTO("IEN"))=""
149 .;don't count the error - the app ack was already counted as an error.
150 .D COUNT^HLOESTAT("IN",$G(HLMSTATE("HDR","RECEIVING APPLICATION")),$G(HLMSTATE("HDR","SENDING APPLICATION")),$S(HLMSTATE("BATCH"):"BATCH",1:$G(HLMSTATE("HDR","MESSAGE TYPE"))),$G(HLMSTATE("HDR","EVENT")))
151 Q
Note: See TracBrowser for help on using the repository browser.