| [613] | 1 | EASECPC ;ALB/PHH,CKN,LBD,AMA,SCK - LTC Copayment Report; 29-AUG-2001
|
|---|
| 2 | ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,19,24,34,40,79**;Mar 15, 2001;Build 3
|
|---|
| 3 | ;
|
|---|
| 4 | ; This routine prints a report of calculated LTC copayments for a veteran.
|
|---|
| 5 | ; It is called by menu option EASEC LTC COPAY PRINT
|
|---|
| 6 | ;
|
|---|
| 7 | EN N DFN,EASRPT,EASADM,EASRDT,MAXRT,DGMTI,DGMTDT
|
|---|
| 8 | ; Select which report to print (1=Institutional (IP); 2=Non-Institutional (OP))
|
|---|
| 9 | S EASRPT=$$RPT Q:'EASRPT
|
|---|
| 10 | ; Select Patient
|
|---|
| 11 | S DFN=$$GETDFN Q:'DFN
|
|---|
| 12 | S EASADM=""
|
|---|
| 13 | ; Get the LTC admission date (if EASRPT=1)
|
|---|
| 14 | I EASRPT=1 S EASADM=$$ADMDT Q:'EASADM
|
|---|
| 15 | ;E S EASADM="" ;EAS*1.0*79
|
|---|
| 16 | ; Get start date for report
|
|---|
| 17 | S EASRDT=$$RPTDT Q:'EASRDT
|
|---|
| 18 | ;EAS*1.0*79 - moved from 4 lines up, and added EASADM as a parameter
|
|---|
| 19 | ;Set EASADM to the report date for Non-Institutional (OP) reports
|
|---|
| 20 | I EASRPT=2 S EASADM=EASRDT
|
|---|
| 21 | ; Get most recent LTC Copay Test for patient and set up LTC variables
|
|---|
| 22 | I '$$GETLTC(DFN,EASADM) Q
|
|---|
| 23 | ; Run the report
|
|---|
| 24 | D QUE
|
|---|
| 25 | Q
|
|---|
| 26 | RPT() ; Select which report to print
|
|---|
| 27 | ; Input: None
|
|---|
| 28 | ; Output: Y - Report Type (1=Institutional (IP); 2=Non-Institutional (OP); 0=Quit)
|
|---|
| 29 | N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
|
|---|
| 30 | W !!,"Report of Calculated Long Term Care Copayments"
|
|---|
| 31 | W !,"=============================================="
|
|---|
| 32 | S DIR(0)="S^1:Institutional (Inpatient);2:Non-Institutional (Outpatient)"
|
|---|
| 33 | S DIR("A")="Enter 1 or 2"
|
|---|
| 34 | D ^DIR I 'Y!($D(DTOUT))!($D(DUOUT)) Q 0
|
|---|
| 35 | Q Y
|
|---|
| 36 | GETDFN() ; Get the veteran's DFN
|
|---|
| 37 | N DIC,DTOUT,DUOUT,X,Y
|
|---|
| 38 | W !
|
|---|
| 39 | S DIC="^DPT(",DIC(0)="AEMZQ",DIC("S")="I $D(^DGMT(408.31,""AID"",3,+Y))"
|
|---|
| 40 | D ^DIC
|
|---|
| 41 | Q:$D(DTOUT)!($D(DUOUT)) 0
|
|---|
| 42 | Q:Y<0 0
|
|---|
| 43 | Q +Y
|
|---|
| 44 | ;EAS*1.0*79 - added EASADM as a parameter
|
|---|
| 45 | GETLTC(DFN,EASADM) ; Get the most recent LTC copay test. If no completed test on
|
|---|
| 46 | ; file, test status is exempt or LTC copay rates not defined, quit 0
|
|---|
| 47 | ; Input: DFN - Patient file IEN
|
|---|
| 48 | ; EASADM - LTC Admission Date
|
|---|
| 49 | ; Output: DGMTI - LTC Copay Test IEN (file #408.31)
|
|---|
| 50 | ; DGMTDT - LTC Copay Test Date
|
|---|
| 51 | ; MAXRT - Maximum daily copay rates for OP and IP LTC
|
|---|
| 52 | ; 1=OK to continue; 0=Not OK to continue
|
|---|
| 53 | N LTC,STAT
|
|---|
| 54 | ;EAS*1.0*79 - added EASADM to $$LST call, and text in WRITE line following
|
|---|
| 55 | S LTC=$$LST^EASECU(DFN,EASADM),DGMTI=+LTC
|
|---|
| 56 | I 'DGMTI W !!,"No LTC Copayment Test on file for this veteran for that LTC admission date!" Q 0
|
|---|
| 57 | S DGMTDT=$P(LTC,U,2),STAT=$P(LTC,U,3)
|
|---|
| 58 | ; Get the maximum daily copay rate for outpatient and inpatient LTC
|
|---|
| 59 | ; DBIA #3717
|
|---|
| 60 | S MAXRT=$$MAXRATE^IBAECU(DGMTDT)
|
|---|
| 61 | I '$P(MAXRT,U)!('$P(MAXRT,U,2)) W !!,"Copayment rates for LTC are not available at this time.",!! Q 0
|
|---|
| 62 | ; Check test status, if anything other than Non-Exempt don't continue
|
|---|
| 63 | D DISDT^EASECU(DFN,EASADM) ;EAS*1.0*79
|
|---|
| 64 | I STAT="NON-EXEMPT" Q 1
|
|---|
| 65 | I STAT="" W !!,"The LTC Copayment Test is incomplete!" Q 0
|
|---|
| 66 | I STAT="EXEMPT" W !!,"This veteran is Exempt from LTC copayments!" Q 0
|
|---|
| 67 | W !!,"This LTC Copayment Test contains an invalid status!"
|
|---|
| 68 | Q 0
|
|---|
| 69 | ADMDT() ; Get the LTC admission date (for IP report only)
|
|---|
| 70 | N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
|
|---|
| 71 | W !
|
|---|
| 72 | S DIR(0)="D^::EX"
|
|---|
| 73 | S DIR("A")="Enter the LTC Admission Date"
|
|---|
| 74 | S DIR("?",1)="Enter the admission date for the current institutional"
|
|---|
| 75 | S DIR("?")="Long Term Care episode."
|
|---|
| 76 | D ^DIR I 'Y!($D(DTOUT))!($D(DUOUT)) Q 0
|
|---|
| 77 | Q Y
|
|---|
| 78 | RPTDT() ; Get the start date for the report
|
|---|
| 79 | N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DAYS
|
|---|
| 80 | RD W !
|
|---|
| 81 | S DIR(0)="D^::EMX"
|
|---|
| 82 | S DIR("A")="Enter the Report Start Date (Month/Year)"
|
|---|
| 83 | S DIR("?",1)="Enter the starting date for the report in the format month/year (e.g. 9/03)."
|
|---|
| 84 | S DIR("?",2)="The report will print 12 months of copayments starting with the"
|
|---|
| 85 | S DIR("?")="month and year entered."
|
|---|
| 86 | D ^DIR I 'Y!($D(DTOUT))!($D(DUOUT)) Q 0
|
|---|
| 87 | S DAYS=$$DOM^EASECPC1(Y)
|
|---|
| 88 | I (Y+DAYS)<$G(EASADM) W !!,*7,"Report Start Date cannot be before LTC Admission Date!" G RD
|
|---|
| 89 | Q Y+DAYS
|
|---|
| 90 | ;
|
|---|
| 91 | QUE ; Get report device. Queue report if requested.
|
|---|
| 92 | N POP,ZTRTN,ZTDESC,ZTSAVE
|
|---|
| 93 | K IOP,%ZIS
|
|---|
| 94 | S %ZIS="MQ"
|
|---|
| 95 | W !
|
|---|
| 96 | D ^%ZIS I POP W !!,"Report Cancelled!" Q
|
|---|
| 97 | I $D(IO("Q")) D Q
|
|---|
| 98 | . S ZTRTN="START^EASECPC1"
|
|---|
| 99 | . S ZTDESC="LTC Copay Calculation Report"
|
|---|
| 100 | . S (ZTSAVE("DFN"),ZTSAVE("DGMTI"),ZTSAVE("DGMTDT"),ZTSAVE("MAXRT"))=""
|
|---|
| 101 | . S (ZTSAVE("EASRPT"),ZTSAVE("EASRDT"))="",ZTSAVE("EASADM")=$G(EASADM)
|
|---|
| 102 | . D ^%ZTLOAD
|
|---|
| 103 | . W !!,"Report "_$S($D(ZTSK):"Queued!",1:"Cancelled!")
|
|---|
| 104 | . D HOME^%ZIS
|
|---|
| 105 | D START^EASECPC1,^%ZISC
|
|---|
| 106 | Q
|
|---|
