source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VHL.m

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

initial load of FOIAVistA 6/30/08 version

File size: 5.8 KB
Line 
1LA7VHL ;DALOI/DLR - Main Driver for incoming HL7 V1.6 messages ; Jan 12, 2005
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,46,62,64,67**;Sep 27, 1994
3 ; This routine is not meant to be invoked by name
4 ;
5 QUIT
6 ;
7 ; This routine is called by the HL7 package V1.6 to process
8 ; incoming HL7 messages. Expected variables are those
9 ; documented in the HL7 package documentation. The line
10 ; tag is called if it is entered into the PROCESSING ROUTINE
11 ; field for the server protocol.
12 ;
13ORR ; Process incoming ORR messages
14ACK ; Process incoming ACK messages
15ORM ; Process incoming ORM messages
16ORU ; Process incoming ORU messages
17 ;
18 N HLA,HLL,HLP,X,Y
19 N LA76248,LA76249,LA7AAT,LA7AERR,LA7CS,LA7DT,LA7ECH,LA7FS,LA7HLS,LA7HLSA,LA7INTYP,LA7MEDT,LA7MTYP,LA7RAP,LA7PRID,LA7RSITE,LA7SAP,LA7SEQ,LA7SSITE,LA7TYPE,LA7VER,LA7VI,LA7VJ,LA7X
20 ;
21 S DT=$$DT^XLFDT
22 S (LA76248,LA76249,LA7INTYP,LA7SEQ)=0
23 ;
24 K ^TMP("HLA",$J)
25 ;
26 ; Setup DUZ array to 'non-human' user LRLAB,HL
27 ; If user not found - send alert to G.LAB MESSAGING
28 S LA7X=$$FIND1^DIC(200,"","OX","LRLAB,HL","B","")
29 I LA7X<1 D Q
30 . N MSG
31 . S MSG="Lab Messaging - Unable to identify user 'LRLAB,HL' in NEW PERSON file"
32 . D XQA^LA7UXQA(0,LA76248,0,0,MSG,"",0)
33 D DUZ^XUP(LA7X)
34 ;
35 ; Set up LA7HLS with HL variables to build ACK message.
36 ; Handle situation when systems use different encoding characters.
37 D RSPINIT^HLFNC2(HL("EIDS"),.LA7HLS)
38 ;
39 ; Move message from HL7 global to Lab global
40 F LA7VI=1:1 X HLNEXT Q:HLQUIT'>0 D
41 . K LA7SEG
42 . I HLNODE="" Q
43 . S LA7SEG(0)=HLNODE
44 . S LA7VJ=0
45 . F S LA7VJ=$O(HLNODE(LA7VJ)) Q:'LA7VJ S LA7SEG(LA7VJ)=HLNODE(LA7VJ)
46 . I $E(LA7SEG(0),1,3)="MSH" D MSH
47 . I LA7SEQ<1 D REJECT("no MSH segment found") Q
48 . D FILE6249^LA7VHLU(LA76249,.LA7SEG)
49 ;
50 ; Update entry in 62.49
51 ; Change status to (Q)ueued for processing from (B)uilding
52 I LA76249>0,$P($G(^LAHM(62.49,LA76249,0)),"^",3)'="E" D
53 . N FDA,LA7ERR
54 . S FDA(1,62.49,LA76249_",",2)="Q"
55 . D FILE^DIE("","FDA(1)","LA7ERR(1)")
56 ;
57 ; Release lock on file #62.49 entry (tells LA7VIN message is stored).
58 I LA76249>0 L -^LAHM(62.49,LA76249)
59 ;
60 ; Run processing routine
61 I '$D(^LAHM(62.48,LA76248,1)) D CREATE^LA7LOG(5)
62 I $D(^LAHM(62.48,LA76248,1)) X ^(1)
63 ;
64 ; Don't (ACK)nowledge ACK or ORR messages
65 I $G(LA7MTYP)="ACK"!($G(LA7MTYP)="ORR") Q
66 ;
67 ; No application acknowledgement
68 I $G(LA7AAT(1))="NE" Q
69 ;
70 ; Other system only wants ACK on successful completion condition and we found an error.
71 I $G(LA7AERR)'="",$G(LA7AAT(1))="SU" Q
72 ;
73 ; Other system only wants ACK on error/reject condition
74 I $G(LA7AERR)="",$G(LA7AAT(1))="ER" Q
75 ;
76 ; If POC interface and no error then quit - send application ack after
77 ; processing message.
78 I $G(LA7AERR)="",LA7INTYP>19,LA7INTYP<30 S X=$$DONTPURG^HLUTIL() Q
79 ;
80 ; If POC interface and error then setup HLL array
81 I LA7INTYP>19,LA7INTYP<30 D
82 . S HLL("SET FOR APP ACK")=1
83 . S HLL("LINKS",1)=HL("EIDS")_"^"_$P(LA76248(0),"^")
84 ;
85 ; HL7 returns this as ACK if no errors found
86 I $G(LA7AERR)="" S HLA("HLA",1)="MSA"_LA7HLS("RFS")_"AA"_LA7HLS("RFS")_HL("MID")
87 ;
88 ; Send ACK message
89 I $D(HLA("HLA")) D
90 . S HLP("NAMESPACE")="LA"
91 . D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.LA7HLSA,"",.HLP)
92 ;
93 I $D(^TMP("HLA",$J)) D
94 . S HLP("NAMESPACE")="LA"
95 . D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.LA7HLSA,"",.HLP)
96 ;
97 Q
98 ;
99 ;
100MSH ;;MSH
101 ;
102 N LA7CFIG,LA7MID,LA7NOW,X
103 ;
104 S LA7SEQ=1
105 S LA7FS=$E(LA7SEG(0),4)
106 S LA7ECH=$E(LA7SEG(0),5,8)
107 S LA7CS=$E(LA7ECH,1)
108 ; Sending application
109 S LA7SAP=$P($$P^LA7VHLU(.LA7SEG,3,LA7FS),LA7CS)
110 ; Sending facility
111 S LA7SSITE=$P($$P^LA7VHLU(.LA7SEG,4,LA7FS),LA7CS)
112 ; Receiving application
113 S LA7RAP=$P($$P^LA7VHLU(.LA7SEG,5,LA7FS),LA7CS)
114 ; Receiving facility
115 S LA7RSITE=$P($$P^LA7VHLU(.LA7SEG,6,LA7FS),LA7CS)
116 ; Date/time of message
117 S LA7MEDT=$$P^LA7VHLU(.LA7SEG,7,LA7FS)
118 ; Message type/trigger event/message structure
119 S X=$$P^LA7VHLU(.LA7SEG,9,LA7FS)
120 S LA7MTYP=$P(X,LA7CS),LA7MTYP("EVN")=$P(X,LA7CS,2),LA7MTYP("MSGSTR")=$P(X,LA7CS,3)
121 ; Message Control ID
122 S LA7MID=$$P^LA7VHLU(.LA7SEG,10,LA7FS)
123 ; Processing ID
124 S LA7PRID=$$P^LA7VHLU(.LA7SEG,11,LA7FS)
125 ; Version ID
126 S LA7VER=$$P^LA7VHLU(.LA7SEG,12,LA7FS)
127 ; Accept acknowledgement type
128 S LA7AAT(0)=$$P^LA7VHLU(.LA7SEG,15,LA7FS)
129 ; Application acknowledgement type
130 S LA7AAT(1)=$$P^LA7VHLU(.LA7SEG,16,LA7FS)
131 ;
132 S LA7CFIG=LA7SAP_LA7SSITE_LA7RAP_LA7RSITE
133 S X=LA7CFIG X ^%ZOSF("LPC")
134 S LA76248=+$O(^LAHM(62.48,"C",$E(LA7CFIG,1,27)_Y,0))
135 I 'LA76248 S LA76248=+$O(^LAHM(62.48,"B",LA7SAP,0))
136 I 'LA76248,$E(LA7SAP,1,11)="LA7V REMOTE" S LA76248=+$O(^LAHM(62.48,"B","LA7V COLLECTION "_$P(LA7SAP," ",3),0))
137 I 'LA76248 D Q
138 . D CREATE^LA7LOG(1)
139 . D REJECT("no config in 62.48")
140 ;
141 ; Determine interface type
142 S LA7INTYP=+$P(^LAHM(62.48,LA76248,0),"^",9)
143 ;
144 I '$P($G(^LAHM(62.48,LA76248,0)),"^",3) D
145 . D CREATE^LA7LOG(3)
146 . D REJECT("config is inactive")
147 ;
148 ; store incoming message in ^LAHM(62.49)
149 S LA76249=$$INIT6249^LA7VHLU
150 I LA76249<1 Q
151 ;
152 ; update entry in 62.49
153 N FDA,LA7ERR
154 I $G(LA76248) S FDA(1,62.49,LA76249_",",.5)=LA76248
155 S FDA(1,62.49,LA76249_",",1)="I"
156 S FDA(1,62.49,LA76249_",",3)=3
157 S FDA(1,62.49,LA76249_",",102)=LA7SAP
158 S FDA(1,62.49,LA76249_",",103)=LA7SSITE
159 S FDA(1,62.49,LA76249_",",104)=LA7RAP
160 S FDA(1,62.49,LA76249_",",105)=LA7RSITE
161 S FDA(1,62.49,LA76249_",",106)=LA7MEDT
162 S FDA(1,62.49,LA76249_",",108)=LA7MTYP
163 S FDA(1,62.49,LA76249_",",109)=LA7MID
164 S FDA(1,62.49,LA76249_",",110)=LA7PRID
165 S FDA(1,62.49,LA76249_",",111)=LA7VER
166 S FDA(1,62.49,LA76249_",",700)=HL("EID")_";"_HLMTIENS_";"_HL("EIDS")
167 D FILE^DIE("","FDA(1)","LA7ERR(1)")
168 ;
169 Q
170 ;
171 ;
172REJECT(LA7AR) ; Build a reject segment if the incoming message could not be processed.
173 ; Setting HLA("HLA",1) conforms to HL7 package rules for acknowledgements
174 ; LA7AR is a free text string that is included in the reject
175 ; message for debugging purposes.
176 ;
177 S HLA("HLA",1)="MSA"_LA7HLS("RFS")_"AR"_LA7HLS("RFS")_HL("MID")_LA7HLS("RFS")_LA7AR
178 S LA7AERR=LA7AR
179 Q
Note: See TracBrowser for help on using the repository browser.