DGQEHL71 ;ALB/JFP - VIC Single HL7 Message Builder;09/01/96
;;5.3;Registration;**73,1015**;DEC 11,1996;Build 21
;;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
;
DGQEHL71 ;ALB/JFP - VIC Single HL7 Message Builder;09/01/96
+1 ;;5.3;Registration;**73,1015**;DEC 11,1996;Build 21
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
EVENT(DGQEEVN,DFN) ; Entry point
+1 ;This option is the main entry point for the ID card driver.
+2 ;All VIC events will processed through this routine.
+3 ;
+4 ;Input : DGQEEVN - HL7 event type to process
+5 ; DFN - pointer to Patient file (#2)
+6 ;
+7 ;Output : Message ID in file 772 sucessful
+8 ; -1^error text
+9 ;
+10 ; -- Check parameters
+11 IF '$DATA(DGQEEVN)
QUIT "-1^Required parameter not passed - event type"
+12 IF '$DATA(DFN)
QUIT "-1^Required parameter not passed - DFN"
+13 ; -- Declare variables
+14 NEW STATUS,HL7XMIT,CNT,INCREM
+15 NEW HLECH,HLEID,HLFS,HLMTIEN,HLRESLT,HLSAN
+16 NEW CLERK,OPT,SAPPL,RAPPL,MID
+17 SET STATUS=0
+18 ;
EVNA08 ; -- A08 Update patient information for VIC
+1 IF DGQEEVN="A08"
Begin DoDot:1
+2 DO A08
End DoDot:1
QUIT STATUS
+3 QUIT "-1^No mumps code for event type "_DGQEEVN
+4 ;
A08 ; -- Builds update patient record
+1 ; -- Initialize variables
+2 ;
+3 ; -- Get pointer to sending event
+4 SET HLEID=+$ORDER(^ORD(101,"B","DGQE HL7 A08 VIC SERVER",0))
+5 ; -- Check existance of event, send error bulletin, done
+6 IF ('HLEID)
Begin DoDot:1
+7 SET STATUS="-1^Unable to initialize HL7 variables - protocol not found"
+8 DO ERRBULL^DGQEHL70(STATUS)
QUIT
End DoDot:1
QUIT
+9 ; -- Get variables from HL7 package
+10 DO INIT^HLFNC2(HLEID,.HL)
+11 ; -- Check existance of HL variables, send error bulletin, done
+12 IF ($ORDER(HL(""))="")
SET STATUS="-1^"_$PIECE(HL,"^",2)
DO ERRBULL^DGQEHL70(STATUS)
QUIT
+13 SET SAPPL=$SELECT($DATA(HL("SAN")):$GET(HL("SAN")),1:" ")
+14 ; -- Set global array
+15 SET HL7XMIT="^TMP(""HLS"","_$JOB_")"
+16 KILL @HL7XMIT
+17 ; -- Build HL7 message, message header build by HL7 package
+18 SET CNT=0
+19 SET INCREM=$$BLDA08^DGQEHL73(DFN,.HL,"",HL7XMIT,CNT)
+20 ; -- Check for error, increment less than 1
+21 IF (INCREM<0)
Begin DoDot:1
+22 SET STATUS="-1^"_$PIECE(INCREM,"^",2)
+23 DO ERRBULL^DGQEHL70(STATUS)
End DoDot:1
QUIT
+24 ; -- Send HL7 message - immediate priority
+25 SET HLP("PRIORITY")="I"
+26 DO GENERATE^HLMA(HLEID,"GM",1,.HLRESLT,"",.HLP)
+27 ; -- Check for error
+28 IF ($PIECE(HLRESLT,"^",2)'="")
Begin DoDot:1
+29 SET STATUS=$PIECE(HLRESLT,"^",2)_"^"_$PIECE(HLRESLT,"^",3)
+30 DO ERRBULL^DGQEHL70(STATUS)
End DoDot:1
QUIT
+31 ; -- Successful call, message ID returned
+32 SET MID=$PIECE(HLRESLT,"^",1)
+33 IF $DATA(JPTEST)
WRITE !,"Message ID = ",MID
+34 ; -- Create tracking entry in ADT/HL7 TRANSMISSION file (#39.4)
+35 SET CLERK=$SELECT(DUZ'="":$PIECE($GET(^VA(200,DUZ,0)),"^",1),1:" ")
+36 SET OPT=$SELECT($DATA(XQY0):$PIECE($GET(XQY0),"^",1),1:" ")
+37 SET FILE=$$FILE^DGQEHL74(MID,DFN,CLERK,OPT,SAPPL)
+38 IF FILE=-1
DO ERRBULL^DGQEHL70($PIECE(FILE,"^",2))
QUIT
+39 QUIT
+40 ;
END ; -- End of code
+1 QUIT
+2 ;
