| [613] | 1 | LA7HL7 ;DALISC/JRR - Main Driver for incoming HL7 messages ; 12/3/1997
|
|---|
| 2 | ;;5.2;LAB MESSAGING;**17,27**;Sep 27, 1994
|
|---|
| 3 | ;This routine is not meant to be invoked by name
|
|---|
| 4 | QUIT
|
|---|
| 5 | ;This routine is called by the HL7 package V1.5 to process
|
|---|
| 6 | ;incoming HL7 messages. Expected variables are those
|
|---|
| 7 | ;documented in the HL7 package documentation. The line
|
|---|
| 8 | ;tag is called if it is entered into the PROCESSING ROUTINE
|
|---|
| 9 | ;field in the HL7 SEGMENT NAME file (771.3). Each 'message
|
|---|
| 10 | ;type' is processed at the line tag of the same name.
|
|---|
| 11 | ;
|
|---|
| 12 | ORU ;Process incoming ORU
|
|---|
| 13 | N X,Y
|
|---|
| 14 | S LA7TYPE="HL7"
|
|---|
| 15 | S LA7MSH=$G(^HL(772,HLDA,"IN",1,0))
|
|---|
| 16 | I LA7MSH="" D REJECT("no MSH in 772") G EXIT
|
|---|
| 17 | S LA7FS=$E(LA7MSH,4)
|
|---|
| 18 | S LA7CFIG=""
|
|---|
| 19 | F LA7=3:1:6 S LA7CFIG=LA7CFIG_$P(LA7MSH,LA7FS,LA7)
|
|---|
| 20 | S X=LA7CFIG X ^%ZOSF("LPC")
|
|---|
| 21 | S LA76248=$O(^LAHM(62.48,"C",$E(LA7CFIG,1,27)_Y,0))
|
|---|
| 22 | I 'LA76248 D GOTO EXIT
|
|---|
| 23 | . D CREATE^LA7LOG(1) D REJECT("no config in 62.48")
|
|---|
| 24 | I '$P($G(^LAHM(62.48,LA76248,0)),"^",3) D GOTO EXIT
|
|---|
| 25 | . D CREATE^LA7LOG(3) D REJECT("config is inactive")
|
|---|
| 26 | ORUPUT ;store incoming message in ^LAHM(62.49,
|
|---|
| 27 | S LA7DTIM=$$NOW^XLFDT
|
|---|
| 28 | ;create a new entry in the queue file
|
|---|
| 29 | L +^LAHM(62.49,0):99999 Q:'$T ; Lock zeroth node of file.
|
|---|
| 30 | F X=$P(^LAHM(62.49,0),"^",3):1 Q:'$D(^LAHM(62.49,X))
|
|---|
| 31 | S LA76249=X
|
|---|
| 32 | L +^LAHM(62.49,LA76249):99999 I '$T L -^LAHM(62.49,0) Q ; Lock entry in file 62.49.
|
|---|
| 33 | K DD,DO
|
|---|
| 34 | S DIC="^LAHM(62.49,",DIC(0)="LF"
|
|---|
| 35 | S DINUM=X
|
|---|
| 36 | S DIC("DR")="1////I;3////3;4////"_LA7DTIM_";.5////"_LA76248
|
|---|
| 37 | S DIC("DR")=DIC("DR")_";2////Q"
|
|---|
| 38 | DO FILE^DICN
|
|---|
| 39 | L -^LAHM(62.49,0) ; Release lock on zeroth node.
|
|---|
| 40 | ;convert field separators to up arrows so can store in fileman global
|
|---|
| 41 | I LA7FS'="^" S LA7MSH=$TR(LA7MSH,"^"," "),LA7MSH=$TR(LA7MSH,LA7FS,"^")
|
|---|
| 42 | S ^LAHM(62.49,LA76249,100)=LA7MSH ;each field in header is field in file
|
|---|
| 43 | ;move message from HL7 global to Lab global
|
|---|
| 44 | S LA71=0
|
|---|
| 45 | F LA7=0:0 S LA7=$O(^HL(772,HLDA,"IN",LA7)) Q:'LA7 D
|
|---|
| 46 | . S LA71=LA7 ;number of records in multiple
|
|---|
| 47 | . S ^LAHM(62.49,LA76249,150,LA7,0)=^HL(772,HLDA,"IN",LA7,0)
|
|---|
| 48 | S ^LAHM(62.49,LA76249,150,0)="^^"_LA71_"^"_LA71_"^"_DT
|
|---|
| 49 | L -^LAHM(62.49,LA76249) ; Release lock on entry in file 62.49 (used by LA7UIIN to know when message is complete).
|
|---|
| 50 | S HLSDATA(2)="MSA"_HLFS_"AA"_HLFS_HLMID ;HL7 returns this as ack
|
|---|
| 51 | ;
|
|---|
| 52 | I '$D(^LAHM(62.48,LA76248,1)) D CREATE^LA7LOG(5)
|
|---|
| 53 | I $D(^LAHM(62.48,LA76248,1)) X ^(1) ;run processing routine
|
|---|
| 54 | ;
|
|---|
| 55 | EXIT K %,%H,%I,DIC,DINUM,DTOUT,DUOUT,LA7,LA71,LA76248,LA76249,LA7AR
|
|---|
| 56 | K LA7CFIG,LA7DTIM,LA7FS,LA7MSH,LA7TYPE,X,Y
|
|---|
| 57 | QUIT ;return control to HLCHK which will send MSA
|
|---|
| 58 | ;
|
|---|
| 59 | REJECT(LA7AR) ;build a reject segment if the incoming message
|
|---|
| 60 | ;could not be processed. After calling this line tag, the
|
|---|
| 61 | ;routine should quit and return control to HLCHK which will
|
|---|
| 62 | ;send the MSA to the sending system. Setting HLSDATA(2)
|
|---|
| 63 | ;conforms to HL7 package rules for acknowledgements
|
|---|
| 64 | ;LA7AR is a free text string that is included in the reject
|
|---|
| 65 | ;message for debugging purposes.
|
|---|
| 66 | S HLSDATA(2)="MSA"_HLFS_"AR"_HLFS_HLMID_HLFS_LA7AR
|
|---|
| 67 | QUIT ;quit REJECT
|
|---|
| 68 | ;
|
|---|
| 69 | Z ;LA7HL7 ;DALISC/JRR - Main Driver for incoming HL7 message
|
|---|
