source: FOIAVistA/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASECEXP.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 6.7 KB
Line 
1EASECEXP ;ALB/LBD - Report of Expiring or Expired LTC Copay Tests; 10-SEP-2003
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**40**;Mar 15, 2001
3 ;
4 ; This routine is called from menu option EASEC LTC COPAY TEST EXPIRE
5 ; and will print a report of LTC Copay Tests that have expired or are
6 ; about to expire.
7 ;
8EN ; Entry point
9 N EASRPT,EASUDT,EASSRT
10 ; Select which report to print (1=Pending Expiration; 2=Expired)
11 S EASRPT=$$RPT Q:'EASRPT
12 ; Select number of days (report 1) or start date (report 2)
13 I EASRPT=1 S EASUDT=$$DATE1
14 E S EASUDT=$$DATE2
15 Q:'EASUDT
16 ; Sort by name or date
17 S EASSRT=$$SRT Q:EASSRT=""
18 ; Run the report
19 D QUE
20 D ^%ZISC,HOME^%ZIS
21 Q
22 ;
23RPT() ; Select which report to print
24 ; Input: None
25 ; Output: Y - Report Type (1=Pending Expiration; 2=Expired; 0=Quit)
26 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
27 W !!,"Report of LTC Copayment Tests"
28 S DIR(0)="S^1:Pending Expiration;2:Expired"
29 S DIR("A")="Enter 1 or 2"
30 S DIR("?",1)="Indicate whether the report should include:"
31 S DIR("?",2)="(1) a list of veterans whose LTC Copayment Test is pending expiration (i.e.,"
32 S DIR("?",3)="the anniversary date of the test is approaching) within a user-specified"
33 S DIR("?",4)="number of days, or"
34 S DIR("?",5)="(2) a list of veterans whose LTC Copayment Test has already expired (i.e.,"
35 S DIR("?")="the anniversary date of the test has passed) since a user-specified date."
36 D ^DIR I 'Y!($D(DTOUT))!($D(DUOUT)) Q 0
37 Q Y
38DATE1() ; Select number of days for report 1
39 ; Input: None
40 ; Output: Y - Number of days to report (1-60)
41 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
42 S DIR(0)="N^1:60",DIR("A")="Enter number of days to report"
43 D ^DIR I 'Y!($D(DTOUT))!($D(DUOUT)) Q 0
44 Q Y
45DATE2() ; Select start date for report 2
46 ; Input: None
47 ; Output: Y - Report start date
48 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,SDT,EDT
49 S SDT=$$FMADD^XLFDT(DT,-365),EDT=$$FMADD^XLFDT(DT,-1)
50 S DIR(0)="D^"_SDT_":"_EDT_":EX",DIR("A")="Enter a start date"
51 D ^DIR I 'Y!($D(DTOUT))!($D(DUOUT)) Q 0
52 Q Y
53SRT() ; Select sort
54 ; Input: None
55 ; Output: Y - Sort (N=Name; D=Date)
56 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
57 S DIR(0)="SB^N:Name;D:Date",DIR("A")="Sort report by Name or Date"
58 S DIR("?",1)="Indicate whether the report should be sorted by the"
59 S DIR("?")="Veteran's Name or the LTC Copay Test Anniversary Date"
60 D ^DIR I $D(DTOUT)!($D(DUOUT)) Q ""
61 Q Y
62 ;
63QUE ; Get the report device, queue if requested
64 N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,POP
65 K IOP,%ZIS
66 S %ZIS="Q" D ^%ZIS I POP W !!,"Report Cancelled!" Q
67 I $D(IO("Q")) D Q
68 .S ZTRTN="START^EASECEXP"
69 .S ZTDESC="PRINT"_$S(EASRPT=1:"EXPIRING",1:"EXPIRED")_"LTC COPAY TESTS"
70 .S (ZTSAVE("EASRPT"),ZTSAVE("EASUDT"),ZTSAVE("EASSRT"))=""
71 .D ^%ZTLOAD
72 .W !,"Report ",$S($D(ZTSK):"Queued!",1:"Cancelled!")
73 D START
74 Q
75 ;
76START ; Generate report
77 ; Input: EASRPT - Report Type (1=Pending Expiration; 2=Expired)
78 ; EASUDT - Number of Days or Start Date
79 ; EASSRT - Sort (N=Name; D=Date)
80 N PG,RPTDT,HDR1,HDR2,HDR3,HDRLN,CRT,LINE,OUT,MXLNE,TMP
81 K ^TMP("EASECEXP",$J) S:$G(ZTSK) ZTREQ="@"
82 D GETREC
83 D PRTVAR
84 U IO D HDR
85 I '$D(^TMP("EASECEXP",$J)) W !!,?10,"*** No records to print ***" Q
86 D PRINT I CRT S OUT=$$PAUSE
87 K ^TMP("EASECEXP",$J)
88 Q
89GETREC ; Loop through Annual Means Test File #408.31 to find LTC Copay Tests
90 ; within the date range
91 N EASSDT,EASEDT,EDT,ST,DFN,EASIEN
92 ; Get start and end dates
93 I EASRPT=1 D
94 .S EASSDT=$$FMADD^XLFDT(DT,-365)
95 .S EASEDT=$$FMADD^XLFDT(EASSDT,EASUDT)
96 E D
97 .S EASSDT=$$FMADD^XLFDT(EASUDT,-365)
98 .S EASEDT=$$FMADD^XLFDT(DT,-365)
99 ; Find records using "AS" x-ref
100 S ST=""
101 F S ST=$O(^DGMT(408.31,"AS",3,ST)) Q:ST="" S EDT=-EASEDT-1 F S EDT=$O(^DGMT(408.31,"AS",3,ST,EDT)) Q:'EDT!(EDT>-EASSDT) S DFN=0 F S DFN=$O(^DGMT(408.31,"AS",3,ST,EDT,DFN)) Q:'DFN D
102 .S EASIEN=$O(^DGMT(408.31,"AS",3,ST,EDT,DFN,0)) Q:'EASIEN
103 .Q:'$D(^DGMT(408.31,EASIEN,0))
104 .;If record meets criteria, save in ^TMP global
105 .I $$CHK(DFN,EASIEN) D SET(DFN,EASIEN,EASSRT)
106 Q
107 ;
108SET(DFN,IEN,SRT) ;Store data to be printed in the ^TMP global
109 ; Input: DFN - Patient IEN
110 ; IEN - LTC Copay Test IEN
111 Q:'$G(DFN) Q:'$G(IEN)
112 I $G(SRT)="" S SRT="D"
113 N NAME,SSN,STAT,REAS,ANNDT
114 S NAME=$$GET1^DIQ(2,DFN_",",.01),SSN=$$GET1^DIQ(2,DFN_",",.09)
115 S ANNDT=$$FMADD^XLFDT(+$G(^DGMT(408.31,IEN,0)),365)
116 S STAT=$$GET1^DIQ(408.31,IEN_",",.03) S:STAT="" STAT="INCOMPLETE"
117 S REAS=$E($$GET1^DIQ(408.31,IEN_",",2.07),1,41)
118 I SRT="D" S ^TMP("EASECEXP",$J,ANNDT,NAME,SSN)=STAT_U_REAS
119 E S ^TMP("EASECEXP",$J,NAME,ANNDT,SSN)=STAT_U_REAS
120 Q
121 ;
122CHK(DFN,EASIEN) ;Check if LTC Copay Test meets criteria for the report
123 ; Input: DFN - Patient IEN
124 ; EASIEN - LTC Copay Test IEN
125 ; Output: 1 = meets criteria for report
126 ; 0 = doesn't meet criteria for report
127 I '$G(DFN)!('$G(EASIEN)) Q 0
128 N LTC,LTCDT,LTCST,CHKDT
129 S CHKDT=+^DGMT(408.31,EASIEN,0)
130 ; Don't report if veteran has had another LTC copay test within the year
131 S LTC=$$LST^EASECU(DFN),LTCDT=$P(LTC,U,2),LTCST=$P(LTC,U,3)
132 I LTCDT,LTCDT>CHKDT,$$FMDIFF^XLFDT(DT,LTCDT)<365,LTCST'="" Q 0
133 ; Don't report if veteran is deceased
134 I $P($G(^DPT(DFN,.35)),U) Q 0
135 ; Don't report if veteran is exempt due to compensable SC disability or
136 ; LTC before 11/30/99
137 I "^1^4^"[(U_$P($G(^DGMT(408.31,EASIEN,2)),U,7)_U) Q 0
138 Q 1
139 ;
140PRTVAR ; Set up variables needed to print report
141 S CRT=$S($E(IOST,1,2)="C-":1,1:0)
142 S TMP="^TMP(""EASECEXP"",$J)"
143 S (PG,OUT)=0,RPTDT=$$FMTE^XLFDT(DT),MXLNE=$S(CRT:13,1:55)
144 S HDR1=$$CJ^XLFSTR("VETERANS WITH LONG TERM CARE COPAYMENT TESTS THAT",80)
145 I EASRPT=1 S HDR2=$$CJ^XLFSTR("ARE PENDING EXPIRATION IN "_EASUDT_" DAYS",80)
146 E S HDR2=$$CJ^XLFSTR("HAVE EXPIRED SINCE "_$$FMTE^XLFDT(EASUDT,2),80)
147 S HDR3="SORTED BY "_$S(EASSRT="D":"DATE",1:"NAME")
148 S HDRLN="",$P(HDRLN,"=",80)=""
149 Q
150HDR ; Print report header
151 S PG=PG+1,LINE=0
152 W @IOF
153 W ?0,"REPORT DATE: ",RPTDT,?73,"PAGE: ",$$RJ^XLFSTR(PG,3)
154 W !!,HDR1,!,HDR2,!,HDR3
155 W !?50,"LTC Test",?66,"LTC Test"
156 W !,"SSN",?14,"Veteran's Name",?46,"Anniversary Date",?67,"Status"
157 W !,HDRLN
158 Q
159PRINT ; Print report data
160 N EASI,EASJ,SSN,REC,NAME,ANNDT,STAT,REAS
161 S EASI=""
162 F S EASI=$O(@TMP@(EASI)) Q:EASI=""!OUT S EASJ="" F S EASJ=$O(@TMP@(EASI,EASJ)) Q:EASJ="" S SSN="" F S SSN=$O(@TMP@(EASI,EASJ,SSN)) Q:SSN="" D
163 .S REC=@TMP@(EASI,EASJ,SSN)
164 .S NAME=$S(EASSRT="D":EASJ,1:EASI),NAME=$E(NAME,1,30)
165 .S ANNDT=$S(EASSRT="D":EASI,1:EASJ),ANNDT=$$FMTDT(ANNDT)
166 .S STAT=$P(REC,U,1)
167 .S REAS=$P(REC,U,2)
168 .I LINE>MXLNE S OUT=$$PAUSE Q:OUT D HDR
169 .W !,$$SSN(SSN),?14,NAME,?50,ANNDT,?66,STAT
170 .S LINE=LINE+1
171 .I STAT="EXEMPT" W !,?30,"Reason: ",REAS S LINE=LINE+1
172 Q
173 ;
174FMTDT(X) ;Format date to print on report
175 Q $E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
176SSN(X) ; Format SSN to print on report
177 Q $E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,9)
178 ;
179PAUSE() ; Prompt for next page or quit, if report is sent to screen
180 N DIR,DIRUT,DUOUT,DTOUT,X,Y
181 I 'CRT Q 0
182 S DIR(0)="E"
183 D ^DIR I 'Y Q 1
184 Q 0
Note: See TracBrowser for help on using the repository browser.