source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGENRPC2.m@ 1259

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

initial load of WorldVistAEHR

File size: 6.7 KB
Line 
1DGENRPC2 ;ALB/CJM -Enrollees by Status, Priority, Preferred Facility Report - Continued; May 12, 1999
2 ;;5.3;Registration;**147,232,306**;Aug 13,1993
3 ;
4PRINT ;
5 N STATS,CRT,QUIT,PAGE,SECTION
6 K ^TMP($J)
7 S QUIT=0
8 S PAGE=0
9 S CRT=$S($E(IOST,1,2)="C-":1,1:0)
10 ;
11 D GETPAT
12 U IO
13 I CRT,PAGE=0 W @IOF
14 S PAGE=1
15 S SECTION="SUMMARY"
16 D HEADER
17 D SUMMARY
18 I DGENRP("LIST") D
19 .S SECTION="PATIENTS"
20 .D HEADER
21 .D PATIENTS
22 I CRT,'QUIT D PAUSE
23 I $D(ZTQUEUED) S ZTREQ="@"
24 D ^%ZISC
25 K ^TMP($J)
26 Q
27LINE(LINE) ;
28 ;Description: prints a line. First prints header if at end of page.
29 ;
30 I CRT,($Y>(IOSL-4)) D
31 .D PAUSE
32 .Q:QUIT
33 .W @IOF
34 .D HEADER
35 .W LINE
36 ;
37 E I ('CRT),($Y>(IOSL-2)) D
38 .W @IOF
39 .D HEADER
40 .W LINE
41 ;
42 E W !,LINE
43 Q
44 ;
45GETPAT ;
46 ;Description: Gets patients to include in the report
47 ;for that reason
48 ;
49 N DFN,STATUS
50 S STATUS=0
51 F S STATUS=$O(^DPT("AENRC",STATUS)) Q:'STATUS D
52 .S DFN=0
53 .F S DFN=$O(^DPT("AENRC",STATUS,DFN)) Q:'DFN D
54 ..N DGINST,DGPFH,PREFAC,DGENRIEN,DGENR,EFFDATE,FACNAME,PATNAME,CATEGORY,PRISUB
55 ..S FACNAME=" "
56 ..S DGENRIEN=$$FINDCUR^DGENA(DFN)
57 ..S CATEGORY=$$CATEGORY^DGENA4(DFN,STATUS)
58 ..Q:'$$GET^DGENA(DGENRIEN,.DGENR)
59 ..Q:DGENR("STATUS")'=STATUS
60 ..S PATNAME=$$NAME^DGENPTA(DFN)
61 ..S DGENR("SUBGRP")=$$EXT^DGENU("SUBGRP",DGENR("SUBGRP"))
62 ..Q:(PATNAME="")
63 ..;
64 ..S PREFAC=$$PREF^DGENPTA(DFN)
65 ..I PREFAC S DGPFH("PREFAC")=PREFAC,DGPFH("EFFDATE")=""
66 ..I PREFAC,'$$GETINST^DGENU($G(DGPFH("PREFAC")),.DGINST) S PREFAC=""
67 ..I (DGENRP("FACILITY","ALL")!$D(DGENRP("FACILITY",+PREFAC))) D
68 ...S PRISUB=+DGENR("PRIORITY")_DGENR("SUBGRP")
69 ...S:PREFAC FACNAME=$$LJ($G(DGINST("STANUM")),10)_$$LJ($G(DGINST("NAME")),45)
70 ...S ^TMP($J,FACNAME,CATEGORY,DGENR("STATUS"))=$G(^TMP($J,FACNAME,CATEGORY,DGENR("STATUS")))+1
71 ...S ^TMP($J,FACNAME,CATEGORY,DGENR("STATUS"),PRISUB)=$G(^TMP($J,FACNAME,CATEGORY,DGENR("STATUS"),PRISUB))+1
72 ...I DGENRP("LIST"),DGENRP("STATUS","ALL")!$D(DGENRP("STATUS",STATUS)),DGENRP("PRIORITY","ALL")!$D(DGENRP("PRIORITY",+DGENR("PRIORITY"))) D
73 ....S ^TMP($J,FACNAME,"PATIENT",CATEGORY,DGENR("STATUS"),PRISUB,$E(PATNAME,1,45),+DGENR("DATE"),+DGENR("DFN"))=DGENRIEN_"^"_$G(DGINST("STANUM"))_"^"_$G(DGPFH("EFFDATE"))
74 Q
75 ;
76HEADER ;
77 ;Description: Prints the report header.
78 ;
79 N LINE
80 I $Y>1 W @IOF
81 W !,"Enrollments by Status, Priority, and Preferred Facility"
82 W ?100,"Page ",PAGE
83 S PAGE=PAGE+1
84 ;
85 W !
86 W $S(SECTION="SUMMARY":" <<< SUMMARY STATISTICS >>>",1:" <<< PATIENT LISTING >>>")
87 W ?100,"Run Date: "_$$FMTE^XLFDT(DT)
88 W !
89 I SECTION="PATIENTS",DGENRP("LIST") D
90 .W !,"Selection Criteria for Patient Listing: "
91 .W !?5,"Enrollment Statuses: "
92 .I DGENRP("STATUS","ALL") D
93 ..W "ALL"
94 .E D
95 ..N STATUS
96 ..S STATUS=""
97 ..F S STATUS=$O(DGENRP("STATUS",STATUS)) Q:'STATUS W $$EXT^DGENU("STATUS",STATUS)_","
98 .;
99 .W !?5,"Enrollment Priorities: "
100 .I DGENRP("PRIORITY","ALL") D
101 ..W "ALL"
102 .E D
103 ..N PRIORITY
104 ..S PRIORITY=""
105 ..F S PRIORITY=$O(DGENRP("PRIORITY",PRIORITY)) Q:'PRIORITY W PRIORITY_", "
106 W:(SECTION="PATIENTS") !,"Name",?39,"PatientID",?54,"DOB",?67,"Status",?86,"Priority",?101,"EnrollDate",?114,"EndDate",?129
107 S $P(LINE,"-",132)="-"
108 W !,LINE,!
109 Q
110 ;
111PAUSE ;
112 ;Description: Screen pause. Sets QUIT=1 if user decides to quit.
113 ;
114 N DIR,X,Y
115 F Q:$Y>(IOSL-3) W !
116 S DIR(0)="E"
117 D ^DIR
118 I ('(+Y))!$D(DIRUT) S QUIT=1
119 Q
120 ;
121SUMMARY ;
122 ;Description: Prints the summary statistics
123 ;
124 N PREFAC,LINE,PRIORITY,STATUS,TOTAL,COUNT,GRNDTOTL
125 S PREFAC=""
126 S GRNDTOTL=0
127 F S PREFAC=$O(^TMP($J,PREFAC)) Q:PREFAC="" D Q:QUIT
128 .D LINE(" ") Q:QUIT
129 .D LINE($$LJ(" ",40)_"PREFERRED FACILITY: "_$S(PREFAC=" ":"none",1:PREFAC)_" "_$G(^TMP($J,PREFAC))) Q:QUIT
130 .D LINE($$LJ(" ",55)_"Enr. Category") Q:QUIT
131 .S TOTAL=0
132 .S CATEGORY=""
133 .F S CATEGORY=$O(^TMP($J,PREFAC,CATEGORY)) Q:CATEGORY="" D Q:QUIT
134 ..D LINE($$LJ(" ",58)_$$EXTCAT^DGENA4(CATEGORY))
135 ..S STATUS=""
136 ..F S STATUS=$O(^TMP($J,PREFAC,CATEGORY,STATUS)) Q:'STATUS D Q:QUIT
137 ...S COUNT=$G(^TMP($J,PREFAC,CATEGORY,STATUS))
138 ...S TOTAL=TOTAL+COUNT
139 ...D LINE(" "_$$LJ($$STATUS(STATUS),18)_" "_$J(COUNT,7))
140 ...Q:QUIT
141 ...S PRIORITY=""
142 ...F S PRIORITY=$O(^TMP($J,PREFAC,CATEGORY,STATUS,PRIORITY)) Q:(PRIORITY="") D Q:QUIT
143 ....S COUNT=$G(^TMP($J,PREFAC,CATEGORY,STATUS,PRIORITY))
144 ....I $L(PRIORITY)=2 D LINE(" Priority "_+PRIORITY_$E(PRIORITY,2)_" "_$J(COUNT,7)) Q
145 ....D LINE(" "_$S(PRIORITY:"Priority "_PRIORITY_" ",1:"No Priority ")_$J(COUNT,7))
146 ...Q:QUIT
147 ...D LINE(" ")
148 ..Q:QUIT
149 .Q:QUIT
150 .S GRNDTOTL=GRNDTOTL+TOTAL
151 .D:(PREFAC=" ") LINE(" TOTAL (NO FACILITY) "_$J(TOTAL,8))
152 .D:(PREFAC'=" ") LINE(" FACILITY TOTAL "_$J(TOTAL,8))
153 .Q:QUIT
154 Q:QUIT
155 W !!
156 D LINE(" TOTAL FOR ALL SELECTED FACILITIES: "_$J(GRNDTOTL,8))
157 Q:QUIT
158 Q
159 ;
160PATIENTS ;
161 ;Description: Prints list of patients
162 ;
163 N PREFAC,DGENRIEN,DGENR,DGPAT,LINE,NODE,PATNAME,STATUS,PRIORITY,ENRDATE,DFN,CATEGORY,I
164 ;
165 S PREFAC=""
166 ;
167 F S PREFAC=$O(^TMP($J,PREFAC)) Q:PREFAC="" D Q:QUIT
168 .D LINE(" ") Q:QUIT
169 .D LINE($$LJ(" ",40)_"PREFERRED FACILITY: "_$S(PREFAC=" ":"none",1:PREFAC)_" "_$G(^TMP($J,PREFAC))) Q:QUIT
170 .S CATEGORY=""
171 .F I=1:1 S CATEGORY=$O(^TMP($J,PREFAC,"PATIENT",CATEGORY)) Q:CATEGORY="" D Q:QUIT
172 ..D:I>1 LINE(" ") Q:QUIT
173 ..D LINE($$LJ(" ",40)_"ENROLLMENT CATEGORY: "_$$EXTCAT^DGENA4(CATEGORY))
174 ..D LINE(" ") Q:QUIT
175 ..S STATUS=""
176 ..F S STATUS=$O(^TMP($J,PREFAC,"PATIENT",CATEGORY,STATUS)) Q:'STATUS D Q:QUIT
177 ...S PRIORITY=""
178 ...F S PRIORITY=$O(^TMP($J,PREFAC,"PATIENT",CATEGORY,STATUS,PRIORITY)) Q:(PRIORITY="") D Q:QUIT
179 ....S PATNAME=0
180 ....F S PATNAME=$O(^TMP($J,PREFAC,"PATIENT",CATEGORY,STATUS,PRIORITY,PATNAME)) Q:(PATNAME="") D Q:QUIT
181 .....S ENRDATE=""
182 .....F S ENRDATE=$O(^TMP($J,PREFAC,"PATIENT",CATEGORY,STATUS,PRIORITY,PATNAME,ENRDATE)) Q:ENRDATE="" D Q:QUIT
183 ......S DFN=0
184 ......F S DFN=$O(^TMP($J,PREFAC,"PATIENT",CATEGORY,STATUS,PRIORITY,PATNAME,ENRDATE,DFN)) Q:'DFN D Q:QUIT
185 .......;
186 .......S NODE=$G(^TMP($J,PREFAC,"PATIENT",CATEGORY,STATUS,PRIORITY,PATNAME,ENRDATE,DFN))
187 .......S DGENRIEN=$P(NODE,"^")
188 .......Q:'DGENRIEN
189 .......Q:'$$GET^DGENA(DGENRIEN,.DGENR)
190 .......Q:'$$GET^DGENPTA(DGENR("DFN"),.DGPAT)
191 .......S LINE=$$LJ(DGPAT("NAME"),37)_" "_$$LJ(DGPAT("PID"),15)_" "
192 .......S LINE=LINE_$$LJ($$DATE(DGPAT("DOB")),12)_" "
193 .......S LINE=LINE_$$LJ($$EXT^DGENU("STATUS",DGENR("STATUS")),17)_" "
194 .......S LINE=LINE_$$LJ(" "_DGENR("PRIORITY")_$S(DGENR("SUBGRP"):$$EXT^DGENU("SUBGRP",DGENR("SUBGRP")),1:""),15)_" "
195 .......S LINE=LINE_$$LJ($$DATE(DGENR("DATE")),12)_" "
196 .......S LINE=LINE_$$LJ($$DATE(DGENR("END")),12)_" "
197 .......D LINE(LINE)
198 .......Q:QUIT
199 .Q:QUIT
200 Q
201 ;
202STATUS(STATUS) ;
203 ;Description: Returns status name.
204 ;
205 Q:'STATUS "No Status"
206 Q $$LOWER^VALM1($$EXT^DGENU("STATUS",STATUS))
207 ;
208DATE(DATE) ;
209 Q $$FMTE^XLFDT(DATE,"1")
210 ;
211LJ(STRING,LENGTH) ;
212 Q $$LJ^XLFSTR($E(STRING,1,LENGTH),LENGTH)
Note: See TracBrowser for help on using the repository browser.