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

EASECU.m

Go to the documentation of this file.
  1. EASECU ;ALB/PHH,LBD,AMA,HM - LTC Co-Pay Test Utilities ; 22 AUG 2001
  1. ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,34,40,79,174**;Mar 15, 2001;Build 26
  1. ;
  1. LST(DFN,DGDT,DGMTYPT) ;Last LTC Co-Pay test for a patient
  1. ; Input -- DFN Patient IEN
  1. ; DGDT Date/Time (Optional- default today@2359)
  1. ; DGMTYPT Type of Test (Optional - if not defined
  1. ; LTC Co-Pay will be assumed)
  1. ; Output -- LTC Co-Pay Test IEN^Date of Test
  1. ; ^Status Name^Status Code^Source of Test
  1. N DGIDT,DGMTFL1,DGMTI,DGNOD,Y I '$D(DGMTYPT) S DGMTYPT=3
  1. S DGIDT=$S($G(DGDT)>0:-DGDT,1:-DT) S:'$P(DGIDT,".",2) DGIDT=DGIDT_.2359
  1. F S DGIDT=+$O(^DGMT(408.31,"AID",DGMTYPT,DFN,DGIDT)) Q:'DGIDT!$G(DGMTFL1) D
  1. . F DGMTI=0:0 S DGMTI=+$O(^DGMT(408.31,"AID",DGMTYPT,DFN,DGIDT,DGMTI)) Q:'DGMTI!$G(DGMTFL1) D
  1. . . S DGNOD=$G(^DGMT(408.31,DGMTI,0)) I DGNOD S DGMTFL1=1,Y=DGMTI_"^"_$P(^(0),"^")_"^"_$$MTS(+$P(^(0),"^",3))_"^"_$P(DGNOD,"^",23)
  1. Q $G(Y)
  1. ;
  1. MTS(DGMTS) ;LTC Co-Pay test status -- default current
  1. ; Input -- DGMTS LTC Co-Pay Test Status IEN
  1. ; Output -- Status Name^Status Code
  1. N Y
  1. I $G(DGMTS) S Y=$P($G(^DG(408.32,DGMTS,0)),"^",1,2)
  1. Q $G(Y)
  1. ;
  1. EXMPT(DFN) ;Check if veteran is exempt from LTC co-payments:
  1. ; If the veteran has a compensable SC disability, OR
  1. ; If the veteran is a single, NSC pensioner not in receipt of A&A
  1. ; If the veteran is a Medal of Honor recipient - EAS*1.0*174 HM
  1. ; and HB benefits
  1. ; Input -- DFN Patient IEN
  1. ; Output -- 0 = veteran not exempt
  1. ; 1 = veteran has compensable SC disability
  1. ; 2 = veteran is single NSC pensioner (no A&A, HB)
  1. ; 14 = veteran is Medal of Honor recipient - EAS*1.0*174 HM
  1. N X,Y,ELG
  1. S Y=0
  1. ; if service connected percentage is greater than 10% OR service
  1. ; connected percentage is less than 10% and annual VA
  1. ; check amount is greater than 0, then exempt type 1
  1. S X=$G(^DPT(DFN,.36)),ELG=$P($G(^DIC(8,+X,0)),U,9)
  1. I ELG=1!($P($G(^DPT(DFN,.3)),U,2)'<10) S Y=1 G EXMPTQ
  1. I ELG=3,$P($G(^DPT(DFN,.3)),U,2)<10,$P($G(^DPT(DFN,.362)),U,20)>0 S Y=1 G EXMPTQ
  1. ;if MOH = "Y" quit
  1. I $P($G(^DPT(DFN,.54)),U,1)="Y" S Y=14 G EXMPTQ ;IF MEDAL OF HONOR = "Y" SET OUTPUT TO BE 14 EAS*1*174 HM
  1. ; if Service Connected quit
  1. I $P($G(^DPT(DFN,.3)),U)="Y" G EXMPTQ
  1. ; if Marital Status = 'Married' or 'Separated' quit
  1. S X=$P($G(^DIC(11,+$P($G(^DPT(DFN,0)),U,5),0)),U,3)
  1. I "^M^S^"[("^"_X_"^") G EXMPTQ
  1. ; if not receiving VA pension quit
  1. S X=$G(^DPT(DFN,.362)) I $P(X,U,14)'="Y" G EXMPTQ
  1. ; if receiving A&A or HP benefits quit
  1. I $P(X,U,12)="Y"!($P(X,U,13)="Y") G EXMPTQ
  1. S Y=2
  1. EXMPTQ Q Y
  1. ;
  1. DIS(DFN) ;Display patient's current LTC Copay Test status and test date
  1. ; Input -- DFN IEN of Patient file
  1. ; Output -- None
  1. N DGX,DGMTI,DGMTDT,DGMTS
  1. Q:'$G(DFN)
  1. S DGX=$$LST(DFN) Q:'DGX
  1. S DGMTI=+DGX,DGMTDT=$P(DGX,U,2),DGMTS=$P(DGX,U,3) S:DGMTS="" DGMTS="UNKNOWN"
  1. W !,"LTC Copayment Status: ",DGMTS," Last Test: " S Y=DGMTDT X ^DD("DD") W Y
  1. ; If last test is over a year old and patient is not deceased or not
  1. ; exempt due to eligibility (compensable SC) or LTC before 11/30/99
  1. ; display message that a new test is required
  1. I $$FMDIFF^XLFDT(DT,DGMTDT)>364 D
  1. . I $P($G(^DPT(DFN,.35)),U) Q
  1. . I "^1^4^"[(U_$P($G(^DGMT(408.31,DGMTI,2)),U,7)_U) Q
  1. . W " **NEW TEST REQUIRED**"
  1. I $P($G(^DGMT(408.31,DGMTI,0)),U,11)=0 W !,"Patient INELIGIBLE to Receive LTC Services -- Did Not Agree to Pay Copayments"
  1. Q
  1. ;
  1. FORM(DGMTI) ; Return the version of the 10-10EC form used to complete
  1. ; the LTC Copay Test passed in DGMTI
  1. ; Input: DGMTI - LTC Copay Test (IEN file #408.31)
  1. ; Output: 0 = Original format
  1. ; 1 = Revised format
  1. I '$G(DGMTI) Q 0
  1. Q $P($G(^DGMT(408.31,DGMTI,2)),U,10)
  1. ;
  1. ;EAS*1.0*79 - Instead of changing DIS (in case another routine
  1. ; calls it), copied it but also used LTC Admission Date
  1. DISDT(DFN,EASADM) ;Display patient's LTC Copay Test status for a given LTC Admission Date
  1. ; Input -- DFN - IEN of Patient file
  1. ; EASADM - LTC Admission Date
  1. ; Output -- None
  1. N DGX,DGMTI,DGMTDT,DGMTS
  1. Q:'$G(DFN) Q:'$G(EASADM)
  1. S DGX=$$LST(DFN,EASADM) Q:'DGX
  1. S DGMTI=+DGX,DGMTDT=$P(DGX,U,2),DGMTS=$P(DGX,U,3) S:DGMTS="" DGMTS="UNKNOWN"
  1. W !,"LTC Copayment Status: ",DGMTS," Last Test: " S Y=DGMTDT X ^DD("DD") W Y
  1. ; If last test is over a year old and patient is not deceased or not
  1. ; exempt due to eligibility (compensable SC) or LTC before 11/30/99
  1. ; display message that a new test is required
  1. I $$FMDIFF^XLFDT(DT,DGMTDT)>364 D
  1. . I $P($G(^DPT(DFN,.35)),U) Q
  1. . I "^1^4^"[(U_$P($G(^DGMT(408.31,DGMTI,2)),U,7)_U) Q
  1. . W " **NEW TEST REQUIRED**"
  1. I $P($G(^DGMT(408.31,DGMTI,0)),U,11)=0 W !,"Patient INELIGIBLE to Receive LTC Services -- Did Not Agree to Pay Copayments"
  1. Q