| 1 | EASPREC2 ;ALB/KCL - ROUTE INCOMING HL7 (ORU) MESSAGES BY EVENT TYPE ; 11/22/02 1:56pm
|
|---|
| 2 | ;;1.0;ENROLLMENT APPLICATION SYSTEM;**23**; 21-OCT-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ; This routine will process (ORU) HL7 messages received from the Edb
|
|---|
| 6 | ; via e*Gate. Currently only the Z06 is being transmitted.
|
|---|
| 7 | ; Event type code indicating type of transmission is in the BHS segment.
|
|---|
| 8 | ; Routines based on type will be called to process these messages. For
|
|---|
| 9 | ; each batch an ACK will be sent to the Edb indicating errors found.
|
|---|
| 10 | ; If any errors are found a batch message with AE(indicating error(s))
|
|---|
| 11 | ; is sent. If no errors only a MSH and MSA with AA(no errors) is sent.
|
|---|
| 12 | ; The following event type codes are processed in the following
|
|---|
| 13 | ; routine(s):
|
|---|
| 14 | ;
|
|---|
| 15 | ; EVENT CODE TRANSMISSION TYPE PROCESSING ROUTINE
|
|---|
| 16 | ; ==============================================================
|
|---|
| 17 | ; Z06 MEANS TEST TRANSMISSIONS EASPREC7
|
|---|
| 18 | ;
|
|---|
| 19 | ;
|
|---|
| 20 | ORU ; - Receive Observational Results Unsolicited Message
|
|---|
| 21 | ;
|
|---|
| 22 | N DIC,%,%H,%I D NOW^%DTC S HLDT=%
|
|---|
| 23 | K HLERR,IVMSEG1,IVMSEG2,IVMSEG3
|
|---|
| 24 | S (HLEVN,IVMCT,IVMERROR,IVMCNTR)=0
|
|---|
| 25 | ; Make sure POSTMASTER DUZ instead of DUZ of Person who
|
|---|
| 26 | ; started Incoming Logical Link
|
|---|
| 27 | S DUZ=.5
|
|---|
| 28 | ;
|
|---|
| 29 | ; - get incoming segment from HL7 (#772) file
|
|---|
| 30 | N IVMRTN,SEGCNT,CNT,STATION,HLEID,HLEIDS
|
|---|
| 31 | S IVMRTN="IVMPREC2" K ^TMP($J,IVMRTN),^TMP("HLA",$J),^TMP("HLS",$J)
|
|---|
| 32 | F SEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D
|
|---|
| 33 | . S CNT=0
|
|---|
| 34 | . S ^TMP($J,IVMRTN,SEGCNT,CNT)=HLNODE
|
|---|
| 35 | . F S CNT=$O(HLNODE(CNT)) Q:'CNT S ^TMP($J,IVMRTN,SEGCNT,CNT)=HLNODE(CNT)
|
|---|
| 36 | ;
|
|---|
| 37 | S HLDA=HLMTIEN
|
|---|
| 38 | S IVMSEG=$G(^TMP($J,IVMRTN,1,0)) I IVMSEG']"" G ORUQ
|
|---|
| 39 | ;
|
|---|
| 40 | ; - check for BHS
|
|---|
| 41 | I $E(IVMSEG,1,3)'="BHS" G ORUQ
|
|---|
| 42 | ;
|
|---|
| 43 | ; - get batch control id
|
|---|
| 44 | S HLFS=HL("FS")
|
|---|
| 45 | S HLECH=HL("ECH")
|
|---|
| 46 | S HLQ=$G(HL("HLQ")) S:HLQ="" HLQ=""""""
|
|---|
| 47 | S IVMHLMID=$P(IVMSEG,HLFS,11)
|
|---|
| 48 | S STATION=$P(IVMSEG,HLFS,6)
|
|---|
| 49 | ;
|
|---|
| 50 | ; - get event type code
|
|---|
| 51 | S IVMETC=$P($P(IVMSEG,HLFS,9),$E(HLECH),3)
|
|---|
| 52 | S IVMETC=$P(IVMETC,$E(HLECH,2),2)
|
|---|
| 53 | S HLEID="EAS EDB ORU-"_IVMETC_" SERVER"
|
|---|
| 54 | S HLEID=$O(^ORD(101,"B",HLEID,0)),HLEIDS=""
|
|---|
| 55 | I HLEID]"" S HLEIDS=$O(^ORD(101,HLEID,775,"B",0))
|
|---|
| 56 | ;
|
|---|
| 57 | ; - process the message according to the event type code
|
|---|
| 58 | S IVMDO=$S(IVMETC="Z06":"EN^EASPREC7",1:"ORUQ")
|
|---|
| 59 | D @IVMDO
|
|---|
| 60 | Q:IVMDO="ORUQ"
|
|---|
| 61 | ;
|
|---|
| 62 | ; - if no error send ACK 'AA' message
|
|---|
| 63 | S HLMTN="ACK"
|
|---|
| 64 | K HLARYTYP,HLMTIENA,HLRESLTA,HLP
|
|---|
| 65 | I 'IVMERROR S HLMID=IVMHLMID D ACK^IVMPREC S HLARYTYP="GM",HLMTIENA=""
|
|---|
| 66 | I IVMERROR S HLARYTYP="GB",HLMTIENA=HLMTIEN ;HLMTIEN comes from ACK^IVMPREC
|
|---|
| 67 | K ^TMP("HLA",$J) M ^TMP("HLA",$J)=^TMP("HLS",$J) K ^TMP("HLS",$J)
|
|---|
| 68 | D GENACK^HLMA1(HLEID,HLMTIENS,HLEIDS,HLARYTYP,1,.HLRESLTA,HLMTIENA,.HLP)
|
|---|
| 69 | ;
|
|---|
| 70 | ORUQ ;
|
|---|
| 71 | K DFN,IVMCNTR,IVMCT,IVMDA,IVMERR,IVMERROR,IVMHLMID,IVMNDE,IVMPTID
|
|---|
| 72 | K IVMSEG,IVMSEG1,IVMSEG2,IVMSEG3,IVMTEXT,XMSUB
|
|---|
| 73 | K HLARYTYP,HLMTIENA,HLRESLTA,HLP
|
|---|
| 74 | K ^TMP($J,IVMRTN),^TMP("HLA",$J),^TMP("HLS",$J)
|
|---|
| 75 | Q
|
|---|
