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

EASECSCC.m

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