BLRHL7 ;cmi/anch/maw - Main Driver for incoming HL7 messages 12/3/1997 ; 22-Oct-2013 09:22 ; MAW
;;5.2;IHS LABORATORY;**1027,1033**;NOV 01, 1997
;
;;5.2;LAB MESSAGING;**17,27**;Sep 27, 1994
;this will be the GIS equivalent of LA7HL7
;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(HLDA) ;EP - Process incoming ORU
N X,Y
S LA7TYPE="HL7"
S LA7MSH=$G(^INTHU(HLDA,3,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($P(LA7MSH,LA7FS,LA7),"^") ;dont get anything in the components
S LA7CFIG=$TR(LA7CFIG,"^") ;cmi/maw 10/08/2007
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
;cmi/flag/maw modified to account for GIS Line Split 7/21/2004
S LA71=0
S BLRSEGF=""
F LA7=0:0 S LA7=$O(^INTHU(HLDA,3,LA7)) Q:'LA7 D
. S BLRSEG=$G(^INTHU(HLDA,3,LA7,0))
. S BLRSEG=$TR(BLRSEG,$C(10)) ;cmi/anch/maw 8/15/2007 added due to UNILAB passing a $C(10) in at the beginning of each line
. S BLRLEN=$L(BLRSEG)
. I $E(BLRSEG,(BLRLEN-3),BLRLEN)="|CR|" D Q
.. I $L($G(BLRSEGF))>0 S BLRSEG=BLRSEGF_BLRSEG
.. S LA71=LA71+1 ;number of records in multiple
.. S ^LAHM(62.49,LA76249,150,LA71,0)=$S(BLRSEG="CR":" ",1:$P(BLRSEG,"|CR|",1)) ;3/3/2006 cmi/maw to make a null line have a blank line
.. I $P($G(^LAHM(62.48,LA76248,0)),U,9)=10 S LA71=LA71+1 ;cmi/maw test for new LEDI filing 3/3/2010
.. I $P($G(^LAHM(62.48,LA76248,0)),U,9)=10 S ^LAHM(62.49,LA76249,150,LA71,0)="" ;test for new LEDI filing 3/3/2010
.. S BLRSEGF=""
. S BLRSEGF=BLRSEGF_BLRSEG
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,BLRSEGF,BLRSEG
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
BLRHL7 ;cmi/anch/maw - Main Driver for incoming HL7 messages 12/3/1997 ; 22-Oct-2013 09:22 ; MAW
+1 ;;5.2;IHS LABORATORY;**1027,1033**;NOV 01, 1997
+2 ;
+3 ;;5.2;LAB MESSAGING;**17,27**;Sep 27, 1994
+4 ;this will be the GIS equivalent of LA7HL7
+5 ;This routine is not meant to be invoked by name
+6 QUIT
+7 ;This routine is called by the HL7 package V1.5 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 in the HL7 SEGMENT NAME file (771.3). Each 'message
+12 ;type' is processed at the line tag of the same name.
+13 ;
ORU(HLDA) ;EP - Process incoming ORU
+1 NEW X,Y
+2 SET LA7TYPE="HL7"
+3 SET LA7MSH=$GET(^INTHU(HLDA,3,1,0))
+4 IF LA7MSH=""
DO REJECT("no MSH in 772")
GOTO EXIT
+5 SET LA7FS=$EXTRACT(LA7MSH,4)
+6 SET LA7CFIG=""
+7 ;dont get anything in the components
FOR LA7=3:1:6
SET LA7CFIG=LA7CFIG_$PIECE($PIECE(LA7MSH,LA7FS,LA7),"^")
+8 ;cmi/maw 10/08/2007
SET LA7CFIG=$TRANSLATE(LA7CFIG,"^")
+9 SET X=LA7CFIG
XECUTE ^%ZOSF("LPC")
+10 SET LA76248=$ORDER(^LAHM(62.48,"C",$EXTRACT(LA7CFIG,1,27)_Y,0))
+11 IF 'LA76248
Begin DoDot:1
+12 DO CREATE^LA7LOG(1)
DO REJECT("no config in 62.48")
End DoDot:1
GOTO EXIT
+13 IF '$PIECE($GET(^LAHM(62.48,LA76248,0)),"^",3)
Begin DoDot:1
+14 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 ;cmi/flag/maw modified to account for GIS Line Split 7/21/2004
+19 SET LA71=0
+20 SET BLRSEGF=""
+21 FOR LA7=0:0
SET LA7=$ORDER(^INTHU(HLDA,3,LA7))
IF 'LA7
QUIT
Begin DoDot:1
+22 SET BLRSEG=$GET(^INTHU(HLDA,3,LA7,0))
+23 ;cmi/anch/maw 8/15/2007 added due to UNILAB passing a $C(10) in at the beginning of each line
SET BLRSEG=$TRANSLATE(BLRSEG,$CHAR(10))
+24 SET BLRLEN=$LENGTH(BLRSEG)
+25 IF $EXTRACT(BLRSEG,(BLRLEN-3),BLRLEN)="|CR|"
Begin DoDot:2
+26 IF $LENGTH($GET(BLRSEGF))>0
SET BLRSEG=BLRSEGF_BLRSEG
+27 ;number of records in multiple
SET LA71=LA71+1
+28 ;3/3/2006 cmi/maw to make a null line have a blank line
SET ^LAHM(62.49,LA76249,150,LA71,0)=$SELECT(BLRSEG="CR":" ",1:$PIECE(BLRSEG,"|CR|",1))
+29 ;cmi/maw test for new LEDI filing 3/3/2010
IF $PIECE($GET(^LAHM(62.48,LA76248,0)),U,9)=10
SET LA71=LA71+1
+30 ;test for new LEDI filing 3/3/2010
IF $PIECE($GET(^LAHM(62.48,LA76248,0)),U,9)=10
SET ^LAHM(62.49,LA76249,150,LA71,0)=""
+31 SET BLRSEGF=""
End DoDot:2
QUIT
+32 SET BLRSEGF=BLRSEGF_BLRSEG
End DoDot:1
+33 SET ^LAHM(62.49,LA76249,150,0)="^^"_LA71_"^"_LA71_"^"_DT
+34 ; Release lock on entry in file 62.49 (used by LA7UIIN to know when message is complete).
LOCK -^LAHM(62.49,LA76249)
+35 ;S HLSDATA(2)="MSA"_HLFS_"AA"_HLFS_HLMID ;HL7 returns this as ack
+36 ;
+37 IF '$DATA(^LAHM(62.48,LA76248,1))
DO CREATE^LA7LOG(5)
+38 ;run processing routine
IF $DATA(^LAHM(62.48,LA76248,1))
XECUTE ^(1)
+39 ;
EXIT KILL %,%H,%I,DIC,DINUM,DTOUT,DUOUT,LA7,LA71,LA76248,LA76249,LA7AR
+1 KILL LA7CFIG,LA7DTIM,LA7FS,LA7MSH,LA7TYPE,X,Y,BLRSEGF,BLRSEG
+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 ;S HLSDATA(2)="MSA"_HLFS_"AR"_HLFS_HLMID_HLFS_LA7AR
+8 ;quit REJECT
QUIT
+9 ;
Z ;LA7HL7 ;DALISC/JRR - Main Driver for incoming HL7 message
