73 lines
2.4 KiB
Mathematica
73 lines
2.4 KiB
Mathematica
|
DGQEHL71 ;ALB/JFP - VIC Single HL7 Message Builder;09/01/96
|
||
|
|
;;V5.3;REGISTRATION;**73**;DEC 11,1996
|
||
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
||
|
|
;
|
||
|
|
EVENT(DGQEEVN,DFN) ; Entry point
|
||
|
|
;This option is the main entry point for the ID card driver.
|
||
|
|
;All VIC events will processed through this routine.
|
||
|
|
;
|
||
|
|
;Input : DGQEEVN - HL7 event type to process
|
||
|
|
; DFN - pointer to Patient file (#2)
|
||
|
|
;
|
||
|
|
;Output : Message ID in file 772 sucessful
|
||
|
|
; -1^error text
|
||
|
|
;
|
||
|
|
; -- Check parameters
|
||
|
|
Q:'$D(DGQEEVN) "-1^Required parameter not passed - event type"
|
||
|
|
Q:'$D(DFN) "-1^Required parameter not passed - DFN"
|
||
|
|
; -- Declare variables
|
||
|
|
N STATUS,HL7XMIT,CNT,INCREM
|
||
|
|
N HLECH,HLEID,HLFS,HLMTIEN,HLRESLT,HLSAN
|
||
|
|
N CLERK,OPT,SAPPL,RAPPL,MID
|
||
|
|
S STATUS=0
|
||
|
|
;
|
||
|
|
EVNA08 ; -- A08 Update patient information for VIC
|
||
|
|
I DGQEEVN="A08" D Q STATUS
|
||
|
|
.D A08
|
||
|
|
Q "-1^No mumps code for event type "_DGQEEVN
|
||
|
|
;
|
||
|
|
A08 ; -- Builds update patient record
|
||
|
|
; -- Initialize variables
|
||
|
|
;
|
||
|
|
; -- Get pointer to sending event
|
||
|
|
S HLEID=+$O(^ORD(101,"B","DGQE HL7 A08 VIC SERVER",0))
|
||
|
|
; -- Check existance of event, send error bulletin, done
|
||
|
|
I ('HLEID) D Q
|
||
|
|
.S STATUS="-1^Unable to initialize HL7 variables - protocol not found"
|
||
|
|
.D ERRBULL^DGQEHL70(STATUS) Q
|
||
|
|
; -- Get variables from HL7 package
|
||
|
|
D INIT^HLFNC2(HLEID,.HL)
|
||
|
|
; -- Check existance of HL variables, send error bulletin, done
|
||
|
|
I ($O(HL(""))="") S STATUS="-1^"_$P(HL,"^",2) D ERRBULL^DGQEHL70(STATUS) Q
|
||
|
|
S SAPPL=$S($D(HL("SAN")):$G(HL("SAN")),1:" ")
|
||
|
|
; -- Set global array
|
||
|
|
S HL7XMIT="^TMP(""HLS"","_$J_")"
|
||
|
|
K @HL7XMIT
|
||
|
|
; -- Build HL7 message, message header build by HL7 package
|
||
|
|
S CNT=0
|
||
|
|
S INCREM=$$BLDA08^DGQEHL73(DFN,.HL,"",HL7XMIT,CNT)
|
||
|
|
; -- Check for error, increment less than 1
|
||
|
|
I (INCREM<0) D Q
|
||
|
|
.S STATUS="-1^"_$P(INCREM,"^",2)
|
||
|
|
.D ERRBULL^DGQEHL70(STATUS)
|
||
|
|
; -- Send HL7 message - immediate priority
|
||
|
|
S HLP("PRIORITY")="I"
|
||
|
|
D GENERATE^HLMA(HLEID,"GM",1,.HLRESLT,"",.HLP)
|
||
|
|
; -- Check for error
|
||
|
|
I ($P(HLRESLT,"^",2)'="") D Q
|
||
|
|
.S STATUS=$P(HLRESLT,"^",2)_"^"_$P(HLRESLT,"^",3)
|
||
|
|
.D ERRBULL^DGQEHL70(STATUS)
|
||
|
|
; -- Successful call, message ID returned
|
||
|
|
S MID=$P(HLRESLT,"^",1)
|
||
|
|
I $D(JPTEST) W !,"Message ID = ",MID
|
||
|
|
; -- Create tracking entry in ADT/HL7 TRANSMISSION file (#39.4)
|
||
|
|
S CLERK=$S(DUZ'="":$P($G(^VA(200,DUZ,0)),"^",1),1:" ")
|
||
|
|
S OPT=$S($D(XQY0):$P($G(XQY0),"^",1),1:" ")
|
||
|
|
S FILE=$$FILE^DGQEHL74(MID,DFN,CLERK,OPT,SAPPL)
|
||
|
|
I FILE=-1 D ERRBULL^DGQEHL70($P(FILE,"^",2)) Q
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
END ; -- End of code
|
||
|
|
Q
|
||
|
|
;
|