Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: EASECMT

EASECMT.m

Go to the documentation of this file.
  1. EASECMT ;ALB/LBD,BDB - Means Test for LTC Co-Pay exemption ; 27 DEC 2001
  1. ;;1.0;ENROLLMENT APPLICATION SYSTEM;**7,16,18,70,88,106**;Mar 15, 2001;Build 28
  1. ;
  1. EN ; This is the entry point for the routine that will find the
  1. ; financial test for a veteran that can be used to check if
  1. ; veteran's income is below the threshold and exempt from LTC
  1. ; co-payments. If a financial test is not on file for the veteran
  1. ; it can be added through this process.
  1. ; Input -- DFN = Patient IEN
  1. ; Output -- DGEXMPT = 1 (exempt from LTC co-payments)
  1. ; = 0 or "" (not exempt from LTC co-payments)
  1. ; DGOUT = 1 (user wants to exit from the process)
  1. N DGCMPLT,DGMTI,DGMTDT,DGMTYPT,DGMTACT,DGL,DGCS,DGMSGF,DGREQF,DGDOM,DGDOM1,Y
  1. ; Does veteran have current LTC co-pay exemption test (type 4)?
  1. S Y=$$GETLTC4(DFN) I Y S DGEXMPT=$S($P(Y,U,3)="EXEMPT":1,1:0) Q
  1. ; Does veteran have current means test?
  1. S DGL=$$LST^DGMTU(DFN),DGMTI=+DGL,DGMTDT=$P(DGL,U,2),DGCS=$P(DGL,U,4)
  1. ; If last means test has status of Cat C or Pend. Adj. and vet agreed
  1. ; to pay MT copay, new means test is not required
  1. I ((DGCS="C")!(DGCS="P")),$P($G(^DGMT(408.31,DGMTI,0)),U,11)=1,DGMTDT>2991005 S DGEXMPT=0 D LTC4(DGMTI,DGEXMPT) Q
  1. ; If means test is required or more than a year old, do new means test
  1. ; EAS*1.0*106 MT less than 1 year old as of "VFA Start Date" and point forward do not expire
  1. I (DGCS="R")!($$OLDMTPF^DGMTU4(DGMTDT)) D Q:$G(DGOUT)!(DGMTYPT=4)
  1. .S (DGADDF,DGMSGF)=1 D ^DGMTR S DGMTYPT=$S(DGREQF:1,1:4)
  1. .I '$$ASK(DGMTYPT) S DGOUT=1 Q
  1. .S DGMTACT="ADD" I DGMTYPT=1,$E(DGMTDT,1,3)=$E(DT,1,3) S DGMTACT="EDT"
  1. .D MT(DFN,DGMTYPT,DGMTACT,.DGMTI,.DGCMPLT)
  1. .I '$G(DGCMPLT) S DGOUT=1 Q
  1. .I DGMTYPT=4 D
  1. ..D DOM^DGMTR I '$G(DGDOM1) D COPYRX^DGMTR1(DFN,DGMTI)
  1. ..S Y=$$GETCODE^DGMTH($P($G(^DGMT(408.31,DGMTI,0)),U,3)),DGEXMPT=$S(Y=0:1,1:0)
  1. ; If no means test or means test is no longer required, check if
  1. ; there is an RX co-pay test, otherwise do new LTC co-pay exemption test
  1. I DGCS=""!(DGCS="N") D Q:$G(DGOUT)!($G(DGMTYPT)=4)
  1. .S DGL=$$LST^DGMTU(DFN,DT,2),DGMTI=+DGL,DGMTDT=$P(DGL,U,2),DGCS=$P(DGL,U,4)
  1. .I DGMTI,'$$OLD^DGMTU4(DGMTDT),("^I^L^")'[("^"_DGCS_"^") Q
  1. .S DGMTYPT=4
  1. .I '$$ASK(DGMTYPT) S DGOUT=1 Q
  1. .D MT(DFN,DGMTYPT,"ADD",.DGMTI,.DGCMPLT)
  1. .I '$G(DGCMPLT) S DGOUT=1 Q
  1. .D DOM^DGMTR I '$G(DGDOM1) D COPYRX^DGMTR1(DFN,DGMTI)
  1. .S Y=$$GETCODE^DGMTH($P($G(^DGMT(408.31,DGMTI,0)),U,3))
  1. .S DGEXMPT=$S(Y=0:1,1:0)
  1. ; Check if veteran's income is below the pension threshold
  1. S DGEXMPT=$$THRES(DFN,DGMTDT)
  1. I DGEXMPT<0 W !!,"The income threshold check could not be completed due to an error." S DGOUT=1 Q
  1. ; Create LTC co-pay exemption test (type 4) by copying MT
  1. D LTC4(DGMTI,DGEXMPT)
  1. Q
  1. ;
  1. THRES(DFN,DGMTDT) ; Is veteran's income below the pension threshold
  1. ; Input - DFN = Patient IEN
  1. ; DGMTDT = Test date
  1. ; Output - = 1 (Below the threshold)
  1. ; = 0 (Above the threshold)
  1. ; = -1(Error)
  1. N DGDC,DGDEP,DGDET,DGERR,DGIN0,DGIN1,DGIN2,DGINI,DGINT,DGINTF,DGIRI
  1. N DGNC,DGND,DGNWT,DGNWTF,DGPRI,DGSP,DGVINI,DGVIR0,DGVIRI,DGTHRES
  1. N DGLY,DGMTPAR
  1. ; Get current single veteran pension threshold amount
  1. S DGTHRES=$$THRES^IBARXEU1(DGMTDT,1,0) I '+DGTHRES Q -1
  1. ; Calculate veteran's income level and check against the threshold
  1. S DGPRI=$O(^DGPR(408.12,"C",DFN_";DPT(",0)) I 'DGPRI Q -1
  1. D GETIENS^DGMTU2(DFN,DGPRI,DGMTDT) I '$G(DGIRI),'$G(DGINI) Q -1
  1. S DGVIRI=DGIRI,DGVINI=DGINI
  1. S DGLY=$$LYR^DGMTSCU1(DGMTDT) D PAR^DGMTSCU
  1. D DEP^DGMTSCU2,INC^DGMTSCU3 I '$D(DGINT) Q -1
  1. ; If vet declined to provide financial info, return 0 (above threshold)
  1. I $P($G(^DGMT(408.31,+$G(DGMTI),0)),U,14) Q 0
  1. I (DGINT-DGDET)'>+DGTHRES Q 1
  1. Q 0
  1. ;
  1. MT(DFN,TYPE,ACT,DGMTI,DGCMPLT) ; Complete a means test or LTC co-pay exemption test
  1. ; Input - DFN = Patient IEN
  1. ; TYPE = Type of test (1=MT; 4=LTC4)
  1. ; ACT = Type of action (ADD or EDT)
  1. ; DGMTI = If EDT action, IEN of test to be edited
  1. ; Output - DGCMPLT = 1 (MT completed)
  1. ; = 0 (MT not completed)
  1. ; DGMTI = IEN of new test
  1. N DGMTYPT,DGMTACT,DGMTROU,DGMT0,DGSTA,TYPESAVE,DGCMPLT
  1. S DGCMPLT=0
  1. I $$LOCK^DGMTUTL(DFN) E Q DGCMPLT
  1. S DGMTYPT=TYPE,DGMTACT=ACT
  1. S TYPESAVE=TYPE ;*GTS - EAS*1*70
  1. S DGMTDT=$S(DGMTACT="EDT":+$G(^DGMT(408.31,DGMTI,0)),1:DT) I 'DGMTDT D MT1 Q
  1. ;*GTS - EAS*1*70
  1. ; If adding a LTC CP Exemption test, TYPE indicates test copied from for ADD^DGMTA
  1. I DGMTACT="ADD" S:TYPE=4 TYPE=1 D ADD^DGMTA S TYPE=TYPESAVE I '$G(DGMTI) D MT1 Q
  1. S DGMTROU="MT1^EASECMT"
  1. G EN^DGMTSC
  1. MT1 I $G(DGMTI) D
  1. .S DGMT0=$G(^DGMT(408.31,DGMTI,0)),DGSTA=$$GETCODE^DGMTH($P(DGMT0,U,3))
  1. .I DGSTA'="","ACP01"[DGSTA,$P(DGMT0,U,7)]"" S DGCMPLT=1
  1. .I 'DGCMPLT,TYPE=4 D DEL ;Delete incomplete LTC copay exemption test
  1. D UNLOCK^DGMTUTL(DFN)
  1. Q
  1. ;
  1. LTC4(DGMT,DGEXMPT) ; Create or update LTC copay exemption test (type 4) by copying
  1. ; means test
  1. ; Input - DGMT = Annual Means Test IEN of test to be copied
  1. ; - DGEXMPT = LTC copayments exemption status (optional)
  1. Q:'DGMT
  1. N DGMT0,DGMT2,DA,DIC,DIK,DLAYGO,X,DFN,DGMTI,DGCONVRT
  1. N DGMTA,DGMTP,DGMTACT,DGMTINF,DGMTYPT
  1. ; Quit if this is a LTC copay exemption test (type 4)
  1. S DGMT0=$G(^DGMT(408.31,DGMT,0)) I $P(DGMT0,U,19)=4 Q
  1. S DGMT2=$G(^DGMT(408.31,DGMT,2))
  1. ; Add a new LTC 4 test or edit an existing LTC 4 test?
  1. S DGMTI=$O(^DGMT(408.31,"AT",DGMT,0))
  1. S DGMTACT=$S(DGMTI:"EDT",1:"ADD")
  1. S DGMTP="" I DGMTACT="EDT" S DGMTP=$G(^DGMT(408.31,DGMTI,0))
  1. S DFN=$P(DGMT0,U,2)
  1. ; Add new entry to Annual Means Test file (#408.31) for LTC 4 test
  1. I DGMTACT="ADD" D Q:DGMTI'>0
  1. .S X=+DGMT0,(DIC,DIK)="^DGMT(408.31,",DIC(0)="L",DLAYGO=408.31
  1. .D FILE^DICN S DGMTI=+Y
  1. .;*GTS - EAS*1*70
  1. .S DGCONVRT=$$VRCHKUP^DGMTU2(4,$P(DGMT0,"^",19),+DGMT0,+DGMT0)
  1. .S DATA(2.11)=1
  1. F I=.01,.02,.04,.05,.06,.11,.14,.15,.18,.23 S DATA(I)=$P(DGMT0,U,(I/.01))
  1. I '$D(DGEXMPT) S DGEXMPT=$$THRES(DFN,$P(DGMT0,U,1))
  1. S DATA(.03)=$S(DGEXMPT:15,1:14),DATA(.07)=DT
  1. S DATA(.019)=4,DATA(2.02)=$P(DGMT2,U,2),DATA(2.08)=DGMT
  1. S DATA(2.05)=$P(DGMT2,U,5)
  1. I $$UPD^DGENDBS(408.31,DGMTI,.DATA,.ERROR)
  1. K DATA,ERROR
  1. ; Update the LTC copay test (type 3), if status changed
  1. I DGMTACT="EDT" D UPLTC3(DGMTI)
  1. ; Update Audit file and IVM Patient file
  1. S DGMTYPT=4,DGMTINF=1 D AFTER^DGMTEVT
  1. D EN^DGMTAUD
  1. D EN^IVMPMTE
  1. Q
  1. ;
  1. ASK(TYPE) ; Does user want to perform MT/LTC4 test now?
  1. ; Input - TYPE = Type of test, 1: MT; 4: LTC Copay Exemption
  1. ; Output - Y = 1 (YES)
  1. ; = 0 (NO)
  1. N DIR,TST
  1. S TST=$S(TYPE=1:"Means Test",1:"LTC Copay Exemption Test")
  1. W !!,"The previous year's financial information is not on file for this veteran.",!,"A ",TST," is required."
  1. S DIR("A")="Do you wish to complete the "_TST_" at this time"
  1. S DIR("B")="NO",DIR(0)="Y"
  1. W ! D ^DIR
  1. Q +(Y)
  1. ;
  1. GETLTC4(DFN,DGMTDT) ; Return last LTC co-pay exemption test (type 4),
  1. ; if less than a year old
  1. ; Input - DFN = Patient IEN
  1. ; DGMTDT (optional) = Date of test
  1. ; Output - Y = Annual Means Test IEN^Date of Test^Status Name^
  1. ; Status Code^Source of Test
  1. ; = "" (no current LTC co-pay exemption test)
  1. N Y
  1. S Y="" Q:'$G(DFN) Y I '$G(DGMTDT) S DGMTDT=DT
  1. S Y=$$LST^DGMTU(DFN,DGMTDT,4) I '(+Y) Q Y
  1. I $$OLD^DGMTU4($P(Y,U,2)) S Y=""
  1. Q Y
  1. ;
  1. DEL ;Delete incomplete LTC Copay Exemption test (type 4)
  1. ; Input -- DGMTI LTC Copay Exemption test IEN
  1. N DA,DIK,DIE,DR,V
  1. Q:'$G(DGMTI) Q:$P($G(^DGMT(408.31,DGMTI,0)),U,19)'=4
  1. ; Delete pointer in Income Relation file (#408.22)
  1. I $D(^DGMT(408.22,"AMT",DGMTI)) D
  1. .S DIE="^DGMT(408.22,",DR="31///@"
  1. .S V=$O(^DGMT(408.22,"AMT",DGMTI,0)) Q:'V
  1. .S IR=0 F S IR=$O(^DGMT(408.22,"AMT",DGMTI,V,IR)) Q:'IR S DA=$O(^(IR,0)) I DA D ^DIE
  1. ; Delete LTC Copay Exemption test from Annual Means Test file (#408.31)
  1. S DA=DGMTI,DIK="^DGMT(408.31,"
  1. D ^DIK
  1. Q
  1. ;
  1. UPLTC3(DGMT4) ;If the status of a LTC Copay Exemption test (type 4) changes,
  1. ;update the status of the LTC Copay test (type 3), if necessary
  1. ; Input -- DGMT4 LTC Copay Exemption test IEN
  1. N DGMT3,DGMTS4,DGMTS3,DGS,DATA,ERROR
  1. Q:'DGMT4
  1. S DGMT3=$O(^DGMT(408.31,"AT",DGMT4,0)) Q:$G(^DGMT(408.31,+DGMT3,0))=""
  1. ; Get test status
  1. S DGMTS4=$$GETNAME^DGMTH($P(^DGMT(408.31,DGMT4,0),U,3))
  1. S DGMTS3=$$GETNAME^DGMTH($P(^DGMT(408.31,DGMT3,0),U,3))
  1. ; If test status is the same quit
  1. I DGMTS4=DGMTS3 Q
  1. ; If LTC copay test (type 3) is Exempt and the Reason for Exemption is
  1. ; anything other than 2 (Income Last Year Below Threshold), quit
  1. I DGMTS3="EXEMPT",$P($G(^DGMT(408.31,DGMT3,2)),U,7)'=2 Q
  1. ; Get IEN of Means Test Status and update LTC copay test
  1. S DGS="" F S DGS=$O(^DG(408.32,"B",DGMTS4,DGS)) Q:'DGS I $P(^DG(408.32,DGS,0),U,19)=3 Q
  1. S DATA(.03)=DGS,DATA(2.07)=$S(DGMTS4="EXEMPT":2,1:"@")
  1. I $$UPD^DGENDBS(408.31,DGMT3,.DATA,.ERROR)
  1. Q