70 lines
3.0 KiB
Mathematica
70 lines
3.0 KiB
Mathematica
LA7HL7 ;DALISC/JRR - Main Driver for incoming HL7 messages ; 12/3/1997
|
|
;;5.2;LAB MESSAGING;**17,27**;Sep 27, 1994
|
|
;This routine is not meant to be invoked by name
|
|
QUIT
|
|
;This routine is called by the HL7 package V1.5 to process
|
|
;incoming HL7 messages. Expected variables are those
|
|
;documented in the HL7 package documentation. The line
|
|
;tag is called if it is entered into the PROCESSING ROUTINE
|
|
;field in the HL7 SEGMENT NAME file (771.3). Each 'message
|
|
;type' is processed at the line tag of the same name.
|
|
;
|
|
ORU ;Process incoming ORU
|
|
N X,Y
|
|
S LA7TYPE="HL7"
|
|
S LA7MSH=$G(^HL(772,HLDA,"IN",1,0))
|
|
I LA7MSH="" D REJECT("no MSH in 772") G EXIT
|
|
S LA7FS=$E(LA7MSH,4)
|
|
S LA7CFIG=""
|
|
F LA7=3:1:6 S LA7CFIG=LA7CFIG_$P(LA7MSH,LA7FS,LA7)
|
|
S X=LA7CFIG X ^%ZOSF("LPC")
|
|
S LA76248=$O(^LAHM(62.48,"C",$E(LA7CFIG,1,27)_Y,0))
|
|
I 'LA76248 D GOTO EXIT
|
|
. D CREATE^LA7LOG(1) D REJECT("no config in 62.48")
|
|
I '$P($G(^LAHM(62.48,LA76248,0)),"^",3) D GOTO EXIT
|
|
. D CREATE^LA7LOG(3) D REJECT("config is inactive")
|
|
ORUPUT ;store incoming message in ^LAHM(62.49,
|
|
S LA7DTIM=$$NOW^XLFDT
|
|
;create a new entry in the queue file
|
|
L +^LAHM(62.49,0):99999 Q:'$T ; Lock zeroth node of file.
|
|
F X=$P(^LAHM(62.49,0),"^",3):1 Q:'$D(^LAHM(62.49,X))
|
|
S LA76249=X
|
|
L +^LAHM(62.49,LA76249):99999 I '$T L -^LAHM(62.49,0) Q ; Lock entry in file 62.49.
|
|
K DD,DO
|
|
S DIC="^LAHM(62.49,",DIC(0)="LF"
|
|
S DINUM=X
|
|
S DIC("DR")="1////I;3////3;4////"_LA7DTIM_";.5////"_LA76248
|
|
S DIC("DR")=DIC("DR")_";2////Q"
|
|
DO FILE^DICN
|
|
L -^LAHM(62.49,0) ; Release lock on zeroth node.
|
|
;convert field separators to up arrows so can store in fileman global
|
|
I LA7FS'="^" S LA7MSH=$TR(LA7MSH,"^"," "),LA7MSH=$TR(LA7MSH,LA7FS,"^")
|
|
S ^LAHM(62.49,LA76249,100)=LA7MSH ;each field in header is field in file
|
|
;move message from HL7 global to Lab global
|
|
S LA71=0
|
|
F LA7=0:0 S LA7=$O(^HL(772,HLDA,"IN",LA7)) Q:'LA7 D
|
|
. S LA71=LA7 ;number of records in multiple
|
|
. S ^LAHM(62.49,LA76249,150,LA7,0)=^HL(772,HLDA,"IN",LA7,0)
|
|
S ^LAHM(62.49,LA76249,150,0)="^^"_LA71_"^"_LA71_"^"_DT
|
|
L -^LAHM(62.49,LA76249) ; Release lock on entry in file 62.49 (used by LA7UIIN to know when message is complete).
|
|
S HLSDATA(2)="MSA"_HLFS_"AA"_HLFS_HLMID ;HL7 returns this as ack
|
|
;
|
|
I '$D(^LAHM(62.48,LA76248,1)) D CREATE^LA7LOG(5)
|
|
I $D(^LAHM(62.48,LA76248,1)) X ^(1) ;run processing routine
|
|
;
|
|
EXIT K %,%H,%I,DIC,DINUM,DTOUT,DUOUT,LA7,LA71,LA76248,LA76249,LA7AR
|
|
K LA7CFIG,LA7DTIM,LA7FS,LA7MSH,LA7TYPE,X,Y
|
|
QUIT ;return control to HLCHK which will send MSA
|
|
;
|
|
REJECT(LA7AR) ;build a reject segment if the incoming message
|
|
;could not be processed. After calling this line tag, the
|
|
;routine should quit and return control to HLCHK which will
|
|
;send the MSA to the sending system. Setting HLSDATA(2)
|
|
;conforms to HL7 package rules for acknowledgements
|
|
;LA7AR is a free text string that is included in the reject
|
|
;message for debugging purposes.
|
|
S HLSDATA(2)="MSA"_HLFS_"AR"_HLFS_HLMID_HLFS_LA7AR
|
|
QUIT ;quit REJECT
|
|
;
|
|
Z ;LA7HL7 ;DALISC/JRR - Main Driver for incoming HL7 message
|