source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPW63.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 9.3 KB
Line 
1SCRPW63 ;BP-CIOFO/KEITH - SC veterans awaiting appointments (cont.) ; 23 August 2002@20:23
2 ;;5.3;Scheduling;**267,269,357**;AUG 13, 1993
3 ;
4E ;Gather data for patients entered report
5 N DFN,SDX,SDATE,SD0,SDSCEL,SDEL,SDYR,SDREL,SDTOT,SDSDT,SDLVDT,SDEDT
6 N SDNAME
7 D SCEL^SCRPW62(.SDSCEL,SDSCVT) ;Get eligibility code pointers
8 S (SDSDT,SDATE)=DT-(10000*SDATES),SDSTOP=0
9 ;Find the patients entered after date specified
10 S DFN=0 F Q:SDSTOP S DFN=$O(^DPT(DFN)) Q:'DFN D
11 .Q:$D(^DPT(DFN,-9)) ;Skip merged records
12 .I DFN#1000=0 D STOP Q:SDSTOP ;Check for stop task request
13 .S SDLVDT=""
14 .S SD0=$G(^DPT(DFN,0)) Q:'$L(SD0)
15 .S SDEDT=$P(SD0,U,16) S:SDEDT SDLVDT=SDEDT
16 .I SDEDT,SDEDT<SDATE Q ;Date entered < start date
17 .I 'SDEDT,SDLVDT<SDATE Q ;No date entered, last valid date < start
18 .S SDEL=+$G(^DPT(DFN,.36)) Q:'$D(SDSCEL(SDEL)) ;Only SC vets
19 .Q:+$G(^DPT(DFN,.35)) ;No deceased patients
20 .Q:$$SCHAPP(DFN) ;Appointments not cancelled by clinic?
21 .S SDYR=$$FMDIFF^XLFDT(DT,$S(SDEDT:SDEDT,1:SDLVDT))\365.25 ;Year entered
22 .S SDEL=SDSCEL(SDEL) D Q:SDFMT="S"
23 ..;Record statistics
24 ..S ^TMP("SCRPW",$J,"STATS",SDYR,SDEL)=$G(^TMP("SCRPW",$J,"STATS",SDYR,SDEL))+1
25 ..Q
26 .S SDNAME=$P(SD0,U) Q:'$L(SDNAME)
27 .S ^TMP("SCRPW",$J,SDEL,SDNAME,DFN)=SD0
28 .Q
29 Q:SDSTOP
30 D:$E(IOST,1,2)="C-" DISP0^SCRPW23
31 I '$D(^TMP("SCRPW",$J)) D Q ;Negative report
32 .D HDR^SCRPW62 S SDX="No patients found within report parameters!"
33 .W !!?(132-$L(SDX)\2),SDX
34 .I $E(IOST)="C",'SDOUT N DIR S DIR(0)="E" D ^DIR
35 .Q
36 ;Detailed report
37 I SDFMT="D" D HDR^SCRPW62 S SDEL=0 F S SDEL=$O(^TMP("SCRPW",$J,SDEL)) Q:'SDEL!SDOUT D
38 .S SDNAME="" F S SDNAME=$O(^TMP("SCRPW",$J,SDEL,SDNAME)) Q:SDNAME=""!SDOUT S DFN=0 D
39 ..F S DFN=$O(^TMP("SCRPW",$J,SDEL,SDNAME,DFN)) Q:'DFN!SDOUT D
40 ...S SDREL=$S(SDEL=1:0,1:+$P($G(^DPT(DFN,.372,0)),U,4))
41 ...D:$Y>(IOSL-(4+SDREL)) HDR^SCRPW62 Q:SDOUT
42 ...S SDX=^TMP("SCRPW",$J,SDEL,SDNAME,DFN) D PLINE(DFN,SDX,SDEL)
43 ...Q
44 .Q
45 Q:SDOUT
46ESUM ;Print summary
47 G:SDELIM EQ
48 S SDT(3)="STATISTICAL SUMMARY" D HDR^SCRPW62 Q:SDOUT
49 W !! S SDYR="",SDTOT=0
50 F S SDYR=$O(^TMP("SCRPW",$J,"STATS",SDYR)) Q:SDYR="" D
51 .S SDEL=0 F S SDEL=$O(^TMP("SCRPW",$J,"STATS",SDYR,SDEL)) Q:'SDEL D
52 ..S SDX=$$CSCEL(SDEL)_" veterans entered "_$S(SDYR=0:"in the past year",SDYR=1:"two years ago",SDYR=2:"three years ago",1:"")_":"
53 ..W !?36,$J(SDX,45),?83,$J(^TMP("SCRPW",$J,"STATS",SDYR,SDEL),6,0)
54 ..S SDTOT=SDTOT+^TMP("SCRPW",$J,"STATS",SDYR,SDEL)
55 ..Q
56 .Q
57 W !?36,$E(SDLINE,1,53),!?75,"TOTAL:",?83,$J(SDTOT,6,0)
58EQ I $E(IOST,1,2)="C-" N DIR S DIR(0)="E" W !! D ^DIR
59 Q
60 ;
61SCHAPP(DFN) ;Look for scheduled appointments not cancelled by clinic
62 ; Input: DFN=patient ifn
63 ;Output: '1' if appointments exist, '0' otherwise
64 N SDI,SDX,SDY
65 S (SDI,SDY)=0
66 F S SDI=$O(^DPT(DFN,"S",SDI)) Q:'SDI!SDY D
67 .S SDX=$G(^DPT(DFN,"S",SDI,0)) Q:'$L(SDX)
68 .S SDX=$P(SDX,U,2) I $L(SDX),"CA"[SDX Q
69 .S SDY=1
70 .Q
71 Q SDY
72 ;
73A ;Gather data for future appointments report
74 N DFN,SDA0,SDX,SDI,SDSCEL,SDEL,SDDATE,SDIFF,SDAPT,SDIVL,SDIVN
75 N SDREL,SDTOT,SDIV,SD0,SDNAME
76 D SCEL^SCRPW62(.SDSCEL,SDSCVT) ;Get eligibility code pointers
77 S DFN=0 F S DFN=$O(^DPT(DFN)) Q:'DFN!SDSTOP D
78 .I DFN#1000=0 D STOP Q:SDSTOP ;Check for stop task request
79 .S SDEL=+$G(^DPT(DFN,.36)) Q:'$D(SDSCEL(SDEL)) ;Only SC vets
80 .S SDEL=SDSCEL(SDEL)
81 .Q:+$G(^DPT(DFN,.35)) ;No deceased patients
82 .S SDI=DT F S SDI=$O(^DPT(DFN,"S",SDI)) Q:'SDI D
83 ..S SDDATE=+$G(^DPT(DFN,"S",SDI,1)) Q:'SDDATE Q:SDDATE>SDI
84 ..S SDA0=$G(^DPT(DFN,"S",SDI,0)) Q:'$L(SDA0)
85 ..S SDIV=$P($G(^SC(+SDA0,0)),U,15) Q:'$$DIV(.SDIV) ;Division check
86 ..;Exclude cancelled appointments
87 ..S SDX=$P(SDA0,U,2) I $L(SDX),"PCA"[SDX Q
88 ..S SDIFF=$$FMDIFF^XLFDT(SDI,SDDATE) Q:SDIFF'>SDATES
89 ..S SDNAME=$P($G(^DPT(DFN,0)),U) Q:'$L(SDNAME)
90 ..;Record detailed information
91 ..S ^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN,SDI)=SDDATE_U_SDA0
92 ..S ^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN)=$G(^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN))+1
93 ..Q
94 .Q
95 Q:SDSTOP
96 ;Tally up statistics
97 S SDIV=0 F S SDIV=$O(^TMP("SCRPW",$J,SDIV)) Q:'SDIV D
98 .S SDEL=0 F S SDEL=$O(^TMP("SCRPW",$J,SDIV,SDEL)) Q:'SDEL D
99 ..S SDNAME="" F S SDNAME=$O(^TMP("SCRPW",$J,SDIV,SDEL,SDNAME)) Q:SDNAME=""!SDOUT D
100 ...S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN)) Q:'DFN D
101 ....S ^TMP("SCRPW",$J,"STATS",SDIV,SDEL,"PTS")=$G(^TMP("SCRPW",$J,"STATS",SDIV,SDEL,"PTS"))+1
102 ....S SDI=0 F S SDI=$O(^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN,SDI)) Q:'SDI D
103 .....S ^TMP("SCRPW",$J,"STATS",SDIV,SDEL,"APPTS")=$G(^TMP("SCRPW",$J,"STATS",SDIV,SDEL,"APPTS"))+1
104 .....Q
105 ....Q
106 ...Q
107 ..Q
108 .Q
109 Q:SDSTOP
110 ;Print report
111 S SDIV="" F S SDIV=$O(SDDIV(SDIV)) Q:'SDIV S SDIV(SDDIV(SDIV))=SDIV
112 I 'SDDIV,$P(SDDIV,U,2)'="ALL DIVISIONS" D
113 .S SDIV($P(SDDIV,U,2))=$$PRIM^VASITE()
114 .Q
115 I $P(SDDIV,U,2)="ALL DIVISIONS" S SDI=0 D
116 .F S SDI=$O(^TMP("SCRPW",$J,SDI)) Q:'SDI D
117 ..S SDX=$P($G(^DG(40.8,SDI,0)),U) S:$L(SDX) SDIV(SDX)=SDI
118 ..Q
119 .Q
120 D:$E(IOST)="C" DISP0^SCRPW23
121 I '$D(^TMP("SCRPW",$J)) D Q ;Negative report
122 .S SDIV=0 D DHDR^SCRPW40(3,.SDT),HDR^SCRPW62
123 .S SDX="No appointments found that meet report criteria."
124 .I SDELIM W !,SDX Q
125 .W !!?(IOM-$L(SDX)\2),SDX
126 .I $E(IOST)="C",'SDOUT N DIR S DIR(0)="E" D ^DIR
127 .Q
128 G:SDFMT="S" ASUM
129 ;Print detailed report by division
130 S SDIVN="" F S SDIVN=$O(SDIV(SDIVN)) Q:SDIVN=""!SDOUT D
131 .S SDIV=SDIV(SDIVN) D ADPRT(.SDIV)
132 .Q
133 Q:SDOUT
134 ;Print summary
135ASUM G:SDELIM AQ
136 S SDT(3)="STATISTICAL SUMMARY" D HDR^SCRPW62 Q:SDOUT
137 W !! S (SDTOT,SDIV,SDIVL)=0,SDIVN=""
138 F S SDIVN=$O(SDIV(SDIVN)) Q:SDIVN="" D
139 .S SDIVN(SDIV(SDIVN))=SDIVN S:$L(SDIVN)>SDIVL SDIVL=$L(SDIVN)
140 F S SDIV=$O(^TMP("SCRPW",$J,"STATS",SDIV)) Q:'SDIV D
141 .S SDEL=0 F S SDEL=$O(^TMP("SCRPW",$J,"STATS",SDIV,SDEL)) Q:'SDEL D
142 ..S SDAPT=^TMP("SCRPW",$J,"STATS",SDIV,SDEL,"APPTS"),SDTOT=SDTOT+SDAPT
143 ..S SDX=$$CSCEL(SDEL)_" appointments at "_SDIVN(SDIV)_":"
144 ..W !?(50-SDIVL),$J(SDX,(28+SDIVL)),?80,$J(SDAPT,6,0)
145 ..Q
146 .Q
147 W !?(50-SDIVL),$E(SDLINE,1,(36+SDIVL)),!?72,"TOTAL:",?80,$J(SDTOT,6,0)
148AQ I $E(IOST)="C",'SDOUT N DIR S DIR(0)="E" D ^DIR
149 Q
150 ;
151DIV(SDIV) ;Check division
152 S:'$L(SDIV) SDIV=$$PRIM^VASITE()
153 Q:'SDDIV 1 Q $D(SDDIV(+SDIV))
154 ;
155 ;
156STOP ;Check for stop task request
157 S:$G(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
158 ;
159ADPRT(SDIV) ;Print report for a division
160 D DHDR^SCRPW40(3,.SDT) S:SDELIM SDPAGE=1
161 I '$D(^TMP("SCRPW",$J,SDIV)) D HDR^SCRPW62 Q:SDOUT D Q
162 .S SDX="No appointments found for this division within report parameters!"
163 .I SDELIM W !,SDX Q
164 .W !!?(132-$L(SDX)\2),SDX Q
165 D HDR^SCRPW62 Q:SDOUT
166 S SDEL="" F S SDEL=$O(^TMP("SCRPW",$J,SDIV,SDEL)) Q:'SDEL!SDOUT D
167 .S SDNAME="" F S SDNAME=$O(^TMP("SCRPW",$J,SDIV,SDEL,SDNAME)) Q:SDNAME=""!SDOUT D
168 ..S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN)) Q:'DFN!SDOUT D
169 ...S SD0=$G(^DPT(DFN,0)) Q:'$L(SD0)
170 ...S SDREL=$S(SDEL=1:0,1:+$P($G(^DPT(DFN,.372,0)),U,4))
171 ...S SDREL=SDREL+^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN)
172 ...D:$Y>(IOSL-(4+SDREL)) HDR^SCRPW62 Q:SDOUT
173 ...D PLINE(DFN,SD0,SDEL)
174 ...Q
175 ..Q
176 .Q
177 Q
178 ;
179PLINE(DFN,SD0,SDEL) ;Print patient detail line
180 ;Input: DFN=patient ifn
181 ; SD0=zeroeth node of patient record
182 ; SDEL=1 or 3 to denote SC > or < 50%
183 ;
184 N SDSSN,SDNAME,SDDTE,SDADD,SDST,SDX,SDI,SDY,SDELN,SDZIP,SDZ,SDZA,SDII
185 S SDNAME=$P(SD0,U),SDSSN=$P(SD0,U,9),SDDTE=$$FMTE^XLFDT($P(SD0,U,16))
186 S SDSSN=$E(SDSSN,1,3)_"-"_$E(SDSSN,4,5)_"-"_$E(SDSSN,6,10)
187 S SDEL=$G(SDEL),SDELN=$$CSCEL(SDEL),SDADD=$G(^DPT(DFN,.11))
188 S SDST=$P($G(^DIC(5,+$P(SDADD,U,5),0)),U,2),SDZIP=$P(SDADD,U,12)
189 S:$L(SDZIP)=9 SDZIP=$E(SDZIP,1,5)_"-"_$E(SDZIP,6,9)
190 I SDELIM D ;Set up delimited output
191 .S SDZ=SDNAME_U_SDSSN_U_SDELN_U_SDDTE_U_$P(SDADD,U)_U_$P(SDADD,U,4)
192 .S SDZ=SDZ_U_SDST_U_SDZIP_U_$P($G(^DPT(DFN,.13)),U)
193 .Q
194 I 'SDELIM D
195 .;Print name, SSN, eligibility, date entered, address and phone number
196 .W !,"Name: ",SDNAME,?39,"SSN: ",SDSSN,?58,"Prim. Elig.: ",SDELN
197 .W ?84,"Date entered: ",SDDTE,!?10,"Address: ",$P(SDADD,U)
198 .W ?55,$P(SDADD,U,4),$S($L($P(SDADD,U,4)):", ",1:""),SDST," ",SDZIP
199 .W ?88,"Phone number: ",$P($G(^DPT(DFN,.13)),U)
200 .;Print SC disabilities for 0-50% SC veterans
201 .I SDEL=3 S SDI=0 F S SDI=$O(^DPT(DFN,.372,SDI)) Q:'SDI D
202 ..S SDX=$G(^DPT(DFN,.372,SDI,0)) Q:'$P(SDX,U,3)
203 ..S SDY=$G(^DIC(31,+SDX,0)) Q:'$L(SDY)
204 ..W !?20,"SC disability: ",$P(SDY,U,3)," ",$P(SDY,U)
205 ..W ?89,"%SC: ",$P(SDX,U,2)
206 ..Q
207 .Q
208 I SDRPT="E" D Q
209 .I SDELIM W !,SDZ Q
210 .W !
211 .Q
212 ;Print appointment details for future appointment report
213 S SDI=0 D
214 .F S SDI=$O(^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN,SDI)) Q:'SDI D
215 ..S SDA0=^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN,SDI)
216 ..I 'SDELIM D
217 ...W !?30,"Appointment: ",$$FMTE^XLFDT(SDI)
218 ...W ?63,$P($G(^SC(+$P(SDA0,U,2),0)),U),?96,"Desired date: "
219 ...W $$FMTE^XLFDT(+SDA0),?124,"(",$$FMDIFF^XLFDT(SDI,+SDA0),")"
220 ...Q
221 ..I SDELIM D ;Delimited output
222 ...N SDC0,SDCP,SDCZ,SDADM,SDADME
223 ...S SDC0=$G(^SC(+$P(SDA0,U,2),0)),SDCZ=$$CPAIR^SCRPW71(SDC0,.SDCP)
224 ...S SDII=0,(SDZA,SDADM,SDADME)=""
225 ...F S SDII=$O(^SC(+$P(SDA0,U,2),"S",SDI,1,SDII)) D Q:'SDII
226 ....Q:+$G(^SC(+$P(SDA0,U,2),"S",SDI,1,+SDII,0))'=DFN
227 ....S SDADM=$P(^SC(+$P(SDA0,U,2),"S",SDI,1,+SDII,0),U,7)
228 ....S SDADME=$$FMTE^XLFDT(SDADM),SDII=0
229 ....Q
230 ...S SDCZ=SDCP_U_$P($$SITE^VASITE(,$P(SDC0,U,15)),U,2)_U_SDADME
231 ...S SDZA=SDZA_U_$$FMTE^XLFDT(SDI)_U_$P(SDC0,U)_U_SDCZ
232 ...S SDZA=SDZA_U_$$FMTE^XLFDT(+SDA0)_U_$$FMDIFF^XLFDT(SDI,+SDA0)
233 ...S SDZA=SDZA_U_$S(SDADM:$$FMDIFF^XLFDT(+SDA0,SDADM),1:"")
234 ...W !,SDZ,SDZA
235 ...Q
236 ..Q
237 .Q
238 W:'SDELIM ! Q
239 ;
240CSCEL(SDEL) ;Convert SC elig. to external
241 Q $S(SDEL=1:"SC 50-100%",SDEL=3:"SC < 50%",1:"")
Note: See TracBrowser for help on using the repository browser.