source: FOIAVistA/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASPREC2.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1EASPREC2 ;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 ;
20ORU ; - 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 ;
70ORUQ ;
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
Note: See TracBrowser for help on using the repository browser.