| [613] | 1 | DGQEHL71 ;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 | ;
|
|---|
| 5 | EVENT(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 | ;
|
|---|
| 24 | EVNA08 ; -- 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 | ;
|
|---|
| 29 | A08 ; -- 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 | ;
|
|---|
| 70 | END ; -- End of code
|
|---|
| 71 | Q
|
|---|
| 72 | ;
|
|---|
