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

EASECPC.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ; This routine prints a report of calculated LTC copayments for a veteran.
  1.  ; It is called by menu option EASEC LTC COPAY PRINT
  1.  ;
  1. EN N DFN,EASRPT,EASADM,EASRDT,MAXRT,DGMTI,DGMTDT
  1.  ; Select which report to print (1=Institutional (IP); 2=Non-Institutional (OP))
  1.  D DISCMSG
  1.  S EASRPT=$$RPT Q:'EASRPT
  1.  ; Select Patient
  1.  S DFN=$$GETDFN Q:'DFN
  1.  S EASADM=""
  1.  ; Get the LTC admission date (if EASRPT=1)
  1.  I EASRPT=1 S EASADM=$$ADMDT Q:'EASADM
  1.  ;E  S EASADM=""   ;EAS*1.0*79
  1.  ; Get start date for report
  1.  S EASRDT=$$RPTDT Q:'EASRDT
  1.  ;EAS*1.0*79 - moved from 4 lines up, and added EASADM as a parameter
  1.  ;Set EASADM to the report date for Non-Institutional (OP) reports
  1.  I EASRPT=2 S EASADM=EASRDT
  1.  ; Get most recent LTC Copay Test for patient and set up LTC variables
  1.  I '$$GETLTC(DFN,EASADM) Q
  1.  ; Run the report
  1.  D QUE
  1.  Q
  1. RPT() ; Select which report to print
  1.  ; Input:   None
  1.  ; Output:  Y - Report Type (1=Institutional (IP); 2=Non-Institutional (OP); 0=Quit)
  1.  N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  W !!,"Report of Calculated Long Term Care Copayments"
  1.  W !,"=============================================="
  1.  S DIR(0)="S^1:Institutional (Inpatient);2:Non-Institutional (Outpatient)"
  1.  S DIR("A")="Enter 1 or 2"
  1.  D ^DIR I 'Y!($D(DTOUT))!($D(DUOUT)) Q 0
  1.  Q Y
  1. GETDFN() ; Get the veteran's DFN
  1.  N DIC,DTOUT,DUOUT,X,Y
  1.  W !
  1.  S DIC="^DPT(",DIC(0)="AEMZQ",DIC("S")="I $D(^DGMT(408.31,""AID"",3,+Y))"
  1.  D ^DIC
  1.  Q:$D(DTOUT)!($D(DUOUT)) 0
  1.  Q:Y<0 0
  1.  Q +Y
  1.  ;EAS*1.0*79 - added EASADM as a parameter
  1. 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
  1.  ; Input:   DFN - Patient file IEN
  1.  ;          EASADM - LTC Admission Date
  1.  ; Output:  DGMTI - LTC Copay Test IEN (file #408.31)
  1.  ;          DGMTDT - LTC Copay Test Date
  1.  ;          MAXRT - Maximum daily copay rates for OP and IP LTC
  1.  ;          1=OK to continue; 0=Not OK to continue
  1.  N LTC,STAT
  1.  ;EAS*1.0*79 - added EASADM to $$LST call, and text in WRITE line following
  1.  S LTC=$$LST^EASECU(DFN,EASADM),DGMTI=+LTC
  1.  I 'DGMTI W !!,"No LTC Copayment Test on file for this veteran for that LTC admission date!" Q 0
  1.  S DGMTDT=$P(LTC,U,2),STAT=$P(LTC,U,3)
  1.  ; Get the maximum daily copay rate for outpatient and inpatient LTC
  1.  ; DBIA #3717
  1.  S MAXRT=$$MAXRATE^IBAECU(DGMTDT)
  1.  I '$P(MAXRT,U)!('$P(MAXRT,U,2)) W !!,"Copayment rates for LTC are not available at this time.",!! Q 0
  1.  ; Check test status, if anything other than Non-Exempt don't continue
  1.  D DISDT^EASECU(DFN,EASADM)   ;EAS*1.0*79
  1.  I STAT="NON-EXEMPT" Q 1
  1.  I STAT="" W !!,"The LTC Copayment Test is incomplete!" Q 0
  1.  I STAT="EXEMPT" W !!,"This veteran is Exempt from LTC copayments!" Q 0
  1.  W !!,"This LTC Copayment Test contains an invalid status!"
  1.  Q 0
  1. ADMDT() ; Get the LTC admission date (for IP report only)
  1.  N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  W !
  1.  S DIR(0)="D^::EX"
  1.  S DIR("A")="Enter the LTC Admission Date"
  1.  S DIR("?",1)="Enter the admission date for the current institutional"
  1.  S DIR("?")="Long Term Care episode."
  1.  D ^DIR I 'Y!($D(DTOUT))!($D(DUOUT)) Q 0
  1.  Q Y
  1. RPTDT() ; Get the start date for the report
  1.  N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DAYS
  1. RD W !
  1.  S DIR(0)="D^::EMX"
  1.  S DIR("A")="Enter the Report Start Date (Month/Year)"
  1.  S DIR("?",1)="Enter the starting date for the report in the format month/year (e.g. 9/03)."
  1.  S DIR("?",2)="The report will print 12 months of copayments starting with the"
  1.  S DIR("?")="month and year entered."
  1.  D ^DIR I 'Y!($D(DTOUT))!($D(DUOUT)) Q 0
  1.  S DAYS=$$DOM^EASECPC1(Y)
  1.  I (Y+DAYS)<$G(EASADM) W !!,*7,"Report Start Date cannot be before LTC Admission Date!" G RD
  1.  Q Y+DAYS
  1.  ;
  1. QUE ; Get report device. Queue report if requested.
  1.  N POP,ZTRTN,ZTDESC,ZTSAVE
  1.  K IOP,%ZIS
  1.  S %ZIS="MQ"
  1.  W !
  1.  D ^%ZIS I POP W !!,"Report Cancelled!" Q
  1.  I $D(IO("Q")) D  Q
  1.  . S ZTRTN="START^EASECPC1"
  1.  . S ZTDESC="LTC Copay Calculation Report"
  1.  . S (ZTSAVE("DFN"),ZTSAVE("DGMTI"),ZTSAVE("DGMTDT"),ZTSAVE("MAXRT"))=""
  1.  . S (ZTSAVE("EASRPT"),ZTSAVE("EASRDT"))="",ZTSAVE("EASADM")=$G(EASADM)
  1.  . D ^%ZTLOAD
  1.  . W !!,"Report "_$S($D(ZTSK):"Queued!",1:"Cancelled!")
  1.  . D HOME^%ZIS
  1.  D START^EASECPC1,^%ZISC
  1.  Q
  1. DISCMSG ;EAS*1*105 This is a disclaimer to remind users that this report
  1.         ; is only for estimates and that values can change.
  1.  W !!,"** This report is intended to provide a projected estimate of charges that"
  1.  W !,"should generate for a patient admitted for a LTC stay. These estimates are"
  1.  W !,"dependent on existing conditions with the projected estimate out to a year "
  1.  W !,"being presented in the report. Be advised that changing circumstances or newer"
  1.  W !,"LTC Copay tests within this timeframe could impact these projected estimates"
  1.  W !,"and a discrepancy can exist from the actual charges billing generates. **"
  1.  Q