| 1 | DGQEHL72 ;ALB/JFP - VIC HL7 Batch 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,DFNARR) ;
|
|---|
| 6 | ; -- This option is the main entry point for the ID card driver.
|
|---|
| 7 | ;
|
|---|
| 8 | ;Input : DGQEEVN - HL7 event type
|
|---|
| 9 | ; DFNARRY - Array of DFNs to process
|
|---|
| 10 | ;
|
|---|
| 11 | ;Output : None
|
|---|
| 12 | ;
|
|---|
| 13 | ; -- Check input variables
|
|---|
| 14 | Q:'$D(DGQEEVN) "-1^required parameter not passed - event type"
|
|---|
| 15 | Q:'$D(DFNARR) "-1^ required parameter not passed - DFN array"
|
|---|
| 16 | ;
|
|---|
| 17 | ; -- Declare variables
|
|---|
| 18 | N HL7XMIT,XMITERR,MAXBATCH,MAXLINE,BATCHCNT,ERRCNT,DFN,MSGID,INCREM
|
|---|
| 19 | N ERRCNT,LINECNT,STATUS,ERRFLG
|
|---|
| 20 | N HLECH,HLEID,HLFS,HLMTIEN,HLRESLT,HLSAN
|
|---|
| 21 | N CLERK,OPT,SAPPL,RAPPL,MID
|
|---|
| 22 | ;
|
|---|
| 23 | EVNA08 ; -- A08 Update patient information for VIC
|
|---|
| 24 | I DGQEEVN="A08" D A08
|
|---|
| 25 | I ERRFLG=1 Q "-1^see mail message for details"
|
|---|
| 26 | Q 0
|
|---|
| 27 | ;
|
|---|
| 28 | A08 ; -- Builds update patient record
|
|---|
| 29 | ;
|
|---|
| 30 | ; -- Initialize global locations
|
|---|
| 31 | S HL7XMIT="^TMP(""HLS"","_$J_")"
|
|---|
| 32 | S XMITERR="^TMP(""DGQE"","_$J_",""ERROR"")"
|
|---|
| 33 | K @XMITERR,@HL7XMIT
|
|---|
| 34 | ; -- Set limits for batch message
|
|---|
| 35 | S MAXBATCH=30
|
|---|
| 36 | S MAXLINE=500
|
|---|
| 37 | ; -- Set up HL7 variables
|
|---|
| 38 | S BATCHCNT=0
|
|---|
| 39 | S ERRCNT=0
|
|---|
| 40 | D INIT
|
|---|
| 41 | ; -- Check for error in init section and quit
|
|---|
| 42 | I ERRFLG=1 D FATAL Q
|
|---|
| 43 | ; -- Loop through list of transactions
|
|---|
| 44 | S DFN=""
|
|---|
| 45 | F S DFN=$O(@DFNARR@(DFN)) Q:('DFN) D
|
|---|
| 46 | .; -- Calculate message control ID
|
|---|
| 47 | .S MSGID=HLMID_"-"_((BATCHCNT#MAXBATCH)+1)
|
|---|
| 48 | .;W !,"MSGID = ",MSGID
|
|---|
| 49 | .; -- Build HL7 message
|
|---|
| 50 | .S INCREM=$$BLDA08^DGQEHL73(DFN,.HL,MSGID,HL7XMIT,LINECNT)
|
|---|
| 51 | .; -- Check for error, increment less than 1
|
|---|
| 52 | .I (INCREM<0) D Q
|
|---|
| 53 | ..S ERRCNT=ERRCNT+1
|
|---|
| 54 | ..S @XMITERR@(DFN)=$P(INCREM,"^",2)
|
|---|
| 55 | .; -- Increment counts
|
|---|
| 56 | .S LINECNT=LINECNT+INCREM
|
|---|
| 57 | .S BATCHCNT=BATCHCNT+1
|
|---|
| 58 | .; -- Create tracking entry in ADT/HL7 transmission file (#39.4)
|
|---|
| 59 | .S FILE=$$FILE^DGQEHL74(MSGID,DFN,CLERK,OPT,SAPPL)
|
|---|
| 60 | .I FILE=-1 D ERRBULL^DGQEHL70($P(FILE,"^",2)) Q
|
|---|
| 61 | .; -- Check max size of batch, Send on max, Reset HL7 variables
|
|---|
| 62 | .I '(BATCHCNT#MAXBATCH)!(LINECNT>MAXLINE) D
|
|---|
| 63 | ..D SNDBTCH
|
|---|
| 64 | ..D INIT
|
|---|
| 65 | ;
|
|---|
| 66 | ; -- Check for unsent batch
|
|---|
| 67 | I ($O(@HL7XMIT@(0))) D
|
|---|
| 68 | .D SNDBTCH
|
|---|
| 69 | ; -- Send Completion bulletin
|
|---|
| 70 | D CMPLBULL^DGQEHL70(BATCHCNT,XMITERR)
|
|---|
| 71 | FATAL ; -- Fatal error or clean up variables, exit code
|
|---|
| 72 | K @XMITERR,@HL7XMIT
|
|---|
| 73 | Q
|
|---|
| 74 | ;
|
|---|
| 75 | INIT ; -- Initialize variables
|
|---|
| 76 | S ERRFLG=0
|
|---|
| 77 | S LINECNT=1
|
|---|
| 78 | K @HL7XMIT
|
|---|
| 79 | ; -- Get pointer to sending event
|
|---|
| 80 | S HLEID=+$O(^ORD(101,"B","DGQE HL7 A08 VIC SERVER",0))
|
|---|
| 81 | ; -- Check existance of event, send error bulletin, done
|
|---|
| 82 | I ('HLEID) D Q
|
|---|
| 83 | .D ERRBULL^DGQEHL70("-1^Unable to initialize HL7 variables - protocol not found")
|
|---|
| 84 | .S ERRFLG=1
|
|---|
| 85 | ; -- Get variables from HL7 package
|
|---|
| 86 | D INIT^HLFNC2(HLEID,.HL)
|
|---|
| 87 | ; -- Check existance of HL variables, send error bulletin, done
|
|---|
| 88 | I ($O(HL(""))="") D Q
|
|---|
| 89 | .D ERRBULL^DGQEHL70("-1^"_$P(HL,"^",2))
|
|---|
| 90 | .S ERRFLG=1
|
|---|
| 91 | ; -- Set variables for transmission file
|
|---|
| 92 | S SAPPL=$S($D(HL("SAN")):$G(HL("SAN")),1:"")
|
|---|
| 93 | S CLERK=$S(DUZ'="":$P($G(^VA(200,DUZ,0)),"^",1),1:"")
|
|---|
| 94 | S OPT=$S($D(XQY0):$P($G(XQY0),"^",2),1:"")
|
|---|
| 95 | ; -- Create batch message
|
|---|
| 96 | D CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
|
|---|
| 97 | ; -- Check to see if batch message created, send error, done
|
|---|
| 98 | I ('HLMTIEN) D Q
|
|---|
| 99 | .D ERRBULL^DGQEHL70("-1^Unable to create batch HL7 message")
|
|---|
| 100 | .S ERRFLG=1
|
|---|
| 101 | Q
|
|---|
| 102 | ;
|
|---|
| 103 | SNDBTCH ; -- Sends batch message
|
|---|
| 104 | S HLP("PRIORITY")="I"
|
|---|
| 105 | D GENERATE^HLMA(HLEID,"GB",1,.HLRESLT,HLMTIEN,.HLP)
|
|---|
| 106 | ; -- Check for error
|
|---|
| 107 | I ($P(HLRESLT,"^",2)'="") D Q
|
|---|
| 108 | .S STATUS=$P(HLRESLT,"^",2)_"^"_$P(HLRESLT,"^",3)
|
|---|
| 109 | .D ERRBULL^DGQEHL70(STATUS)
|
|---|
| 110 | .S ERRFLG=1
|
|---|
| 111 | ; -- Successful call, message ID returned
|
|---|
| 112 | S STATUS=$P(HLRESLT,"^",1)
|
|---|
| 113 | I $D(JPTEST) W !,"Message ID = ",STATUS
|
|---|
| 114 | Q
|
|---|
| 115 | ;
|
|---|
| 116 | END ; -- End of code
|
|---|
| 117 | Q
|
|---|
| 118 | ;
|
|---|
