- 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