Routine: EASPREC4

EASPREC4 ;ALB/PJH,TDM - PROCESS INCOMING HL7 (QRY) MESSAGES ; 3/30/09 8:37pm

 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**71,94**;15-MAR-01;Build 6

 ;;Per VHA Directive 2004-038, this routine should not be modified.

 ; CLONED FROM IVMPREC (ESR EVENT DRIVER)

 ; This routine will process (QRY) HL7 messages received from HEC

 ; At present, the (QRY) message queries for updated information

 ; for a single patient.

QRY ; - Receive Query Message requesting further information

 S (HLEVN,IVMCT,IVMERROR,IVMFLAG)=0

 K IVMQUERY("LTD"),IVMQUERY("OVIS") ;Variables needed to open/close last visit date and outpt visit QUERIES

 S IVMRTN="IVMPREC"

 K ^TMP($J,IVMRTN),^TMP("HLS",$J),^TMP("HLA",$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  D

 ..S ^TMP($J,IVMRTN,SEGCNT,CNT)=HLNODE(CNT)

 ; INITIALIZE HL7 VARIABLES

 S HLEID="VAMC "_$P($$SITE^VASITE,"^",3)_" ORF-Z07 SERVER"

 S HLEID=$O(^ORD(101,"B",HLEID,0))

 D INIT^HLFNC2(HLEID,.HL)

 S HLEIDS="EAS ESR "_$P($$SITE^VASITE,"^",3)_" ORF-Z07 CLIENT"

 S HLEIDS=$O(^ORD(101,"B",HLEIDS,0))

 I '$D(^ORD(101,HLEID,775,"B",+HLEIDS)) S HLEIDS=""

 ; IVM*2.0*105 BAJ 11/02/2005 Temp global for Consistency Checks

 K ^TMP($J,"CC")

 F IVMDA=0:0 S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)) Q:'IVMDA  S IVMSEG=$G(^(IVMDA,0)) I $E(IVMSEG,1,3)="QRD"!($E(IVMSEG,1,3)="MSH") D

 .I $E(IVMSEG,1,3)="MSH" S IVMMSHID=$P(IVMSEG,HLFS,10),MSGID=$P(IVMSEG,HLFS,10),HLMID=MSGID Q

 .K HLERR S IVMFLAG=1

 .S IVMSEG=$P(IVMSEG,HLFS,2,999) ; strip off segment name

 .S IVMQLR=$P(IVMSEG,HLFS,7),DFN=$P(IVMSEG,HLFS,8),IVMIY=$P(IVMSEG,HLFS,10)

 .D ERRCK

 .I $D(HLERR) D ACK

 .I '$D(HLERR) D

 ..N EVENTS

 ..; - if master query - create entry in (#301.9) file

 ..I IVMQLR>1,'DFN D  Q

 ...S IVMSEG1="QRD"_HLFS_IVMSEG

 ...S:'$D(^IVM(301.9,1,10,0)) ^(0)="^301.9001DA^"

 ...S DA(1)=1,DIC="^IVM(301.9,1,10,",DIC(0)=""

 ...S X=IVMIY

 ...K DO,DD D FILE^DICN

 ...S DA=+Y,DA(1)=1,DIE="^IVM(301.9,1,10,"

 ...S DR=".02///NOW;.04////^S X=IVMMSHID;10////^S X=IVMSEG1" D ^DIE

..;

 ..; Send AE if veteran has a Pseudo SSN and eligibility is not verified

 ..;Removed with IVM*2*105

 ..; I '$$SNDPSSN^IVMPTRN7(DFN) S HLERR="Pseudo SSN must be verified" D ACK Q

..;

 ..; - if Primary Eligibility = Employee generate error & quit

 ..N DGPRIM

 ..S DGPRIM=$$GET1^DIQ(2,DFN_",",.361)

 ..I $G(DGPRIM)]"" S DGPRIM=$O(^DIC(8,"B",DGPRIM,0))

 ..I $G(DGPRIM)]"" S DGPRIM=$P($G(^DIC(8,DGPRIM,0)),U,9)

 ..I $G(DGPRIM)=14 S HLERR="Message not sent.  Patient is an employee" D ACK Q

..;

 ..; Do Z07 Consistency checks and if fail generate error & quit

 ..I '$$EN^IVMZ07C(DFN) S HLERR="Message not sent.  Inconsistencies in Record" D ACK K ^TMP($J,"CC") Q

