source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLTF2.m@ 1607

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

initial load of FOIAVistA 6/30/08 version
File size: 8.2 KB
Line 
1HLTF2 ;AISC/SAW/MTC-Process Message Text File Entries (Cont'd) ;10/17/2007 09:44
2 ;;1.6;HEALTH LEVEL SEVEN;**25,122**;Oct 13, 1995;Build 14
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5MERGEIN(LLD0,LLD1,MTIEN,HDR,MSA) ;Merge Data From Communication Server
6 ;Module Logical Link File into Message Text File
7 ;
8 ;This is a subroutine call with parameter passing. The output
9 ;parameters HDR (and optionally) MSA are returned by this call.
10 ;
11 ;Required input parameters
12 ; LLD0 = Internal entry number where message is stored in Logical Link
13 ; file or XM if message is stored in MailMan
14 ; LLD1 = Internal entry number of IN QUEUE multiple entry in Logical
15 ; Link file (Only required for messages stored in Logical
16 ; Link file)
17 ; MTIEN = Internal entry number where message is to be copied to in
18 ; Message Text file
19 ; HDR = The variable in which the message header segment will
20 ; be returned
21 ; MSA = The variable in which the message acknowledgement segment
22 ; will be returned, if one exists for this message
23 ;
24 ;Check for required parameters
25 I $G(LLD0)']""!('$G(MTIEN)) Q
26 I LLD0'="XM",'$G(LLD1) Q
27 N FLG,HLCHAR,HLEVN,HLFS,I,X,X1,HLDONE
28 S (FLG,HLCHAR,HLEVN,X)=0
29 ;
30 ; patch HL*1.6*122: MPI-client/server
31 F L +^HL(772,+$G(MTIEN)):10 Q:$T H 1
32 ;
33 ;Move data from Logical Link file to Message Text file
34 I LLD0'="XM" D
35 .S I=0 F S X=$O(^HLCS(870,LLD0,1,LLD1,1,X)) Q:X'>0 S X1=$G(^(X,0)) S:"FHS,BHS,MSH"[$E(X1,1,3) FLG=1 I FLG S HLCHAR=HLCHAR+$L(X1) D
36 ..;If header segment, process it and set HDR equal to it
37 ..I X1'="","FHS,BHS,MSH"[$E(X1,1,3) D
38 ...I '$D(HDR) S HDR=X1,HLFS=$E(X1,4) I $E(HDR,1,3)="BHS" S MSA="MSA"_HLFS_$P($P(HDR,HLFS,10),$E(HDR,5),1)_HLFS_$P(HDR,HLFS,12)_HLFS_$P($P(HDR,HLFS,10),$E(HDR,5),2)
39 ...S $P(X1,HLFS,8)=""
40 ...S:$E(X1,1,3)="MSH" HLEVN=HLEVN+1
41 ..;If acknowledgement segment, set MSA equal to it
42 ..I $E(X1,1,3)="MSA",'$D(MSA),$E($G(HDR),1,3)="MSH" S MSA=X1
43 ..S I=I+1,^HL(772,MTIEN,"IN",I,0)=X1
44 ;
45 ;Move data from MailMan Message file to Message Text file
46 I LLD0="XM" D
47 .S I=0 F X XMREC Q:XMER<0 S:"FHS,BHS,MSH"[$E(XMRG,1,3) FLG=1 I FLG S HLCHAR=HLCHAR+$L(XMRG) D Q:XMER<0
48 ..;If header segment, process it and set HDR equal to it
49 ..I XMRG'="","FHS,BHS,MSH"[$E(XMRG,1,3) D
50 ...I '$D(HDR) S HDR=XMRG,HLFS=$E(XMRG,4) I $E(HDR,1,3)="BHS" S MSA="MSA"_HLFS_$P($P(HDR,HLFS,10),$E(HDR,5),1)_HLFS_$P(HDR,HLFS,12)_HLFS_$P($P(HDR,HLFS,10),$E(HDR,5),2)
51 ...S $P(XMRG,HLFS,8)=""
52 ...S:$E(XMRG,1,3)="MSH" HLEVN=HLEVN+1
53 ..;If acknowledgement segment, set MSA equal to it
54 ..I $E(XMRG,1,3)="MSA",'$D(MSA),$E($G(HDR),1,3)="MSH" S MSA=XMRG
55 ..S I=I+1,^HL(772,MTIEN,"IN",I,0)=XMRG
56 S ^HL(772,MTIEN,"IN",0)="^^"_I_"^"_I_"^"_$$DT^XLFDT_"^"
57 ;Update statistics in Message Text file for this entry
58 ;
59 ; patch HL*1.6*122: MPI-client/server
60 L -^HL(772,+$G(MTIEN))
61 ;
62 D STATS^HLTF0(MTIEN,HLCHAR,HLEVN)
63 Q
64MERGEOUT(MTIEN,LLD0,LLD1,HDR) ;Merge Text in Message Text File into
65 ;Communication Server Module Logical Link File
66 ;
67 ;This is a routine call with parameter passing. There are no output
68 ;parameters returned by this call.
69 ;
70 ;Required input parameters
71 ; MTIEN = Internal entry number where message is stored in Message
72 ; Text file
73 ; LLD0 = Internal entry number where message is to be copied to in
74 ; Logical Link file
75 ; LLD1 = Internal entry number of IN QUEUE multiple entry in Logical
76 ; Link file
77 ; HDR = Name of the array that contains HL7 Header segment
78 ; format: HLHDR - Used with indirection to build message in out
79 ; queue
80 ; This routine will first take the header information in the array
81 ; specified by HDR and merge into the Message Text field of file 870.
82 ; Then it will move the message contained in 772 (MTIEN) into 870.
83 ;
84 ;Check for required parameters
85 I '$G(MTIEN)!('$G(LLD0))!('$G(LLD1))!(HDR="") Q
86 ;
87 ;-- initilize
88 N I,X
89 S I=0
90 ;
91 ; patch HL*1.6*122: MPI-client/server
92 F L +^HLCS(870,+$G(LLD0),2,+$G(LLD1)):10 Q:$T H 1
93 ;
94 ;-- move header into 870 from HDR array
95 S X="" F S X=$O(@HDR@(X)) Q:'X D
96 . S I=I+1,^HLCS(870,LLD0,2,LLD1,1,I,0)=@HDR@(X)
97 S I=I+1,^HLCS(870,LLD0,2,LLD1,1,I,0)=""
98 ;
99 ;Move data from Message Text file to Logical Link file
100 S X=0 F S X=$O(^HL(772,MTIEN,"IN",X)) Q:X="" D
101 . S I=I+1,^HLCS(870,LLD0,2,LLD1,1,I,0)=$G(^HL(772,MTIEN,"IN",X,0))
102 ;
103 ;-- update 0 node of message and format arrays
104 S ^HLCS(870,LLD0,2,LLD1,1,0)="^^"_I_"^"_I_"^"_$$DT^XLFDT_"^"
105 ;
106 ; patch HL*1.6*122: MPI-client/server
107 L -^HLCS(870,+$G(LLD0),2,+$G(LLD1))
108 ;
109 Q
110OUT(HLDA,HLMID,HLMTN) ;File Data in Message Text File for Outgoing Message
111 ;Version 1.5 Interface Only
112 ;
113 ; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
114 ; OUT, IN, and ACK to HLTF2 routine.
115 ;
116 Q:'$D(HLFS)
117 ;
118 I HLMTN="ACK"!(HLMTN="MCF")!(HLMTN="ORR") Q:'$D(HLMSA) D ACK(HLMSA,"I") Q
119 ;
120 ;-- if message contained MSA find inbound message
121 I $D(HLMSA),$D(HLNDAP),$P(HLMSA,HLFS,3)]"" D
122 . N HLDAI
123 . S HLDAI=0
124 . F S HLDAI=$O(^HL(772,"AH",+$P($G(HLNDAP0),U,12),$P(HLMSA,HLFS,3),HLDAI)) Q:'HLDAI!($P($G(^HL(772,+HLDAI,0)),U,4)="I")
125 . I 'HLDAI K HLDAI
126 ;
127 D STUFF^HLTF0("O")
128 ;
129 N HLAC S HLAC=$S($D(HLERR):4,'$P(HLNDAP0,"^",10):1,1:2) D STATUS^HLTF0(HLDA,HLAC,$G(HLMSG))
130 D:$D(HLCHAR) STATS^HLTF0(HLDA,HLCHAR,$G(HLEVN))
131 ;
132 ;-- update status if MSA and found inbound message
133 I $D(HLMSA),$D(HLDAI) D
134 .N HLERR,HLMSG I $P(HLMSA,HLFS,4)]"" S HLERR=$P(HLMSA,HLFS,4)
135 .S HLAC=$P(HLMSA,HLFS,2)
136 .I HLAC'="AA" S HLMSG=$S(HLAC="AR":"Application Reject",HLAC="AE":"Application Error",1:"")_" - "_HLERR
137 .S HLAC=$S(HLAC'="AA":4,1:3) D STATUS^HLTF0(HLDAI,HLAC,$G(HLMSG))
138 Q
139 ;
140IN(HLMTN,HLMID,HLTIME) ;File Data in Message Text File for Incoming Message
141 ;Version 1.5 Interface Only
142 ;
143 ; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
144 ; OUT, IN, and ACK to HLTF2 routine.
145 ;
146 Q:'$D(HLFS)
147 I HLMTN="ACK"!(HLMTN="MCF")!(HLMTN="ORR") Q:'$D(HLMSA) D ACK(HLMSA,"O",$G(HLDA)) Q
148 ;
149 N HLDAI S HLDA=0
150 I $D(HLNDAP),HLMID]"" D
151 .F S HLDA=+$O(^HL(772,"AH",+$P($G(HLNDAP0),U,12),HLMID,HLDA)) Q:'HLDA!($P($G(^HL(772,+HLDA,0)),U,4)="I")
152 .I HLDA D
153 ..S HLDT=+$P($G(^HL(772,HLDA,0)),"^"),HLDT1=$$HLDATE^HLFNC(HLDT)
154 ..K ^HL(772,HLDA,"IN")
155 .I $D(HLMSA),$P(HLMSA,HLFS,3)]"" D
156 ..S HLDAI=0
157 ..F S HLDAI=$O(^HL(772,"AH",+$P($G(HLNDAP0),U,12),$P(HLMSA,HLFS,3),HLDAI)) Q:'HLDAI!($P($G(^HL(772,+HLDAI,0)),U,4)="O")
158 ..I 'HLDAI K HLDAI
159 ;
160 ; patch HL*1.6*122: MPI-client/server
161 ; I 'HLDA D CREATE(.HLMID,.HLDA,.HLDT,.HLDT1) K HLZ
162 I 'HLDA D CREATE^HLTF(.HLMID,.HLDA,.HLDT,.HLDT1) K HLZ
163 ;
164 D STUFF^HLTF0("I")
165 N HLAC S HLAC=$S($D(HLERR):4,1:1) D STATUS^HLTF0(HLDA,HLAC,$G(HLMSG))
166 ;
167 D MERGE15^HLTF1("G",HLDA,"HLR",HLTIME)
168 ;
169 I '$D(HLERR),$D(HLMSA),$D(HLDAI) D
170 .N HLAC,HLERR,HLMSG I $P(HLMSA,HLFS,4)]"" S HLERR=$P(HLMSA,HLFS,4)
171 .S HLAC=$P(HLMSA,HLFS,2) I HLAC'="AA" S HLMSG=$S(HLAC="AR":"Application Reject",1:"Application Error")_" - "_HLERR
172 .S HLAC=$S(HLAC'="AA":4,1:3) D STATUS^HLTF0(HLDAI,HLAC,$G(HLMSG))
173 Q
174 ;
175ACK(HLMSA,HLIO,HLDA) ;Process 'ACK' Message Type - Version 1.5 Interface Only
176 ;
177 ; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
178 ; OUT, IN, and ACK to HLTF2 routine.
179 ;
180 ; To determine the correct message to link the ACK, HLIO is used.
181 ; For an ack from DHCP (original message from remote system) then
182 ; HLIO should be "I" so that the correct inbound message is ack-ed. For
183 ; an inbound ack (original message outbound from DHCP) HLIO should be
184 ; "O". This distinction must be made due to the possible duplicate
185 ; message ids from a bi-direction interface.
186 ;
187 ; Input : MSA - MSA from ACK message.
188 ; HLIO - Either "I" or "O" : See note above.
189 ;Output : None
190 ;
191 N HLAC,HLMIDI
192 ;-- set up required vars
193 S HLAC=$P(HLMSA,HLFS,2),HLMIDI=$P(HLMSA,HLFS,3)
194 ;-- quit
195 Q:HLMIDI']""!(HLAC']"")!('$D(HLNDAP))
196 ;-- find message to ack
197 I '$G(HLDA) S HLDA=0 D
198 . F S HLDA=+$O(^HL(772,"AH",+$P($G(HLNDAP0),U,12),HLMIDI,HLDA)) Q:'HLDA!($P($G(^HL(772,+HLDA,0)),U,4)=HLIO)
199 ;-- quit if no message
200 Q:'$D(^HL(772,+HLDA,0))
201 ;-- check for error
202 I $P(HLMSA,HLFS,4)]"" N HLERR S HLERR=$P(HLMSA,HLFS,4)
203 I $D(HLERR),'$D(HLMSG) N HLMSG S HLMSG="Error During Receipt of Acknowledgement Message"_$S(HLAC="AR":" - Application Reject",HLAC="AE":" - Application Error",1:"")_" - "_HLERR
204 ;-- update status
205 S HLAC=$S(HLMTN="MCF":2,HLAC'="AA":4,1:3)
206 D STATUS^HLTF0(HLDA,HLAC,$G(HLMSG))
207 Q
208 ;
Note: See TracBrowser for help on using the repository browser.