IVMCM6 ;ALB/SEK,JAN,RTK,CKN,TDM,GN,HM - COMPLETE DCD INCOME TEST ;4/10/20 11:41am
;;2.0;INCOME VERIFICATION MATCH;**17,25,39,44,50,53,49,58,62,67,84,115,136,190,193**;21-OCT-94;Build 37
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;IVM*2*84 - insure DGMTP is defined by LTC test prior to calling
; audit
;
EN ; This routine will update annual means test file (#408.31):
;
; Note: There is no entry in 408.31 for income screening.
;
;
;Input:
; DGMTI - ien of new Annual Means Test which requires completion
; IVMMTIEN - ien of replaced test (may not exist)
;
; - open case record in (#301.5) file
N DGREF,DATA,CODE,FIELD,RET,NODE0,NODE2,OK2SND
D CHKTST,OPEN
;
; - if income screening goto MTBULL
I IVMTYPE=3 G MTBULL
;
; - setup variables for (#408.31) file
;get the ZMT segment, translate HLQ's to NULLS
S IVMSEG=$G(^TMP($J,"IVMCM","ZMT"_IVMTYPE)) ; get mt/copay ZMT segment
F FIELD=4:1:32 I FIELD'=24,$P(IVMSEG,HLFS,FIELD)=HLQ S $P(IVMSEG,HLFS,FIELD)="" ;IVM*2.0*193
;
S IVM1=$$FMDATE^HLFNC($P(IVMSEG,"^",10)) ; dt/time completed
S IVM2=$P(IVMSEG,"^",7) ; agree to pay deductible
S IVM3=$$FMDATE^HLFNC($P(IVMSEG,"^",15)) ; dt vet signed test
S IVM4=$P(IVMSEG,"^",16) ; declines to give income info field
S:IVM4 DGREF=""
S IVM5=$$FMDATE^HLFNC($P(IVMSEG,"^",6)) ; dt/time of adjudication
S IVM6=$P(IVMSEG,"^",3) ;status
S IVM7=$P(IVMSEG,"^",13) ; hardship
S:$G(IVMHADJ) IVMCAT=$P(IVMSEG,"^",3) ; test status
S IVM8=$P(IVMSEG,"^",22) ; site conducting test
S IVM9=$P(IVMSEG,"^",23) ; site granting hardship
S IVM10=$P(IVMSEG,"^",11) ; prev years threshold
S IVM11=$P(IVMSEG,"^",18) ; source of test
S IVM12=$$FMDATE^HLFNC($P(IVMSEG,"^",24)) ; hardship effective date
S IVM13=$$FMDATE^HLFNC($P(IVMSEG,"^",25)) ; date/time last edited
S IVM14=$P(IVMSEG,"^",26) ; test determined status
S IVM15=$P(IVMSEG,"^",4) ; income
S IVM16=$P(IVMSEG,"^",5) ; net worth
S IVM17=$P(IVMSEG,"^",8) ; threshold A
S IVM18=$P(IVMSEG,"^",9) ; deductible expenses
S IVM19=$P(IVMSEG,"^",12) ; total dependents
S IVM20=$P(IVMSEG,"^",27) ; signature valid?
S IVM21=$$FMDATE^HLFNC($P(IVMSEG,"^",14)) ; hardship review date
S IVM22=$P(IVMSEG,"^",28) ; GMT threshold
S IVM23=$P(IVMSEG,"^",29) ; hardship reason
S IVM24=+$P(IVMSEG,"^",30) ; Means Test Version
S IVM25=$$FMDATE^HLFNC($P(IVMSEG,"^",2)) ;Means Test Date ;IVM*2.0*190
S IVM26=$$FMDATE^HLFNC($P(IVMSEG,"^",32)) ;Hardship Expiration Date ;IVM*2.0*193
S DATA(2.13)=IVM26 ; IVM*2.0*193
;IVM*2.0*193;HM; when Hardship Expiration Date is after effective date and not a future date
; - set Hardship to "NO" and Hardship Expired to "YES"
I IVM26'="",(IVM12<=IVM26)&(IVM26<=DT) D
.S IVM7=0,DATA(.2)=IVM7
.S DATA(2.12)=1
;
;old tests may not have the field Test-Determined Status
I IVM14="" D
. I IVMTYPE=1,IVM7,"AG"[IVM6 D Q
. . I IVM6="A",(IVM15'>IVM22) S IVM14="G" Q ;Income <= GMT Threshold
. . S IVM14="C"
. S IVM14=IVM6
;
; - fields for means test, copay test and Long Term Care Test
S DATA(.14)=IVM4,DATA(.18)=IVM19,DATA(.23)=IVM11,DATA(2.05)=IVM8,DATA(.06)=DUZ,DATA(.07)=IVM1,DATA(2.02)=IVM13,DATA(2.03)=$$GETSTAT^DGMTH(IVM14,IVMTYPE),DATA(2.11)=IVM24
;
I IVM7 S DATA(.08)=.5,DATA(.09)=$$NOW^XLFDT
;
I 'IVM4 S DATA(.04)=IVM15,DATA(.15)=IVM18
;
; - means test fields
I IVMTYPE=1 D
. S DATA(.11)=IVM2,DATA(.12)=IVM17,DATA(.2)=IVM7,DATA(.24)=IVM3,DATA(.29)=IVM20,DATA(2.04)=IVM9,DATA(.1)=IVM5,DATA(2.01)=IVM12
. I 'IVM4 S DATA(.05)=IVM16
. S DATA(.16)=IVM10,DATA(.21)=IVM21,DATA(.27)=IVM22,DATA(2.09)=IVM23
;
; - Long Term Care fields
I IVMTYPE=4 D
. N DATE,TYPE
. ;set pointer to associated means test or RX copay test if there is one
. I $P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,2) S DATE=$P(^TMP($J,"IVMCM","ZMT1"),HLFS,2),TYPE=1
. E I $P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,2) S DATE=$P(^TMP($J,"IVMCM","ZMT2"),HLFS,2),TYPE=2
. I $G(DATE) S DATA(2.08)=$P($$LST^DGMTU(DFN,DATE,TYPE),"^")
. S DATA(.11)=IVM2
. I 'IVM4 S DATA(.05)=IVM16
. K DATA(2.03) ;test determined status is not used in LTC test
;
I $G(IVMMTIEN) D
. ; Get record data to compare with HL7 Message data
. S NODE0=$G(^DGMT(408.31,IVMMTIEN,0))
. S NODE2=$G(^DGMT(408.31,IVMMTIEN,2))
. ;
. ; If Site Conducting Test is the same, get Completed By from record.t
. I $P(NODE2,"^",5)=IVM8 S DATA(.06)=$P(NODE0,"^",6)
. ;
. ; If there are Comments, copy them into new record
. I $O(^DGMT(408.31,IVMMTIEN,"C",0)) S DATA(50)="^DGMT(408.31,"_IVMMTIEN_",""C"")"
. ;
. I IVMTYPE=1 D
. . ; Hardship is YES in msg and record, and the Site Granting Hardship
. . ; is the same as the site receiving the msg, keep the record data
. . I IVM7,$P(NODE0,"^",20),IVM9=$P($$SITE^VASITE,"^",3) S DATA(.21)=$P(NODE0,"^",21),DATA(.22)=$P(NODE0,"^",22),DATA(.08)=$P(NODE0,"^",8),DATA(.09)=$P(NODE0,"^",9)
. . ;
. . ;hardship effective date should always be what is coming in in the ZMT segment
. . S DATA(2.01)=IVM12 ; IVM*2.0*193
. . ;
. . ; Hardship is YES in msg and record, and the Site Granting Hardship
. . ; is NOT the same in both the msg and record, keep the message data
. . I IVM7,$P(NODE0,"^",20),$P(NODE2,"^",4)'=IVM9 S DATA(.22)=DATA(.06)
. . ;
. . ; Hardship is YES in msg and NO in record, keep the message data
. . I IVM7,'$P(NODE0,"^",20) S DATA(.22)=DATA(.06)
. . ;
. . ; Hardship is set to delete in msg, delete the Hardship
. . I IVM12=HLQ!('IVM7&($P(NODE0,"^",20))) D
. . . ; DG*5.3*997;HM; If hardship expr date (IVM26) not null, and if hardship eff date (IVM12) <= hardship expr date (IVM26)
. . . ; and hardship expr date (IVM26) is less than or equal to now (DT) then it is an expiration record, quit (do not clear data values)
. . . I IVM26'="",(IVM12<=IVM26)&(IVM26<=DT) Q
. . . S (DATA(.08),DATA(.09),DATA(.2),DATA(.21),DATA(.22),DATA(2.01),DATA(2.04),DATA(2.09))=""
. . . I $P(NODE0,"^",20) D BULL2^IVMCMB(DFN,$P(NODE2,"^"),$P(NODE2,"^",4))
. . ;
. . ; Hardship is NO in msg and in record, keep the message data
. . I 'IVM7,'$P(NODE0,"^",20) S DATA(.22)=""
. . ;
. . ; Notify site of hardship?
. . I IVM12'=HLQ,IVM7,((IVM12'=$P(NODE2,"^"))!('$P(NODE0,"^",20))) D BULL1^IVMCMB(DFN,IVM12,IVM9)
. . ;
. . ; Notify site to discontinue net-worth development?
. . I IVM11=3,$P(NODE0,"^",23)=1,$$GETCODE^DGMTH($P(NODE0,"^",3))="P" D BULL3^IVMCMB(DFN)
. . ;
. . ; Put message in comments field IVM*2.0*190
. . I IVM12'="",IVM12<IVM25 D
. . . K ^TMP($J,"IVMCM6","COMMENT")
. . . S ^TMP($J,"IVMCM6","COMMENT",1)="Received/Uploaded Test on "_$$FTIME^VALM1(IVM1)_" with data inconsistencies. "
. . . S ^TMP($J,"IVMCM6","COMMENT",2)=": Hardship Effective Date earlier than Means Test Date"
. . . D WP^DIE(408.31,""_DGMTI_",",50,"K","^TMP($J,""IVMCM6"",""COMMENT"")")
. . . K DATA(50),^TMP($J,"IVMCM6","COMMENT") ;remove anything hanging around for comment field 50 so nothing gets overwritten
. . I IVM12'="",IVM12>=IVM25 D
. . . I $$CHKCMT(IVMMTIEN) S DATA(50)="" D RMVECMT(IVMMTIEN)
. . . I $D(^TMP($J,"IVMCM","NTE")) D
. . . . K ^TMP($J,"IVMCM6","COMMENT")
. . . . N IVMNTECT,IVMNTED
. . . . S IVMNTED=0
. . . . F IVMNTECT=1:1 D Q:IVMNTED
. . . . . I '$D(^TMP($J,"IVMCM","NTE",IVMNTECT)) S IVMNTED=1 Q
. . . . . S ^TMP($J,"IVMCM6","COMMENT",IVMNTECT)=$P(^TMP($J,"IVMCM","NTE",IVMNTECT),"^")
. . . . D WP^DIE(408.31,""_DGMTI_",",50,"K","^TMP($J,""IVMCM6"",""COMMENT"")")
. . . . K DATA(50),^TMP($J,"IVMCM6","COMMENT")
. . I IVM12="",$$CHKCMT(IVMMTIEN) D RMVECMT(IVMMTIEN)
;
;
;determine status based on test-determined status and hardship
S CODE=IVM14
I IVMTYPE=1,DATA(.2) S CODE=IVM6
S DATA(.03)=$$GETSTAT^DGMTH(CODE,IVMTYPE)
;
I $$UPD^DGENDBS(408.31,DGMTI,.DATA) D
. ; can't call MT Events protocol for Long Term Care Copay Exemption
. ; Tests as it triggers an IB and Enrollment update
. ; so manually call needed protocols to trigger audit, date stamp
. ; and transmission (if necessary)
. I IVMTYPE=4 D Q
. . S:$G(DGMTACT)="" DGMTACT="ADD"
. . S DGMTP=$G(DGMTP) ;IVM*2*84
. . S DGMTINF=1 ;Means Test Interactive/Non-interactive flag
. . D AFTER^DGMTEVT
. . D EN^DGMTAUD ;means test audit event
. . D ^IVMPMTE ;IVM means test event
. . D DATETIME^DGMTU4($G(DGMTI)) ;date stamp
. ;
. ; - call means test event driver if not future test
. I 'IVMFUTR D
. . D:(IVMTYPE=1) MTPRIME^DGMTU4(DGMTI)
. . D:(IVMTYPE=2) RXPRIME^DGMTU4(DGMTI)
. . S CODE=$$GETCODE^DGMTH($P($G(^DGMT(408.31,DGMTI,0)),"^",3))
. E D
. . ;enter to list of future tests kept in the IVM Patient file
. . D ADDFUTR^IVMPLOG2(DGMTI)
. . ;also, if HEC changed the test to a future date, there could be
. . ;a test on file for the same income year marked as primary
. . I $G(IVMMTIEN),$P(NODE2,"^",5)=IVM8 D
. . . N DATA,ERROR,DGMTI,DGMTACT,DGMTYPT,DGMTA
. . . S DATA(2)=0
. . . I $$UPD^DGENDBS(408.31,IVMMTIEN,.DATA,.ERROR)
. . . ; if the test being replaced by the uploaded future test
. . . ; becomes non-primary and the site conducted both tests
. . . ; then call Means Test event driver (non interactively)
. . . S DGMTACT="EDT",DGMTI=IVMMTIEN,DGMTYPT=IVMTYPE,DGMTINF=1
. . . D AFTER^DGMTEVT
. . . D EN^DGMTEVT
. . . D
. . . . N DGMSGF,DGADDF
. . . . S DGMSGF=1,DGADDF=0
. . . . D EN^DGMTR
. D:OK2SND TRNSMT
;
;
MTBULL ; Build results array
D ADD^IVMCMB(DFN,IVMTYPE,$S(IVMFUTR:"Future Test",1:"New Test"),$G(IVMMTDT),$S($G(IVMMTIEN):$$GETCODE^DGMTH($P($G(^DGMT(408.31,IVMMTIEN,0)),"^",3)),1:""),CODE)
;
CLEANUP ; cleanup
K DGCAT,DGCOMF,DGMTACT,DGMTI,DGMTINF,DGMTPAR,DGTHB,IVMBU45,IVMOP,IVMOP1
K IVM1,IVM2,IVM3,IVM4,IVM5,IVM6,IVM7,IVM8,IVM9,IVM10,IVM11,IVM12,IVM13,IVM14,IVMCAT,IVMCEA,IVMCEB,IVMMTA,IVM15,IVM16,IVM17,IVM18,IVM19,IVM20,IVM21
K IVM22,IVM23,IVM24,IVM25,IVM26 ;IVM*2.0*190 IVM*2.0*193
Q
;
CHKCMT(MTIEN) ; CHECK FOR HARDSHIP COMMENT IVM*2.0*190
; DBIA 968 NAME: DBIA968 FILE: 408.31 ROOT: DGMT(408.31,
N CNT,RET,COMMENT,DIC,DR,DA
S DIC=408.31,DR="50",DA=MTIEN
S DR(408.311)=".01",DA(408.311)=1
D EN^DIQ1
S CNT=0,RET=0
F S CNT=$O(^UTILITY("DIQ1",$J,408.31,MTIEN,50,CNT)) Q:CNT="" D Q:RET
.S COMMENT=^UTILITY("DIQ1",$J,408.31,MTIEN,50,CNT)
.I COMMENT["Hardship Effective Date earlier than Means Test Date" S RET=1
Q RET
;
RMVECMT(MTIEN) ; REMOVE COMMENTS NOT NEEDED IVM*2.0*190
; DBIA 968 NAME:DBIA968 FILE: 408.31 ROOT: DGMT(408.31,
N CNT,RET,COMMENT,DIC,DR,DA,IVMFNDC1,IVMFNDC2,IVMLNCT
S DIC=408.31,DR="50",DA=MTIEN,IVMFNDC1=0,IVMFNDC2=0,IVMLNCT=0
S DR(408.311)=".01",DA(408.311)=1
D EN^DIQ1
S CNT=0,RET=0
F S CNT=$O(^UTILITY("DIQ1",$J,408.31,MTIEN,50,CNT)) Q:CNT="" D Q:RET
.S COMMENT=^UTILITY("DIQ1",$J,408.31,MTIEN,50,CNT),(IVMFNDC1,IVMFNDC2)=0
.I COMMENT["Received/Uploaded Test on"&(COMMENT["with data inconsistencies") S IVMFNDC1=1
.I COMMENT["Hardship Effective Date earlier than Means Test Date" S IVMFNDC2=1
.I 'IVMFNDC1,'IVMFNDC2 S IVMLNCT=IVMLNCT+1,^TMP($J,"IVMCM6","COMMENT",IVMLNCT)=COMMENT
I IVMLNCT>0 D WP^DIE(408.31,""_MTIEN_",",50,"K","^TMP($J,""IVMCM6"",""COMMENT"")") K ^TMP($J,"IVMCM6","COMMENT")
Q
;
OPEN ; open case record for uploaded test
S IVMOP="",IVMOP=$O(^IVM(301.5,"AYR",DGLY,DFN,IVMOP)) I 'IVMOP D OPEN1 Q
S IVMOP1=$G(^IVM(301.5,IVMOP,0)) I 'IVMOP1 D OPEN1 Q
I $P(IVMOP1,"^",4)=1 S DA=+IVMOP D Q
. S DIE="^IVM(301.5,",DR=".03////1;.04////0"
. D OPEN2
Q
OPEN1 K DD,DO
S DIC="^IVM(301.5,",DIC(0)="LMNZ",X=DFN,DLAYGO=301.5
D FILE^DICN Q:Y'>0 S DA=+Y
S DIE="^IVM(301.5,",DR=".02////^S X=DGLY;.03////1;.04////0"
OPEN2 D ^DIE K DD,DO,DIC,DLAYGO,X,Y,DIE,DR
Q
;
MTDRIVER ; call means test event driver
; dgmtact
; adj adjudicated mt
; cat hardship mt
; add new mt or copay
; edit corrected mt or copay
;
N IVMDA,IVMDT,IVMFLG,IVMMTDT,IVMNEW
S DGMTACT=$S($G(IVMHADJ)=1:"ADJ",$G(IVMHADJ)=2:"CAT",'$G(DGMTP):"ADD",1:"EDT")
D AFTER^DGMTEVT
S DGMTINF=1 ; non-interactive flag
D EN^DGMTEVT
Q
;
CHKTST ; Verify if the incoming Income Test requires a Z07 transmission.
;
N MTREC,REC01,ZMTSEG
S OK2SND=0
S MTREC=$G(^DGMT(408.31,DGMTI,0))
Q:'$D(^DGMT(408.31,DGMTI,0))
; Check if the Source of the Test is DCD
S ZMTSEG=$G(^TMP($J,"IVMCM","ZMT"_IVMTYPE))
Q:$P($G(^DG(408.34,+$P(ZMTSEG,U,18),0)),U)'="DCD"
;Check if the DCD software has been installed
Q:'$$VERSION^XPDUTL("IVMC")
;
; If the source of the test is DCD, and the site receiving the test
; is a DCD site, set the record to transmit.
S OK2SND=1
Q
;
TRNSMT ; Set the record to transmit due to DCD Criteria
N REC01,DCDDATA,DCDIEN,EVENTS,ERROR
S REC01=$O(^IVM(301.5,"AYR",DGLY,DFN,""))
S DCDDATA(.04)=0,DCDIEN=REC01
I $$UPD^DGENDBS(301.5,DCDIEN,.DCDDATA,.ERROR)
S EVENTS("DCD")=1
I $$SETSTAT^IVMPLOG(REC01,.EVENTS)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMCM6 13049 printed Dec 13, 2024@02:01:18 Page 2
IVMCM6 ;ALB/SEK,JAN,RTK,CKN,TDM,GN,HM - COMPLETE DCD INCOME TEST ;4/10/20 11:41am
+1 ;;2.0;INCOME VERIFICATION MATCH;**17,25,39,44,50,53,49,58,62,67,84,115,136,190,193**;21-OCT-94;Build 37
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;IVM*2*84 - insure DGMTP is defined by LTC test prior to calling
+5 ; audit
+6 ;
EN ; This routine will update annual means test file (#408.31):
+1 ;
+2 ; Note: There is no entry in 408.31 for income screening.
+3 ;
+4 ;
+5 ;Input:
+6 ; DGMTI - ien of new Annual Means Test which requires completion
+7 ; IVMMTIEN - ien of replaced test (may not exist)
+8 ;
+9 ; - open case record in (#301.5) file
+10 NEW DGREF,DATA,CODE,FIELD,RET,NODE0,NODE2,OK2SND
+11 DO CHKTST
DO OPEN
+12 ;
+13 ; - if income screening goto MTBULL
+14 IF IVMTYPE=3
GOTO MTBULL
+15 ;
+16 ; - setup variables for (#408.31) file
+17 ;get the ZMT segment, translate HLQ's to NULLS
+18 ; get mt/copay ZMT segment
SET IVMSEG=$GET(^TMP($JOB,"IVMCM","ZMT"_IVMTYPE))
+19 ;IVM*2.0*193
FOR FIELD=4:1:32
IF FIELD'=24
IF $PIECE(IVMSEG,HLFS,FIELD)=HLQ
SET $PIECE(IVMSEG,HLFS,FIELD)=""
+20 ;
+21 ; dt/time completed
SET IVM1=$$FMDATE^HLFNC($PIECE(IVMSEG,"^",10))
+22 ; agree to pay deductible
SET IVM2=$PIECE(IVMSEG,"^",7)
+23 ; dt vet signed test
SET IVM3=$$FMDATE^HLFNC($PIECE(IVMSEG,"^",15))
+24 ; declines to give income info field
SET IVM4=$PIECE(IVMSEG,"^",16)
+25 if IVM4
SET DGREF=""
+26 ; dt/time of adjudication
SET IVM5=$$FMDATE^HLFNC($PIECE(IVMSEG,"^",6))
+27 ;status
SET IVM6=$PIECE(IVMSEG,"^",3)
+28 ; hardship
SET IVM7=$PIECE(IVMSEG,"^",13)
+29 ; test status
if $GET(IVMHADJ)
SET IVMCAT=$PIECE(IVMSEG,"^",3)
+30 ; site conducting test
SET IVM8=$PIECE(IVMSEG,"^",22)
+31 ; site granting hardship
SET IVM9=$PIECE(IVMSEG,"^",23)
+32 ; prev years threshold
SET IVM10=$PIECE(IVMSEG,"^",11)
+33 ; source of test
SET IVM11=$PIECE(IVMSEG,"^",18)
+34 ; hardship effective date
SET IVM12=$$FMDATE^HLFNC($PIECE(IVMSEG,"^",24))
+35 ; date/time last edited
SET IVM13=$$FMDATE^HLFNC($PIECE(IVMSEG,"^",25))
+36 ; test determined status
SET IVM14=$PIECE(IVMSEG,"^",26)
+37 ; income
SET IVM15=$PIECE(IVMSEG,"^",4)
+38 ; net worth
SET IVM16=$PIECE(IVMSEG,"^",5)
+39 ; threshold A
SET IVM17=$PIECE(IVMSEG,"^",8)
+40 ; deductible expenses
SET IVM18=$PIECE(IVMSEG,"^",9)
+41 ; total dependents
SET IVM19=$PIECE(IVMSEG,"^",12)
+42 ; signature valid?
SET IVM20=$PIECE(IVMSEG,"^",27)
+43 ; hardship review date
SET IVM21=$$FMDATE^HLFNC($PIECE(IVMSEG,"^",14))
+44 ; GMT threshold
SET IVM22=$PIECE(IVMSEG,"^",28)
+45 ; hardship reason
SET IVM23=$PIECE(IVMSEG,"^",29)
+46 ; Means Test Version
SET IVM24=+$PIECE(IVMSEG,"^",30)
+47 ;Means Test Date ;IVM*2.0*190
SET IVM25=$$FMDATE^HLFNC($PIECE(IVMSEG,"^",2))
+48 ;Hardship Expiration Date ;IVM*2.0*193
SET IVM26=$$FMDATE^HLFNC($PIECE(IVMSEG,"^",32))
+49 ; IVM*2.0*193
SET DATA(2.13)=IVM26
+50 ;IVM*2.0*193;HM; when Hardship Expiration Date is after effective date and not a future date
+51 ; - set Hardship to "NO" and Hardship Expired to "YES"
+52 IF IVM26'=""
IF (IVM12<=IVM26)&(IVM26<=DT)
Begin DoDot:1
+53 SET IVM7=0
SET DATA(.2)=IVM7
+54 SET DATA(2.12)=1
End DoDot:1
+55 ;
+56 ;old tests may not have the field Test-Determined Status
+57 IF IVM14=""
Begin DoDot:1
+58 IF IVMTYPE=1
IF IVM7
IF "AG"[IVM6
Begin DoDot:2
+59 ;Income <= GMT Threshold
IF IVM6="A"
IF (IVM15'>IVM22)
SET IVM14="G"
QUIT
+60 SET IVM14="C"
End DoDot:2
QUIT
+61 SET IVM14=IVM6
End DoDot:1
+62 ;
+63 ; - fields for means test, copay test and Long Term Care Test
+64 SET DATA(.14)=IVM4
SET DATA(.18)=IVM19
SET DATA(.23)=IVM11
SET DATA(2.05)=IVM8
SET DATA(.06)=DUZ
SET DATA(.07)=IVM1
SET DATA(2.02)=IVM13
SET DATA(2.03)=$$GETSTAT^DGMTH(IVM14,IVMTYPE)
SET DATA(2.11)=IVM24
+65 ;
+66 IF IVM7
SET DATA(.08)=.5
SET DATA(.09)=$$NOW^XLFDT
+67 ;
+68 IF 'IVM4
SET DATA(.04)=IVM15
SET DATA(.15)=IVM18
+69 ;
+70 ; - means test fields
+71 IF IVMTYPE=1
Begin DoDot:1
+72 SET DATA(.11)=IVM2
SET DATA(.12)=IVM17
SET DATA(.2)=IVM7
SET DATA(.24)=IVM3
SET DATA(.29)=IVM20
SET DATA(2.04)=IVM9
SET DATA(.1)=IVM5
SET DATA(2.01)=IVM12
+73 IF 'IVM4
SET DATA(.05)=IVM16
+74 SET DATA(.16)=IVM10
SET DATA(.21)=IVM21
SET DATA(.27)=IVM22
SET DATA(2.09)=IVM23
End DoDot:1
+75 ;
+76 ; - Long Term Care fields
+77 IF IVMTYPE=4
Begin DoDot:1
+78 NEW DATE,TYPE
+79 ;set pointer to associated means test or RX copay test if there is one
+80 IF $PIECE($GET(^TMP($JOB,"IVMCM","ZMT1")),HLFS,2)
SET DATE=$PIECE(^TMP($JOB,"IVMCM","ZMT1"),HLFS,2)
SET TYPE=1
+81 IF '$TEST
IF $PIECE($GET(^TMP($JOB,"IVMCM","ZMT2")),HLFS,2)
SET DATE=$PIECE(^TMP($JOB,"IVMCM","ZMT2"),HLFS,2)
SET TYPE=2
+82 IF $GET(DATE)
SET DATA(2.08)=$PIECE($$LST^DGMTU(DFN,DATE,TYPE),"^")
+83 SET DATA(.11)=IVM2
+84 IF 'IVM4
SET DATA(.05)=IVM16
+85 ;test determined status is not used in LTC test
KILL DATA(2.03)
End DoDot:1
+86 ;
+87 IF $GET(IVMMTIEN)
Begin DoDot:1
+88 ; Get record data to compare with HL7 Message data
+89 SET NODE0=$GET(^DGMT(408.31,IVMMTIEN,0))
+90 SET NODE2=$GET(^DGMT(408.31,IVMMTIEN,2))
+91 ;
+92 ; If Site Conducting Test is the same, get Completed By from record.t
+93 IF $PIECE(NODE2,"^",5)=IVM8
SET DATA(.06)=$PIECE(NODE0,"^",6)
+94 ;
+95 ; If there are Comments, copy them into new record
+96 IF $ORDER(^DGMT(408.31,IVMMTIEN,"C",0))
SET DATA(50)="^DGMT(408.31,"_IVMMTIEN_",""C"")"
+97 ;
+98 IF IVMTYPE=1
Begin DoDot:2
+99 ; Hardship is YES in msg and record, and the Site Granting Hardship
+100 ; is the same as the site receiving the msg, keep the record data
+101 IF IVM7
IF $PIECE(NODE0,"^",20)
IF IVM9=$PIECE($$SITE^VASITE,"^",3)
SET DATA(.21)=$PIECE(NODE0,"^",21)
SET DATA(.22)=$PIECE(NODE0,"^",22)
SET DATA(.08)=$PIECE(NODE0,"^",8)
SET DATA(.09)=$PIECE(NODE0,"^",9)
+102 ;
+103 ;hardship effective date should always be what is coming in in the ZMT segment
+104 ; IVM*2.0*193
SET DATA(2.01)=IVM12
+105 ;
+106 ; Hardship is YES in msg and record, and the Site Granting Hardship
+107 ; is NOT the same in both the msg and record, keep the message data
+108 IF IVM7
IF $PIECE(NODE0,"^",20)
IF $PIECE(NODE2,"^",4)'=IVM9
SET DATA(.22)=DATA(.06)
+109 ;
+110 ; Hardship is YES in msg and NO in record, keep the message data
+111 IF IVM7
IF '$PIECE(NODE0,"^",20)
SET DATA(.22)=DATA(.06)
+112 ;
+113 ; Hardship is set to delete in msg, delete the Hardship
+114 IF IVM12=HLQ!('IVM7&($PIECE(NODE0,"^",20)))
Begin DoDot:3
+115 ; DG*5.3*997;HM; If hardship expr date (IVM26) not null, and if hardship eff date (IVM12) <= hardship expr date (IVM26)
+116 ; and hardship expr date (IVM26) is less than or equal to now (DT) then it is an expiration record, quit (do not clear data values)
+117 IF IVM26'=""
IF (IVM12<=IVM26)&(IVM26<=DT)
QUIT
+118 SET (DATA(.08),DATA(.09),DATA(.2),DATA(.21),DATA(.22),DATA(2.01),DATA(2.04),DATA(2.09))=""
+119 IF $PIECE(NODE0,"^",20)
DO BULL2^IVMCMB(DFN,$PIECE(NODE2,"^"),$PIECE(NODE2,"^",4))
End DoDot:3
+120 ;
+121 ; Hardship is NO in msg and in record, keep the message data
+122 IF 'IVM7
IF '$PIECE(NODE0,"^",20)
SET DATA(.22)=""
+123 ;
+124 ; Notify site of hardship?
+125 IF IVM12'=HLQ
IF IVM7
IF ((IVM12'=$PIECE(NODE2,"^"))!('$PIECE(NODE0,"^",20)))
DO BULL1^IVMCMB(DFN,IVM12,IVM9)
+126 ;
+127 ; Notify site to discontinue net-worth development?
+128 IF IVM11=3
IF $PIECE(NODE0,"^",23)=1
IF $$GETCODE^DGMTH($PIECE(NODE0,"^",3))="P"
DO BULL3^IVMCMB(DFN)
+129 ;
+130 ; Put message in comments field IVM*2.0*190
+131 IF IVM12'=""
IF IVM12<IVM25
Begin DoDot:3
+132 KILL ^TMP($JOB,"IVMCM6","COMMENT")
+133 SET ^TMP($JOB,"IVMCM6","COMMENT",1)="Received/Uploaded Test on "_$$FTIME^VALM1(IVM1)_" with data inconsistencies. "
+134 SET ^TMP($JOB,"IVMCM6","COMMENT",2)=": Hardship Effective Date earlier than Means Test Date"
+135 DO WP^DIE(408.31,""_DGMTI_",",50,"K","^TMP($J,""IVMCM6"",""COMMENT"")")
+136 ;remove anything hanging around for comment field 50 so nothing gets overwritten
KILL DATA(50),^TMP($JOB,"IVMCM6","COMMENT")
End DoDot:3
+137 IF IVM12'=""
IF IVM12>=IVM25
Begin DoDot:3
+138 IF $$CHKCMT(IVMMTIEN)
SET DATA(50)=""
DO RMVECMT(IVMMTIEN)
+139 IF $DATA(^TMP($JOB,"IVMCM","NTE"))
Begin DoDot:4
+140 KILL ^TMP($JOB,"IVMCM6","COMMENT")
+141 NEW IVMNTECT,IVMNTED
+142 SET IVMNTED=0
+143 FOR IVMNTECT=1:1
Begin DoDot:5
+144 IF '$DATA(^TMP($JOB,"IVMCM","NTE",IVMNTECT))
SET IVMNTED=1
QUIT
+145 SET ^TMP($JOB,"IVMCM6","COMMENT",IVMNTECT)=$PIECE(^TMP($JOB,"IVMCM","NTE",IVMNTECT),"^")
End DoDot:5
if IVMNTED
QUIT
+146 DO WP^DIE(408.31,""_DGMTI_",",50,"K","^TMP($J,""IVMCM6"",""COMMENT"")")
+147 KILL DATA(50),^TMP($JOB,"IVMCM6","COMMENT")
End DoDot:4
End DoDot:3
+148 IF IVM12=""
IF $$CHKCMT(IVMMTIEN)
DO RMVECMT(IVMMTIEN)
End DoDot:2
End DoDot:1
+149 ;
+150 ;
+151 ;determine status based on test-determined status and hardship
+152 SET CODE=IVM14
+153 IF IVMTYPE=1
IF DATA(.2)
SET CODE=IVM6
+154 SET DATA(.03)=$$GETSTAT^DGMTH(CODE,IVMTYPE)
+155 ;
+156 IF $$UPD^DGENDBS(408.31,DGMTI,.DATA)
Begin DoDot:1
+157 ; can't call MT Events protocol for Long Term Care Copay Exemption
+158 ; Tests as it triggers an IB and Enrollment update
+159 ; so manually call needed protocols to trigger audit, date stamp
+160 ; and transmission (if necessary)
+161 IF IVMTYPE=4
Begin DoDot:2
+162 if $GET(DGMTACT)=""
SET DGMTACT="ADD"
+163 ;IVM*2*84
SET DGMTP=$GET(DGMTP)
+164 ;Means Test Interactive/Non-interactive flag
SET DGMTINF=1
+165 DO AFTER^DGMTEVT
+166 ;means test audit event
DO EN^DGMTAUD
+167 ;IVM means test event
DO ^IVMPMTE
+168 ;date stamp
DO DATETIME^DGMTU4($GET(DGMTI))
End DoDot:2
QUIT
+169 ;
+170 ; - call means test event driver if not future test
+171 IF 'IVMFUTR
Begin DoDot:2
+172 if (IVMTYPE=1)
DO MTPRIME^DGMTU4(DGMTI)
+173 if (IVMTYPE=2)
DO RXPRIME^DGMTU4(DGMTI)
+174 SET CODE=$$GETCODE^DGMTH($PIECE($GET(^DGMT(408.31,DGMTI,0)),"^",3))
End DoDot:2
+175 IF '$TEST
Begin DoDot:2
+176 ;enter to list of future tests kept in the IVM Patient file
+177 DO ADDFUTR^IVMPLOG2(DGMTI)
+178 ;also, if HEC changed the test to a future date, there could be
+179 ;a test on file for the same income year marked as primary
+180 IF $GET(IVMMTIEN)
IF $PIECE(NODE2,"^",5)=IVM8
Begin DoDot:3
+181 NEW DATA,ERROR,DGMTI,DGMTACT,DGMTYPT,DGMTA
+182 SET DATA(2)=0
+183 IF $$UPD^DGENDBS(408.31,IVMMTIEN,.DATA,.ERROR)
+184 ; if the test being replaced by the uploaded future test
+185 ; becomes non-primary and the site conducted both tests
+186 ; then call Means Test event driver (non interactively)
+187 SET DGMTACT="EDT"
SET DGMTI=IVMMTIEN
SET DGMTYPT=IVMTYPE
SET DGMTINF=1
+188 DO AFTER^DGMTEVT
+189 DO EN^DGMTEVT
+190 Begin DoDot:4
+191 NEW DGMSGF,DGADDF
+192 SET DGMSGF=1
SET DGADDF=0
+193 DO EN^DGMTR
End DoDot:4
End DoDot:3
End DoDot:2
+194 if OK2SND
DO TRNSMT
End DoDot:1
+195 ;
+196 ;
MTBULL ; Build results array
+1 DO ADD^IVMCMB(DFN,IVMTYPE,$SELECT(IVMFUTR:"Future Test",1:"New Test"),$GET(IVMMTDT),$SELECT($GET(IVMMTIEN):$$GETCODE^DGMTH($PIECE($GET(^DGMT(408.31,IVMMTIEN,0)),"^",3)),1:""),CODE)
+2 ;
CLEANUP ; cleanup
+1 KILL DGCAT,DGCOMF,DGMTACT,DGMTI,DGMTINF,DGMTPAR,DGTHB,IVMBU45,IVMOP,IVMOP1
+2 KILL IVM1,IVM2,IVM3,IVM4,IVM5,IVM6,IVM7,IVM8,IVM9,IVM10,IVM11,IVM12,IVM13,IVM14,IVMCAT,IVMCEA,IVMCEB,IVMMTA,IVM15,IVM16,IVM17,IVM18,IVM19,IVM20,IVM21
+3 ;IVM*2.0*190 IVM*2.0*193
KILL IVM22,IVM23,IVM24,IVM25,IVM26
+4 QUIT
+5 ;
CHKCMT(MTIEN) ; CHECK FOR HARDSHIP COMMENT IVM*2.0*190
+1 ; DBIA 968 NAME: DBIA968 FILE: 408.31 ROOT: DGMT(408.31,
+2 NEW CNT,RET,COMMENT,DIC,DR,DA
+3 SET DIC=408.31
SET DR="50"
SET DA=MTIEN
+4 SET DR(408.311)=".01"
SET DA(408.311)=1
+5 DO EN^DIQ1
+6 SET CNT=0
SET RET=0
+7 FOR
SET CNT=$ORDER(^UTILITY("DIQ1",$JOB,408.31,MTIEN,50,CNT))
if CNT=""
QUIT
Begin DoDot:1
+8 SET COMMENT=^UTILITY("DIQ1",$JOB,408.31,MTIEN,50,CNT)
+9 IF COMMENT["Hardship Effective Date earlier than Means Test Date"
SET RET=1
End DoDot:1
if RET
QUIT
+10 QUIT RET
+11 ;
RMVECMT(MTIEN) ; REMOVE COMMENTS NOT NEEDED IVM*2.0*190
+1 ; DBIA 968 NAME:DBIA968 FILE: 408.31 ROOT: DGMT(408.31,
+2 NEW CNT,RET,COMMENT,DIC,DR,DA,IVMFNDC1,IVMFNDC2,IVMLNCT
+3 SET DIC=408.31
SET DR="50"
SET DA=MTIEN
SET IVMFNDC1=0
SET IVMFNDC2=0
SET IVMLNCT=0
+4 SET DR(408.311)=".01"
SET DA(408.311)=1
+5 DO EN^DIQ1
+6 SET CNT=0
SET RET=0
+7 FOR
SET CNT=$ORDER(^UTILITY("DIQ1",$JOB,408.31,MTIEN,50,CNT))
if CNT=""
QUIT
Begin DoDot:1
+8 SET COMMENT=^UTILITY("DIQ1",$JOB,408.31,MTIEN,50,CNT)
SET (IVMFNDC1,IVMFNDC2)=0
+9 IF COMMENT["Received/Uploaded Test on"&(COMMENT["with data inconsistencies")
SET IVMFNDC1=1
+10 IF COMMENT["Hardship Effective Date earlier than Means Test Date"
SET IVMFNDC2=1
+11 IF 'IVMFNDC1
IF 'IVMFNDC2
SET IVMLNCT=IVMLNCT+1
SET ^TMP($JOB,"IVMCM6","COMMENT",IVMLNCT)=COMMENT
End DoDot:1
if RET
QUIT
+12 IF IVMLNCT>0
DO WP^DIE(408.31,""_MTIEN_",",50,"K","^TMP($J,""IVMCM6"",""COMMENT"")")
KILL ^TMP($JOB,"IVMCM6","COMMENT")
+13 QUIT
+14 ;
OPEN ; open case record for uploaded test
+1 SET IVMOP=""
SET IVMOP=$ORDER(^IVM(301.5,"AYR",DGLY,DFN,IVMOP))
IF 'IVMOP
DO OPEN1
QUIT
+2 SET IVMOP1=$GET(^IVM(301.5,IVMOP,0))
IF 'IVMOP1
DO OPEN1
QUIT
+3 IF $PIECE(IVMOP1,"^",4)=1
SET DA=+IVMOP
Begin DoDot:1
+4 SET DIE="^IVM(301.5,"
SET DR=".03////1;.04////0"
+5 DO OPEN2
End DoDot:1
QUIT
+6 QUIT
OPEN1 KILL DD,DO
+1 SET DIC="^IVM(301.5,"
SET DIC(0)="LMNZ"
SET X=DFN
SET DLAYGO=301.5
+2 DO FILE^DICN
if Y'>0
QUIT
SET DA=+Y
+3 SET DIE="^IVM(301.5,"
SET DR=".02////^S X=DGLY;.03////1;.04////0"
OPEN2 DO ^DIE
KILL DD,DO,DIC,DLAYGO,X,Y,DIE,DR
+1 QUIT
+2 ;
MTDRIVER ; call means test event driver
+1 ; dgmtact
+2 ; adj adjudicated mt
+3 ; cat hardship mt
+4 ; add new mt or copay
+5 ; edit corrected mt or copay
+6 ;
+7 NEW IVMDA,IVMDT,IVMFLG,IVMMTDT,IVMNEW
+8 SET DGMTACT=$SELECT($GET(IVMHADJ)=1:"ADJ",$GET(IVMHADJ)=2:"CAT",'$GET(DGMTP):"ADD",1:"EDT")
+9 DO AFTER^DGMTEVT
+10 ; non-interactive flag
SET DGMTINF=1
+11 DO EN^DGMTEVT
+12 QUIT
+13 ;
CHKTST ; Verify if the incoming Income Test requires a Z07 transmission.
+1 ;
+2 NEW MTREC,REC01,ZMTSEG
+3 SET OK2SND=0
+4 SET MTREC=$GET(^DGMT(408.31,DGMTI,0))
+5 if '$DATA(^DGMT(408.31,DGMTI,0))
QUIT
+6 ; Check if the Source of the Test is DCD
+7 SET ZMTSEG=$GET(^TMP($JOB,"IVMCM","ZMT"_IVMTYPE))
+8 if $PIECE($GET(^DG(408.34,+$PIECE(ZMTSEG,U,18),0)),U)'="DCD"
QUIT
+9 ;Check if the DCD software has been installed
+10 if '$$VERSION^XPDUTL("IVMC")
QUIT
+11 ;
+12 ; If the source of the test is DCD, and the site receiving the test
+13 ; is a DCD site, set the record to transmit.
+14 SET OK2SND=1
+15 QUIT
+16 ;
TRNSMT ; Set the record to transmit due to DCD Criteria
+1 NEW REC01,DCDDATA,DCDIEN,EVENTS,ERROR
+2 SET REC01=$ORDER(^IVM(301.5,"AYR",DGLY,DFN,""))
+3 SET DCDDATA(.04)=0
SET DCDIEN=REC01
+4 IF $$UPD^DGENDBS(301.5,DCDIEN,.DCDDATA,.ERROR)
+5 SET EVENTS("DCD")=1
+6 IF $$SETSTAT^IVMPLOG(REC01,.EVENTS)
+7 ;
+8 QUIT