..;

 ..; - prepare (ACK) message

 ..D:'$D(HLERR) MSGHDR   ;header (MSH)

 ..D ACK     ;message (MSA)

..;

 ..; - set up local HL7 event type code in MSH

 ..S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)="QRD"_HLFS_IVMSEG ; copy of incoming QRD

..;

 ..; - build 'FULL' transmission (note: without MSH segment)

 ..S IVMMTDT=$E(IVMIY,1,3)+1_"1231.9999"

 ..D FULL^IVMPTRN7(DFN,IVMMTDT,.EVENTS,.IVMCT,.IVMGTOT,,1,,.IVMQUERY)

 F Z="LTD","OVIS" I $G(IVMQUERY(Z)) D CLOSE^SDQ(IVMQUERY(Z)) K IVMQUERY(Z)

 I 'IVMFLAG S HLERR="Invalid Message Format" D ACK

 S HLMTN="ORF"

 S HLMTIENA=HLMTIEN

 K ^TMP("HLA",$J) M ^TMP("HLA",$J)=^TMP("HLS",$J) K ^TMP("HLS",$J)

 D GENACK^HLMA1(HLEID,HLMTIENS,HLEIDS,"GB",1,.HLRESLTA,HLMTIENA,.HLP)

QRYQ K DFN,DR,HLEVN,IVMCT,IVMDA,IVMERROR,IVMFLAG,IVMIY,IVMMTDT,IVMSEG,IVMSEG1,IVMQLR,IVMMSHID,MSGID,MSHID

 K ^TMP("HLA",$J),^TMP("HLS",$J),^TMP($J,IVMRTN)

