149 lines
6.6 KiB
Mathematica
149 lines
6.6 KiB
Mathematica
EASECSCC ;ALB/LBD - LTC Co-Pay Test Screen Completion;13 AUG 2001 ; 3/20/03 2:24pm
|
|
;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,34,40**;Mar 15, 2001
|
|
;
|
|
;NOTE: This routine was modified from DGMTSCC for LTC Co-pay
|
|
; Input -- DFN Patient IEN
|
|
; DGMTACT Menu Action
|
|
; DGMTDT Date of Test
|
|
; DGMTYPT Type of Test 3=LTC COPAY
|
|
; DGMTPAR Annual Means Test Parameters
|
|
; DGMTI Annual Means Test IEN
|
|
; DGVINI Veteran Individual Annual Income IEN
|
|
; DGVIRI Veteran Income Relation IEN
|
|
; DGVPRI Veteran Patient Relation IEN
|
|
; Output -- DGERR 1=INCOMPLETE and 0=COMPLETE
|
|
;
|
|
EN N DGCAT,DGCOMF,DGDC,DGDET,DGIN0,DGIN1,DGIN2,DGINT,DGINTF,DGMTS,DGNC,DGND,DGNWT,DGNWTF,DGREF1,DGSP,DGTYC,DGTHA,DGTHB,DGVIR0,DGCOPS,DGCOST,DGRE,DGSTA,DGAGR
|
|
S DGERR=0
|
|
S DGCOMF=1 D DEP^EASECSU3,INC^EASECSU3
|
|
; If veteran's income is below the threshold then exempt from LTC copay
|
|
; LTC III (EAS*1*34) modified to make vet with $0 income exempt
|
|
I DGINT'>+$$THRES^IBARXEU1(DGMTDT,1,0) D G Q
|
|
.D EXMPT(DFN,DGMTI,12)
|
|
.D PRT
|
|
; Check if test can be completed
|
|
D CHK I DGERR W !?3,*7,"LTC copay test cannot be completed." G Q
|
|
; Did vet refuse to give income info
|
|
I 'DGINTF,'DGNWTF S DGREF1="" D G Q:$D(DTOUT)!($D(DUOUT))
|
|
.D REF
|
|
.I $D(DGREF) S DGSTA="NON-EXEMPT"
|
|
; Get test status (Exempt or Non-Exempt)
|
|
D STA G Q:$D(DTOUT)!($D(DUOUT))
|
|
; Does vet agree to pay co-payments
|
|
I $G(DGSTA)="NON-EXEMPT" D AGREE G Q:$D(DTOUT)!($D(DUOUT))
|
|
UPD S DA=DGMTI,DIE="^DGMT(408.31,",DIE("NO^")="",DR="[EASEC COMPLETE LTC CO-PAY TEST]" D ^DIE K DA,DIE,DR I '$D(DGFIN) S DGERR=1 G Q
|
|
W !?3,"...The LTC copay test has been completed with a status of ",DGSTA,"..."
|
|
D PRT
|
|
;
|
|
Q K DGFIN,DGREF,DTOUT,DUOUT,Y
|
|
Q
|
|
;
|
|
COM ;Check if user wants to complete the LTC co-pay test
|
|
N DIR
|
|
S DIR("A")="Do you wish to complete the LTC copay test"
|
|
S DIR("B")="YES",DIR(0)="Y" D ^DIR
|
|
Q
|
|
;
|
|
REF ;Check if patient declines to provide income information
|
|
N DIR,Y
|
|
S DIR("A")="Does veteran decline to give income information"
|
|
I $P($G(^DGMT(408.31,DGMTI,0)),"^",14)]"" S DIR("B")=$$YN^DGMTSCU1($P(^(0),"^",14))
|
|
S:'$D(DIR("B")) DIR("B")="NO"
|
|
S DIR("?")="Answer 'Y' or 'N'."
|
|
S DIR("?",1)="Enter whether the veteran declines to provide current income information."
|
|
S DIR(0)="Y" D ^DIR K DIR G REFQ:$D(DTOUT)!($D(DUOUT))
|
|
S:Y DGREF=""
|
|
REFQ Q
|
|
;
|
|
CHK ;Check if LTC copay test can be completed
|
|
; For LTC III (EAS*1*34) removed check if expenses greater than income
|
|
N DGA,DGD,DGDEP,DGREL,DGL,DGM,I
|
|
D GETREL^DGMTU11(DFN,"CS",$E(DGMTDT,1,3)_"0000",$S($G(DGMTI):DGMTI,1:""))
|
|
S DGM=$P(DGVIR0,"^",14),DGL=$P(DGVIR0,"^",17),DGD=$P(DGVIR0,"^",8)
|
|
I DGM="" W !?3,"Marital section must be completed." S DGERR=1
|
|
; For LTC IV (EAS*1*40) added check for legally separated
|
|
I DGM,'DGL,'$D(DGREL("S")) W !?3,"Married is 'YES'. An active spouse for this LTC copay test does not exist." S DGERR=1
|
|
I 'DGM,$D(DGREL("S")) W !?3,"An active spouse exists for this LTC copay test. Married should be 'YES'." S DGERR=1
|
|
I DGD']"" W !?3,"Dependent Children section must be completed." S DGERR=1
|
|
I DGD,'$D(DGREL("C")) W !?3,"Dependent Children is 'YES'. No active children exist." S DGERR=1
|
|
I 'DGD,$D(DGREL("C")) W !?3,"Active children exist. Dependent Children should be 'YES'." S DGERR=1
|
|
Q:$G(DGERR)
|
|
N CNT,ACT,DGDEP,FLAG,DGINCP
|
|
D INIT^EASECDEP S CNT=0 D
|
|
.F S CNT=$O(DGDEP(CNT)) Q:'CNT I $P(DGDEP(CNT),U,2)="SPOUSE" D Q:$G(DGERR)
|
|
..D GETIENS^EASECU2(DFN,$P(DGDEP(CNT),U,20),DGMTDT)
|
|
..S DGINCP=$G(^DGMT(408.22,+DGIRI,"MT")) S:DGINCP FLAG=$G(FLAG)+1
|
|
..I $G(FLAG)>1 W !?3,"Patient has more than one spouse for this LTC copay test." S DGERR=1
|
|
Q
|
|
;
|
|
STA ;Ask test status
|
|
N DIR,Y,SCRN
|
|
S DGMTS=$P($G(^DGMT(408.31,DGMTI,0)),U,3)
|
|
S DGRE=$P($G(^DGMT(408.31,DGMTI,2)),U,7)
|
|
I DGMTS S DGSTA=$P($G(^DG(408.32,DGMTS,0)),U)
|
|
I '$D(DGSTA) S DGSTA="NON-EXEMPT"
|
|
I DGSTA="EXEMPT",("12"[DGRE),$G(DGINT)>+$$THRES^IBARXEU1(DGMTDT,1,0) S DGSTA="NON-EXEMPT"
|
|
I DGSTA="EXEMPT",$G(DGNSTA)="NON-EXEMPT" S DGSTA="NON-EXEMPT"
|
|
S DIR("A")="LTC Copay Test Status" S DIR("B")=DGSTA
|
|
S DIR(0)="P^408.32:EM",DIR("S")="I $P(^(0),U,19)=3"
|
|
D ^DIR K DIR Q:'Y!($D(DTOUT))!($D(DUOUT))
|
|
S DGMTS=+Y,DGSTA=$P(Y,U,2) Q:DGSTA="NON-EXEMPT"
|
|
;If Exempt, ask reason for exemption
|
|
S DIR("A")="Reason for Exemption"
|
|
I DGRE S DIR("B")=$P($G(^EAS(714.1,DGRE,0)),U)
|
|
; Screen the look-up on file #714.1. Exemption reasons 1, 2 and 12
|
|
; will be screened out unless this is the call from the Edit option
|
|
; (DGEFLG=1) and only reason 1 is screened out.
|
|
S SCRN="2^12^" S:$G(DGEFLG) SCRN=""
|
|
S DIR("S")="I $P(^(0),U,2),""^1^"_SCRN_"""'[(U_Y_U)"
|
|
S DIR(0)="P^714.1:EM" D ^DIR K DIR I 'Y!($D(DTOUT))!($D(DUOUT)) D G STA
|
|
.W !!,"A reason for exemption must be entered for an Exempt status.",!
|
|
S DGRE=+Y
|
|
Q
|
|
AGREE ;Ask if vet agrees to pay co-payment
|
|
N DIR,Y
|
|
S DIR("A")="Does the veteran agree to pay copayments"
|
|
I $P($G(^DGMT(408.31,DGMTI,0)),U,11)]"" S DIR("B")=$$YN^DGMTSCU1($P(^(0),U,11))
|
|
S:'$D(DIR("B")) DIR("B")="YES"
|
|
S DIR("?")="Answer 'Y' or 'N'."
|
|
S DIR("?",1)="Enter in this field whether the veteran agrees to pay the"
|
|
S DIR("?",2)="LTC copayments. The veteran must also sign the 1010-EC form"
|
|
S DIR("?",3)="agreeing to pay the copayments. If the veteran does not agree"
|
|
S DIR("?",4)="to pay the copayments, the veteran becomes ineligible to"
|
|
S DIR("?",5)="receive extended care services."
|
|
S DIR(0)="Y" D ^DIR K DIR Q:$D(DTOUT)!($D(DUOUT))
|
|
S DGAGR=Y
|
|
Q
|
|
PRT ;Print Extended Care Services test (1010EC)
|
|
N DIR,Y,X,ZTSK
|
|
S DIR("A")="PRINT 10-10EC"
|
|
S DIR("B")="YES",DIR(0)="Y" D ^DIR G PRTQ:'Y!($D(DTOUT))!($D(DUOUT))
|
|
S ZTSK=$$QUE^EASEC10E(DFN,DGMTI)
|
|
PRTQ Q
|
|
;
|
|
EXMPT(DFN,DGMTI,EX) ; Veteran is exempt from LTC co-payments
|
|
; Complete LTC co-pay test in Annual Means Test file (#408.31)
|
|
; Input -- DFN Patient IEN
|
|
; DGMTI Annual Means Test IEN
|
|
; EX Copay exemption code
|
|
; 1 = SC compensable disability
|
|
; 2 = NSC, single, receiving VA pension (no A&A, HB)
|
|
; or
|
|
; Income (last year) is below single pension threshold
|
|
; 12 = Income (current year) is below single pension threshold
|
|
Q:'DGMTI Q:'EX
|
|
N DATA,I
|
|
W !! F I=1:1:80 W "="
|
|
W !!,?10,"Veteran is EXEMPT from Long Term Care copayments."
|
|
W !,?10,"Reason for Exemption: ",$P($G(^EAS(714.1,EX,0)),U)
|
|
W !! F I=1:1:80 W "="
|
|
W !!
|
|
S DATA(.03)=$O(^DG(408.32,"C","X","")),DATA(2.07)=EX,DATA(.06)=DUZ
|
|
S (DATA(.07),DATA(2.02))=$$NOW^XLFDT
|
|
S DATA(.04)=$G(DGINT),DATA(.05)=$G(DGNWT),DATA(.15)=$G(DGDET)
|
|
S DATA(.18)=$G(DGND),DATA(2.08)=$P($$GETLTC4^EASECMT(DFN),U,1)
|
|
S DATA(.14)=$S($D(DGREF):1,1:0) ;LTC III (EAS*1*34)
|
|
I $$UPD^DGENDBS(408.31,DGMTI,.DATA) Q
|
|
W !,"ERROR: COULD NOT UPDATE LTC COPAY TEST",!!
|
|
Q
|