source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASECPC.m@ 1753

Last change on this file since 1753 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.1 KB
RevLine 
[613]1EASECPC ;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 ;
7EN 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
26RPT() ; 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
36GETDFN() ; 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
45GETLTC(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
69ADMDT() ; 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
78RPTDT() ; Get the start date for the report
79 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DAYS
80RD 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 ;
91QUE ; 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
Note: See TracBrowser for help on using the repository browser.