source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGQEHL71.m@ 1259

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1DGQEHL71 ;ALB/JFP - VIC Single HL7 Message Builder;09/01/96
2 ;;V5.3;REGISTRATION;**73**;DEC 11,1996
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EVENT(DGQEEVN,DFN) ; Entry point
6 ;This option is the main entry point for the ID card driver.
7 ;All VIC events will processed through this routine.
8 ;
9 ;Input : DGQEEVN - HL7 event type to process
10 ; DFN - pointer to Patient file (#2)
11 ;
12 ;Output : Message ID in file 772 sucessful
13 ; -1^error text
14 ;
15 ; -- Check parameters
16 Q:'$D(DGQEEVN) "-1^Required parameter not passed - event type"
17 Q:'$D(DFN) "-1^Required parameter not passed - DFN"
18 ; -- Declare variables
19 N STATUS,HL7XMIT,CNT,INCREM
20 N HLECH,HLEID,HLFS,HLMTIEN,HLRESLT,HLSAN
21 N CLERK,OPT,SAPPL,RAPPL,MID
22 S STATUS=0
23 ;
24EVNA08 ; -- A08 Update patient information for VIC
25 I DGQEEVN="A08" D Q STATUS
26 .D A08
27 Q "-1^No mumps code for event type "_DGQEEVN
28 ;
29A08 ; -- Builds update patient record
30 ; -- Initialize variables
31 ;
32 ; -- Get pointer to sending event
33 S HLEID=+$O(^ORD(101,"B","DGQE HL7 A08 VIC SERVER",0))
34 ; -- Check existance of event, send error bulletin, done
35 I ('HLEID) D Q
36 .S STATUS="-1^Unable to initialize HL7 variables - protocol not found"
37 .D ERRBULL^DGQEHL70(STATUS) Q
38 ; -- Get variables from HL7 package
39 D INIT^HLFNC2(HLEID,.HL)
40 ; -- Check existance of HL variables, send error bulletin, done
41 I ($O(HL(""))="") S STATUS="-1^"_$P(HL,"^",2) D ERRBULL^DGQEHL70(STATUS) Q
42 S SAPPL=$S($D(HL("SAN")):$G(HL("SAN")),1:" ")
43 ; -- Set global array
44 S HL7XMIT="^TMP(""HLS"","_$J_")"
45 K @HL7XMIT
46 ; -- Build HL7 message, message header build by HL7 package
47 S CNT=0
48 S INCREM=$$BLDA08^DGQEHL73(DFN,.HL,"",HL7XMIT,CNT)
49 ; -- Check for error, increment less than 1
50 I (INCREM<0) D Q
51 .S STATUS="-1^"_$P(INCREM,"^",2)
52 .D ERRBULL^DGQEHL70(STATUS)
53 ; -- Send HL7 message - immediate priority
54 S HLP("PRIORITY")="I"
55 D GENERATE^HLMA(HLEID,"GM",1,.HLRESLT,"",.HLP)
56 ; -- Check for error
57 I ($P(HLRESLT,"^",2)'="") D Q
58 .S STATUS=$P(HLRESLT,"^",2)_"^"_$P(HLRESLT,"^",3)
59 .D ERRBULL^DGQEHL70(STATUS)
60 ; -- Successful call, message ID returned
61 S MID=$P(HLRESLT,"^",1)
62 I $D(JPTEST) W !,"Message ID = ",MID
63 ; -- Create tracking entry in ADT/HL7 TRANSMISSION file (#39.4)
64 S CLERK=$S(DUZ'="":$P($G(^VA(200,DUZ,0)),"^",1),1:" ")
65 S OPT=$S($D(XQY0):$P($G(XQY0),"^",1),1:" ")
66 S FILE=$$FILE^DGQEHL74(MID,DFN,CLERK,OPT,SAPPL)
67 I FILE=-1 D ERRBULL^DGQEHL70($P(FILE,"^",2)) Q
68 Q
69 ;
70END ; -- End of code
71 Q
72 ;
Note: See TracBrowser for help on using the repository browser.