source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGENRPA2.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: 4.2 KB
Line 
1DGENRPA2 ;ALB/CJM/CKN - Enrolled Veterans Report Cont.; JUL 9,1997 ; 11/15/01 8:47am ; 07/22/02
2 ;;5.3;Registration;**121,147,232,306,417,456**;Aug 13,1993
3 ;
4PRINT ;
5 N STATS,CRT,QUIT,PAGE1
6 S QUIT=0
7 S PAGE1=1
8 S CRT=$S($E(IOST,1,2)="C-":1,1:0)
9 ;
10 D GETSTATS
11 U IO
12 I CRT,PAGE1 W @IOF S PAGE1=0
13 D HEADER
14 D PART1
15 ;D:'QUIT PART2
16 ;I 'QUIT,CRT D PAUSE
17 I $D(ZTQUEUED) S ZTREQ="@"
18 D ^%ZISC
19 Q
20LINE(LINE) ;
21 ;Description: prints a line. First prints header if at end of page.
22 ;
23 I CRT,($Y>(IOSL-4)) D
24 .D PAUSE
25 .Q:QUIT
26 .W @IOF
27 .D HEADER
28 .W LINE
29 ;
30 E I ('CRT),($Y>(IOSL-2)) D
31 .W @IOF
32 .D HEADER
33 .W LINE
34 ;
35 E W !,LINE
36 Q
37 ;
38GETSTATS ;
39 ;Description: Gathers the statistics for the report
40 ;
41 ;*** note *** - part II of report removed, lines commented out were
42 ;for that reason
43 ;
44 N DFN,PRIORITY,STATUS,I,ENRSBGRP
45 S STATUS=""
46 F S STATUS=$O(^DPT("AENRC",STATUS)) Q:STATUS="" D
47 .S DFN=0
48 .F S DFN=$O(^DPT("AENRC",STATUS,DFN)) Q:'DFN D
49 ..S ENRSBGRP=""
50 ..S PRIORITY=+$$PRIORITY^DGENA(DFN)
51 ..S:((PRIORITY=7)!(PRIORITY=8)) ENRSBGRP=$$EXT^DGENU("SUBGRP",$$ENRSBGRP^DGENA4(DFN))
52 ..S CATEGORY=$$CATEGORY^DGENA4(DFN)
53 ..S STATS("PRI",PRIORITY_ENRSBGRP)=1+$G(STATS("PRI",PRIORITY_ENRSBGRP))
54 ..S STATS("PRI",PRIORITY_ENRSBGRP,"CAT",CATEGORY)=1+$G(STATS("PRI",PRIORITY_ENRSBGRP,"CAT",CATEGORY))
55 ..S STATS("STATUS",STATUS)=1+$G(STATS("STATUS",STATUS))
56 ;.E I $$VET^DGENPTA(DFN),'$$DEATH^DGENPTA(DFN),$$ACTIVE^DGENPTA(DFN,$G(INDATE)) D
57 ;..S STATUS=+$$STATUS^DGENA(DFN)
58 ;..S STATS("NOT ENROLLED","STATUS",STATUS)=1+$G(STATS("NOT ENROLLED","STATUS",STATUS))
59 Q
60 ;
61HEADER ;
62 ;Description: Prints the report header.
63 ;
64 W !,?((IOM-24)\2),"Enrolled Veterans Report"
65 W !,?((IOM-12)\2),$$FMTE^XLFDT(DT,"D")
66 W !!
67 Q
68 ;
69PAUSE ;
70 ;Description: Screen pause. Sets QUIT=1 if user decides to quit.
71 ;
72 N DIR,X,Y
73 F Q:$Y>(IOSL-3) W !
74 S DIR(0)="E" D ^DIR
75 I '(+Y) S QUIT=1
76 Q
77 ;
78PART1 ;
79 ;Description: Prints statistics for enrolled veterans.
80 ;
81 N AMOUNT,TOTAL,STATUS,PRIORITY,CATEGORY,TOTCAT
82 W !!,"CURRENTLY ENROLLED VETERANS AND VETERANS WITH PENDING APPLICATIONS",!!
83 W ?59,"Enrolled",?75,"Not Enrolled",?97,"In Process",!
84 S TOTAL=0
85 S PRIORITY=""
86 F S PRIORITY=$O(STATS("PRI",PRIORITY)) Q:PRIORITY="" D Q:QUIT
87 .S AMOUNT=+$G(STATS("PRI",PRIORITY))
88 .D:PRIORITY=0 LINE(" NO Priority Group: "_" "_$$F(AMOUNT))
89 .D:PRIORITY'=0 LINE(" Priority Group "_$S($L(PRIORITY)=1:PRIORITY_" : ",1:$E(PRIORITY)_$E(PRIORITY,2)_" : ")_$$F(AMOUNT))
90 .D CATEGORY(1)
91 .S TOTAL=TOTAL+AMOUNT
92 Q:QUIT
93 D LINE(" =====================================")
94 Q:QUIT
95 D LINE(" Total: "_$$F(TOTAL))
96 D CATEGORY(0)
97 Q:QUIT
98 W !!
99 S (TOTAL,STATUS)=0
100 F S STATUS=$O(STATS("STATUS",STATUS)) Q:STATUS="" D Q:QUIT
101 .S AMOUNT=+STATS("STATUS",STATUS)
102 .D LINE($$LJ^XLFSTR(" "_$E($$STATUS(STATUS),1,45)_" Status:",54)_$$F(AMOUNT))
103 .S TOTAL=TOTAL+(AMOUNT)
104 Q:QUIT
105 D LINE(" ==============================================================")
106 Q:QUIT
107 D LINE($$LJ^XLFSTR(" Total:",54)_$$F(TOTAL))
108 Q
109 ;
110PART2 ;
111 ;Description: Prints statistics for veterans not enrolled.
112 ;
113 N AMOUNT,STATUS,PRIORITY,TOTAL
114 D LINE(" ")
115 D LINE(" ")
116 D LINE("VETERANS NOT ENROLLED WITH INPATIENT OR OUTPATIENT ACTIVITY SINCE "_$$FMTE^XLFDT(INDATE,"D"))
117 D LINE(" ")
118 S TOTAL=0
119 F STATUS=3:1:9 D Q:QUIT
120 .S AMOUNT=$G(STATS("NOT ENROLLED","STATUS",STATUS))
121 .D LINE($$LJ^XLFSTR(" "_$$STATUS(STATUS)_" Status:",40)_$$F(AMOUNT))
122 .S TOTAL=TOTAL+(AMOUNT)
123 Q:QUIT
124 D LINE(" ================================================")
125 Q:QUIT
126 D LINE($$LJ^XLFSTR(" Total:",40)_$$F(TOTAL))
127 Q
128 ;
129F(X) ;
130 ;Description: Formats X, a number, used as standard format for report.
131 ;
132 Q $J($FN(X,","),12)
133 ;
134STATUS(STATUS) ;
135 ;Description: Returns status name.
136 ;
137 Q $$LOWER^VALM1($$EXT^DGENU("STATUS",STATUS))
138 ;
139CATEGORY(FLG) ;
140 ;Displays category totals for each priority
141 ; Input:
142 ; FLG - 0 Displays category totals for each priority
143 ; 1 Displays total categorys
144 ;
145 N CATEGORY
146 F CATEGORY="E","N","P" D
147 .W ?$S(CATEGORY="E":55,CATEGORY="N":75,1:95)
148 .I FLG D Q
149 ..Q:+$G(STATS("PRI",PRIORITY,"CAT",CATEGORY))=0
150 ..W $$F(STATS("PRI",PRIORITY,"CAT",CATEGORY))
151 ..S TOTCAT(CATEGORY)=$G(TOTCAT(CATEGORY))+STATS("PRI",PRIORITY,"CAT",CATEGORY)
152 .Q:+$G(TOTCAT(CATEGORY))=0
153 .W $$F(TOTCAT(CATEGORY))
154 Q
Note: See TracBrowser for help on using the repository browser.