- 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 Feb 18, 2025@23:22:01 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