source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLTF.m@ 1005

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

revised back to 6/30/08 version
File size: 9.0 KB
Line 
1HLTF ;AISC/SAW,JRP-Create/Process Message Text File Entries ;01/23/06 12:56
2 ;;1.6;HEALTH LEVEL SEVEN;**1,19,43,55,109,120**;Oct 13, 1995;Build 12
3FILE ;Create Entries in files 772 and 773 for Version 1.5 Interface Only
4 D CREATE(,.HLDA,.HLDT,.HLDT1)
5 Q
6CREATE(HLMID,MTIEN,HLDT,HLDT1) ;Create entries in Message Text (#772)
7 ;
8 ;Input : HLMID = Variable in which value of message ID will be
9 ; returned (pass by reference)
10 ; MTIEN = Variable in which IEN of Message Text file entry
11 ; will be returned (pass by reference)
12 ; HLDT = Variable in which current date/time in FM internal
13 ; format will be returned (pass by reference)
14 ; HLDT1 = Variable in which current date/time in HL7 format
15 ; will be returned (pass by reference)
16 ;
17 ;Output : See above
18 ;
19 ;Notes : If HLDT has a value [upon entry], the created entries will
20 ; be given that value for their date/time (value of .01)
21 ; : Current date/time used if HLDT is not passed or invalid
22 ;
23 ;Make entry in Message Administration file
24 N Y
25 S HLDT=$G(HLDT)
26 D MT(.HLDT)
27 S Y=$$CHNGMID(MTIEN,.HLMID),HLDT1=$$HLDATE^HLFNC(HLDT)
28 Q
29TCP(HLMID,MTIEN,HLDT) ;create new message in 772 & 773 entries
30 ;used for incoming messages and outgoing responses
31 ;Input : HLMID = Variable in which value of message ID will be
32 ; returned (pass by reference)
33 ; MTIEN = Variable in which IEN of file 773 entry
34 ; will be returned (pass by reference)
35 ; HLDT = Variable in which current date/time in FM internal
36 ; format will be returned (pass by reference)
37 ;
38 S HLDT=$G(HLDT),HLMID=$G(HLMID)
39 D MT(.HLDT)
40 S MTIEN=$$MA(MTIEN,.HLMID)
41 Q
42 ;
43MT(HLX) ;Create entry in Message Text file (#772)
44 ;
45 ;Input : HLX = Date/time entry in file should be given (value of .01)
46 ; Defaults to current date/time
47 ;
48 ;Output : HLDT = Date/time of created entry (value of .01)
49 ; : HLDT1 = HLDT in HL7 format
50 ;
51 ;Notes : HLX must be in FileMan format (default value used if not)
52 ; : HLDT will be in FileMan format
53 ; : MTIEN is ien in file 772
54 ;
55 ;Check for input
56 S HLX=$G(HLX)
57 ;Declare variables
58 N DIC,DD,DO,HLCNT,HLJ,X,Y
59 F HLCNT=0:1 D Q:Y>0 H HLCNT
60 . I (HLX'?7N.1".".6N) S HLX=$$NOW^XLFDT
61 . S DIC="^HL(772,",DIC(0)="L",(HLDT,X)=HLX
62 . S Y=$$STUB772(X) ; This call substituted for D FILE^DICN by HL*1.6*109
63 . ;Entry not created - try again
64 . I Y<0 S HLX="" Q
65 . S MTIEN=+Y
66 ;***If we didn't get a record in 772, need to do something
67 I Y<0 Q
68 S HLDT1=$$HLDATE^HLFNC(HLDT)
69 Q
70 ;add to Message Admin file #773
71MA(X,HLMID) ;X=ien in file 772, HLMID=msg. id (passed by ref.)
72 ;return ien in file 773
73 Q:'$G(^HL(772,X,0)) 0
74 N DA,DD,DO,DIC,DIE,DR,HLDA,HLCNT,HLJ,Y
75 S DIC="^HLMA(",DIC(0)="L"
76 F HLCNT=0:1 D Q:Y>0 H HLCNT
77 . S Y=$$STUB773(X) ; This call substituted for D FILE^DICN by HL*1.6*109
78 ;***If we didn't get a record in 773, need to do something
79 I Y<0 Q 0
80 S HLDA=+Y,HLMID=$$MAID(HLDA,$G(HLMID))
81 Q HLDA
82 ;
83MAID(Y,HLMID) ;Determine message ID (if needed) & store message ID
84 ;Y=ien in 773, HLMID=id, Output message id
85 N HLJ
86 ;need to have id contain institution number to make unique
87 S:$G(HLMID)="" HLMID=+$P($$PARAM^HLCS2,U,6)_Y
88 S HLJ(773,Y_",",2)=HLMID
89 D FILE^HLDIE("","HLJ","","MAID","HLTF") ;HL*1.6*109
90 Q HLMID
91 ;
92CHNGMID(PTRMT,NEWID) ;Change message ID for entry in Message Text file
93 ;Input : PTRMT - Pointer to entry in Message Text file (#772)
94 ; NEWID - New message ID
95 ;Output : 0 = Success
96 ; -1^ErrorText = Error/Bad input
97 ;
98 ;Check input
99 S PTRMT=+$G(PTRMT)
100 S NEWID=$G(NEWID)
101 Q:('$D(^HL(772,PTRMT,0))) "-1^Did not pass valid pointer to Message Text file (#772)"
102 N HLJ
103 I $G(NEWID)="" S NEWID=+$P($$PARAM^HLCS2,U,6)_PTRMT
104 S HLJ(772,PTRMT_",",6)=NEWID
105 D FILE^HLDIE("","HLJ","","CHNGMID","HLTF") ; HL*1.6*109
106 Q 0
107 ;
108OUT(HLDA,HLMID,HLMTN) ;File Data in Message Text File for Outgoing Message
109 ;Version 1.5 Interface Only
110 Q:'$D(HLFS)
111 ;
112 I HLMTN="ACK"!(HLMTN="MCF")!(HLMTN="ORR") Q:'$D(HLMSA) D ACK(HLMSA,"I") Q
113 ;
114 ;-- if message contained MSA find inbound message
115 I $D(HLMSA),$D(HLNDAP),$P(HLMSA,HLFS,3)]"" D
116 . N HLDAI
117 . S HLDAI=0
118 . 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")
119 . I 'HLDAI K HLDAI
120 ;
121 D STUFF^HLTF0("O")
122 ;
123 N HLAC S HLAC=$S($D(HLERR):4,'$P(HLNDAP0,"^",10):1,1:2) D STATUS^HLTF0(HLDA,HLAC,$G(HLMSG))
124 D:$D(HLCHAR) STATS^HLTF0(HLDA,HLCHAR,$G(HLEVN))
125 ;
126 ;-- update status if MSA and found inbound message
127 I $D(HLMSA),$D(HLDAI) D
128 .N HLERR,HLMSG I $P(HLMSA,HLFS,4)]"" S HLERR=$P(HLMSA,HLFS,4)
129 .S HLAC=$P(HLMSA,HLFS,2)
130 .I HLAC'="AA" S HLMSG=$S(HLAC="AR":"Application Reject",HLAC="AE":"Application Error",1:"")_" - "_HLERR
131 .S HLAC=$S(HLAC'="AA":4,1:3) D STATUS^HLTF0(HLDAI,HLAC,$G(HLMSG))
132 Q
133 ;
134IN(HLMTN,HLMID,HLTIME) ;File Data in Message Text File for Incoming Message
135 ;Version 1.5 Interface Only
136 Q:'$D(HLFS)
137 I HLMTN="ACK"!(HLMTN="MCF")!(HLMTN="ORR") Q:'$D(HLMSA) D ACK(HLMSA,"O",$G(HLDA)) Q
138 ;
139 N HLDAI S HLDA=0
140 I $D(HLNDAP),HLMID]"" D
141 .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")
142 .I HLDA D
143 ..S HLDT=+$P($G(^HL(772,HLDA,0)),"^"),HLDT1=$$HLDATE^HLFNC(HLDT)
144 ..K ^HL(772,HLDA,"IN")
145 .I $D(HLMSA),$P(HLMSA,HLFS,3)]"" D
146 ..S HLDAI=0
147 ..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")
148 ..I 'HLDAI K HLDAI
149 ;
150 I 'HLDA D CREATE(.HLMID,.HLDA,.HLDT,.HLDT1) K HLZ
151 ;
152 D STUFF^HLTF0("I")
153 N HLAC S HLAC=$S($D(HLERR):4,1:1) D STATUS^HLTF0(HLDA,HLAC,$G(HLMSG))
154 ;
155 D MERGE15^HLTF1("G",HLDA,"HLR",HLTIME)
156 ;
157 I '$D(HLERR),$D(HLMSA),$D(HLDAI) D
158 .N HLAC,HLERR,HLMSG I $P(HLMSA,HLFS,4)]"" S HLERR=$P(HLMSA,HLFS,4)
159 .S HLAC=$P(HLMSA,HLFS,2) I HLAC'="AA" S HLMSG=$S(HLAC="AR":"Application Reject",1:"Application Error")_" - "_HLERR
160 .S HLAC=$S(HLAC'="AA":4,1:3) D STATUS^HLTF0(HLDAI,HLAC,$G(HLMSG))
161 Q
162 ;
163ACK(HLMSA,HLIO,HLDA) ;Process 'ACK' Message Type - Version 1.5 Interface Only
164 ; To determine the correct message to link the ACK, HLIO is used.
165 ; For an ack from DHCP (original message from remote system) then
166 ; HLIO should be "I" so that the correct inbound message is ack-ed. For
167 ; an inbound ack (original message outbound from DHCP) HLIO should be
168 ; "O". This distinction must be made due to the possible duplicate
169 ; message ids from a bi-direction interface.
170 ;
171 ; Input : MSA - MSA from ACK message.
172 ; HLIO - Either "I" or "O" : See note above.
173 ;Output : None
174 ;
175 N HLAC,HLMIDI
176 ;-- set up required vars
177 S HLAC=$P(HLMSA,HLFS,2),HLMIDI=$P(HLMSA,HLFS,3)
178 ;-- quit
179 Q:HLMIDI']""!(HLAC']"")!('$D(HLNDAP))
180 ;-- find message to ack
181 I '$G(HLDA) S HLDA=0 D
182 . 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)
183 ;-- quit if no message
184 Q:'$D(^HL(772,+HLDA,0))
185 ;-- check for error
186 I $P(HLMSA,HLFS,4)]"" N HLERR S HLERR=$P(HLMSA,HLFS,4)
187 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
188 ;-- update status
189 S HLAC=$S(HLMTN="MCF":2,HLAC'="AA":4,1:3)
190 D STATUS^HLTF0(HLDA,HLAC,$G(HLMSG))
191 Q
192 ;
193STUB772(FLD01,OS) ;
194 ;This function creates a new stub record in file 772. The Stub record may consist of only the 0 node with a value of "^". If a value is passed in for the .01 field it will be included in the 0 node and its "B" x-ref set.
195 ;Inputs:
196 ; OS (optional), the value of ^%ZOSF("OS")
197 ; FLD01 (optional), the value for the .01 field
198 ;Output - the function returns the ien of the newly created record
199 ;
200 N IEN
201 I '$L($G(OS)) N OS S OS=$G(^%ZOSF("OS"))
202 ;
203 ; patch HL*1.6*120, protect Else command
204 ; I OS'["DSM",OS'["OpenM" D
205 I OS'["DSM",OS'["OpenM" D I 1
206 .F L +^HLCS(869.3,1,772):10 S IEN=+$G(^HLCS(869.3,1,772))+1,^HLCS(869.3,1,772)=IEN S:$D(^HL(772,IEN)) IEN=0,^HLCS(869.3,1,772)=($O(^HL(772,":"),-1)\1) L -^HLCS(869.3,1,772) Q:IEN
207 E D
208 .F S IEN=$I(^HLCS(869.3,1,772),1) S:$D(^HL(772,IEN)) IEN=0,^HLCS(869.3,1,772)=($O(^HL(772,":"),-1)\1) Q:IEN
209 S ^HL(772,IEN,0)=$G(FLD01)_"^"
210 I $L($G(FLD01)) S ^HL(772,"B",FLD01,IEN)=""
211 Q IEN
212 ;
213STUB773(FLD01,OS) ;
214 ;This function creates a new stub record in file 772. The Stub record may consist of only the 0 node with a value of "^". If a value is passed in for the .01 field it will be included in the 0 node and its "B" x-ref set.
215 ;Inputs:
216 ; OS (optional), the value of ^%ZOSF("OS")
217 ; FLD01 (optional), the value for the .01 field
218 ;Output - the function returns the ien of the newly created record
219 ;
220 N IEN
221 I '$L($G(OS)) N OS S OS=$G(^%ZOSF("OS"))
222 ;
223 ; patch HL*1.6*120, protect Else command
224 ; I OS'["DSM",OS'["OpenM" D
225 I OS'["DSM",OS'["OpenM" D I 1
226 .F L +^HLCS(869.3,1,773):10 S IEN=+$G(^HLCS(869.3,1,773))+1,^HLCS(869.3,1,773)=IEN S:$D(^HLMA(IEN)) IEN=0,^HLCS(869.3,1,773)=($O(^HLMA(":"),-1)\1) L -^HLCS(869.3,1,773) Q:IEN
227 E D
228 .F S IEN=$I(^HLCS(869.3,1,773),1) S:$D(^HLMA(IEN)) IEN=0,^HLCS(869.3,1,773)=($O(^HLMA(":"),-1)\1) Q:IEN
229 S ^HLMA(IEN,0)=$G(FLD01)_"^"
230 I $L($G(FLD01)) S ^HLMA("B",FLD01,IEN)=""
231 Q IEN
Note: See TracBrowser for help on using the repository browser.