ERRCK ; Perform error checks on HL7 (QRD) segment

 I ('DFN!(DFN'=+DFN)) S:IVMQLR'>1 HLERR="Invalid DFN"

 I '$D(HLERR) S IVMIY=$$FMDATE^HLFNC(IVMIY) I $E(IVMIY,4,7)'="0000"!($E(IVMIY,1,3)<292) S HLERR="Invalid Income Year"

 I '$D(HLERR),$P(IVMSEG,HLFS,2)'="R" S HLERR="Invalid Query Format Code"

 I '$D(HLERR),$P(IVMSEG,HLFS,3)'="I",($P(IVMSEG,HLFS,3)'="D") S HLERR="Invalid Query Priority"

 I '$D(HLERR),$P(IVMSEG,HLFS,9)'="DEM" S HLERR="Invalid Query Subject Filter"

 I '$D(HLERR),$P(IVMSEG,HLFS,12)'="T" S HLERR="Invalid Query Results Level"

MSGHDR ; prepare header MSH segment in batch of 100 message events

 ; input variables:

 ;          IVMCT record counter

 ;          HLEVN event number

 ;          MSHID outgoing message id

 ;             HL array for protocol

 N MID,HLRES

 S HLEVN=$G(HLEVN)+1

 D:(HLEVN#100)=1

 .K MSHID,HLDT,HLDT1,HLMTIEN

 .D INIT^HLFNC2(HLEID,.HL)

 .D CREATE^HLTF(.MSHID,.HLMTIEN,.HLDT,.HLDT1)

 S MID=MSHID_"-"_HLEVN

 D MSH^HLFNC2(.HL,MID,.HLRES)

 S IVMCT=$G(IVMCT)+1

 S ^TMP("HLS",$J,IVMCT)=HLRES

ACK ; prepare positive and negative acknowledgement (ACK) message

 ; (positive acknowledgement: MSA segment with no MSH segment)

 ; (negative acknowledgement: MSA segment with MSH segment)

 N MID,HLRES

 S IVMCT=$G(IVMCT)+1

 D:$D(HLERR)

 .S IVMERROR=1

 .S HLEVN=HLEVN+1

 .D:(HLEVN#100)=1

 ..K HLMID,HLMTIEN,HLDT,HLDT1 ; set up batch

 ..D INIT^HLFNC2(HLEID,.HL)

 ..D CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)

 .S MID=HLMID_"-"_HLEVN

 .D MSH^HLFNC2(.HL,MID,.HLRES)

 .S ^TMP("HLS",$J,IVMCT)=HLRES

 .S IVMCT=IVMCT+1

 .S ^TMP("HLS",$J,IVMCT)="MSA"_HLFS_"AE"_HLFS_MSGID_HLFS_HLERR_"- SSN "_$S($G(DFN):$P($$PT^IVMUFNC4(DFN),"^",2),1:"NOT FOUND")

 I '$D(HLERR) S ^TMP("HLS",$J,IVMCT)="MSA"_HLFS_"AA"_HLFS_HLMID

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASPREC4   5510     printed  Mar 13, 2025@21:00:18                                                                                                                                                                                                    Page 2

EASPREC4  ;ALB/PJH,TDM - PROCESS INCOMING HL7 (QRY) MESSAGES ; 3/30/09 8:37pm

 +1       ;;1.0;ENROLLMENT APPLICATION SYSTEM;**71,94**;15-MAR-01;Build 6

 +2       ;;Per VHA Directive 2004-038, this routine should not be modified.

 +3       ;

 +4       ; CLONED FROM IVMPREC (ESR EVENT DRIVER)

 +5       ;

 +6       ; This routine will process (QRY) HL7 messages received from HEC

 +7       ; At present, the (QRY) message queries for updated information

 +8       ; for a single patient.

 +9       ;

 +10      ;

QRY       ; - Receive Query Message requesting further information

 +1       ;

 +2        SET (HLEVN,IVMCT,IVMERROR,IVMFLAG)=0

 +3       ;

 +4       ;Variables needed to open/close last visit date and outpt visit QUERIES

           KILL IVMQUERY("LTD"),IVMQUERY("OVIS")

 +5        SET IVMRTN="IVMPREC"

 +6        KILL ^TMP($JOB,IVMRTN),^TMP("HLS",$JOB),^TMP("HLA",$JOB)

 +7        FOR SEGCNT=1:1

               XECUTE HLNEXT

               if HLQUIT'>0

                   QUIT

               Begin DoDot:1

 +8                SET CNT=0

 +9                SET ^TMP($JOB,IVMRTN,SEGCNT,CNT)=HLNODE

 +10               FOR

                       SET CNT=$ORDER(HLNODE(CNT))

                       if 'CNT

                           QUIT

                       Begin DoDot:2

 +11                       SET ^TMP($JOB,IVMRTN,SEGCNT,CNT)=HLNODE(CNT)

                       End DoDot:2

               End DoDot:1

 +12      ;

 +13      ; INITIALIZE HL7 VARIABLES

 +14       SET HLEID="VAMC "_$PIECE($$SITE^VASITE,"^",3)_" ORF-Z07 SERVER"

 +15       SET HLEID=$ORDER(^ORD(101,"B",HLEID,0))

 +16       DO INIT^HLFNC2(HLEID,.HL)

 +17       SET HLEIDS="EAS ESR "_$PIECE($$SITE^VASITE,"^",3)_" ORF-Z07 CLIENT"

 +18       SET HLEIDS=$ORDER(^ORD(101,"B",HLEIDS,0))

 +19       IF '$DATA(^ORD(101,HLEID,775,"B",+HLEIDS))

               SET HLEIDS=""

 +20      ;

 +21      ; IVM*2.0*105 BAJ 11/02/2005 Temp global for Consistency Checks

 +22       KILL ^TMP($JOB,"CC")

 +23      ;

 +24       FOR IVMDA=0:0

               SET IVMDA=$ORDER(^TMP($JOB,IVMRTN,IVMDA))

               if 'IVMDA

                   QUIT

               SET IVMSEG=$GET(^(IVMDA,0))

               IF $EXTRACT(IVMSEG,1,3)="QRD"!($EXTRACT(IVMSEG,1,3)="MSH")

                   Begin DoDot:1

 +25                   IF $EXTRACT(IVMSEG,1,3)="MSH"

                           SET IVMMSHID=$PIECE(IVMSEG,HLFS,10)

                           SET MSGID=$PIECE(IVMSEG,HLFS,10)

                           SET HLMID=MSGID

                           QUIT

 +26                   KILL HLERR

                       SET IVMFLAG=1

 +27      ; strip off segment name

                       SET IVMSEG=$PIECE(IVMSEG,HLFS,2,999)

 +28                   SET IVMQLR=$PIECE(IVMSEG,HLFS,7)

                       SET DFN=$PIECE(IVMSEG,HLFS,8)

                       SET IVMIY=$PIECE(IVMSEG,HLFS,10)

 +29                   DO ERRCK

 +30                   IF $DATA(HLERR)

                           DO ACK

 +31                   IF '$DATA(HLERR)

                           Begin DoDot:2

 +32                           NEW EVENTS

 +33      ; - if master query - create entry in (#301.9) file

 +34                           IF IVMQLR>1

                                   IF 'DFN

                                       Begin DoDot:3

 +35                                       SET IVMSEG1="QRD"_HLFS_IVMSEG

 +36                                       if '$DATA(^IVM(301.9,1,10,0))

                                               SET ^(0)="^301.9001DA^"

 +37                                       SET DA(1)=1

                                           SET DIC="^IVM(301.9,1,10,"

                                           SET DIC(0)=""

 +38                                       SET X=IVMIY

 +39                                       KILL DO,DD

                                           DO FILE^DICN

 +40                                       SET DA=+Y

                                           SET DA(1)=1

                                           SET DIE="^IVM(301.9,1,10,"

 +41                                       SET DR=".02///NOW;.04////^S X=IVMMSHID;10////^S X=IVMSEG1"

                                           DO ^DIE

                                       End DoDot:3

                                       QUIT

 +42      ;

 +43      ; Send AE if veteran has a Pseudo SSN and eligibility is not verified

 +44      ;Removed with IVM*2*105

 +45      ; I '$$SNDPSSN^IVMPTRN7(DFN) S HLERR="Pseudo SSN must be verified" D ACK Q

 +46      ;

 +47      ; - if Primary Eligibility = Employee generate error & quit

 +48                           NEW DGPRIM

 +49                           SET DGPRIM=$$GET1^DIQ(2,DFN_",",.361)

 +50                           IF $GET(DGPRIM)]""

                                   SET DGPRIM=$ORDER(^DIC(8,"B",DGPRIM,0))

 +51                           IF $GET(DGPRIM)]""

                                   SET DGPRIM=$PIECE($GET(^DIC(8,DGPRIM,0)),U,9)

 +52                           IF $GET(DGPRIM)=14

                                   SET HLERR="Message not sent.  Patient is an employee"

                                   DO ACK

                                   QUIT

 +53      ;

 +54      ; Do Z07 Consistency checks and if fail generate error & quit

 +55                           IF '$$EN^IVMZ07C(DFN)

                                   SET HLERR="Message not sent.  Inconsistencies in Record"

                                   DO ACK

                                   KILL ^TMP($JOB,"CC")

                                   QUIT

 +56      ;

 +57      ; - prepare (ACK) message

 +58      ;header (MSH)

                               if '$DATA(HLERR)

                                   DO MSGHDR

 +59      ;message (MSA)

                               DO ACK

 +60      ;

 +61      ; - set up local HL7 event type code in MSH

 +62      ; copy of incoming QRD

                               SET IVMCT=IVMCT+1

                               SET ^TMP("HLS",$JOB,IVMCT)="QRD"_HLFS_IVMSEG

 +63      ;

 +64      ; - build 'FULL' transmission (note: without MSH segment)

 +65                           SET IVMMTDT=$EXTRACT(IVMIY,1,3)+1_"1231.9999"

 +66                           DO FULL^IVMPTRN7(DFN,IVMMTDT,.EVENTS,.IVMCT,.IVMGTOT,,1,,.IVMQUERY)

                           End DoDot:2

                   End DoDot:1

 +67      ;

 +68       FOR Z="LTD","OVIS"

               IF $GET(IVMQUERY(Z))

                   DO CLOSE^SDQ(IVMQUERY(Z))

                   KILL IVMQUERY(Z)

 +69       IF 'IVMFLAG

               SET HLERR="Invalid Message Format"

               DO ACK

 +70       SET HLMTN="ORF"

 +71       SET HLMTIENA=HLMTIEN

 +72       KILL ^TMP("HLA",$JOB)

           MERGE ^TMP("HLA",$JOB)=^TMP("HLS",$JOB)

           KILL ^TMP("HLS",$JOB)

 +73       DO GENACK^HLMA1(HLEID,HLMTIENS,HLEIDS,"GB",1,.HLRESLTA,HLMTIENA,.HLP)

 +74      ;

QRYQ       KILL DFN,DR,HLEVN,IVMCT,IVMDA,IVMERROR,IVMFLAG,IVMIY,IVMMTDT,IVMSEG,IVMSEG1,IVMQLR,IVMMSHID,MSGID,MSHID

 +1        KILL ^TMP("HLA",$JOB),^TMP("HLS",$JOB),^TMP($JOB,IVMRTN)

 +2        QUIT

 +3       ;

 +4       ;

ERRCK     ; Perform error checks on HL7 (QRD) segment

 +1        IF ('DFN!(DFN'=+DFN))

               if IVMQLR'>1

                   SET HLERR="Invalid DFN"

 +2        IF '$DATA(HLERR)

               SET IVMIY=$$FMDATE^HLFNC(IVMIY)

               IF $EXTRACT(IVMIY,4,7)'="0000"!($EXTRACT(IVMIY,1,3)<292)

                   SET HLERR="Invalid Income Year"

 +3        IF '$DATA(HLERR)

               IF $PIECE(IVMSEG,HLFS,2)'="R"

                   SET HLERR="Invalid Query Format Code"

 +4        IF '$DATA(HLERR)

               IF $PIECE(IVMSEG,HLFS,3)'="I"

                   IF ($PIECE(IVMSEG,HLFS,3)'="D")

                       SET HLERR="Invalid Query Priority"

 +5        IF '$DATA(HLERR)

               IF $PIECE(IVMSEG,HLFS,9)'="DEM"

                   SET HLERR="Invalid Query Subject Filter"

 +6        IF '$DATA(HLERR)

               IF $PIECE(IVMSEG,HLFS,12)'="T"

                   SET HLERR="Invalid Query Results Level"

 +7       ;

 +8        QUIT

 +9       ;

MSGHDR    ; prepare header MSH segment in batch of 100 message events

 +1       ; input variables:

 +2       ;          IVMCT record counter

 +3       ;          HLEVN event number

 +4       ;          MSHID outgoing message id

 +5       ;             HL array for protocol

 +6       ;

 +7        NEW MID,HLRES

 +8        SET HLEVN=$GET(HLEVN)+1

 +9        if (HLEVN#100)=1

               Begin DoDot:1

 +10               KILL MSHID,HLDT,HLDT1,HLMTIEN

 +11               DO INIT^HLFNC2(HLEID,.HL)

 +12               DO CREATE^HLTF(.MSHID,.HLMTIEN,.HLDT,.HLDT1)

               End DoDot:1

 +13       SET MID=MSHID_"-"_HLEVN

 +14       DO MSH^HLFNC2(.HL,MID,.HLRES)

 +15       SET IVMCT=$GET(IVMCT)+1

 +16       SET ^TMP("HLS",$JOB,IVMCT)=HLRES

 +17       QUIT

 +18      ;

ACK       ; prepare positive and negative acknowledgement (ACK) message

 +1       ; (positive acknowledgement: MSA segment with no MSH segment)

 +2       ; (negative acknowledgement: MSA segment with MSH segment)

 +3        NEW MID,HLRES

 +4        SET IVMCT=$GET(IVMCT)+1

 +5        if $DATA(HLERR)

               Begin DoDot:1

 +6                SET IVMERROR=1

 +7                SET HLEVN=HLEVN+1

 +8                if (HLEVN#100)=1

                       Begin DoDot:2

 +9       ; set up batch

                           KILL HLMID,HLMTIEN,HLDT,HLDT1

 +10                       DO INIT^HLFNC2(HLEID,.HL)

 +11                       DO CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)

                       End DoDot:2

 +12               SET MID=HLMID_"-"_HLEVN

 +13               DO MSH^HLFNC2(.HL,MID,.HLRES)

 +14               SET ^TMP("HLS",$JOB,IVMCT)=HLRES

 +15               SET IVMCT=IVMCT+1

 +16               SET ^TMP("HLS",$JOB,IVMCT)="MSA"_HLFS_"AE"_HLFS_MSGID_HLFS_HLERR_"- SSN "_$SELECT($GET(DFN):$PIECE($$PT^IVMUFNC4(DFN),"^",2),1:"NOT FOUND")

               End DoDot:1

 +17       IF '$DATA(HLERR)

               SET ^TMP("HLS",$JOB,IVMCT)="MSA"_HLFS_"AA"_HLFS_HLMID

 +18      ;

 +19       QUIT

 +20      ;

EASPREC4.m