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
LA7HL7 ;DALISC/JRR - Main Driver for incoming HL7 messages ; 12/3/1997
+1 ;;5.2;LAB MESSAGING;**17,27**;Sep 27, 1994
+2 ;This routine is not meant to be invoked by name
+3 QUIT
+4 ;This routine is called by the HL7 package V1.5 to process
+5 ;incoming HL7 messages. Expected variables are those
+6 ;documented in the HL7 package documentation. The line
+7 ;tag is called if it is entered into the PROCESSING ROUTINE
+8 ;field in the HL7 SEGMENT NAME file (771.3). Each 'message
+9 ;type' is processed at the line tag of the same name.
+10 ;
ORU ;Process incoming ORU
+1 NEW X,Y
+2 SET LA7TYPE="HL7"
+3 SET LA7MSH=$GET(^HL(772,HLDA,"IN",1,0))
+4 IF LA7MSH=""
DO REJECT("no MSH in 772")
GOTO EXIT
+5 SET LA7FS=$EXTRACT(LA7MSH,4)
+6 SET LA7CFIG=""
+7 FOR LA7=3:1:6
SET LA7CFIG=LA7CFIG_$PIECE(LA7MSH,LA7FS,LA7)
+8 SET X=LA7CFIG
XECUTE ^%ZOSF("LPC")
+9 SET LA76248=$ORDER(^LAHM(62.48,"C",$EXTRACT(LA7CFIG,1,27)_Y,0))
+10 IF 'LA76248
Begin DoDot:1
+11 DO CREATE^LA7LOG(1)
DO REJECT("no config in 62.48")
End DoDot:1
GOTO EXIT
+12 IF '$PIECE($GET(^LAHM(62.48,LA76248,0)),"^",3)
Begin DoDot:1
+13 DO CREATE^LA7LOG(3)
DO REJECT("config is inactive")
End DoDot:1
GOTO EXIT
ORUPUT ;store incoming message in ^LAHM(62.49,
+1 SET LA7DTIM=$$NOW^XLFDT
+2 ;create a new entry in the queue file
+3 ; Lock zeroth node of file.
LOCK +^LAHM(62.49,0):99999
IF '$TEST
QUIT
+4 FOR X=$PIECE(^LAHM(62.49,0),"^",3):1
IF '$DATA(^LAHM(62.49,X))
QUIT
+5 SET LA76249=X
+6 ; Lock entry in file 62.49.
LOCK +^LAHM(62.49,LA76249):99999
IF '$TEST
LOCK -^LAHM(62.49,0)
QUIT
+7 KILL DD,DO
+8 SET DIC="^LAHM(62.49,"
SET DIC(0)="LF"
+9 SET DINUM=X
+10 SET DIC("DR")="1////I;3////3;4////"_LA7DTIM_";.5////"_LA76248
+11 SET DIC("DR")=DIC("DR")_";2////Q"
+12 DO FILE^DICN
+13 ; Release lock on zeroth node.
LOCK -^LAHM(62.49,0)
+14 ;convert field separators to up arrows so can store in fileman global
+15 IF LA7FS'="^"
SET LA7MSH=$TRANSLATE(LA7MSH,"^"," ")
SET LA7MSH=$TRANSLATE(LA7MSH,LA7FS,"^")
+16 ;each field in header is field in file
SET ^LAHM(62.49,LA76249,100)=LA7MSH
+17 ;move message from HL7 global to Lab global
+18 SET LA71=0
+19 FOR LA7=0:0
SET LA7=$ORDER(^HL(772,HLDA,"IN",LA7))
IF 'LA7
QUIT
Begin DoDot:1
+20 ;number of records in multiple
SET LA71=LA7
+21 SET ^LAHM(62.49,LA76249,150,LA7,0)=^HL(772,HLDA,"IN",LA7,0)
End DoDot:1
+22 SET ^LAHM(62.49,LA76249,150,0)="^^"_LA71_"^"_LA71_"^"_DT
+23 ; Release lock on entry in file 62.49 (used by LA7UIIN to know when message is complete).
LOCK -^LAHM(62.49,LA76249)
+24 ;HL7 returns this as ack
SET HLSDATA(2)="MSA"_HLFS_"AA"_HLFS_HLMID
+25 ;
+26 IF '$DATA(^LAHM(62.48,LA76248,1))
DO CREATE^LA7LOG(5)
+27 ;run processing routine
IF $DATA(^LAHM(62.48,LA76248,1))
XECUTE ^(1)
+28 ;
EXIT KILL %,%H,%I,DIC,DINUM,DTOUT,DUOUT,LA7,LA71,LA76248,LA76249,LA7AR
+1 KILL LA7CFIG,LA7DTIM,LA7FS,LA7MSH,LA7TYPE,X,Y
+2 ;return control to HLCHK which will send MSA
QUIT
+3 ;
REJECT(LA7AR) ;build a reject segment if the incoming message
+1 ;could not be processed. After calling this line tag, the
+2 ;routine should quit and return control to HLCHK which will
+3 ;send the MSA to the sending system. Setting HLSDATA(2)
+4 ;conforms to HL7 package rules for acknowledgements
+5 ;LA7AR is a free text string that is included in the reject
+6 ;message for debugging purposes.
+7 SET HLSDATA(2)="MSA"_HLFS_"AR"_HLFS_HLMID_HLFS_LA7AR
+8 ;quit REJECT
QUIT
+9 ;
Z ;LA7HL7 ;DALISC/JRR - Main Driver for incoming HL7 message
