EASPREC3 ;ALB/PJH,BDB,MNH - PROCESS INCOMING HL7 (QRY) MESSAGES ;11/27/07 3:04pm
;;1.0;ENROLLMENT APPLICATION SYSTEM;**71,111,113**;15-MAR-01;Build 53
;;Per VA Directive 6402, this routine should not be modified.
;
; CLONED FROM IVMPREC2 (ESR EVENT DRIVER)
;
; This routine will process (ORU) HL7 messages received from the
; IVM center. Event type code indicating type of transmission is
; in the BHS segment. Routines based on type will be called to
; process these messages. For each batch an ACK will be sent to
; the IVM Center indicating errors found. If any errors are found
; a batch message with AE(indicating error(s)) is sent. If no errors
; only a MSH and MSA with AA(no errors) is sent. The following event
; type codes are processed in the following routines:
;
; EVENT CODE TRANSMISSION TYPE PROCESSING ROUTINE
; ==============================================================
; Z03 SSN TRANSMISSIONS IVMPREC5
; Z04 INSURANCE TRANSMISSIONS IVMPREC3
; Z05 DEMOGRAPHIC TRANSMISSIONS IVMPREC6
; Z06 MEANS TEST TRANSMISSIONS EASPREC6
; Z08 CASE STATUS TRANSMISSIONS IVMPREC4
; Z10 INCOME TEST TRANSMISSIONS IVMCM
; Z11 ENROLLMENT/ELIGIBILTY ORUZ11^DGENUPL
;
;
ORU ; - Receive Observational Results Unsolicited Message
;
N DIC,%,%H,%I D NOW^%DTC S HLDT=%
K HLERR,IVMSEG1,IVMSEG2,IVMSEG3
S (HLEVN,IVMCT,IVMERROR,IVMCNTR)=0
; Make sure POSTMASTER DUZ instead of DUZ of Person who
; started Incoming Logical Link
S DUZ=.5
;
; - get incoming segment from HL7 (#772) file
N IVMRTN,SEGCNT,CNT,STATION,HLEID,HLEIDS
S IVMRTN="IVMPREC2" K ^TMP($J,IVMRTN),^TMP("HLA",$J),^TMP("HLS",$J)
F SEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D
. S CNT=0
. S ^TMP($J,IVMRTN,SEGCNT,CNT)=HLNODE
. F S CNT=$O(HLNODE(CNT)) Q:'CNT S ^TMP($J,IVMRTN,SEGCNT,CNT)=HLNODE(CNT)
;
S HLDA=HLMTIEN
S IVMSEG=$G(^TMP($J,IVMRTN,1,0)) I IVMSEG']"" G ORUQ
;
; - check for BHS
I $E(IVMSEG,1,3)'="BHS" G ORUQ
;
; - get batch control id
S HLFS=HL("FS")
S HLECH=HL("ECH")
S HLQ=$G(HL("HLQ")) S:HLQ="" HLQ=""""""
S IVMHLMID=$P(IVMSEG,HLFS,11)
S STATION=$P(IVMSEG,HLFS,6)
;
; - get event type code
S IVMETC=$P($P(IVMSEG,HLFS,9),$E(HLECH),3)
S IVMETC=$P(IVMETC,$E(HLECH,2),2)
S HLEID="EAS ESR "_STATION_" ORU-"_IVMETC_" SERVER"
I IVMETC="Z04" S HLEID=HLEID_" H" ;HEC TO VAMC
S HLEID=$O(^ORD(101,"B",HLEID,0)),HLEIDS=""
I HLEID]"" S HLEIDS=$O(^ORD(101,HLEID,775,"B",0))
;
; - process the message according to the event type code
;ADD Z06 EAS*1.0*111
;S IVMDO=$S(IVMETC="Z03":"EN^IVMPREC5",IVMETC="Z04":"EN^IVMPREC3",IVMETC="Z05":"EN^IVMPREC6",IVMETC="Z06":"EN^EASPREC6",IVMETC="Z08":"EN^IVMPREC4",IVMETC="Z10":"ORU^IVMCM",IVMETC="Z11":"ORUZ11^DGENUPL",1:"ORUQ")
S IVMDO=$S(IVMETC="Z03":"EN^IVMPREC5",IVMETC="Z04":"EN^IVMPREC3",IVMETC="Z05":"EN^IVMPREC6",IVMETC="Z06":"EN^EASPREC6",IVMETC="Z08":"EN^IVMPREC4",IVMETC="Z10":"ORU^EASCM",IVMETC="Z11":"ORUZ11^DGENUPL",1:"ORUQ") ;EAS*1*113
I IVMETC="Z11" D
.D ORUZ11^DGENUPL(HLDA,.IVMERROR)
.S IVMCT=2*IVMERROR
.S HLEVN=IVMERROR
I IVMETC'="Z11" D
.D @IVMDO
Q:IVMDO="ORUQ"
;
; - if no error send ACK 'AA' message
S HLMTN="ACK"
K HLARYTYP,HLMTIENA,HLRESLTA,HLP
I 'IVMERROR S HLMID=IVMHLMID D ACK^IVMPREC S HLARYTYP="GM",HLMTIENA=""
I IVMERROR S HLARYTYP="GB",HLMTIENA=HLMTIEN ;HLMTIEN comes from ACK^IVMPREC
K ^TMP("HLA",$J) M ^TMP("HLA",$J)=^TMP("HLS",$J) K ^TMP("HLS",$J)
D GENACK^HLMA1(HLEID,HLMTIENS,HLEIDS,HLARYTYP,1,.HLRESLTA,HLMTIENA,.HLP)
; The following line is added for PFSS Registration. This line will ensure any patient
; registration updates received from the HEC are forwarded to a COTS billing application
; See DBIA#4780 - this line will need re enabling if PFSS is active
;S X="DGPFSS1" X ^%ZOSF("TEST") I $T D SEND^DGPFSS1(DFN,0)
;
ORUQ ;
;
K DFN,IVMCNTR,IVMCT,IVMDA,IVMERR,IVMERROR,IVMHLMID,IVMNDE,IVMPTID
K IVMSEG,IVMSEG1,IVMSEG2,IVMSEG3,IVMTEXT,XMSUB
K HLARYTYP,HLMTIENA,HLRESLTA,HLP
K ^TMP($J,IVMRTN),^TMP("HLA",$J),^TMP("HLS",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASPREC3 4044 printed Apr 09, 2024@21:00:10 Page 2
EASPREC3 ;ALB/PJH,BDB,MNH - PROCESS INCOMING HL7 (QRY) MESSAGES ;11/27/07 3:04pm
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**71,111,113**;15-MAR-01;Build 53
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; CLONED FROM IVMPREC2 (ESR EVENT DRIVER)
+5 ;
+6 ; This routine will process (ORU) HL7 messages received from the
+7 ; IVM center. Event type code indicating type of transmission is
+8 ; in the BHS segment. Routines based on type will be called to
+9 ; process these messages. For each batch an ACK will be sent to
+10 ; the IVM Center indicating errors found. If any errors are found
+11 ; a batch message with AE(indicating error(s)) is sent. If no errors
+12 ; only a MSH and MSA with AA(no errors) is sent. The following event
+13 ; type codes are processed in the following routines:
+14 ;
+15 ; EVENT CODE TRANSMISSION TYPE PROCESSING ROUTINE
+16 ; ==============================================================
+17 ; Z03 SSN TRANSMISSIONS IVMPREC5
+18 ; Z04 INSURANCE TRANSMISSIONS IVMPREC3
+19 ; Z05 DEMOGRAPHIC TRANSMISSIONS IVMPREC6
+20 ; Z06 MEANS TEST TRANSMISSIONS EASPREC6
+21 ; Z08 CASE STATUS TRANSMISSIONS IVMPREC4
+22 ; Z10 INCOME TEST TRANSMISSIONS IVMCM
+23 ; Z11 ENROLLMENT/ELIGIBILTY ORUZ11^DGENUPL
+24 ;
+25 ;
ORU ; - Receive Observational Results Unsolicited Message
+1 ;
+2 NEW DIC,%,%H,%I
DO NOW^%DTC
SET HLDT=%
+3 KILL HLERR,IVMSEG1,IVMSEG2,IVMSEG3
+4 SET (HLEVN,IVMCT,IVMERROR,IVMCNTR)=0
+5 ; Make sure POSTMASTER DUZ instead of DUZ of Person who
+6 ; started Incoming Logical Link
+7 SET DUZ=.5
+8 ;
+9 ; - get incoming segment from HL7 (#772) file
+10 NEW IVMRTN,SEGCNT,CNT,STATION,HLEID,HLEIDS
+11 SET IVMRTN="IVMPREC2"
KILL ^TMP($JOB,IVMRTN),^TMP("HLA",$JOB),^TMP("HLS",$JOB)
+12 FOR SEGCNT=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
Begin DoDot:1
+13 SET CNT=0
+14 SET ^TMP($JOB,IVMRTN,SEGCNT,CNT)=HLNODE
+15 FOR
SET CNT=$ORDER(HLNODE(CNT))
if 'CNT
QUIT
SET ^TMP($JOB,IVMRTN,SEGCNT,CNT)=HLNODE(CNT)
End DoDot:1
+16 ;
+17 SET HLDA=HLMTIEN
+18 SET IVMSEG=$GET(^TMP($JOB,IVMRTN,1,0))
IF IVMSEG']""
GOTO ORUQ
+19 ;
+20 ; - check for BHS
+21 IF $EXTRACT(IVMSEG,1,3)'="BHS"
GOTO ORUQ
+22 ;
+23 ; - get batch control id
+24 SET HLFS=HL("FS")
+25 SET HLECH=HL("ECH")
+26 SET HLQ=$GET(HL("HLQ"))
if HLQ=""
SET HLQ=""""""
+27 SET IVMHLMID=$PIECE(IVMSEG,HLFS,11)
+28 SET STATION=$PIECE(IVMSEG,HLFS,6)
+29 ;
+30 ; - get event type code
+31 SET IVMETC=$PIECE($PIECE(IVMSEG,HLFS,9),$EXTRACT(HLECH),3)
+32 SET IVMETC=$PIECE(IVMETC,$EXTRACT(HLECH,2),2)
+33 SET HLEID="EAS ESR "_STATION_" ORU-"_IVMETC_" SERVER"
+34 ;HEC TO VAMC
IF IVMETC="Z04"
SET HLEID=HLEID_" H"
+35 SET HLEID=$ORDER(^ORD(101,"B",HLEID,0))
SET HLEIDS=""
+36 IF HLEID]""
SET HLEIDS=$ORDER(^ORD(101,HLEID,775,"B",0))
+37 ;
+38 ; - process the message according to the event type code
+39 ;ADD Z06 EAS*1.0*111
+40 ;S IVMDO=$S(IVMETC="Z03":"EN^IVMPREC5",IVMETC="Z04":"EN^IVMPREC3",IVMETC="Z05":"EN^IVMPREC6",IVMETC="Z06":"EN^EASPREC6",IVMETC="Z08":"EN^IVMPREC4",IVMETC="Z10":"ORU^IVMCM",IVMETC="Z11":"ORUZ11^DGENUPL",1:"ORUQ")
+41 ;EAS*1*113
SET IVMDO=$SELECT(IVMETC="Z03":"EN^IVMPREC5",IVMETC="Z04":"EN^IVMPREC3",IVMETC="Z05":"EN^IVMPREC6",IVMETC="Z06":"EN^EASPREC6",IVMETC="Z08":"EN^IVMPREC4",IVMETC="Z10":"ORU^EASCM",IVMETC="Z11":"ORUZ11^DGENUPL",1:"ORUQ")
+42 IF IVMETC="Z11"
Begin DoDot:1
+43 DO ORUZ11^DGENUPL(HLDA,.IVMERROR)
+44 SET IVMCT=2*IVMERROR
+45 SET HLEVN=IVMERROR
End DoDot:1
+46 IF IVMETC'="Z11"
Begin DoDot:1
+47 DO @IVMDO
End DoDot:1
+48 if IVMDO="ORUQ"
QUIT
+49 ;
+50 ; - if no error send ACK 'AA' message
+51 SET HLMTN="ACK"
+52 KILL HLARYTYP,HLMTIENA,HLRESLTA,HLP
+53 IF 'IVMERROR
SET HLMID=IVMHLMID
DO ACK^IVMPREC
SET HLARYTYP="GM"
SET HLMTIENA=""
+54 ;HLMTIEN comes from ACK^IVMPREC
IF IVMERROR
SET HLARYTYP="GB"
SET HLMTIENA=HLMTIEN
+55 KILL ^TMP("HLA",$JOB)
MERGE ^TMP("HLA",$JOB)=^TMP("HLS",$JOB)
KILL ^TMP("HLS",$JOB)
+56 DO GENACK^HLMA1(HLEID,HLMTIENS,HLEIDS,HLARYTYP,1,.HLRESLTA,HLMTIENA,.HLP)
+57 ; The following line is added for PFSS Registration. This line will ensure any patient
+58 ; registration updates received from the HEC are forwarded to a COTS billing application
+59 ; See DBIA#4780 - this line will need re enabling if PFSS is active
+60 ;S X="DGPFSS1" X ^%ZOSF("TEST") I $T D SEND^DGPFSS1(DFN,0)
+61 ;
ORUQ ;
+1 ;
+2 KILL DFN,IVMCNTR,IVMCT,IVMDA,IVMERR,IVMERROR,IVMHLMID,IVMNDE,IVMPTID
+3 KILL IVMSEG,IVMSEG1,IVMSEG2,IVMSEG3,IVMTEXT,XMSUB
+4 KILL HLARYTYP,HLMTIENA,HLRESLTA,HLP
+5 KILL ^TMP($JOB,IVMRTN),^TMP("HLA",$JOB),^TMP("HLS",$JOB)
+6 QUIT
