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

EASECE.m

Go to the documentation of this file.
  1. EASECE ;ALB/PHH,LBD - Edit an Existing LTC Co-Pay Test ;17 AUG 2001
  1. ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,34,40**;Mar 15, 2001
  1. ;
  1. EN ;Entry point to edit an existing LTC co-pay test
  1. N DGMDOD S DGMDOD="",DGMTYPT=3
  1. S DIC("S")="I $D(^DGMT(408.31,""AID"",DGMTYPT,+Y))"
  1. I $D(DGMTDFN)#2 K DGMTDFN
  1. S DIC="^DPT(",DIC(0)="AEMQ" W ! D ^DIC K DIC G Q:Y<0 S (DFN,DGMTDFN)=+Y
  1. I $P($G(^DPT(DFN,.35)),U)'="" S DGMDOD=$P(^DPT(DFN,.35),U)
  1. I $G(DGMDOD) W !,"Patient died on: ",$$FMTE^XLFDT(DGMDOD,"1D") Q
  1. ;
  1. DT S DIC("A")="Select DATE OF LTC COPAY TEST: "
  1. I $D(^DGMT(408.31,+$$LST^EASECU(DFN,"",DGMTYPT),0)) S DIC("B")=$P(^(0),"^")
  1. S DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,19)=DGMTYPT"
  1. S DIC="^DGMT(408.31,",DIC(0)="EQZ" W ! D EN^DGMTLK K DIC G Q:Y<0
  1. S DGMTI=+Y,DGMTDT=$P(Y,"^",2),DGMT0=Y(0)
  1. ;
  1. ;If test is uneditable, print error message and allow user to view test
  1. ;or print 10/10EC
  1. ;
  1. I '$P($G(^DG(408.34,+$P(Y(0),U,23),0)),U,2) D D:$G(DGMTERR) VIEWPRT G EN
  1. .W !!?3,*7,"Warning: Uneditable LTC Copay test. The source of this test is "_$S($$SR^DGMTAUD1(Y(0))]"":$$SR^DGMTAUD1(Y(0)),1:"UNKNOWN")
  1. .W !?12,"which has been flagged as an uneditable source.",!
  1. .S DIR("A")="Would you like to view the LTC Copay test or print the 10-10EC",DIR("B")="NO",DIR(0)="Y"
  1. .D ^DIR K DIR S DGMTERR=Y I $D(DTOUT)!($D(DUOUT)) K DGMTERR,DTOUT,DUOUT
  1. ;
  1. ; If user holds DG MTDELETE security key, allow test date to be edited.
  1. ; LTC III (EAS*1*34)
  1. I $D(^XUSEC("DG MTDELETE",+$G(DUZ))) D
  1. .N DIR,DA,DR,DIE,X,Y,DTOUT,DUOUT,DIROUT,DIRUT,DGNEWDT
  1. .S DIR(0)="D^:DT:EX",DIR("A")="DATE OF TEST",DIR("B")=$$FMTE^XLFDT(DGMTDT,1)
  1. .S DIR("?")="Enter a date that is less than or equal to today."
  1. .S DIR("?",1)="Enter the date of the LTC Copay Test."
  1. .D ^DIR K DIR Q:'Y!(Y=DGMTDT) S DGNEWDT=Y
  1. .S DIR(0)="Y",DIR("A")="Are you sure you want to change the date of the LTC Copay Test",DIR("B")="NO" D ^DIR Q:'Y
  1. .S DIE="^DGMT(408.31,",DA=DGMTI,DR=".01////"_DGNEWDT_";2.02///NOW"
  1. .D ^DIE
  1. ;
  1. EXMPT ; Is veteran exempt?
  1. S DGEXMPT=$$EXMPT^EASECU(DFN)
  1. I DGEXMPT D EXMPT^EASECSCC(DFN,DGMTI,DGEXMPT) D Q G EN
  1. ;
  1. D DISPLAY^EASECU23(DGMTI,DGMTYPT),PAUSE I $D(DTOUT)!($D(DUOUT)) K DTOUT,DUOUT G EN
  1. ;
  1. ; Allow user to edit LTC copay test status or reason for exemption.
  1. ; If veteran is exempt for reason other than low income, don't do
  1. ; income check. Added for LTC Phase IV (EAS*1*40)
  1. W ! S DGEFLG=1 D STA^EASECSCC K DGEFLG
  1. I $G(DGSTA)="EXEMPT",$G(DGRE),"^2^12^"'[(U_DGRE_U) D EXMPT^EASECSCC(DFN,DGMTI,DGRE) D Q G EN
  1. S DGNSTA=$G(DGSTA)
  1. ;
  1. ; Check if veteran's income is below the pension threshold
  1. D EN^EASECMT I $G(DGOUT) D Q G EN
  1. I DGEXMPT D EXMPT^EASECSCC(DFN,DGMTI,2) D Q G EN
  1. S DGMT0=$G(^DGMT(408.31,DGMTI,0)) F I=4,5,15 I $P(DGMT0,U,I) G EDT
  1. ; Display message for vets who declined to provide income info
  1. ; LTC III (EAS*1*34)
  1. I $P(DGMT0,U,14)=1 D
  1. .W !! F I=1:1:80 W "="
  1. .W !!,?10,"Veteran is NOT EXEMPT from Long Term Care copayments and"
  1. .W !,?10,"must complete a 10-10EC form."
  1. .W !! F I=1:1:80 W "="
  1. ; Does veteran decline to provide income information?
  1. W !!
  1. D REF^EASECSCC I $D(DTOUT)!($D(DUOUT)) D Q G EN
  1. I $D(DGREF) D D Q G EN
  1. .; Ask if veteran agrees to pay copayments; complete LTC copay test
  1. .D AGREE^EASECSCC Q:$D(DTOUT)!($D(DUOUT))
  1. .S DGSTA="NON-EXEMPT",DGCAT="T" D STA^DGMTSCU2 S (DGINT,DGDET,DGNWT)=""
  1. .D UPD^EASECSCC
  1. ;
  1. EDT S DGMTACT="EDT",DGMTROU="EN^EASECE" G EN^EASECSC
  1. ;
  1. Q K DFN,DGEXMPT,DGMTACT,DGMTDT,DGMTERR,DGMT0,DGMTI,DGMTROU,DGMTYPT,DGMTX,DGOUT,DTOUT,DUOUT,X,Y
  1. K DGREF,DGSTA,DGCAT,DGINT,DGDET,DGNWT,I,DGFORM,DGMTS,DGRE,DGNSTA
  1. Q
  1. ;
  1. PAUSE S DIR(0)="E" D ^DIR
  1. Q
  1. ;
  1. VIEWPRT ; Select 1 to view an uneditable means test or 2 to print a 10/10EC
  1. ;
  1. S DIR(0)="S^1:View LTC Copay Test;2:Print LTC Copay Test 10-10EC",DIR("A")="Select Choice"
  1. D ^DIR S DGMTANS=Y G:$D(DTOUT)!($D(DUOUT)) VIEWPRTQ
  1. I DGMTANS=1 D EN1^EASECV
  1. I DGMTANS=2 D OEN^EASEC10E
  1. VIEWPRTQ ;
  1. K DGMTANS,DIR,DTOUT,DUOUT,Y
  1. Q
  1. ;