DGQEHL72 ;ALB/JFP - VIC HL7 Batch Message Builder;09/01/96
;;V5.3;REGISTRATION;**73,1015**;DEC 11,1996;Build 21
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EVENT(DGQEEVN,DFNARR) ;
; -- This option is the main entry point for the ID card driver.
;
;Input : DGQEEVN - HL7 event type
; DFNARRY - Array of DFNs to process
;
;Output : None
;
; -- Check input variables
Q:'$D(DGQEEVN) "-1^required parameter not passed - event type"
Q:'$D(DFNARR) "-1^ required parameter not passed - DFN array"
;
; -- Declare variables
N HL7XMIT,XMITERR,MAXBATCH,MAXLINE,BATCHCNT,ERRCNT,DFN,MSGID,INCREM
N ERRCNT,LINECNT,STATUS,ERRFLG
N HLECH,HLEID,HLFS,HLMTIEN,HLRESLT,HLSAN
N CLERK,OPT,SAPPL,RAPPL,MID
;
EVNA08 ; -- A08 Update patient information for VIC
I DGQEEVN="A08" D A08
I ERRFLG=1 Q "-1^see mail message for details"
Q 0
;
A08 ; -- Builds update patient record
;
; -- Initialize global locations
S HL7XMIT="^TMP(""HLS"","_$J_")"
S XMITERR="^TMP(""DGQE"","_$J_",""ERROR"")"
K @XMITERR,@HL7XMIT
; -- Set limits for batch message
S MAXBATCH=30
S MAXLINE=500
; -- Set up HL7 variables
S BATCHCNT=0
S ERRCNT=0
D INIT
; -- Check for error in init section and quit
I ERRFLG=1 D FATAL Q
; -- Loop through list of transactions
S DFN=""
F S DFN=$O(@DFNARR@(DFN)) Q:('DFN) D
.; -- Calculate message control ID
.S MSGID=HLMID_"-"_((BATCHCNT#MAXBATCH)+1)
.;W !,"MSGID = ",MSGID
.; -- Build HL7 message
.S INCREM=$$BLDA08^DGQEHL73(DFN,.HL,MSGID,HL7XMIT,LINECNT)
.; -- Check for error, increment less than 1
.I (INCREM<0) D Q
..S ERRCNT=ERRCNT+1
..S @XMITERR@(DFN)=$P(INCREM,"^",2)
.; -- Increment counts
.S LINECNT=LINECNT+INCREM
.S BATCHCNT=BATCHCNT+1
.; -- Create tracking entry in ADT/HL7 transmission file (#39.4)
.S FILE=$$FILE^DGQEHL74(MSGID,DFN,CLERK,OPT,SAPPL)
.I FILE=-1 D ERRBULL^DGQEHL70($P(FILE,"^",2)) Q
.; -- Check max size of batch, Send on max, Reset HL7 variables
.I '(BATCHCNT#MAXBATCH)!(LINECNT>MAXLINE) D
..D SNDBTCH
..D INIT
;
; -- Check for unsent batch
I ($O(@HL7XMIT@(0))) D
.D SNDBTCH
; -- Send Completion bulletin
D CMPLBULL^DGQEHL70(BATCHCNT,XMITERR)
FATAL ; -- Fatal error or clean up variables, exit code
K @XMITERR,@HL7XMIT
Q
;
INIT ; -- Initialize variables
S ERRFLG=0
S LINECNT=1
K @HL7XMIT
; -- 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
.D ERRBULL^DGQEHL70("-1^Unable to initialize HL7 variables - protocol not found")
.S ERRFLG=1
; -- Get variables from HL7 package
D INIT^HLFNC2(HLEID,.HL)
; -- Check existance of HL variables, send error bulletin, done
I ($O(HL(""))="") D Q
.D ERRBULL^DGQEHL70("-1^"_$P(HL,"^",2))
.S ERRFLG=1
; -- Set variables for transmission file
S SAPPL=$S($D(HL("SAN")):$G(HL("SAN")),1:"")
S CLERK=$S(DUZ'="":$P($G(^VA(200,DUZ,0)),"^",1),1:"")
S OPT=$S($D(XQY0):$P($G(XQY0),"^",2),1:"")
; -- Create batch message
D CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
; -- Check to see if batch message created, send error, done
I ('HLMTIEN) D Q
.D ERRBULL^DGQEHL70("-1^Unable to create batch HL7 message")
.S ERRFLG=1
Q
;
SNDBTCH ; -- Sends batch message
S HLP("PRIORITY")="I"
D GENERATE^HLMA(HLEID,"GB",1,.HLRESLT,HLMTIEN,.HLP)
; -- Check for error
I ($P(HLRESLT,"^",2)'="") D Q
.S STATUS=$P(HLRESLT,"^",2)_"^"_$P(HLRESLT,"^",3)
.D ERRBULL^DGQEHL70(STATUS)
.S ERRFLG=1
; -- Successful call, message ID returned
S STATUS=$P(HLRESLT,"^",1)
I $D(JPTEST) W !,"Message ID = ",STATUS
Q
;
END ; -- End of code
Q
;
DGQEHL72 ;ALB/JFP - VIC HL7 Batch Message Builder;09/01/96
+1 ;;V5.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,DFNARR) ;
+1 ; -- This option is the main entry point for the ID card driver.
+2 ;
+3 ;Input : DGQEEVN - HL7 event type
+4 ; DFNARRY - Array of DFNs to process
+5 ;
+6 ;Output : None
+7 ;
+8 ; -- Check input variables
+9 IF '$DATA(DGQEEVN)
QUIT "-1^required parameter not passed - event type"
+10 IF '$DATA(DFNARR)
QUIT "-1^ required parameter not passed - DFN array"
+11 ;
+12 ; -- Declare variables
+13 NEW HL7XMIT,XMITERR,MAXBATCH,MAXLINE,BATCHCNT,ERRCNT,DFN,MSGID,INCREM
+14 NEW ERRCNT,LINECNT,STATUS,ERRFLG
+15 NEW HLECH,HLEID,HLFS,HLMTIEN,HLRESLT,HLSAN
+16 NEW CLERK,OPT,SAPPL,RAPPL,MID
+17 ;
EVNA08 ; -- A08 Update patient information for VIC
+1 IF DGQEEVN="A08"
DO A08
+2 IF ERRFLG=1
QUIT "-1^see mail message for details"
+3 QUIT 0
+4 ;
A08 ; -- Builds update patient record
+1 ;
+2 ; -- Initialize global locations
+3 SET HL7XMIT="^TMP(""HLS"","_$JOB_")"
+4 SET XMITERR="^TMP(""DGQE"","_$JOB_",""ERROR"")"
+5 KILL @XMITERR,@HL7XMIT
+6 ; -- Set limits for batch message
+7 SET MAXBATCH=30
+8 SET MAXLINE=500
+9 ; -- Set up HL7 variables
+10 SET BATCHCNT=0
+11 SET ERRCNT=0
+12 DO INIT
+13 ; -- Check for error in init section and quit
+14 IF ERRFLG=1
DO FATAL
QUIT
+15 ; -- Loop through list of transactions
+16 SET DFN=""
+17 FOR
SET DFN=$ORDER(@DFNARR@(DFN))
IF ('DFN)
QUIT
Begin DoDot:1
+18 ; -- Calculate message control ID
+19 SET MSGID=HLMID_"-"_((BATCHCNT#MAXBATCH)+1)
+20 ;W !,"MSGID = ",MSGID
+21 ; -- Build HL7 message
+22 SET INCREM=$$BLDA08^DGQEHL73(DFN,.HL,MSGID,HL7XMIT,LINECNT)
+23 ; -- Check for error, increment less than 1
+24 IF (INCREM<0)
Begin DoDot:2
+25 SET ERRCNT=ERRCNT+1
+26 SET @XMITERR@(DFN)=$PIECE(INCREM,"^",2)
End DoDot:2
QUIT
+27 ; -- Increment counts
+28 SET LINECNT=LINECNT+INCREM
+29 SET BATCHCNT=BATCHCNT+1
+30 ; -- Create tracking entry in ADT/HL7 transmission file (#39.4)
+31 SET FILE=$$FILE^DGQEHL74(MSGID,DFN,CLERK,OPT,SAPPL)
+32 IF FILE=-1
DO ERRBULL^DGQEHL70($PIECE(FILE,"^",2))
QUIT
+33 ; -- Check max size of batch, Send on max, Reset HL7 variables
+34 IF '(BATCHCNT#MAXBATCH)!(LINECNT>MAXLINE)
Begin DoDot:2
+35 DO SNDBTCH
+36 DO INIT
End DoDot:2
End DoDot:1
+37 ;
+38 ; -- Check for unsent batch
+39 IF ($ORDER(@HL7XMIT@(0)))
Begin DoDot:1
+40 DO SNDBTCH
End DoDot:1
+41 ; -- Send Completion bulletin
+42 DO CMPLBULL^DGQEHL70(BATCHCNT,XMITERR)
FATAL ; -- Fatal error or clean up variables, exit code
+1 KILL @XMITERR,@HL7XMIT
+2 QUIT
+3 ;
INIT ; -- Initialize variables
+1 SET ERRFLG=0
+2 SET LINECNT=1
+3 KILL @HL7XMIT
+4 ; -- Get pointer to sending event
+5 SET HLEID=+$ORDER(^ORD(101,"B","DGQE HL7 A08 VIC SERVER",0))
+6 ; -- Check existance of event, send error bulletin, done
+7 IF ('HLEID)
Begin DoDot:1
+8 DO ERRBULL^DGQEHL70("-1^Unable to initialize HL7 variables - protocol not found")
+9 SET ERRFLG=1
End DoDot:1
QUIT
+10 ; -- Get variables from HL7 package
+11 DO INIT^HLFNC2(HLEID,.HL)
+12 ; -- Check existance of HL variables, send error bulletin, done
+13 IF ($ORDER(HL(""))="")
Begin DoDot:1
+14 DO ERRBULL^DGQEHL70("-1^"_$PIECE(HL,"^",2))
+15 SET ERRFLG=1
End DoDot:1
QUIT
+16 ; -- Set variables for transmission file
+17 SET SAPPL=$SELECT($DATA(HL("SAN")):$GET(HL("SAN")),1:"")
+18 SET CLERK=$SELECT(DUZ'="":$PIECE($GET(^VA(200,DUZ,0)),"^",1),1:"")
+19 SET OPT=$SELECT($DATA(XQY0):$PIECE($GET(XQY0),"^",2),1:"")
+20 ; -- Create batch message
+21 DO CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
+22 ; -- Check to see if batch message created, send error, done
+23 IF ('HLMTIEN)
Begin DoDot:1
+24 DO ERRBULL^DGQEHL70("-1^Unable to create batch HL7 message")
+25 SET ERRFLG=1
End DoDot:1
QUIT
+26 QUIT
+27 ;
SNDBTCH ; -- Sends batch message
+1 SET HLP("PRIORITY")="I"
+2 DO GENERATE^HLMA(HLEID,"GB",1,.HLRESLT,HLMTIEN,.HLP)
+3 ; -- Check for error
+4 IF ($PIECE(HLRESLT,"^",2)'="")
Begin DoDot:1
+5 SET STATUS=$PIECE(HLRESLT,"^",2)_"^"_$PIECE(HLRESLT,"^",3)
+6 DO ERRBULL^DGQEHL70(STATUS)
+7 SET ERRFLG=1
End DoDot:1
QUIT
+8 ; -- Successful call, message ID returned
+9 SET STATUS=$PIECE(HLRESLT,"^",1)
+10 IF $DATA(JPTEST)
WRITE !,"Message ID = ",STATUS
+11 QUIT
+12 ;
END ; -- End of code
+1 QUIT
+2 ;
