Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BLRHL7

BLRHL7.m

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