IVMPREC ;ALB/MLI/ESD,BAJ - PROCESS INCOMING HL7 (QRY) MESSAGES ; 8/17/06 2:37pm
;;2.0;INCOME VERIFICATION MATCH;**1,9,11,15,18,24,34,105**;JUL 8,1996;Build 2
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; 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=$O(^ORD(101,HLEID,775,"B",0))
;
; 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
..;
..; - 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)
;
; IVM*2.0*105 BAJ 11/02/2005
; send AE if inconsistencies found.
I ^TMP($J,"CC",0) S HLERR="Message not sent. Inconsistencies in Record" D ACK
K ^TMP($J,"CC")
;
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)
Q
;
;
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"
;
Q
;
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
Q
;
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
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMPREC 5049 printed Sep 23, 2025@19:37:33 Page 2
IVMPREC ;ALB/MLI/ESD,BAJ - PROCESS INCOMING HL7 (QRY) MESSAGES ; 8/17/06 2:37pm
+1 ;;2.0;INCOME VERIFICATION MATCH;**1,9,11,15,18,24,34,105**;JUL 8,1996;Build 2
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; This routine will process (QRY) HL7 messages received from HEC
+5 ; At present, the (QRY) message queries for updated information
+6 ; for a single patient.
+7 ;
+8 ;
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=$ORDER(^ORD(101,HLEID,775,"B",0))
+18 ;
+19 ; IVM*2.0*105 BAJ 11/02/2005 Temp global for Consistency Checks
+20 KILL ^TMP($JOB,"CC")
+21 ;
+22 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
+23 IF $EXTRACT(IVMSEG,1,3)="MSH"
SET IVMMSHID=$PIECE(IVMSEG,HLFS,10)
SET MSGID=$PIECE(IVMSEG,HLFS,10)
SET HLMID=MSGID
QUIT
+24 KILL HLERR
SET IVMFLAG=1
+25 ; strip off segment name
SET IVMSEG=$PIECE(IVMSEG,HLFS,2,999)
+26 SET IVMQLR=$PIECE(IVMSEG,HLFS,7)
SET DFN=$PIECE(IVMSEG,HLFS,8)
SET IVMIY=$PIECE(IVMSEG,HLFS,10)
+27 DO ERRCK
+28 IF $DATA(HLERR)
DO ACK
+29 IF '$DATA(HLERR)
Begin DoDot:2
+30 NEW EVENTS
+31 ; - if master query - create entry in (#301.9) file
+32 IF IVMQLR>1
IF 'DFN
Begin DoDot:3
+33 SET IVMSEG1="QRD"_HLFS_IVMSEG
+34 if '$DATA(^IVM(301.9,1,10,0))
SET ^(0)="^301.9001DA^"
+35 SET DA(1)=1
SET DIC="^IVM(301.9,1,10,"
SET DIC(0)=""
+36 SET X=IVMIY
+37 KILL DO,DD
DO FILE^DICN
+38 SET DA=+Y
SET DA(1)=1
SET DIE="^IVM(301.9,1,10,"
+39 SET DR=".02///NOW;.04////^S X=IVMMSHID;10////^S X=IVMSEG1"
DO ^DIE
End DoDot:3
QUIT
+40 ;
+41 ; Send AE if veteran has a Pseudo SSN and eligibility is not verified
+42 ; Removed with IVM*2*105
+43 ; I '$$SNDPSSN^IVMPTRN7(DFN) S HLERR="Pseudo SSN must be verified" D ACK Q
+44 ;
+45 ; - prepare (ACK) message
+46 ;header (MSH)
if '$DATA(HLERR)
DO MSGHDR
+47 ;message (MSA)
DO ACK
+48 ;
+49 ; - set up local HL7 event type code in MSH
+50 ; copy of incoming QRD
SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)="QRD"_HLFS_IVMSEG
+51 ;
+52 ; - build 'FULL' transmission (note: without MSH segment)
+53 SET IVMMTDT=$EXTRACT(IVMIY,1,3)+1_"1231.9999"
+54 DO FULL^IVMPTRN7(DFN,IVMMTDT,.EVENTS,.IVMCT,.IVMGTOT,,1,,.IVMQUERY)
End DoDot:2
End DoDot:1
+55 ;
+56 ; IVM*2.0*105 BAJ 11/02/2005
+57 ; send AE if inconsistencies found.
+58 IF ^TMP($JOB,"CC",0)
SET HLERR="Message not sent. Inconsistencies in Record"
DO ACK
+59 KILL ^TMP($JOB,"CC")
+60 ;
+61 FOR Z="LTD","OVIS"
IF $GET(IVMQUERY(Z))
DO CLOSE^SDQ(IVMQUERY(Z))
KILL IVMQUERY(Z)
+62 IF 'IVMFLAG
SET HLERR="Invalid Message Format"
DO ACK
+63 SET HLMTN="ORF"
+64 SET HLMTIENA=HLMTIEN
+65 KILL ^TMP("HLA",$JOB)
MERGE ^TMP("HLA",$JOB)=^TMP("HLS",$JOB)
KILL ^TMP("HLS",$JOB)
+66 DO GENACK^HLMA1(HLEID,HLMTIENS,HLEIDS,"GB",1,.HLRESLTA,HLMTIENA,.HLP)
+67 ;
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 ;
