IVMUFNC5 ;ALB/AEG,HM - IVM UTILITIES CONTINUED ;8/10/05 1:39pm
;;2.0;INCOME VERIFICATION MATCH;**55,109,149,183**;5-10-2002;Build 30
;
AGE(DT) ;
N Y
S Y=$E(DT,1,3)-1_"0000",Y=Y-10000
Q Y
;
INCY(IVMMTDT) ;
N Y
S Y=$E(IVMMTDT,1,3)_"0000",Y=Y-10000
Q Y
;
CATC(DATA) ;
; Extrinsic function to determine is incoming ZMT1 segment meets
; one of the following groups:
; 1. Cat C or Pending Adj. / Provided income info / test date
; is 10/6/99 or later and Agreed to Pay is YES.
; OR
;
; 2. Category C based upon declination to provide income info
; but agreed to pay deductible.
;
;
; Input(s): $G(^TMP($J,"IVMCM","ZMT1")) global node - Incoming ZMT
; segment.
;
; Output(s): Function Value. 1 = Yes patient meets one of the criteria
; 0 = NO test does not meet criteria.
; 99 = initialize value and default criteria outside of criteria being checked.
N MTDAT,RETV
S RETV=99
Q:'$D(DATA) 0
S MTDAT("DT")=$$FMDATE^HLFNC($P($G(DATA),U,2)),MTDAT("MTS")=$P($G(DATA),U,3)
S MTDAT("APD")=$P($G(DATA),U,7),MTDAT("DCLI")=$P($G(DATA),U,16)
; Patient Provided income information.
I '+$G(MTDAT("DCLI")) D
.; If Cat C or Pending Adjudication test date on or after 10/6/99
.; Provided Income info and Agreed to Pay.
.;
.I $G(MTDAT("MTS"))="C",$G(MTDAT("DT"))'<2991006,$G(MTDAT("APD"))=1 S RETV=1 Q
.I $G(MTDAT("MTS"))="P",$G(MTDAT("DT"))'<2991006,$G(MTDAT("APD"))=1 S RETV=1 Q
.;check CATC status MT for date less than 10/6/1999 and set the RETV = 0 for error IVM*2.0*183
.I $G(MTDAT("MTS"))="C",$G(MTDAT("DT"))<2991006,$G(MTDAT("APD"))=1 S RETV=0 Q ;IVM*2.0*183 HM
.;Pending Adjudication status MT and if date less than 10/6/1999 and set RETV = 0 for error IVM*2.0*183
.I $G(MTDAT("MTS"))="P",$G(MTDAT("DT"))<2991006,$G(MTDAT("APD"))=1 S RETV=0 Q ;IVM*2.0*183 HM
; Patient Declined to provide income information.
I +$G(MTDAT("DCLI")) D
.; Cat C and Agreed to Pay - No date restriction
.I $G(MTDAT("MTS"))="C",+$G(MTDAT("APD")) S RETV=1 Q
;
Q RETV
;
ACCMT(DATA) ;
; Added for IVM*2.0*183 HM
; Extrinsic function to determine is incoming ZMT1 segment meets
; one of the following groups:
; 1. Based upon patient's income information, these patients are
; subject to MT and their status is MT Copay Exempt. ;IVM*2.0*183 HM
;
; OR
;
; 2. Patient is Geographic Means Test (GMT) based upon patients who provide
; income information and agreement to pay the deductible(s). The patient
; Means Test status is GMT Copay Required. ;IVM*2.0*183 HM
;
; Input(s): $G(^TMP($J,"IVMCM","ZMT1")) global node - Incoming ZMT
; segment.
;
; Output(s): Function Value. 1 = Yes patient meets one of the criteria
; 0 = NO test does not meet criteria.
; 99 = initialize value and default criteria outside of criteria being checked.
;
;Controlled Subscription ICR #7088; Supports use of OLDMTPF^DGMTU4(TESTDATE)
;Checks if the date is more than 1 year old of the VFA Start Date
;
N MTDAT,RETV,IVML
S RETV=99
Q:'$D(DATA) 0
S MTDAT("APD")=$P($G(DATA),U,7) ;agree to pay deductible information
S MTDAT("DT")=$$FMDATE^HLFNC($P($G(DATA),U,2)),MTDAT("MTS")=$P($G(DATA),U,3)
;check for MT Copay Exempt status and MT less than 1 year old as of "VFA Start Date"
I MTDAT("MTS")="A",'$$OLDMTPF^DGMTU4(MTDAT("DT")) S RETV=1 ;Logic for #1 comment above
I MTDAT("MTS")="A",+$$OLDMTPF^DGMTU4(MTDAT("DT")) S RETV=0
;check for GMT Copay Required status and agreed to pay and MT less than 1 year old as of "VFA Start Date" and does require patient income
I MTDAT("MTS")="G",'$$OLDMTPF^DGMTU4(MTDAT("DT")),$G(MTDAT("APD"))=1 S RETV=1 ;Logic for #2 comment above
I MTDAT("MTS")="G",+$$OLDMTPF^DGMTU4(MTDAT("DT")),$G(MTDAT("APD"))=1 S RETV=0
;
Q RETV
;
ELIG(DFN) ; Eligibility Check for Cat C uploads older than previous
; income year data.
;
; Input: DFN - Patient IEN
; Output: Function Value 0 if Z10 upload not appropriate
;
N IVMELI
S IVMELI=0
; Check primary eligibility
I $D(^DPT(DFN,.36)) S X=^(.36) D
.; If NSC or SC < 50 0% appropriate to upload old test.
.I $P($G(^DIC(8,+X,0)),U,9)=5!($$SC(DFN)) S IVMELI=1
.I $P(X,U,12)=1 S IVMELI=0
.I $P(X,U,13)=1 S IVMELI=0
.K X
; If deceased patient --- don't upload.
I +$$GET1^DIQ(2,DFN_",",.351,"I") S IVMELI=0
; If eligible for medicaid, don't upload.
I +$$GET1^DIQ(2,DFN_",",.381,"I") S IVMELI=0
; Check PH status.
I $P($G(^DPT(DFN,.53)),U)="Y" S IVMELI=0
; Catastrophically disabled
I $P($G(^DPT(DFN,.39)),U,6)="Y" S IVMELI=0 ;IVM*2.0*149
; Medal of Honor, don't upload
I $P($G(^DPT(DFN,.54)),U)="Y" S IVMELI=0 ;IVM*2.0*183 HM
Q IVMELI
;
SC(DFN) ; Check to see if patient is SC 0% non-compensable.
; Input -- DFN Patient IEN
; Output -- Function value 1=Yes or 0=No
;
N IVMG,IVME,IVMF,IVMY
S IVMY=0
; Primary Eligibility is SC < 50 %
I $D(^DPT(DFN,.36)),$P($G(^DIC(8,+X,0)),U,9)=3 S IVMY=1
G:'IVMY SCQ
; Service Connected percentage = 0
I $P($G(^DPT(DFN,.3)),U,2)'=0 S IVMY=0 G SCQ
; No Total annual VA Check amount
I $P($G(^DPT(DFN,.362)),U,20) S IVMY=0 G SCQ
; POW Status indicated.
I $P($G(^DPT(DFN,.52)),U,5)="Y" S IVMY=0 G SCQ
; Purple Heart Indicated.
I $P($G(^DPT(DFN,.53)),U)="Y" S IVMY=0 G SCQ
; Check Secondary Eligibilities.
F IVMG=2,4,15:1:18 S IVME(IVMG)=""
S IVMG=0 F S IVMG=$O(^DPT(DFN,"E","B",IVMG)) Q:'IVMG D SEL I IVMF,$D(IVME(+IVMF)) S IVMY=0 Q
SCQ Q +$G(IVMY)
;
SEL ;
S IVMF=$G(^DIC(8,+IVMG,0)) I IVMF="" Q
S IVMF=$P(IVMF,U,9)
I IVMF=""!('$D(^DIC(8.1,+IVMF,0))) D
.S IVMF=""
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMUFNC5 5796 printed Apr 09, 2024@21:02:40 Page 2
IVMUFNC5 ;ALB/AEG,HM - IVM UTILITIES CONTINUED ;8/10/05 1:39pm
+1 ;;2.0;INCOME VERIFICATION MATCH;**55,109,149,183**;5-10-2002;Build 30
+2 ;
AGE(DT) ;
+1 NEW Y
+2 SET Y=$EXTRACT(DT,1,3)-1_"0000"
SET Y=Y-10000
+3 QUIT Y
+4 ;
INCY(IVMMTDT) ;
+1 NEW Y
+2 SET Y=$EXTRACT(IVMMTDT,1,3)_"0000"
SET Y=Y-10000
+3 QUIT Y
+4 ;
CATC(DATA) ;
+1 ; Extrinsic function to determine is incoming ZMT1 segment meets
+2 ; one of the following groups:
+3 ; 1. Cat C or Pending Adj. / Provided income info / test date
+4 ; is 10/6/99 or later and Agreed to Pay is YES.
+5 ; OR
+6 ;
+7 ; 2. Category C based upon declination to provide income info
+8 ; but agreed to pay deductible.
+9 ;
+10 ;
+11 ; Input(s): $G(^TMP($J,"IVMCM","ZMT1")) global node - Incoming ZMT
+12 ; segment.
+13 ;
+14 ; Output(s): Function Value. 1 = Yes patient meets one of the criteria
+15 ; 0 = NO test does not meet criteria.
+16 ; 99 = initialize value and default criteria outside of criteria being checked.
+17 NEW MTDAT,RETV
+18 SET RETV=99
+19 if '$DATA(DATA)
QUIT 0
+20 SET MTDAT("DT")=$$FMDATE^HLFNC($PIECE($GET(DATA),U,2))
SET MTDAT("MTS")=$PIECE($GET(DATA),U,3)
+21 SET MTDAT("APD")=$PIECE($GET(DATA),U,7)
SET MTDAT("DCLI")=$PIECE($GET(DATA),U,16)
+22 ; Patient Provided income information.
+23 IF '+$GET(MTDAT("DCLI"))
Begin DoDot:1
+24 ; If Cat C or Pending Adjudication test date on or after 10/6/99
+25 ; Provided Income info and Agreed to Pay.
+26 ;
+27 IF $GET(MTDAT("MTS"))="C"
IF $GET(MTDAT("DT"))'<2991006
IF $GET(MTDAT("APD"))=1
SET RETV=1
QUIT
+28 IF $GET(MTDAT("MTS"))="P"
IF $GET(MTDAT("DT"))'<2991006
IF $GET(MTDAT("APD"))=1
SET RETV=1
QUIT
+29 ;check CATC status MT for date less than 10/6/1999 and set the RETV = 0 for error IVM*2.0*183
+30 ;IVM*2.0*183 HM
IF $GET(MTDAT("MTS"))="C"
IF $GET(MTDAT("DT"))<2991006
IF $GET(MTDAT("APD"))=1
SET RETV=0
QUIT
+31 ;Pending Adjudication status MT and if date less than 10/6/1999 and set RETV = 0 for error IVM*2.0*183
+32 ;IVM*2.0*183 HM
IF $GET(MTDAT("MTS"))="P"
IF $GET(MTDAT("DT"))<2991006
IF $GET(MTDAT("APD"))=1
SET RETV=0
QUIT
End DoDot:1
+33 ; Patient Declined to provide income information.
+34 IF +$GET(MTDAT("DCLI"))
Begin DoDot:1
+35 ; Cat C and Agreed to Pay - No date restriction
+36 IF $GET(MTDAT("MTS"))="C"
IF +$GET(MTDAT("APD"))
SET RETV=1
QUIT
End DoDot:1
+37 ;
+38 QUIT RETV
+39 ;
ACCMT(DATA) ;
+1 ; Added for IVM*2.0*183 HM
+2 ; Extrinsic function to determine is incoming ZMT1 segment meets
+3 ; one of the following groups:
+4 ; 1. Based upon patient's income information, these patients are
+5 ; subject to MT and their status is MT Copay Exempt. ;IVM*2.0*183 HM
+6 ;
+7 ; OR
+8 ;
+9 ; 2. Patient is Geographic Means Test (GMT) based upon patients who provide
+10 ; income information and agreement to pay the deductible(s). The patient
+11 ; Means Test status is GMT Copay Required. ;IVM*2.0*183 HM
+12 ;
+13 ; Input(s): $G(^TMP($J,"IVMCM","ZMT1")) global node - Incoming ZMT
+14 ; segment.
+15 ;
+16 ; Output(s): Function Value. 1 = Yes patient meets one of the criteria
+17 ; 0 = NO test does not meet criteria.
+18 ; 99 = initialize value and default criteria outside of criteria being checked.
+19 ;
+20 ;Controlled Subscription ICR #7088; Supports use of OLDMTPF^DGMTU4(TESTDATE)
+21 ;Checks if the date is more than 1 year old of the VFA Start Date
+22 ;
+23 NEW MTDAT,RETV,IVML
+24 SET RETV=99
+25 if '$DATA(DATA)
QUIT 0
+26 ;agree to pay deductible information
SET MTDAT("APD")=$PIECE($GET(DATA),U,7)
+27 SET MTDAT("DT")=$$FMDATE^HLFNC($PIECE($GET(DATA),U,2))
SET MTDAT("MTS")=$PIECE($GET(DATA),U,3)
+28 ;check for MT Copay Exempt status and MT less than 1 year old as of "VFA Start Date"
+29 ;Logic for #1 comment above
IF MTDAT("MTS")="A"
IF '$$OLDMTPF^DGMTU4(MTDAT("DT"))
SET RETV=1
+30 IF MTDAT("MTS")="A"
IF +$$OLDMTPF^DGMTU4(MTDAT("DT"))
SET RETV=0
+31 ;check for GMT Copay Required status and agreed to pay and MT less than 1 year old as of "VFA Start Date" and does require patient income
+32 ;Logic for #2 comment above
IF MTDAT("MTS")="G"
IF '$$OLDMTPF^DGMTU4(MTDAT("DT"))
IF $GET(MTDAT("APD"))=1
SET RETV=1
+33 IF MTDAT("MTS")="G"
IF +$$OLDMTPF^DGMTU4(MTDAT("DT"))
IF $GET(MTDAT("APD"))=1
SET RETV=0
+34 ;
+35 QUIT RETV
+36 ;
ELIG(DFN) ; Eligibility Check for Cat C uploads older than previous
+1 ; income year data.
+2 ;
+3 ; Input: DFN - Patient IEN
+4 ; Output: Function Value 0 if Z10 upload not appropriate
+5 ;
+6 NEW IVMELI
+7 SET IVMELI=0
+8 ; Check primary eligibility
+9 IF $DATA(^DPT(DFN,.36))
SET X=^(.36)
Begin DoDot:1
+10 ; If NSC or SC < 50 0% appropriate to upload old test.
+11 IF $PIECE($GET(^DIC(8,+X,0)),U,9)=5!($$SC(DFN))
SET IVMELI=1
+12 IF $PIECE(X,U,12)=1
SET IVMELI=0
+13 IF $PIECE(X,U,13)=1
SET IVMELI=0
+14 KILL X
End DoDot:1
+15 ; If deceased patient --- don't upload.
+16 IF +$$GET1^DIQ(2,DFN_",",.351,"I")
SET IVMELI=0
+17 ; If eligible for medicaid, don't upload.
+18 IF +$$GET1^DIQ(2,DFN_",",.381,"I")
SET IVMELI=0
+19 ; Check PH status.
+20 IF $PIECE($GET(^DPT(DFN,.53)),U)="Y"
SET IVMELI=0
+21 ; Catastrophically disabled
+22 ;IVM*2.0*149
IF $PIECE($GET(^DPT(DFN,.39)),U,6)="Y"
SET IVMELI=0
+23 ; Medal of Honor, don't upload
+24 ;IVM*2.0*183 HM
IF $PIECE($GET(^DPT(DFN,.54)),U)="Y"
SET IVMELI=0
+25 QUIT IVMELI
+26 ;
SC(DFN) ; Check to see if patient is SC 0% non-compensable.
+1 ; Input -- DFN Patient IEN
+2 ; Output -- Function value 1=Yes or 0=No
+3 ;
+4 NEW IVMG,IVME,IVMF,IVMY
+5 SET IVMY=0
+6 ; Primary Eligibility is SC < 50 %
+7 IF $DATA(^DPT(DFN,.36))
IF $PIECE($GET(^DIC(8,+X,0)),U,9)=3
SET IVMY=1
+8 if 'IVMY
GOTO SCQ
+9 ; Service Connected percentage = 0
+10 IF $PIECE($GET(^DPT(DFN,.3)),U,2)'=0
SET IVMY=0
GOTO SCQ
+11 ; No Total annual VA Check amount
+12 IF $PIECE($GET(^DPT(DFN,.362)),U,20)
SET IVMY=0
GOTO SCQ
+13 ; POW Status indicated.
+14 IF $PIECE($GET(^DPT(DFN,.52)),U,5)="Y"
SET IVMY=0
GOTO SCQ
+15 ; Purple Heart Indicated.
+16 IF $PIECE($GET(^DPT(DFN,.53)),U)="Y"
SET IVMY=0
GOTO SCQ
+17 ; Check Secondary Eligibilities.
+18 FOR IVMG=2,4,15:1:18
SET IVME(IVMG)=""
+19 SET IVMG=0
FOR
SET IVMG=$ORDER(^DPT(DFN,"E","B",IVMG))
if 'IVMG
QUIT
DO SEL
IF IVMF
IF $DATA(IVME(+IVMF))
SET IVMY=0
QUIT
SCQ QUIT +$GET(IVMY)
+1 ;
SEL ;
+1 SET IVMF=$GET(^DIC(8,+IVMG,0))
IF IVMF=""
QUIT
+2 SET IVMF=$PIECE(IVMF,U,9)
+3 IF IVMF=""!('$DATA(^DIC(8.1,+IVMF,0)))
Begin DoDot:1
+4 SET IVMF=""
+5 QUIT
End DoDot:1
+6 QUIT
