- 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 ;
