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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.3 KB
Line 
1DGFFP03 ; ALB/SCK - FUGITIVE FELON PROGRAM VISIT REPORT ; 11/14/2002
2 ;;5.3;Registration;**485**;Aug 13, 1993
3 ;
4QUE ;
5 N ZTSAVE,DGTMP,DIR,Y,DGEND,DGBEG,DIRUT,ZTRTN,ZTDESC,ZTDTH,ZTIO,%ZIS
6 ;
7 S DIR(0)="YAO",DIR("B")="YES",DIR("A")="Print report by date range? "
8 S DIR("?",1)="Enter 'YES' to print the report showing those patients for whom the"
9 S DIR("?",2)="flag was set within a specific date range."
10 S DIR("?")="Enter 'NO' to print for all dates."
11 D ^DIR K DIR
12 Q:$D(DIRUT)
13 I '+Y S (DGBEG,DGEND)=0
14 E D GETDT^DGFFP02(.DGBEG,.DGEND)
15 ;
16 W !,$CHAR(7)
17 W !?5,">> This report requires a 132-column printer"
18 S %ZIS="Q" D ^%ZIS G EXIT:POP
19 I $D(IO("Q")) D START Q
20 D RPT,^%ZISC
21 Q
22 ;
23START ;
24 S ZTDTH=$$NOW^XLFDT
25 S ZTSAVE("DGBEG")="",ZTSAVE("DGEND")=""
26 S ZTDESC="DGFFP CURRENT STATUS REPORT"
27 S ZTRTN="RPT^DGFFP03"
28 D ^%ZTLOAD
29 I $D(ZTSK)[0 W !!?5,"Report canceled"
30 E W !!?5,"Report Queued"
31EXIT D HOME^%ZIS
32 Q
33 ;
34RPT ;
35 N PAGE
36 ;
37 U IO
38 S PAGE=1
39 K ^TMP("DGFFP",$J)
40 ;
41 I +DGBEG>0 D GETLST(DGBEG,DGEND)
42 E D GETALL
43 ;
44 D PRINT(DGBEG,DGEND)
45 K ^TMP("DGFFP",$J)
46 D ^%ZISC
47 Q
48 ;
49GETALL ; Retrieve entire list of patient to print
50 N DGDFN,DFN,VAROOT,DGINP
51 ;
52 S DGDFN=0
53 F S DGDFN=$O(^DPT("AXFFP",1,DGDFN)) Q:'DGDFN D
54 . S DFN=DGDFN,VAROOT="DGINP"
55 . D INP^VADPT
56 . S ^TMP("DGFFP",$J,$S(+DGINP(1):"I",1:"O"),$$GET1^DIQ(2,DGDFN,.01),DGDFN)=""
57 . K DGINP
58 Q
59 ;
60GETLST(DGBEG,DGEND) ; Retrieve list of patients with the Fugitive Felon Flag set within specified date range
61 N DGDFN,DFN,VAROOT,DGINP,DGFFP
62 ;
63 S DGEND=$$FMADD^XLFDT(DGEND,1)
64 S DGDFN=0
65 F S DGDFN=$O(^DPT("AXFFP",1,DGDFN)) Q:'DGDFN D
66 . S DGFFP=$P($G(^DPT(DGDFN,"FFP")),U,3)
67 . I DGFFP>DGBEG&(DGFFP<DGEND) D
68 . . S DFN=DGDFN,VAROOT="DGINP"
69 . . D INP^VADPT
70 . . S ^TMP("DGFFP",$J,$S(+DGINP(1):"I",1:"O"),$$GET1^DIQ(2,DGDFN,.01),DGDFN)=""
71 . . K DGINP
72 Q
73 ;
74PRINT(DGBEG,DGEND) ; Print report
75 ;
76 D INPT(DGBEG,DGEND)
77 D OUTP(DGBEG,DGEND)
78 D SCHED(DGBEG,DGEND)
79 Q
80 ;
81INPT(DGBEG,DGEND) ;
82 N DGNAME,DFN,DGABRT,VA,DGAPT,TXT,DGSTAT
83 ;
84 D HDR(DGBEG,DGEND)
85 D INPHDR
86 ;
87 I '$D(^TMP("DGFFP",$J,"I")) W !!,"No Patients Found" Q
88 S DGNAME=""
89 F S DGNAME=$O(^TMP("DGFFP",$J,"I",DGNAME)) Q:DGNAME']"" D Q:$G(DGABRT)
90 . S DFN=0
91 . F S DFN=$O(^TMP("DGFFP",$J,"I",DGNAME,DFN)) Q:'DFN D Q:$G(DGABRT)
92 . . D PID^VADPT6
93 . . S TXT=$E(DGNAME,1,$L(DGNAME))_" ("_VA("BID")_")" W !,TXT
94 . . D PRNINP(DFN)
95 . . D PRNSCRP(DFN)
96 . . D PRNRCNT(DFN)
97 . . W !
98 . . I (($Y+5)>IOSL) D
99 . . . I $$PAUSE^DGFFP02 S DGABRT=1 Q
100 .. . D HDR(DGBEG,DGEND),INPHDR
101 Q
102 ;
103OUTP(DGBEG,DGEND) ;
104 N DGNAME,DFN,DGABRT,VA,DGAPT,TXT,DGSTAT
105 ;
106 D HDR(DGBEG,DGEND)
107 D OUTHDR
108 ;
109 I '$D(^TMP("DGFFP",$J,"O")) W !!,"No Patients Found" Q
110 S DGNAME=""
111 F S DGNAME=$O(^TMP("DGFFP",$J,"O",DGNAME)) Q:DGNAME']"" D Q:$G(DGABRT)
112 . S DFN=0
113 . F S DFN=$O(^TMP("DGFFP",$J,"O",DGNAME,DFN)) Q:'DFN D Q:$G(DGABRT)
114 . . D PID^VADPT6
115 . . S TXT=$E(DGNAME,1,$L(DGNAME))_" ("_VA("BID")_")" W !,TXT
116 . . D PRNSCRP(DFN)
117 . . D PRNRCNT(DFN)
118 . . D PRNAPT(DFN)
119 . . W !
120 . . I (($Y+5)>IOSL) D
121 . . . I $$PAUSE^DGFFP02 S DGABRT=1 Q
122 . . . D HDR(DGBEG,DGEND),INPHDR
123 Q
124 ;
125SCHED(DGBEG,DGEND) ;
126 N DGNAME,DFN,DGABRT,VA,DGAPT,TXT,DGSTAT,TMPARY
127 ;
128 D HDR(DGBEG,DGEND)
129 D FUHDR
130 ;
131 S DFN=0
132 F S DFN=$O(^DPT("AXFFP",1,DFN)) Q:'DFN D
133 . S ^TMP("DGFFP",$J,"F",$$GET1^DIQ(2,DFN,.01),DFN)=""
134 ;
135 S DGNAME=""
136 F S DGNAME=$O(^TMP("DGFFP",$J,"F",DGNAME)) Q:DGNAME']"" D Q:$G(DGABRT)
137 . S DFN=0
138 . F S DFN=$O(^TMP("DGFFP",$J,"F",DGNAME,DFN)) Q:'DFN D Q:$G(DGABRT)
139 . . S TMPARY="^TMP(""DGFFPF"",$J)" K @TMPARY
140 . . D GETFUADM(DFN,TMPARY)
141 . . Q:'$D(@TMPARY)
142 . . D PID^VADPT6
143 . . S TXT=$E(DGNAME,1,$L(DGNAME))_" ("_VA("BID")_")" W !,TXT
144 . . D PRNSCRP(DFN)
145 . . D PRNRCNT(DFN)
146 . . D PRNFUT(TMPARY)
147 . . K @TMPARY
148 Q
149 ;
150PRNFUT(TMPARY) ;
151 N DGDT,DGWARD
152 ;
153 S DGDT=0
154 F S DGDT=$O(@TMPARY@(DGDT)) Q:'DGDT D
155 . W !?40,$$FMTE^XLFDT(DGDT,"1P")
156 . S DGWARD=$P(@TMPARY@(DGDT),U,8)
157 . W ?80,$$GET1^DIQ(42,DGWARD,.01)
158 Q
159 ;
160PRNSCRP(DFN) ; Print Active Script Information
161 N DGSCRPT
162 ;
163 S DGSCRPT=$$GET1^DIQ(55,DFN,50)
164 W ?110,$S(DGSCRPT>0:DGSCRPT,1:"None")
165 Q
166 ;
167PRNINP(DFN) ; Print Inpatient Information
168 N VAROOT,DGIN
169 ;
170 S VAROOT="DGIN"
171 D IN5^VADPT
172 W ?40,$P(DGIN(2),U,2)
173 W ?55,$$FMTE^XLFDT($P(DGIN(3),U,1),"D")
174 W ?70,$P(DGIN(6),U,2)
175 W ?80,$P(DGIN(5),U,2)
176 Q
177 ;
178PRNRCNT(DFN) ; Print most recent activity
179 N DGLAST
180 ;
181 S DGLAST=$$LASTACT^DGFFPLM(DFN)
182 I DGLAST]"" D
183 . W !?3,">> "_DGLAST
184 Q
185 ;
186PRNAPT(DFN) ; Print Future Appointment information
187 N LINE,DGRTN,DGCLN,DGDT,TEMP
188 ;
189 S TEMP="^TMP(""VASD"",$J)"
190 K @TEMP
191 D GETAPT(DFN,TEMP)
192 S DGCLN=""
193 F S DGCLN=$O(@TEMP@(DGCLN)) Q:DGCLN']"" D Q:$G(RSLT)
194 . W !?40,DGCLN
195 . S DGDT=0
196 . F S DGDT=$O(@TEMP@(DGCLN,DGDT)) Q:'DGDT D Q:$G(RSLT)
197 . . W ?70,$$FMTE^XLFDT(DGDT,"1P"),!
198 K @TEMP
199 Q
200 ;
201GETAPT(DFN,TEMP) ; Sort Clinic appointments by clinic
202 N LINE,VAROOT,VASD,DGAPT
203 ;
204 D SDA^VADPT
205 S DGAPT="^UTILITY(""VASD"",$J)"
206 S LINE=0
207 F S LINE=$O(@DGAPT@(LINE)) Q:'LINE D
208 . S @TEMP@($P(@DGAPT@(LINE,"E"),U,2),$P(@DGAPT@(LINE,"I"),U,1))=$P(@DGAPT@(LINE,"E"),U,3)
209 K @DGAPT
210 Q
211 ;
212GETFUADM(DFN,TMPARY) ; Get future scheduled admissions
213 N DGIEN,DGNODE
214 ;
215 S DGIEN=0
216 F S DGIEN=$O(^DGS(41.1,"B",DFN,DGIEN)) Q:'DGIEN D
217 . S DGNODE=$G(^DGS(41.1,DGIEN,0))
218 . S @TMPARY@($P(DGNODE,U,2))=DGNODE
219 Q
220 ;
221HDR(DGBEG,DGEND) ;
222 N LINE,TXT,SPACE
223 ;
224 I $E(IOST,1,2)="C-"!($G(PAGE)>1) W @IOF
225 S TXT="Fugitive Felon Status Report"
226 S SPACE=(IOM-$L(TXT))/2
227 W !?SPACE,TXT
228 ;
229 I DGBEG>0 D
230 . S TXT="Report Date Range: "_$$FMTE^XLFDT(DGBEG)_" to "_$$FMTE^XLFDT(DGEND)
231 . S SPACE=(IOM-$L(TXT))/2
232 . W !?SPACE,TXT
233 ;
234 S TXT="Print Date: "_$$FMTE^XLFDT($$NOW^XLFDT)
235 S SPACE=(IOM-$L(TXT))/2
236 W !?SPACE,TXT
237 ;
238 S TXT="Page: "_PAGE
239 S SPACE=(IOM-$L(TXT))/2
240 W !?SPACE,TXT
241 S PAGE=PAGE+1
242 Q
243 ;
244INPHDR ;
245 N TXT,LINE,SPACE
246 ;
247 S TXT="Inpatient Listing"
248 S SPACE=(IOM-$L(TXT))/2
249 W !?SPACE,TXT
250 ;
251 W !!,"Patient Name",?40,"Movement",?55,"Date",?70,"Room/Bed",?80,"Ward",?110,"Active Scripts?"
252 S $P(LINE,"=",IOM)="" W !,LINE
253 Q
254 ;
255OUTHDR ;
256 N TXT,LINE,SPACE
257 ;
258 S TXT="Outpatient Listing"
259 S SPACE=(IOM-$L(TXT))/2
260 W !?SPACE,TXT
261 ;
262 W !!,"Patient Name",?40,"Clinic",?70,"Appt. D/T",?110,"Active Scripts?"
263 S $P(LINE,"=",IOM)="" W !,LINE
264 Q
265 ;
266FUHDR ;
267 N TXT,LINE,SPACE
268 ;
269 S TXT="Future Scheduled Admissions"
270 S SPACE=(IOM-$L(TXT))/2
271 W !?SPACE,TXT
272 ;
273 W !!,"Patient Name",?40,"Scheduled Admission",?80,"Ward",?110,"Active Scripts?"
274 S $P(LINE,"=",IOM)="" W !,LINE
275 Q
Note: See TracBrowser for help on using the repository browser.