IVMCM ;ALB/SEK,KCL,RTK,AEG,BRM,AEG,HM,KUM - PROCESS INCOME TEST (Z10) TRANSMISSIONS ;3/30/20 1:48pm
;;2.0;INCOME VERIFICATION MATCH;**12,17,28,41,44,53,34,49,59,55,63,77,74,123,115,183,190,162**;21-OCT-94;Build 44
;Per VHA Directive 2004-038, this routine should not be modified.
;
;Supported ICRs
; #3812 - $$FINDCUR^DGENA()
; #2056 - $$GET1^DIQ(}
; #2462 - Reference to file #27.11
;
ORF ; Handler for ORF type HL7 messages received from HEC
;
; Make sure POSTMASTER DUZ instead of DUZ of Person who
; started Incoming Logical Link.
S DUZ=.5
N CNT,IVMRTN,SEGCNT
S IVMRTN="IVMCMX" ;USE "IVMCMX" BECAUSE "IVMCM" ALREADY USED
K ^TMP($J,IVMRTN),DIC
S (DGMSGF,DGMTMSG)=1 ; HL7 rtn. Don't need DG interative messages.
S HLECH=HL("ECH"),HLQ=HL("Q"),HLMID=HL("MID")
K %,%H,%I D NOW^%DTC S HLDT=%
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)
S HLDA=HLMTIEN
;
N SEG,EVENT,MSGID
S:'$D(HLEVN) HLEVN=0
D NXTSEG^DGENUPL(HLDA,0,.SEG)
Q:(SEG("TYPE")'="MSH") ;would not have reached here if this happened!
S EVENT=$P(SEG(9),$E(HLECH),2)
;
; INITIALIZE HL7 VARIABLES
S HLEID="VAMC "_$P($$SITE^VASITE,"^",3)_" ORF-"_EVENT_" SERVER"
S HLEID=$O(^ORD(101,"B",HLEID,0))
D INIT^HLFNC2(HLEID,.HL)
S HLEIDS=$O(^ORD(101,HLEID,775,"B",0))
;
; Handle means test signature ORF (Z06) event
I EVENT="Z06" D ORF^IVMPREC7
;
; Handle income test ORF (Z10) event
I EVENT="Z10" D Z10
;
; Handle enrollment/elig. ORF (Z11) event
I EVENT="Z11" D
.S MSGID=SEG(10)
.D ORFZ11^DGENUPL(HLDA,MSGID)
;
K ^TMP($J,IVMRTN)
Q
;
;
Z10 ; Entry point for receipt of ORF~Z10 transmission
; The Income Test (Z10) transmission has the following format:
;
; BHS ORF msgs do not include batch header or trailer.
; {MSH
; PID They will include the sequence: MSA
; ZIC QRD
; ZIR QRF
; {ZDP These segments will follow the MSH segment.
; ZIC
; ZIR
; }
; {NTE Updated for IVM*2.0*190
; }
; {ZMT
; }
; ZBT
; }
; BTS
;
S IVMORF=1 ; set ORF msg flag
S (HLEVN,IVMCT,IVMERROR,IVMCNTR)=0 ; init vars
;
ORU ; Entry point for receipt of ORU~Z10 trans (called by IVMPREC2)
S IVMTYPE=5,IVMZ10F=1
;
; - loop through the msg in (#772 file), and process (PROC) msgs
S IVMDA=0 F S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)) Q:'IVMDA S IVMSEG=$G(^(IVMDA,0)) I $E(IVMSEG,1,3)="MSH" D PROC Q:'IVMDA
;
; - if ORF msg flag, update the Query Tran Log
I $G(IVMORF) D
.I $G(DFN),$D(IVMMCI) D
..N IVMCR
..S IVMCR=$P("1^2^3^7^5^6^4","^",IVMTYPE) ;map reason to test type
..D FIND^IVMCQ2(DFN,IVMMCI,HLDT,$S($D(HLERR):5,1:IVMCR),1)
;
; - if tests are uploaded, generate notification msg
I $D(^TMP($J,"IVMBULL")) D ^IVMCMB
;
ENQ ;
K IVMDA,IVMORF,IVMSEG,IVMFLGC,IVMTYPE,IVMMTIEN,IVMMTDT,IVMDGBT,IVMMCI
K ^TMP($J,"IVMCM"),^("IVMBULL"),DGMSGF,DGADDF,IVMCPAY,IVMBULL,DFN
K DGMTMSG,IVMZ10F
Q
;
PROC ; Process each HL7 message from (#772) file
;
N IVMFUTR,TMSTAMP,SOURCE,NODE,HSDATE,IVMZ10,DGMTP,DGMTACT,DGMTI,DGMTA,SRCTST,IVMREGO ;IVM*2.0*190
S DGMTACT="ADD"
D PRIOR^DGMTEVT
S IVMZ10="UPLOAD IN PROGRESS"
S IVMFUTR=0 ;this flag will indicate whether or not a test with a future date is being uploaded
S IVMMTIEN=0
;
S MSGID=$P(IVMSEG,HLFS,10) ; msg control id for ACK's
; - check if DCD messaging is enabled
I '$$DCDON^IVMUPAR1() D PROB^IVMCMC("Facility has DCD messaging disabled") Q
;
; - check HL7 msg structure for errors
K HLERR,^TMP($J,"IVMCM")
D ^IVMCMC I $D(HLERR) K:HLERR="" HLERR Q
;
; Determine type of test/transmission
S IVMTYPE=0
;
; - was a means test sent?
I $P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,2) S IVMTYPE=1 ; MT trans
;
; - if MT and CT transmitted, error - pt can't have both unless
; one is a deletion, but HEC not currently handling that situation
I IVMTYPE,$P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,2) D PROB^IVMCMC("Patient can not have both a Means Test and Copay Test") Q
I $P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,2) S IVMTYPE=2 ; CT trans
;
; IVM*2.0*162 - BEGIN
S IVMREGO=""
I (IVMTYPE=1)!(IVMTYPE=2) D
.;Find patient's current enrollment record
.N IVMENIEN,IVMENRC
.S IVMENIEN=""
.S IVMENRC=""
.; $$FINDCUR^DGENA(DFN) is supported by ICR #3812
.S IVMENIEN=$$FINDCUR^DGENA(DFN)
.I IVMENIEN S IVMENRC=$$GET1^DIQ(27.11,IVMENIEN_",",.04,"I")
.I $G(IVMENRC)=25 S IVMREGO="Y"
I IVMREGO="Y" D PROB^IVMCMC("Enrollment Status is Registration Only - not subject to Means Test or RX Copay Test") Q
; IVM*2.0*162 - END
; - if no MT or CT or LTC then Income Screening
I 'IVMTYPE,'$P($G(^TMP($J,"IVMCM","ZMT4")),HLFS,2) S IVMTYPE=3 ; IS trans
;
;send an eligibility query if no eligibility code
I '$$ELIG^IVMCUF1(DFN),'$$PENDING^DGENQRY(DFN) I $$SEND^DGENQRY1(DFN)
;
; obtain locks used to sychronize upload with local income test options
D GETLOCKS^IVMCUPL(DFN)
;
;
MT ; If transmission is a Means Test
N NODE0,RET,CODE,DATA,MTSIG,MTSIGDT,CATCA ;IVM*2.0*183 HM
S HLQ=$G(HL("Q"))
S:HLQ="" HLQ=""""""
I IVMTYPE=1 D I $D(HLERR) G PROCQ
.S IVMMTDT=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,2))
.S TMSTAMP=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,25))
.S HSDATE=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,24))
.S SOURCE=$P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,22)
.S SRCTST=$P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,18) ;IVM*2.0*190
.S MTSIG=$P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,27)
.S MTSIGDT=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,15))
.S IVMLAST=$$LST^DGMTU(DFN,$E(IVMMTDT,1,3)_1231,1)
.; Check that test is for same year
.I $P(IVMLAST,U,2),$E($P(IVMLAST,U,2),1,3)'=$E(IVMMTDT,1,3) S IVMLAST=""
.Q:$$UPDMTSIG^IVMCMF(+IVMLAST,TMSTAMP,MTSIG,MTSIGDT)
.I $$Z06MT^EASPTRN1(+IVMLAST) D PROB^IVMCMC("IVM Means Test already on file for this year") Q
.I '$$ELIG^IVMUFNC5(DFN) D PROB^IVMCMC("Means Test upload not appropriate for current patient") Q
.I $$AGE^IVMUFNC5(DT)>$$INCY^IVMUFNC5(IVMMTDT) D I $D(HLERR) Q ;IVM*2.0*183 HM
..N CATCZMT S CATCZMT=$G(^TMP($J,"IVMCM","ZMT1"))
..S CATC=$$CATC^IVMUFNC5(CATCZMT)
..I '+$G(CATC) D PROB^IVMCMC("Only Means Tests in current/previous income years are valid (not effective)") K CATC Q ;IVM*2.0*183 HM
..;IVM*2.0*183 HM Check if MT Copay Exempt or GMT Copay Required
..S CATCA=$$ACCMT^IVMUFNC5(CATCZMT) ;IVM*2.0*183 HM
..I '+$G(CATCA) D PROB^IVMCMC("Only Means Tests greater than or equal to one year prior to the VFA Start Date of 1/1/2013 are valid for MT COPAY EXEMPT or GMT COPAY REQUIRED") K CATCA Q ;IVM*2.0*183 HM
.;
.; - perform edit checks and file MT
.D CHKDT
.;deletion indicator sent?
.I $P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,3)=HLQ D Q
..D
...;if there is a future test for that income year, delete that
...N IEN,DATA,IVMPAT
...S IEN=$$FUTURE(DFN,($E(IVMMTDT,1,3)-1),1,.IVMPAT)
...I IEN S DATA(.06)="" I $$UPD^DGENDBS(301.5,IVMPAT,.DATA)
...I IEN,$D(^DGMT(408.31,IEN,0)) D
....S IVMMTIEN=IEN
....S IVMFUTR=1
...E D
....S IVMFUTR=0
..Q:('IVMMTIEN)
..S NODE0=$G(^DGMT(408.31,IVMMTIEN,0))
..I $$EN^IVMCMD(IVMMTIEN) D
...S RET=$$LST^DGMTU(DFN,DT,IVMTYPE)
...S CODE=$S(($E($P(RET,"^",2),1,3)=$E(DT,1,3)):$P(RET,"^",4),1:"")
...D ADD^IVMCMB(DFN,IVMTYPE,$S(IVMFUTR:"DELETE FUTR TEST",1:"DELETE PRMRY TEST"),+$G(NODE0),$$GETCODE^DGMTH($P(NODE0,"^",3)),CODE)
.;
.;check timestamp - if matches current primary test and hardship matches, then this is a duplicate and does not need to be uploaded
.I TMSTAMP D
..S NODE=""
..I IVMFUTR N IVMMTIEN S IVMMTIEN=$$FUTURE(DFN,($E(IVMMTDT,1,3)-1),1)
..Q:'IVMMTIEN
..S NODE=$G(^DGMT(408.31,IVMMTIEN,2))
.S NODE0=$G(^DGMT(408.31,IVMMTIEN,0))
.I TMSTAMP,TMSTAMP=$P(NODE,"^",2),IVMMTDT=$P(NODE0,"^"),SOURCE=$P(NODE,"^",5),(HSDATE=$P(NODE,"^")) Q
.;
.D DELTYPE^IVMCMD(DFN,IVMMTDT,2)
.D EN^IVMCM1
;
;
CT ; If transmission is a Copay Test
N NODE0,RET,CODE,DATA
I IVMTYPE=2 D I $D(HLERR) G PROCQ
.S IVMMTDT=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,2))
.S TMSTAMP=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,25))
.S SOURCE=$P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,22)
.S SRCTST=$P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,18) ;IVM*2.0*190
.S IVMLAST=$$LST^DGMTU(DFN,$E(IVMMTDT,1,3)_1231,2)
.S IVMCPAY=$$RXST^IBARXEU(DFN)
.I $$AGE^IVMUFNC5(DT)>$$INCY^IVMUFNC5(IVMMTDT) D PROB^IVMCMC("Only Copay Tests in the current/previous income years are valid. (Not effective)") Q
.; - perform edit checks and file CT
.D CHKDT
.;deletion indicator sent?
.I $P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,3)=HLQ D Q
..D
...;if there is a future test for that income year, delete that
...N IEN,DATA,IVMPAT
...S IEN=$$FUTURE(DFN,($E(IVMMTDT,1,3)-1),2,.IVMPAT)
...I IEN S DATA(.07)="" I $$UPD^DGENDBS(301.5,IVMPAT,.DATA)
...I IEN,$D(^DGMT(408.31,IEN,0)) D
....S IVMMTIEN=IEN
....S IVMFUTR=1
...E D
....S IVMFUTR=0
..Q:('IVMMTIEN)
..S NODE0=$G(^DGMT(408.31,IVMMTIEN,0))
..I $$EN^IVMCMD(IVMMTIEN) D
...S RET=$$LST^DGMTU(DFN,DT,IVMTYPE)
...S CODE=$S(($E($P(RET,"^",2),1,3)=$E(DT,1,3)):$P(RET,"^",4),1:"")
...D ADD^IVMCMB(DFN,IVMTYPE,$S(IVMFUTR:"DELETE FUTR TEST",1:"DELETE PRMRY TEST"),+$G(NODE0),$$GETCODE^DGMTH($P(NODE0,"^",3)),CODE)
.;
.;check timestamp - if matches current primary test, then this is a duplicate and does not need to be uploaded
.I TMSTAMP D
..S NODE=""
..I IVMFUTR N IVMMTIEN S IVMMTIEN=$$FUTURE(DFN,($E(IVMMTDT,1,3)-1),2)
..Q:'IVMMTIEN
..S NODE=$G(^DGMT(408.31,IVMMTIEN,2))
.S NODE0=$G(^DGMT(408.31,IVMMTIEN,0))
.I TMSTAMP,TMSTAMP=$P(NODE,"^",2),IVMMTDT=$P(NODE0,"^"),SOURCE=$P(NODE,"^",5) Q
.;
.D DELTYPE^IVMCMD(DFN,IVMMTDT,1)
.D EN^IVMCM1
;
IS ; - If transmission is income screening info only then do not process
; - outside of the scope of MTS
;I IVMTYPE=3 S IVMMTDT=0 D EN^IVMCM1 I $D(HLERR) G PROCQ
I IVMTYPE=3 S IVMMTDT=0
;
LTC ; If transmission contains a Long Term Care Test (TYPE 4 TEST)
I $P($G(^TMP($J,"IVMCM","ZMT4")),HLFS,2) D LTC^IVMCM1
;
PROCQ ;
; release locks used to sychronize upload with local income test options
D RELLOCKS^IVMCUPL(DFN)
Q
;
CHKDT ; check date of income test being uploaded
; Is it a future date? If so, set IVMFUTR=1
;
; IVMMTIEN is the IEN of current primary test for the year
;
I $E($P(IVMLAST,"^",2),1,3)=$E(IVMMTDT,1,3) S IVMMTIEN=+IVMLAST
I IVMMTDT>DT S IVMFUTR=1
Q
FUTURE(DFN,YEAR,TYPE,IVMPAT) ;
;Returns the ien of the future test, if there is one
;Inputs: DFN
; YEAR - income year
; TYPE - type of test
;Output:
; function value - ien of future means test, if there is one, "" otherwise
; IVMPAT - Pointer to the IVM Patient file for the income year if there is an entry (pass by reference)
;
N RET
S RET=""
S IVMPAT=$$FIND^IVMPLOG(DFN,YEAR)
I IVMPAT S RET=$P($G(^IVM(301.5,IVMPAT,0)),"^",$S(TYPE=1:6,1:7))
Q RET
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMCM 11211 printed Sep 23, 2025@19:36:33 Page 2
IVMCM ;ALB/SEK,KCL,RTK,AEG,BRM,AEG,HM,KUM - PROCESS INCOME TEST (Z10) TRANSMISSIONS ;3/30/20 1:48pm
+1 ;;2.0;INCOME VERIFICATION MATCH;**12,17,28,41,44,53,34,49,59,55,63,77,74,123,115,183,190,162**;21-OCT-94;Build 44
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;Supported ICRs
+5 ; #3812 - $$FINDCUR^DGENA()
+6 ; #2056 - $$GET1^DIQ(}
+7 ; #2462 - Reference to file #27.11
+8 ;
ORF ; Handler for ORF type HL7 messages received from HEC
+1 ;
+2 ; Make sure POSTMASTER DUZ instead of DUZ of Person who
+3 ; started Incoming Logical Link.
+4 SET DUZ=.5
+5 NEW CNT,IVMRTN,SEGCNT
+6 ;USE "IVMCMX" BECAUSE "IVMCM" ALREADY USED
SET IVMRTN="IVMCMX"
+7 KILL ^TMP($JOB,IVMRTN),DIC
+8 ; HL7 rtn. Don't need DG interative messages.
SET (DGMSGF,DGMTMSG)=1
+9 SET HLECH=HL("ECH")
SET HLQ=HL("Q")
SET HLMID=HL("MID")
+10 KILL %,%H,%I
DO NOW^%DTC
SET HLDT=%
+11 FOR SEGCNT=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
Begin DoDot:1
+12 SET CNT=0
+13 SET ^TMP($JOB,IVMRTN,SEGCNT,CNT)=HLNODE
+14 FOR
SET CNT=$ORDER(HLNODE(CNT))
if 'CNT
QUIT
Begin DoDot:2
+15 SET ^TMP($JOB,IVMRTN,SEGCNT,CNT)=HLNODE(CNT)
End DoDot:2
End DoDot:1
+16 SET HLDA=HLMTIEN
+17 ;
+18 NEW SEG,EVENT,MSGID
+19 if '$DATA(HLEVN)
SET HLEVN=0
+20 DO NXTSEG^DGENUPL(HLDA,0,.SEG)
+21 ;would not have reached here if this happened!
if (SEG("TYPE")'="MSH")
QUIT
+22 SET EVENT=$PIECE(SEG(9),$EXTRACT(HLECH),2)
+23 ;
+24 ; INITIALIZE HL7 VARIABLES
+25 SET HLEID="VAMC "_$PIECE($$SITE^VASITE,"^",3)_" ORF-"_EVENT_" SERVER"
+26 SET HLEID=$ORDER(^ORD(101,"B",HLEID,0))
+27 DO INIT^HLFNC2(HLEID,.HL)
+28 SET HLEIDS=$ORDER(^ORD(101,HLEID,775,"B",0))
+29 ;
+30 ; Handle means test signature ORF (Z06) event
+31 IF EVENT="Z06"
DO ORF^IVMPREC7
+32 ;
+33 ; Handle income test ORF (Z10) event
+34 IF EVENT="Z10"
DO Z10
+35 ;
+36 ; Handle enrollment/elig. ORF (Z11) event
+37 IF EVENT="Z11"
Begin DoDot:1
+38 SET MSGID=SEG(10)
+39 DO ORFZ11^DGENUPL(HLDA,MSGID)
End DoDot:1
+40 ;
+41 KILL ^TMP($JOB,IVMRTN)
+42 QUIT
+43 ;
+44 ;
Z10 ; Entry point for receipt of ORF~Z10 transmission
+1 ; The Income Test (Z10) transmission has the following format:
+2 ;
+3 ; BHS ORF msgs do not include batch header or trailer.
+4 ; {MSH
+5 ; PID They will include the sequence: MSA
+6 ; ZIC QRD
+7 ; ZIR QRF
+8 ; {ZDP These segments will follow the MSH segment.
+9 ; ZIC
+10 ; ZIR
+11 ; }
+12 ; {NTE Updated for IVM*2.0*190
+13 ; }
+14 ; {ZMT
+15 ; }
+16 ; ZBT
+17 ; }
+18 ; BTS
+19 ;
+20 ; set ORF msg flag
SET IVMORF=1
+21 ; init vars
SET (HLEVN,IVMCT,IVMERROR,IVMCNTR)=0
+22 ;
ORU ; Entry point for receipt of ORU~Z10 trans (called by IVMPREC2)
+1 SET IVMTYPE=5
SET IVMZ10F=1
+2 ;
+3 ; - loop through the msg in (#772 file), and process (PROC) msgs
+4 SET IVMDA=0
FOR
SET IVMDA=$ORDER(^TMP($JOB,IVMRTN,IVMDA))
if 'IVMDA
QUIT
SET IVMSEG=$GET(^(IVMDA,0))
IF $EXTRACT(IVMSEG,1,3)="MSH"
DO PROC
if 'IVMDA
QUIT
+5 ;
+6 ; - if ORF msg flag, update the Query Tran Log
+7 IF $GET(IVMORF)
Begin DoDot:1
+8 IF $GET(DFN)
IF $DATA(IVMMCI)
Begin DoDot:2
+9 NEW IVMCR
+10 ;map reason to test type
SET IVMCR=$PIECE("1^2^3^7^5^6^4","^",IVMTYPE)
+11 DO FIND^IVMCQ2(DFN,IVMMCI,HLDT,$SELECT($DATA(HLERR):5,1:IVMCR),1)
End DoDot:2
End DoDot:1
+12 ;
+13 ; - if tests are uploaded, generate notification msg
+14 IF $DATA(^TMP($JOB,"IVMBULL"))
DO ^IVMCMB
+15 ;
ENQ ;
+1 KILL IVMDA,IVMORF,IVMSEG,IVMFLGC,IVMTYPE,IVMMTIEN,IVMMTDT,IVMDGBT,IVMMCI
+2 KILL ^TMP($JOB,"IVMCM"),^("IVMBULL"),DGMSGF,DGADDF,IVMCPAY,IVMBULL,DFN
+3 KILL DGMTMSG,IVMZ10F
+4 QUIT
+5 ;
PROC ; Process each HL7 message from (#772) file
+1 ;
+2 ;IVM*2.0*190
NEW IVMFUTR,TMSTAMP,SOURCE,NODE,HSDATE,IVMZ10,DGMTP,DGMTACT,DGMTI,DGMTA,SRCTST,IVMREGO
+3 SET DGMTACT="ADD"
+4 DO PRIOR^DGMTEVT
+5 SET IVMZ10="UPLOAD IN PROGRESS"
+6 ;this flag will indicate whether or not a test with a future date is being uploaded
SET IVMFUTR=0
+7 SET IVMMTIEN=0
+8 ;
+9 ; msg control id for ACK's
SET MSGID=$PIECE(IVMSEG,HLFS,10)
+10 ; - check if DCD messaging is enabled
+11 IF '$$DCDON^IVMUPAR1()
DO PROB^IVMCMC("Facility has DCD messaging disabled")
QUIT
+12 ;
+13 ; - check HL7 msg structure for errors
+14 KILL HLERR,^TMP($JOB,"IVMCM")
+15 DO ^IVMCMC
IF $DATA(HLERR)
if HLERR=""
KILL HLERR
QUIT
+16 ;
+17 ; Determine type of test/transmission
+18 SET IVMTYPE=0
+19 ;
+20 ; - was a means test sent?
+21 ; MT trans
IF $PIECE($GET(^TMP($JOB,"IVMCM","ZMT1")),HLFS,2)
SET IVMTYPE=1
+22 ;
+23 ; - if MT and CT transmitted, error - pt can't have both unless
+24 ; one is a deletion, but HEC not currently handling that situation
+25 IF IVMTYPE
IF $PIECE($GET(^TMP($JOB,"IVMCM","ZMT2")),HLFS,2)
DO PROB^IVMCMC("Patient can not have both a Means Test and Copay Test")
QUIT
+26 ; CT trans
IF $PIECE($GET(^TMP($JOB,"IVMCM","ZMT2")),HLFS,2)
SET IVMTYPE=2
+27 ;
+28 ; IVM*2.0*162 - BEGIN
+29 SET IVMREGO=""
+30 IF (IVMTYPE=1)!(IVMTYPE=2)
Begin DoDot:1
+31 ;Find patient's current enrollment record
+32 NEW IVMENIEN,IVMENRC
+33 SET IVMENIEN=""
+34 SET IVMENRC=""
+35 ; $$FINDCUR^DGENA(DFN) is supported by ICR #3812
+36 SET IVMENIEN=$$FINDCUR^DGENA(DFN)
+37 IF IVMENIEN
SET IVMENRC=$$GET1^DIQ(27.11,IVMENIEN_",",.04,"I")
+38 IF $GET(IVMENRC)=25
SET IVMREGO="Y"
End DoDot:1
+39 IF IVMREGO="Y"
DO PROB^IVMCMC("Enrollment Status is Registration Only - not subject to Means Test or RX Copay Test")
QUIT
+40 ; IVM*2.0*162 - END
+41 ; - if no MT or CT or LTC then Income Screening
+42 ; IS trans
IF 'IVMTYPE
IF '$PIECE($GET(^TMP($JOB,"IVMCM","ZMT4")),HLFS,2)
SET IVMTYPE=3
+43 ;
+44 ;send an eligibility query if no eligibility code
+45 IF '$$ELIG^IVMCUF1(DFN)
IF '$$PENDING^DGENQRY(DFN)
IF $$SEND^DGENQRY1(DFN)
+46 ;
+47 ; obtain locks used to sychronize upload with local income test options
+48 DO GETLOCKS^IVMCUPL(DFN)
+49 ;
+50 ;
MT ; If transmission is a Means Test
+1 ;IVM*2.0*183 HM
NEW NODE0,RET,CODE,DATA,MTSIG,MTSIGDT,CATCA
+2 SET HLQ=$GET(HL("Q"))
+3 if HLQ=""
SET HLQ=""""""
+4 IF IVMTYPE=1
Begin DoDot:1
+5 SET IVMMTDT=$$FMDATE^HLFNC($PIECE($GET(^TMP($JOB,"IVMCM","ZMT1")),HLFS,2))
+6 SET TMSTAMP=$$FMDATE^HLFNC($PIECE($GET(^TMP($JOB,"IVMCM","ZMT1")),HLFS,25))
+7 SET HSDATE=$$FMDATE^HLFNC($PIECE($GET(^TMP($JOB,"IVMCM","ZMT1")),HLFS,24))
+8 SET SOURCE=$PIECE($GET(^TMP($JOB,"IVMCM","ZMT1")),HLFS,22)
+9 ;IVM*2.0*190
SET SRCTST=$PIECE($GET(^TMP($JOB,"IVMCM","ZMT1")),HLFS,18)
+10 SET MTSIG=$PIECE($GET(^TMP($JOB,"IVMCM","ZMT1")),HLFS,27)
+11 SET MTSIGDT=$$FMDATE^HLFNC($PIECE($GET(^TMP($JOB,"IVMCM","ZMT1")),HLFS,15))
+12 SET IVMLAST=$$LST^DGMTU(DFN,$EXTRACT(IVMMTDT,1,3)_1231,1)
+13 ; Check that test is for same year
+14 IF $PIECE(IVMLAST,U,2)
IF $EXTRACT($PIECE(IVMLAST,U,2),1,3)'=$EXTRACT(IVMMTDT,1,3)
SET IVMLAST=""
+15 if $$UPDMTSIG^IVMCMF(+IVMLAST,TMSTAMP,MTSIG,MTSIGDT)
QUIT
+16 IF $$Z06MT^EASPTRN1(+IVMLAST)
DO PROB^IVMCMC("IVM Means Test already on file for this year")
QUIT
+17 IF '$$ELIG^IVMUFNC5(DFN)
DO PROB^IVMCMC("Means Test upload not appropriate for current patient")
QUIT
+18 ;IVM*2.0*183 HM
IF $$AGE^IVMUFNC5(DT)>$$INCY^IVMUFNC5(IVMMTDT)
Begin DoDot:2
+19 NEW CATCZMT
SET CATCZMT=$GET(^TMP($JOB,"IVMCM","ZMT1"))
+20 SET CATC=$$CATC^IVMUFNC5(CATCZMT)
+21 ;IVM*2.0*183 HM
IF '+$GET(CATC)
DO PROB^IVMCMC("Only Means Tests in current/previous income years are valid (not effective)")
KILL CATC
QUIT
+22 ;IVM*2.0*183 HM Check if MT Copay Exempt or GMT Copay Required
+23 ;IVM*2.0*183 HM
SET CATCA=$$ACCMT^IVMUFNC5(CATCZMT)
+24 ;IVM*2.0*183 HM
IF '+$GET(CATCA)
DO PROB^IVMCMC("Only Means Tests greater than or equal to one year prior to the VFA Start Date of 1/1/2013 are valid for MT COPAY EXEMPT or GMT COPAY REQUIRED")
KILL CATCA
QUIT
End DoDot:2
IF $DATA(HLERR)
QUIT
+25 ;
+26 ; - perform edit checks and file MT
+27 DO CHKDT
+28 ;deletion indicator sent?
+29 IF $PIECE($GET(^TMP($JOB,"IVMCM","ZMT1")),HLFS,3)=HLQ
Begin DoDot:2
+30 Begin DoDot:3
+31 ;if there is a future test for that income year, delete that
+32 NEW IEN,DATA,IVMPAT
+33 SET IEN=$$FUTURE(DFN,($EXTRACT(IVMMTDT,1,3)-1),1,.IVMPAT)
+34 IF IEN
SET DATA(.06)=""
IF $$UPD^DGENDBS(301.5,IVMPAT,.DATA)
+35 IF IEN
IF $DATA(^DGMT(408.31,IEN,0))
Begin DoDot:4
+36 SET IVMMTIEN=IEN
+37 SET IVMFUTR=1
End DoDot:4
+38 IF '$TEST
Begin DoDot:4
+39 SET IVMFUTR=0
End DoDot:4
End DoDot:3
+40 if ('IVMMTIEN)
QUIT
+41 SET NODE0=$GET(^DGMT(408.31,IVMMTIEN,0))
+42 IF $$EN^IVMCMD(IVMMTIEN)
Begin DoDot:3
+43 SET RET=$$LST^DGMTU(DFN,DT,IVMTYPE)
+44 SET CODE=$SELECT(($EXTRACT($PIECE(RET,"^",2),1,3)=$EXTRACT(DT,1,3)):$PIECE(RET,"^",4),1:"")
+45 DO ADD^IVMCMB(DFN,IVMTYPE,$SELECT(IVMFUTR:"DELETE FUTR TEST",1:"DELETE PRMRY TEST"),+$GET(NODE0),$$GETCODE^DGMTH($PIECE(NODE0,"^",3)),CODE)
End DoDot:3
End DoDot:2
QUIT
+46 ;
+47 ;check timestamp - if matches current primary test and hardship matches, then this is a duplicate and does not need to be uploaded
+48 IF TMSTAMP
Begin DoDot:2
+49 SET NODE=""
+50 IF IVMFUTR
NEW IVMMTIEN
SET IVMMTIEN=$$FUTURE(DFN,($EXTRACT(IVMMTDT,1,3)-1),1)
+51 if 'IVMMTIEN
QUIT
+52 SET NODE=$GET(^DGMT(408.31,IVMMTIEN,2))
End DoDot:2
+53 SET NODE0=$GET(^DGMT(408.31,IVMMTIEN,0))
+54 IF TMSTAMP
IF TMSTAMP=$PIECE(NODE,"^",2)
IF IVMMTDT=$PIECE(NODE0,"^")
IF SOURCE=$PIECE(NODE,"^",5)
IF (HSDATE=$PIECE(NODE,"^"))
QUIT
+55 ;
+56 DO DELTYPE^IVMCMD(DFN,IVMMTDT,2)
+57 DO EN^IVMCM1
End DoDot:1
IF $DATA(HLERR)
GOTO PROCQ
+58 ;
+59 ;
CT ; If transmission is a Copay Test
+1 NEW NODE0,RET,CODE,DATA
+2 IF IVMTYPE=2
Begin DoDot:1
+3 SET IVMMTDT=$$FMDATE^HLFNC($PIECE($GET(^TMP($JOB,"IVMCM","ZMT2")),HLFS,2))
+4 SET TMSTAMP=$$FMDATE^HLFNC($PIECE($GET(^TMP($JOB,"IVMCM","ZMT2")),HLFS,25))
+5 SET SOURCE=$PIECE($GET(^TMP($JOB,"IVMCM","ZMT2")),HLFS,22)
+6 ;IVM*2.0*190
SET SRCTST=$PIECE($GET(^TMP($JOB,"IVMCM","ZMT2")),HLFS,18)
+7 SET IVMLAST=$$LST^DGMTU(DFN,$EXTRACT(IVMMTDT,1,3)_1231,2)
+8 SET IVMCPAY=$$RXST^IBARXEU(DFN)
+9 IF $$AGE^IVMUFNC5(DT)>$$INCY^IVMUFNC5(IVMMTDT)
DO PROB^IVMCMC("Only Copay Tests in the current/previous income years are valid. (Not effective)")
QUIT
+10 ; - perform edit checks and file CT
+11 DO CHKDT
+12 ;deletion indicator sent?
+13 IF $PIECE($GET(^TMP($JOB,"IVMCM","ZMT2")),HLFS,3)=HLQ
Begin DoDot:2
+14 Begin DoDot:3
+15 ;if there is a future test for that income year, delete that
+16 NEW IEN,DATA,IVMPAT
+17 SET IEN=$$FUTURE(DFN,($EXTRACT(IVMMTDT,1,3)-1),2,.IVMPAT)
+18 IF IEN
SET DATA(.07)=""
IF $$UPD^DGENDBS(301.5,IVMPAT,.DATA)
+19 IF IEN
IF $DATA(^DGMT(408.31,IEN,0))
Begin DoDot:4
+20 SET IVMMTIEN=IEN
+21 SET IVMFUTR=1
End DoDot:4
+22 IF '$TEST
Begin DoDot:4
+23 SET IVMFUTR=0
End DoDot:4
End DoDot:3
+24 if ('IVMMTIEN)
QUIT
+25 SET NODE0=$GET(^DGMT(408.31,IVMMTIEN,0))
+26 IF $$EN^IVMCMD(IVMMTIEN)
Begin DoDot:3
+27 SET RET=$$LST^DGMTU(DFN,DT,IVMTYPE)
+28 SET CODE=$SELECT(($EXTRACT($PIECE(RET,"^",2),1,3)=$EXTRACT(DT,1,3)):$PIECE(RET,"^",4),1:"")
+29 DO ADD^IVMCMB(DFN,IVMTYPE,$SELECT(IVMFUTR:"DELETE FUTR TEST",1:"DELETE PRMRY TEST"),+$GET(NODE0),$$GETCODE^DGMTH($PIECE(NODE0,"^",3)),CODE)
End DoDot:3
End DoDot:2
QUIT
+30 ;
+31 ;check timestamp - if matches current primary test, then this is a duplicate and does not need to be uploaded
+32 IF TMSTAMP
Begin DoDot:2
+33 SET NODE=""
+34 IF IVMFUTR
NEW IVMMTIEN
SET IVMMTIEN=$$FUTURE(DFN,($EXTRACT(IVMMTDT,1,3)-1),2)
+35 if 'IVMMTIEN
QUIT
+36 SET NODE=$GET(^DGMT(408.31,IVMMTIEN,2))
End DoDot:2
+37 SET NODE0=$GET(^DGMT(408.31,IVMMTIEN,0))
+38 IF TMSTAMP
IF TMSTAMP=$PIECE(NODE,"^",2)
IF IVMMTDT=$PIECE(NODE0,"^")
IF SOURCE=$PIECE(NODE,"^",5)
QUIT
+39 ;
+40 DO DELTYPE^IVMCMD(DFN,IVMMTDT,1)
+41 DO EN^IVMCM1
End DoDot:1
IF $DATA(HLERR)
GOTO PROCQ
+42 ;
IS ; - If transmission is income screening info only then do not process
+1 ; - outside of the scope of MTS
+2 ;I IVMTYPE=3 S IVMMTDT=0 D EN^IVMCM1 I $D(HLERR) G PROCQ
+3 IF IVMTYPE=3
SET IVMMTDT=0
+4 ;
LTC ; If transmission contains a Long Term Care Test (TYPE 4 TEST)
+1 IF $PIECE($GET(^TMP($JOB,"IVMCM","ZMT4")),HLFS,2)
DO LTC^IVMCM1
+2 ;
PROCQ ;
+1 ; release locks used to sychronize upload with local income test options
+2 DO RELLOCKS^IVMCUPL(DFN)
+3 QUIT
+4 ;
CHKDT ; check date of income test being uploaded
+1 ; Is it a future date? If so, set IVMFUTR=1
+2 ;
+3 ; IVMMTIEN is the IEN of current primary test for the year
+4 ;
+5 IF $EXTRACT($PIECE(IVMLAST,"^",2),1,3)=$EXTRACT(IVMMTDT,1,3)
SET IVMMTIEN=+IVMLAST
+6 IF IVMMTDT>DT
SET IVMFUTR=1
+7 QUIT
FUTURE(DFN,YEAR,TYPE,IVMPAT) ;
+1 ;Returns the ien of the future test, if there is one
+2 ;Inputs: DFN
+3 ; YEAR - income year
+4 ; TYPE - type of test
+5 ;Output:
+6 ; function value - ien of future means test, if there is one, "" otherwise
+7 ; IVMPAT - Pointer to the IVM Patient file for the income year if there is an entry (pass by reference)
+8 ;
+9 NEW RET
+10 SET RET=""
+11 SET IVMPAT=$$FIND^IVMPLOG(DFN,YEAR)
+12 IF IVMPAT
SET RET=$PIECE($GET(^IVM(301.5,IVMPAT,0)),"^",$SELECT(TYPE=1:6,1:7))
+13 QUIT RET
