[613] | 1 | EASECU ;ALB/PHH,LBD,AMA - LTC Co-Pay Test Utilities ; 22 AUG 2001
|
---|
| 2 | ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,34,40,79**;Mar 15, 2001;Build 3
|
---|
| 3 | ;
|
---|
| 4 | LST(DFN,DGDT,DGMTYPT) ;Last LTC Co-Pay test for a patient
|
---|
| 5 | ; Input -- DFN Patient IEN
|
---|
| 6 | ; DGDT Date/Time (Optional- default today@2359)
|
---|
| 7 | ; DGMTYPT Type of Test (Optional - if not defined
|
---|
| 8 | ; LTC Co-Pay will be assumed)
|
---|
| 9 | ; Output -- LTC Co-Pay Test IEN^Date of Test
|
---|
| 10 | ; ^Status Name^Status Code^Source of Test
|
---|
| 11 | N DGIDT,DGMTFL1,DGMTI,DGNOD,Y I '$D(DGMTYPT) S DGMTYPT=3
|
---|
| 12 | S DGIDT=$S($G(DGDT)>0:-DGDT,1:-DT) S:'$P(DGIDT,".",2) DGIDT=DGIDT_.2359
|
---|
| 13 | F S DGIDT=+$O(^DGMT(408.31,"AID",DGMTYPT,DFN,DGIDT)) Q:'DGIDT!$G(DGMTFL1) D
|
---|
| 14 | . F DGMTI=0:0 S DGMTI=+$O(^DGMT(408.31,"AID",DGMTYPT,DFN,DGIDT,DGMTI)) Q:'DGMTI!$G(DGMTFL1) D
|
---|
| 15 | . . S DGNOD=$G(^DGMT(408.31,DGMTI,0)) I DGNOD S DGMTFL1=1,Y=DGMTI_"^"_$P(^(0),"^")_"^"_$$MTS(+$P(^(0),"^",3))_"^"_$P(DGNOD,"^",23)
|
---|
| 16 | Q $G(Y)
|
---|
| 17 | ;
|
---|
| 18 | MTS(DGMTS) ;LTC Co-Pay test status -- default current
|
---|
| 19 | ; Input -- DGMTS LTC Co-Pay Test Status IEN
|
---|
| 20 | ; Output -- Status Name^Status Code
|
---|
| 21 | N Y
|
---|
| 22 | I $G(DGMTS) S Y=$P($G(^DG(408.32,DGMTS,0)),"^",1,2)
|
---|
| 23 | Q $G(Y)
|
---|
| 24 | ;
|
---|
| 25 | EXMPT(DFN) ;Check if veteran is exempt from LTC co-payments:
|
---|
| 26 | ; If the veteran has a compensable SC disability, OR
|
---|
| 27 | ; If the veteran is a single, NSC pensioner not in receipt of A&A
|
---|
| 28 | ; and HB benefits
|
---|
| 29 | ; Input -- DFN Patient IEN
|
---|
| 30 | ; Output -- 0 = veteran not exempt
|
---|
| 31 | ; 1 = veteran has compensable SC disability
|
---|
| 32 | ; 2 = veteran is single NSC pensioner (no A&A, HB)
|
---|
| 33 | N X,Y,ELG
|
---|
| 34 | S Y=0
|
---|
| 35 | ; if service connected percentage is greater than 10% OR service
|
---|
| 36 | ; connected percentage is less than 10% and annual VA
|
---|
| 37 | ; check amount is greater than 0, then exempt type 1
|
---|
| 38 | S X=$G(^DPT(DFN,.36)),ELG=$P($G(^DIC(8,+X,0)),U,9)
|
---|
| 39 | I ELG=1!($P($G(^DPT(DFN,.3)),U,2)'<10) S Y=1 G EXMPTQ
|
---|
| 40 | I ELG=3,$P($G(^DPT(DFN,.3)),U,2)<10,$P($G(^DPT(DFN,.362)),U,20)>0 S Y=1 G EXMPTQ
|
---|
| 41 | ; if Service Connected quit
|
---|
| 42 | I $P($G(^DPT(DFN,.3)),U)="Y" G EXMPTQ
|
---|
| 43 | ; if Marital Status = 'Married' or 'Separated' quit
|
---|
| 44 | S X=$P($G(^DIC(11,+$P($G(^DPT(DFN,0)),U,5),0)),U,3)
|
---|
| 45 | I "^M^S^"[("^"_X_"^") G EXMPTQ
|
---|
| 46 | ; if not receiving VA pension quit
|
---|
| 47 | S X=$G(^DPT(DFN,.362)) I $P(X,U,14)'="Y" G EXMPTQ
|
---|
| 48 | ; if receiving A&A or HP benefits quit
|
---|
| 49 | I $P(X,U,12)="Y"!($P(X,U,13)="Y") G EXMPTQ
|
---|
| 50 | S Y=2
|
---|
| 51 | EXMPTQ Q Y
|
---|
| 52 | ;
|
---|
| 53 | DIS(DFN) ;Display patient's current LTC Copay Test status and test date
|
---|
| 54 | ; Input -- DFN IEN of Patient file
|
---|
| 55 | ; Output -- None
|
---|
| 56 | N DGX,DGMTI,DGMTDT,DGMTS
|
---|
| 57 | Q:'$G(DFN)
|
---|
| 58 | S DGX=$$LST(DFN) Q:'DGX
|
---|
| 59 | S DGMTI=+DGX,DGMTDT=$P(DGX,U,2),DGMTS=$P(DGX,U,3) S:DGMTS="" DGMTS="UNKNOWN"
|
---|
| 60 | W !,"LTC Copayment Status: ",DGMTS," Last Test: " S Y=DGMTDT X ^DD("DD") W Y
|
---|
| 61 | ; If last test is over a year old and patient is not deceased or not
|
---|
| 62 | ; exempt due to eligibility (compensable SC) or LTC before 11/30/99
|
---|
| 63 | ; display message that a new test is required
|
---|
| 64 | I $$FMDIFF^XLFDT(DT,DGMTDT)>364 D
|
---|
| 65 | . I $P($G(^DPT(DFN,.35)),U) Q
|
---|
| 66 | . I "^1^4^"[(U_$P($G(^DGMT(408.31,DGMTI,2)),U,7)_U) Q
|
---|
| 67 | . W " **NEW TEST REQUIRED**"
|
---|
| 68 | I $P($G(^DGMT(408.31,DGMTI,0)),U,11)=0 W !,"Patient INELIGIBLE to Receive LTC Services -- Did Not Agree to Pay Copayments"
|
---|
| 69 | Q
|
---|
| 70 | ;
|
---|
| 71 | FORM(DGMTI) ; Return the version of the 10-10EC form used to complete
|
---|
| 72 | ; the LTC Copay Test passed in DGMTI
|
---|
| 73 | ; Input: DGMTI - LTC Copay Test (IEN file #408.31)
|
---|
| 74 | ; Output: 0 = Original format
|
---|
| 75 | ; 1 = Revised format
|
---|
| 76 | I '$G(DGMTI) Q 0
|
---|
| 77 | Q $P($G(^DGMT(408.31,DGMTI,2)),U,10)
|
---|
| 78 | ;
|
---|
| 79 | ;EAS*1.0*79 - Instead of changing DIS (in case another routine
|
---|
| 80 | ; calls it), copied it but also used LTC Admission Date
|
---|
| 81 | DISDT(DFN,EASADM) ;Display patient's LTC Copay Test status for a given LTC Admission Date
|
---|
| 82 | ; Input -- DFN - IEN of Patient file
|
---|
| 83 | ; EASADM - LTC Admission Date
|
---|
| 84 | ; Output -- None
|
---|
| 85 | N DGX,DGMTI,DGMTDT,DGMTS
|
---|
| 86 | Q:'$G(DFN) Q:'$G(EASADM)
|
---|
| 87 | S DGX=$$LST(DFN,EASADM) Q:'DGX
|
---|
| 88 | S DGMTI=+DGX,DGMTDT=$P(DGX,U,2),DGMTS=$P(DGX,U,3) S:DGMTS="" DGMTS="UNKNOWN"
|
---|
| 89 | W !,"LTC Copayment Status: ",DGMTS," Last Test: " S Y=DGMTDT X ^DD("DD") W Y
|
---|
| 90 | ; If last test is over a year old and patient is not deceased or not
|
---|
| 91 | ; exempt due to eligibility (compensable SC) or LTC before 11/30/99
|
---|
| 92 | ; display message that a new test is required
|
---|
| 93 | I $$FMDIFF^XLFDT(DT,DGMTDT)>364 D
|
---|
| 94 | . I $P($G(^DPT(DFN,.35)),U) Q
|
---|
| 95 | . I "^1^4^"[(U_$P($G(^DGMT(408.31,DGMTI,2)),U,7)_U) Q
|
---|
| 96 | . W " **NEW TEST REQUIRED**"
|
---|
| 97 | I $P($G(^DGMT(408.31,DGMTI,0)),U,11)=0 W !,"Patient INELIGIBLE to Receive LTC Services -- Did Not Agree to Pay Copayments"
|
---|
| 98 | Q
|
---|