Index: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMCM.m
===================================================================
--- WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMCM.m	(revision 613)
+++ WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMCM.m	(revision 623)
@@ -1,264 +1,262 @@
-IVMCM	;ALB/SEK,KCL,RTK,AEG,BRM,AEG - PROCESS INCOME TEST (Z10) TRANSMISSIONS ; 04/23/03 1:43pm
-	;;2.0;INCOME VERIFICATION MATCH;**12,17,28,41,44,53,34,49,59,55,63,77,74,123**;21-OCT-94;Build 6
-	;
-	;
-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
-	;        }
-	;        {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 and send ACK
-	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)
-	.;D ACK^IVMPREC:'$D(HLERR)
-	.;N HLRESLTA,HLP
-	.;D GENACK^HLMA1(HLEID,HLMTIEN,HLEIDS,"LM",1,.HLRESLTA,"",.HLP)
-	;
-	; - 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
-	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
-	;
-	; - 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
-	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 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=""
-	.I $$Z06MT^EASPTRN1(+IVMLAST) D PROB^IVMCMC("IVM Means Test already on file for this year") Q
-	.I '$$ELIG^IVMUFNC5(DFN) S ERRMSG="Means Test upload not appropriate for current patient"
-	.I $$AGE^IVMUFNC5(DT)>$$INCY^IVMUFNC5(IVMMTDT) D
-	..N CATCZMT S CATCZMT=$G(^TMP($J,"IVMCM","ZMT1"))
-	..S CATC=$$CATC^IVMUFNC5(CATCZMT)
-	..I '+$G(CATC) S ERRMSG="Only Means Tests in current/previous income years are valid (not effective)"
-	.I $G(ERRMSG)'="" D PROB^IVMCMC(ERRMSG) K ERRMSG,CATC Q
-	.;
-	.; - 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 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
+IVMCM ;ALB/SEK,KCL,RTK,AEG,BRM,AEG - PROCESS INCOME TEST (Z10) TRANSMISSIONS ; 04/23/03 1:43pm
+ ;;2.0;INCOME VERIFICATION MATCH;**12,17,28,41,44,53,34,49,59,55,63,77,74**;21-OCT-94
+ ;
+ ;
+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
+ ;        }
+ ;        {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 and send ACK
+ 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)
+ .;D ACK^IVMPREC:'$D(HLERR)
+ .;N HLRESLTA,HLP
+ .;D GENACK^HLMA1(HLEID,HLMTIEN,HLEIDS,"LM",1,.HLRESLTA,"",.HLP)
+ ;
+ ; - 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
+ 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
+ ;
+ ; - 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
+ 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 IVMLAST=$$LST^DGMTU(DFN,$E(IVMMTDT,1,3)_1231,1)
+ .I $$Z06MT^EASPTRN1(+IVMLAST) Q
+ .I '$$ELIG^IVMUFNC5(DFN) S ERRMSG="Means Test upload not appropriate for current patient"
+ .I $$AGE^IVMUFNC5(DT)>$$INCY^IVMUFNC5(IVMMTDT) D
+ ..N CATCZMT S CATCZMT=$G(^TMP($J,"IVMCM","ZMT1"))
+ ..S CATC=$$CATC^IVMUFNC5(CATCZMT)
+ ..I '+$G(CATC) S ERRMSG="Only Means Tests in current/previous income years are valid (not effective)"
+ .I $G(ERRMSG)'="" D PROB^IVMCMC(ERRMSG) K ERRMSG,CATC Q
+ .;
+ .; - 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 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
