source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASMTRPT.m@ 1800

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

initial load of WorldVistAEHR
File size: 7.2 KB
RevLine 
[613]1EASMTRPT ; MIN/TCM ALB/SCK - AUTOMATED MEANS TEST LETTERS REPORTS ; 7/6/01
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,12,15**;MAR 15,2001
3 ;
4UNRTN ; Unreturned letters report
5 N EASN,CTR,EASNODE,TOT,EAS6,EASIEN,EAX
6 ;
7 W @IOF
8 D WAIT^DICD
9 ;
10 F EAX=0,30,60 S CTR(EAX)=0
11 ;
12 S EASIEN=0
13 F S EASIEN=$O(^EAS(713.2,"AC",0,EASIEN)) Q:'EASIEN D
14 . I $P($G(^EAS(713.2,EASIEN,"Z")),U,3) S CTR(0)=CTR(0)+1 Q
15 . I $P($G(^EAS(713.2,EASIEN,4)),U,3) S CTR(30)=CTR(30)+1 Q
16 . I $P($G(^EAS(713.2,EASIEN,6)),U,3) S CTR(60)=CTR(60)+1 Q
17PRT1 ;
18 W !!,$CHAR(7),"Summary of Most Recent Unreturned Means Test Letters"
19 ;
20 W !!,"60-day letters printed: ",$J(CTR(60),6)
21 W !!,"30-day letters printed: ",$J(CTR(30),6)
22 W !!," 0-day letters printed: ",$J(CTR(0),6)
23 W !,"=============================="
24 S TOT=CTR(60)+CTR(30)+CTR(0)
25 W !!," Total: ",$J(TOT,6)
26 ;
27 W !!
28 D PAUSE^EASMTUTL
29 ;
30 Q
31 ;
32LTRSTAT ; Means Test Letter Statistics Report
33 N EASDT,EASB,EASE,ZTSAVE
34 ;
35 S EASDT=$$ASK("Processing")
36 Q:'EASDT
37 ;
38 S EASB=$P(EASDT,U,1),EASE=$P(EASDT,U,2)
39 S ZTSAVE("EASB")="",ZTSAVE("EASE")=""
40 ;
41 D EN^XUTMDEVQ("QUE2^EASMTRPT","EAS MT LETTER STATISTICS REPORT",.ZTSAVE)
42 Q
43 ;
44QUE2 ; Queued entry point for letters statistics
45 N EAYTOT,EAYRTN,EAPRHB,EAS1,EASX,EAX,EASCMT,EAIEN
46 ;
47 ; Begin search Letter Status File, #713.2
48 ; Set counters
49 S EAPRHB=0
50 F EASX=0,30,60 S EAYTOT(EASX)=0
51 F EASX="AG","OTR","OWN","FUT" S EAYRTN(EASX)=0
52 ;
53 S EAS1=$$FMADD^XLFDT(EASB,"","","",-1)
54 F S EAS1=$O(^EAS(713.2,"B",EAS1)) Q:'EAS1!(EAS1>EASE) D
55 . S EAIEN=0
56 . F S EAIEN=$O(^EAS(713.2,"B",EAS1,EAIEN)) Q:'EAIEN D
57 . . I $P($G(^EAS(713.2,EAIEN,"Z")),U,3) S EAYTOT(0)=EAYTOT(0)+1
58 . . I $P($G(^EAS(713.2,EAIEN,4)),U,3) S EAYTOT(30)=EAYTOT(30)+1
59 . . I $P($G(^EAS(713.2,EAIEN,6)),U,3) S EAYTOT(60)=EAYTOT(60)+1
60 . . D INCPRHB(EAIEN,.EAPRHB)
61 . . I $P(^EAS(713.2,EAIEN,0),U,4) D
62 . . . K EASCMT
63 . . . S EAX=$$GET1^DIQ(713.2,EAIEN,7,"","EASCMT")
64 . . . I $G(EASCMT(1))["AUTO-GENERATED" S EAYRTN("AG")=EAYRTN("AG")+1 Q
65 . . . I $G(EASCMT(1))["'OWNED'" S EAYRTN("OWN")=EAYRTN("OWN")+1 Q
66 . . . I $G(EASCMT(1))["FUTURE MEANS TEST" S EAYRTN("FUT")=EAYRTN("FUT")+1 Q
67 . . . S EAYRTN("OTR")=EAYRTN("OTR")+1
68 ;
69PRT2 ;
70 N LINE,TAB
71 ;
72 W @IOF
73 W !,"MEANS TEST LETTERS STATISTIC REPORT"
74 W !,"Letter Processing Date Range: ",$$FMTE^XLFDT(EASB)," thru ",$$FMTE^XLFDT(EASE)
75 W !,"Print Date: ",$$FMTE^XLFDT($$NOW^XLFDT)
76 ;
77 W !!,"Letter type:",?25,"60-day",?35,"30-day",?45,"0-day",?55,"Totals"
78 S $P(LINE,"=",IOM)="" W !,LINE
79 ;
80 W !!,"Letters printed:"
81 W ?25,EAYTOT(60),?35,EAYTOT(30),?45,EAYTOT(0)
82 W ?55,EAYTOT(60)+EAYTOT(30)+EAYTOT(0)
83 ;
84 W !!,"Means Test returned Totals"
85 W !," AUTO-GENERATED:",?35,$FN(EAYRTN("AG"),",")
86 W !," Future MT:",?35,$FN(EAYRTN("FUT"),",")
87 W !," Owned by Other Site:",?35,$FN(EAYRTN("OWN"),",")
88 W !," Returned by Veteran:",?35,$FN(EAYRTN("OTR"),",")
89 W !," Total:",?35,$FN(EAYRTN("AG")+EAYRTN("OWN")+EAYRTN("OTR")+EAYRTN("FUT"),",")
90 W !!,"Count of patient records set to prohibit letter during date range: ",$G(EAPRHB)
91 I $E(IOST,1,2)="C-" D PAUSE^EASMTUTL
92 Q
93 ;
94SUMMRY ; Automated MT Ltrs Summary
95 N SDATE,EDATE,EASDT,SDISP,EDISP,EAX
96 ;
97 S EASDT=$$ASK("Processing")
98 Q:'EASDT
99 S (SDATE,SDISP)=$P(EASDT,U)
100 S (EDATE,EDISP)=$P(EASDT,U,2)
101 S SDATE=$$FMADD^XLFDT(SDATE,"","","",-1)
102 S ZTSAVE("SDATE")="",ZTSAVE("EDATE")="",ZTSAVE("SDISP")="",ZTSAVE("EDISP")=""
103 W !!,$CHAR(7),"A 132-Column printer is required for this report"
104 D EN^XUTMDEVQ("QUE3^EASMTRPT","EAS MT PROCESSING SUMMARY REPORT",.ZTSAVE)
105 Q
106 ;
107QUE3 ; PROCESSING SUMMARY REPORT
108 N EASN,EASIEN,EANODE,EALNE,EATYP,PAGE,EASABRT,COL,EAWP,WP
109 N COL1,COL2,COL3,COL4,COL5,COL6,COL7,COL8,COL9
110 ;
111 S COL1=0,COL2=10,COL3=50,COL4=63,COL5=73,COL6=84,COL7=95,COL8=108,COL9=120
112 S PAGE=1
113 D HDR("AUTOMATED MT LETTERS SUMMARY",SDISP,EDISP)
114 ;
115 W !!,"Entry",?COL2,"Patient",?COL3,"Means Test",?COL4,"Letter",?COL5,"Print",?COL6,"Flag to",?COL7,"Letter",?COL8,"Print",?COL9,"Prohibit"
116 W !,?COL3,"Date",?COL4,"Type",?COL5,"Date",?COL6,"Print",?COL7,"Printed?",?COL8,"Date",?COL9,"Flag?",!
117 ;
118 S EASN=SDATE
119 F S EASN=$O(^EAS(713.2,"AD",EASN)) Q:'EASN!(EASN>EDATE) D Q:$G(EASABRT)
120 . S EASIEN=0
121 . F S EASIEN=$O(^EAS(713.2,"AD",EASN,EASIEN)) Q:'EASIEN D Q:$G(EASABRT)
122 . . K EANODE0 S EANODE0=$G(^EAS(713.2,EASIEN,0))
123 . . W !,EASIEN,?COL2,$E($$GET1^DIQ(713.2,EASIEN,2),1,25)_" ("_$$LAST4($P(EANODE0,U,2))_")"
124 . . I $$DECEASED^EASMTUTL(EASIEN) W " *D*"
125 . . W ?COL3,$$FMTE^XLFDT($P(EANODE0,U,3),"2D")
126 . . K EANODE6 S EANODE6=$G(^EAS(713.2,EASIEN,6))
127 . . W ?COL4,"60-Day",?COL5,$$FMTE^XLFDT($P(EANODE6,U,1),"2D"),?COL6,$S($P(EANODE6,U,2)=1:"YES",1:"NO")
128 . . W ?COL7,$S($P(EANODE6,U,3)=1:"YES",1:"NO"),?COL8,$$FMTE^XLFDT($P(EANODE6,U,4),"2D"),?COL9
129 . . I $D(^EAS(713.1,"AP",1,$P(EANODE0,U,2))) W "YES"
130 . . W !
131 . . I $P($G(EANODE0),U,4) W ?15,"MT Returned: ",$$FMTE^XLFDT($P(EANODE0,U,5),"2D")
132 . . K EANODE4 S EANODE4=$G(^EAS(713.2,EASIEN,4))
133 . . W ?COL4,"30-Day",?COL5,$$FMTE^XLFDT($P(EANODE4,U,1),"2D"),?COL6,$S($P(EANODE4,U,2)=1:"YES",1:"NO")
134 . . W ?COL7,$S($P(EANODE4,U,3)=1:"YES",1:"NO"),?COL8,$$FMTE^XLFDT($P(EANODE4,U,4),"2D"),!
135 . . W ?15 I $P($G(EANODE0),U,4) K WP S EAWP=$$GET1^DIQ(713.2,EASIEN,7,"","WP") D
136 . . . Q:$G(EAWP)']""
137 . . . W $E(WP(1),1,30)
138 . . K EANODEZ S EANODEZ=$G(^EAS(713.2,EASIEN,"Z"))
139 . . W ?COL4,"0-Day",?COL5,$$FMTE^XLFDT($P(EANODEZ,U,1),"2D"),?COL6,$S($P(EANODEZ,U,2)=1:"YES",1:"NO")
140 . . W ?COL7,$S($P(EANODEZ,U,3)=1:"YES",1:"NO"),?COL8,$$FMTE^XLFDT($P(EANODEZ,U,4),"2D"),!
141 . . S $P(LINE,"-",IOM)="" W !?42,$E(LINE,1,IOM-42)
142 . . I ($Y+6)>IOSL D
143 . . . D HDR("AUTOMATED MT LETTERS SUMMARY",SDISP,EDISP)
144 . . . Q:$G(EASABRT)
145 . . . W !!,"Entry",?COL2,"Patient",?COL3,"Means Test",?COL4,"Letter",?COL5,"Print",?COL6,"Flag to",?COL7,"Letter",?COL8,"Print",?COL9,"Prohibit"
146 . . . W !,?COL3,"Date",?COL4,"Type",?COL5,"Date",?COL6,"Print",?COL7,"Printed?",?COL8,"Date",?COL9,"Flag?",!
147 Q
148 ;
149HDR(TITLE,SDISP,EDISP) ; Print report header
150 N LINE,TAB
151 ;
152 I $E(IOST,1,2)="C-" D Q:$G(EASABRT)
153 . S DIR(0)="E"
154 . D ^DIR K DIR
155 . I 'Y S EASABRT=1
156 ;
157 W @IOF
158 W TITLE
159 I SDISP>0,EDISP>0 W !,"Date Range: ",$$FMTE^XLFDT(SDISP)," thru ",$$FMTE^XLFDT(EDISP)
160 ;
161 W !!,"Print Date: ",$$FMTE^XLFDT($$NOW^XLFDT)
162 S TAB=IOM-8
163 I $G(PAGE) W ?TAB,"Page "_PAGE S PAGE=PAGE+1
164 ;
165 S $P(LINE,"=",IOM)="" W !,LINE
166 Q
167 ;
168ASK(PRMPT) ; Get Date range
169 N DIR,DIRUT,SDATE,EDATE
170 ;
171 ; Get date range for the report
172 S DIR(0)="DAO^2881001:DT:EX"
173 S DIR("A")="Start with "_PRMPT_" date: "
174 S DIR("?",1)="Date cannot be earlier than October 1, 1988"
175 S DIR("?")="^D HELP^%DTC"
176 S DIR("B")="OCT 1, 1998"
177 D ^DIR
178 I $D(DIRUT) Q 0
179 S SDATE=Y
180 ;
181 S DIR(0)="DAO^"_SDATE_"::EX"
182 S DIR("A")="Ending "_PRMPT_" date: "
183 S DIR("?",1)="Date must after "_$$FMTE^XLFDT(SDATE)
184 S DIR("?")="^D HELP^%DTC"
185 S DIR("B")="TODAY"
186 D ^DIR K DIR
187 I $D(DIRUT) Q 0
188 S EDATE=Y
189 Q $G(SDATE)_U_$G(EDATE)
190 ;
191INCPRHB(EASN,EAPRHB) ; Increment Prohibited Letters Flag count
192 ; Input
193 ; EASN -
194 ; EAPRHB -
195 ;
196 N EASPAT,EASDFN
197 ;
198 Q:'EASN
199 S EASPAT=$G(^EAS(713.2,EASN,2))
200 Q:'EASPAT
201 I $D(^EAS(713.1,"AP",1,EASPAT)) D
202 . S EAPRHB=EAPRHB+1
203 . S EASDFN=$O(^EAS(713.1,"B",EASPAT,0))
204 . S EAPRHB(EASDFN)=""
205 Q
206 ;
207LAST4(EASIEN) ; Return last four for patient
208 N DFN,RSLT
209 ;
210 S DFN=$$GET1^DIQ(713.1,EASIEN,.01,"I")
211 I '$G(DFN) Q 0
212 D PID^VADPT
213 S RSLT=VA("BID")
214 D KVA^VADPT
215 Q RSLT
Note: See TracBrowser for help on using the repository browser.