EASECPC ;ALB/PHH,CKN,LBD,AMA,SCK - LTC Copayment Report; 29-AUG-2001 ; 12/10/12 5:37pm
;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,19,24,34,40,79,105**;Mar 15, 2001;Build 4
;
; This routine prints a report of calculated LTC copayments for a veteran.
; It is called by menu option EASEC LTC COPAY PRINT
;
EN N DFN,EASRPT,EASADM,EASRDT,MAXRT,DGMTI,DGMTDT
; Select which report to print (1=Institutional (IP); 2=Non-Institutional (OP))
D DISCMSG
S EASRPT=$$RPT Q:'EASRPT
; Select Patient
S DFN=$$GETDFN Q:'DFN
S EASADM=""
; Get the LTC admission date (if EASRPT=1)
I EASRPT=1 S EASADM=$$ADMDT Q:'EASADM
;E S EASADM="" ;EAS*1.0*79
; Get start date for report
S EASRDT=$$RPTDT Q:'EASRDT
;EAS*1.0*79 - moved from 4 lines up, and added EASADM as a parameter
;Set EASADM to the report date for Non-Institutional (OP) reports
I EASRPT=2 S EASADM=EASRDT
; Get most recent LTC Copay Test for patient and set up LTC variables
I '$$GETLTC(DFN,EASADM) Q
; Run the report
D QUE
Q
RPT() ; Select which report to print
; Input: None
; Output: Y - Report Type (1=Institutional (IP); 2=Non-Institutional (OP); 0=Quit)
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
W !!,"Report of Calculated Long Term Care Copayments"
W !,"=============================================="
S DIR(0)="S^1:Institutional (Inpatient);2:Non-Institutional (Outpatient)"
S DIR("A")="Enter 1 or 2"
D ^DIR I 'Y!($D(DTOUT))!($D(DUOUT)) Q 0
Q Y
GETDFN() ; Get the veteran's DFN
N DIC,DTOUT,DUOUT,X,Y
W !
S DIC="^DPT(",DIC(0)="AEMZQ",DIC("S")="I $D(^DGMT(408.31,""AID"",3,+Y))"
D ^DIC
Q:$D(DTOUT)!($D(DUOUT)) 0
Q:Y<0 0
Q +Y
;EAS*1.0*79 - added EASADM as a parameter
GETLTC(DFN,EASADM) ; Get the most recent LTC copay test. If no completed test on
; file, test status is exempt or LTC copay rates not defined, quit 0
; Input: DFN - Patient file IEN
; EASADM - LTC Admission Date
; Output: DGMTI - LTC Copay Test IEN (file #408.31)
; DGMTDT - LTC Copay Test Date
; MAXRT - Maximum daily copay rates for OP and IP LTC
; 1=OK to continue; 0=Not OK to continue
N LTC,STAT
;EAS*1.0*79 - added EASADM to $$LST call, and text in WRITE line following
S LTC=$$LST^EASECU(DFN,EASADM),DGMTI=+LTC
I 'DGMTI W !!,"No LTC Copayment Test on file for this veteran for that LTC admission date!" Q 0
S DGMTDT=$P(LTC,U,2),STAT=$P(LTC,U,3)
; Get the maximum daily copay rate for outpatient and inpatient LTC
; DBIA #3717
S MAXRT=$$MAXRATE^IBAECU(DGMTDT)
I '$P(MAXRT,U)!('$P(MAXRT,U,2)) W !!,"Copayment rates for LTC are not available at this time.",!! Q 0
; Check test status, if anything other than Non-Exempt don't continue
D DISDT^EASECU(DFN,EASADM) ;EAS*1.0*79
I STAT="NON-EXEMPT" Q 1
I STAT="" W !!,"The LTC Copayment Test is incomplete!" Q 0
I STAT="EXEMPT" W !!,"This veteran is Exempt from LTC copayments!" Q 0
W !!,"This LTC Copayment Test contains an invalid status!"
Q 0
ADMDT() ; Get the LTC admission date (for IP report only)
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
W !
S DIR(0)="D^::EX"
S DIR("A")="Enter the LTC Admission Date"
S DIR("?",1)="Enter the admission date for the current institutional"
S DIR("?")="Long Term Care episode."
D ^DIR I 'Y!($D(DTOUT))!($D(DUOUT)) Q 0
Q Y
RPTDT() ; Get the start date for the report
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DAYS
RD W !
S DIR(0)="D^::EMX"
S DIR("A")="Enter the Report Start Date (Month/Year)"
S DIR("?",1)="Enter the starting date for the report in the format month/year (e.g. 9/03)."
S DIR("?",2)="The report will print 12 months of copayments starting with the"
S DIR("?")="month and year entered."
D ^DIR I 'Y!($D(DTOUT))!($D(DUOUT)) Q 0
S DAYS=$$DOM^EASECPC1(Y)
I (Y+DAYS)<$G(EASADM) W !!,*7,"Report Start Date cannot be before LTC Admission Date!" G RD
Q Y+DAYS
;
QUE ; Get report device. Queue report if requested.
N POP,ZTRTN,ZTDESC,ZTSAVE
K IOP,%ZIS
S %ZIS="MQ"
W !
D ^%ZIS I POP W !!,"Report Cancelled!" Q
I $D(IO("Q")) D Q
. S ZTRTN="START^EASECPC1"
. S ZTDESC="LTC Copay Calculation Report"
. S (ZTSAVE("DFN"),ZTSAVE("DGMTI"),ZTSAVE("DGMTDT"),ZTSAVE("MAXRT"))=""
. S (ZTSAVE("EASRPT"),ZTSAVE("EASRDT"))="",ZTSAVE("EASADM")=$G(EASADM)
. D ^%ZTLOAD
. W !!,"Report "_$S($D(ZTSK):"Queued!",1:"Cancelled!")
. D HOME^%ZIS
D START^EASECPC1,^%ZISC
Q
DISCMSG ;EAS*1*105 This is a disclaimer to remind users that this report
; is only for estimates and that values can change.
W !!,"** This report is intended to provide a projected estimate of charges that"
W !,"should generate for a patient admitted for a LTC stay. These estimates are"
W !,"dependent on existing conditions with the projected estimate out to a year "
W !,"being presented in the report. Be advised that changing circumstances or newer"
W !,"LTC Copay tests within this timeframe could impact these projected estimates"
W !,"and a discrepancy can exist from the actual charges billing generates. **"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASECPC 5027 printed Oct 16, 2024@17:54:54 Page 2
EASECPC ;ALB/PHH,CKN,LBD,AMA,SCK - LTC Copayment Report; 29-AUG-2001 ; 12/10/12 5:37pm
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,19,24,34,40,79,105**;Mar 15, 2001;Build 4
+2 ;
+3 ; This routine prints a report of calculated LTC copayments for a veteran.
+4 ; It is called by menu option EASEC LTC COPAY PRINT
+5 ;
EN NEW DFN,EASRPT,EASADM,EASRDT,MAXRT,DGMTI,DGMTDT
+1 ; Select which report to print (1=Institutional (IP); 2=Non-Institutional (OP))
+2 DO DISCMSG
+3 SET EASRPT=$$RPT
if 'EASRPT
QUIT
+4 ; Select Patient
+5 SET DFN=$$GETDFN
if 'DFN
QUIT
+6 SET EASADM=""
+7 ; Get the LTC admission date (if EASRPT=1)
+8 IF EASRPT=1
SET EASADM=$$ADMDT
if 'EASADM
QUIT
+9 ;E S EASADM="" ;EAS*1.0*79
+10 ; Get start date for report
+11 SET EASRDT=$$RPTDT
if 'EASRDT
QUIT
+12 ;EAS*1.0*79 - moved from 4 lines up, and added EASADM as a parameter
+13 ;Set EASADM to the report date for Non-Institutional (OP) reports
+14 IF EASRPT=2
SET EASADM=EASRDT
+15 ; Get most recent LTC Copay Test for patient and set up LTC variables
+16 IF '$$GETLTC(DFN,EASADM)
QUIT
+17 ; Run the report
+18 DO QUE
+19 QUIT
RPT() ; Select which report to print
+1 ; Input: None
+2 ; Output: Y - Report Type (1=Institutional (IP); 2=Non-Institutional (OP); 0=Quit)
+3 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+4 WRITE !!,"Report of Calculated Long Term Care Copayments"
+5 WRITE !,"=============================================="
+6 SET DIR(0)="S^1:Institutional (Inpatient);2:Non-Institutional (Outpatient)"
+7 SET DIR("A")="Enter 1 or 2"
+8 DO ^DIR
IF 'Y!($DATA(DTOUT))!($DATA(DUOUT))
QUIT 0
+9 QUIT Y
GETDFN() ; Get the veteran's DFN
+1 NEW DIC,DTOUT,DUOUT,X,Y
+2 WRITE !
+3 SET DIC="^DPT("
SET DIC(0)="AEMZQ"
SET DIC("S")="I $D(^DGMT(408.31,""AID"",3,+Y))"
+4 DO ^DIC
+5 if $DATA(DTOUT)!($DATA(DUOUT))
QUIT 0
+6 if Y<0
QUIT 0
+7 QUIT +Y
+8 ;EAS*1.0*79 - added EASADM as a parameter
GETLTC(DFN,EASADM) ; Get the most recent LTC copay test. If no completed test on
+1 ; file, test status is exempt or LTC copay rates not defined, quit 0
+2 ; Input: DFN - Patient file IEN
+3 ; EASADM - LTC Admission Date
+4 ; Output: DGMTI - LTC Copay Test IEN (file #408.31)
+5 ; DGMTDT - LTC Copay Test Date
+6 ; MAXRT - Maximum daily copay rates for OP and IP LTC
+7 ; 1=OK to continue; 0=Not OK to continue
+8 NEW LTC,STAT
+9 ;EAS*1.0*79 - added EASADM to $$LST call, and text in WRITE line following
+10 SET LTC=$$LST^EASECU(DFN,EASADM)
SET DGMTI=+LTC
+11 IF 'DGMTI
WRITE !!,"No LTC Copayment Test on file for this veteran for that LTC admission date!"
QUIT 0
+12 SET DGMTDT=$PIECE(LTC,U,2)
SET STAT=$PIECE(LTC,U,3)
+13 ; Get the maximum daily copay rate for outpatient and inpatient LTC
+14 ; DBIA #3717
+15 SET MAXRT=$$MAXRATE^IBAECU(DGMTDT)
+16 IF '$PIECE(MAXRT,U)!('$PIECE(MAXRT,U,2))
WRITE !!,"Copayment rates for LTC are not available at this time.",!!
QUIT 0
+17 ; Check test status, if anything other than Non-Exempt don't continue
+18 ;EAS*1.0*79
DO DISDT^EASECU(DFN,EASADM)
+19 IF STAT="NON-EXEMPT"
QUIT 1
+20 IF STAT=""
WRITE !!,"The LTC Copayment Test is incomplete!"
QUIT 0
+21 IF STAT="EXEMPT"
WRITE !!,"This veteran is Exempt from LTC copayments!"
QUIT 0
+22 WRITE !!,"This LTC Copayment Test contains an invalid status!"
+23 QUIT 0
ADMDT() ; Get the LTC admission date (for IP report only)
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+2 WRITE !
+3 SET DIR(0)="D^::EX"
+4 SET DIR("A")="Enter the LTC Admission Date"
+5 SET DIR("?",1)="Enter the admission date for the current institutional"
+6 SET DIR("?")="Long Term Care episode."
+7 DO ^DIR
IF 'Y!($DATA(DTOUT))!($DATA(DUOUT))
QUIT 0
+8 QUIT Y
RPTDT() ; Get the start date for the report
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DAYS
RD WRITE !
+1 SET DIR(0)="D^::EMX"
+2 SET DIR("A")="Enter the Report Start Date (Month/Year)"
+3 SET DIR("?",1)="Enter the starting date for the report in the format month/year (e.g. 9/03)."
+4 SET DIR("?",2)="The report will print 12 months of copayments starting with the"
+5 SET DIR("?")="month and year entered."
+6 DO ^DIR
IF 'Y!($DATA(DTOUT))!($DATA(DUOUT))
QUIT 0
+7 SET DAYS=$$DOM^EASECPC1(Y)
+8 IF (Y+DAYS)<$GET(EASADM)
WRITE !!,*7,"Report Start Date cannot be before LTC Admission Date!"
GOTO RD
+9 QUIT Y+DAYS
+10 ;
QUE ; Get report device. Queue report if requested.
+1 NEW POP,ZTRTN,ZTDESC,ZTSAVE
+2 KILL IOP,%ZIS
+3 SET %ZIS="MQ"
+4 WRITE !
+5 DO ^%ZIS
IF POP
WRITE !!,"Report Cancelled!"
QUIT
+6 IF $DATA(IO("Q"))
Begin DoDot:1
+7 SET ZTRTN="START^EASECPC1"
+8 SET ZTDESC="LTC Copay Calculation Report"
+9 SET (ZTSAVE("DFN"),ZTSAVE("DGMTI"),ZTSAVE("DGMTDT"),ZTSAVE("MAXRT"))=""
+10 SET (ZTSAVE("EASRPT"),ZTSAVE("EASRDT"))=""
SET ZTSAVE("EASADM")=$GET(EASADM)
+11 DO ^%ZTLOAD
+12 WRITE !!,"Report "_$SELECT($DATA(ZTSK):"Queued!",1:"Cancelled!")
+13 DO HOME^%ZIS
End DoDot:1
QUIT
+14 DO START^EASECPC1
DO ^%ZISC
+15 QUIT
DISCMSG ;EAS*1*105 This is a disclaimer to remind users that this report
+1 ; is only for estimates and that values can change.
+2 WRITE !!,"** This report is intended to provide a projected estimate of charges that"
+3 WRITE !,"should generate for a patient admitted for a LTC stay. These estimates are"
+4 WRITE !,"dependent on existing conditions with the projected estimate out to a year "
+5 WRITE !,"being presented in the report. Be advised that changing circumstances or newer"
+6 WRITE !,"LTC Copay tests within this timeframe could impact these projected estimates"
+7 WRITE !,"and a discrepancy can exist from the actual charges billing generates. **"
+8 QUIT
