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

LA7HL7.m

Go to the documentation of this file. 
  1. LA7HL7 ;DALISC/JRR - Main Driver for incoming HL7 messages ; 12/3/1997
  1.  ;;5.2;LAB MESSAGING;**17,27**;Sep 27, 1994
  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 ;Process incoming ORU
  1.  N X,Y
  1.  S LA7TYPE="HL7"
  1.  S LA7MSH=$G(^HL(772,HLDA,"IN",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(LA7MSH,LA7FS,LA7)
  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.  S LA71=0
  1.  F LA7=0:0 S LA7=$O(^HL(772,HLDA,"IN",LA7)) Q:'LA7  D
  1.  . S LA71=LA7 ;number of records in multiple
  1.  . S ^LAHM(62.49,LA76249,150,LA7,0)=^HL(772,HLDA,"IN",LA7,0)
  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
  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