source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPW75.m@ 629

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

initial load of FOIAVistA 6/30/08 version
File size: 9.2 KB
Line 
1SCRPW75 ;BP-CIOFO/KEITH,ESW - Clinic Appointment Availability Extract (cont.) ; 5/15/03 3:15pm
2 ;;5.3;Scheduling;**206,223,241,249,291**;AUG 13, 1993
3 ;
4NAVA(SDBDT,SDEDT,SDEX) ;Gather next available appointment wait time information
5 ;Input: SDBDT=beginning date
6 ;Input: SDEDT=ending date
7 ;Input: SDEX='0' for user report, '1' for Austin extract
8 ;Output: ^TMP("SDNAVA",$J) array in the format:
9 ; ^TMP("SDNAVA",$J,division)='x'
10 ; ^TMP("SDNAVA",$J,division,credit_pair)='x'
11 ; ^TMP("SDNAVA",$J,division,credit_pair,clinic_ifn)='x'
12 ; ^TMP("SDNAVA",$J,division;credit_pair,clinic_ifn,date_scheduled)='x'
13 ; where 'x' consists of:
14 ; piece 1 = flag '0' appts.
15 ; 2 = ave. flag '0' wait time
16 ; 3 = flag '1' appts.
17 ; 4 = ave. flag '1' wait time
18 ; 5 = flag '2' appts.
19 ; 6 = ave. flag '2' wait time
20 ; 7 = flag '3' appts.
21 ; 8 = ave. flag '3' wait time
22 ; 9 = follow-up next ava. appts.
23 ; 10 = follow-up next ava. wait time
24 ; 11 = follow-up non-next ava. appts. <2 days
25 ; 12 = follow-up non-next ava. appts. <2 days wait time*
26 ; 13 = follow-up non-next ava. appts. 2-7 days
27 ; 14 = follow-up non-next ava. appts. 2-7 days wait time*
28 ; 15 = follow-up non-next ava. appts. 8-30 days
29 ; 16 = follow-up non-next ava. appts. 8-30 days wait time*
30 ; 17 = follow-up non-next ava. appts. 31-60 days
31 ; 18 = follow-up non-next ava. appts. 31-60 days wait time*
32 ; 19 = follow-up non-next ava. appts. >60 days
33 ; 20 = follow-up non-next ava. appts. >60 days wait time*
34 ; 21 = non-follow-up next ava. appts.
35 ; 22 = non-follow-up next ava. wait time
36 ; 23 = non-follow-up non-next ava. appts. <2 days
37 ; 24 = non-follow-up non-next ava. appts. <2 days wait time*
38 ; 25 = non-follow-up non-next ava. appts. <2 days wait time**
39 ; 26 = non-follow-up non-next ava. appts. 2-7 days
40 ; 27 = non-follow-up non-next ava. appts. 2-7 days wait time*
41 ; 28 = non-follow-up non-next ava. appts. 2-7 days wait time**
42 ; 29 = non-follow-up non-next ava. appts. 8-30 days
43 ; 30 = non-follow-up non-next ava. appts. 8-30 days wait time*
44 ; 31 = non-follow-up non-next ava. appts. 8-30 days wait time**
45 ; 32 = non-follow-up non-next ava. appts. 31-60 days
46 ; 33 = non-follow-up non-next ava. appts. 31-60 days wait time*
47 ; 34 = non-follow-up non-next ava. appts. 31-60 days wait time**
48 ; 35 = non-follow-up non-next ava. appts. >60 days
49 ; 36 = non-follow-up non-next ava. appts. >60 days wait time*
50 ; 37 = non-follow-up non-next ava. appts. >60 days wait time**
51 ; 38 = percent of non-next ava. appts. within 30 days
52 ; 39 = percent of next ava. appts. within 30 days
53 ;
54 ; ^TMP("SDNAVB",$J) array in the format:
55 ; ^TMP("SDNAVB",$J,division,credit_pair,clinic_ifn)='y'
56 ; where 'y' consists of:
57 ; piece 1 = % non-follow-up next ava. appts. within 30 days*
58 ; 2 = % non-follow-up next ava. appts. within 30 days**
59 ; 3 = % non-follow-up non-next ava. appts. within 30 days*
60 ; 4 = % non-follow-up non-next ava. appts. within 30 days**
61 ; 5 = sum of squared wait time next ava. appts.**
62 ; 6 = sum of squared wait time non-follow-up appts.*
63 ; 7 = sum of squared wait time non-follow-up appts.**
64 ; 8 = total non-follow-up appointments
65 ;
66 ; * desired date to appointment date
67 ; ** transaction date to appointment date
68 ;
69 N SDT,SDCT,DFN,SDADT,SDAP,SDAP0,SDWAIT,SDSFU,SDCWT3,SDAVE
70 N SDCL,SDFLAG,SDX,SDY,SDZ,SDI,SC0,SDCP,SDSDEV,SDSDDT,SDAVE2
71 S SDT=SDBDT-1,(SDOUT,SDCT)=0
72 K ^TMP("SDWNAVA",$J),^TMP("SDXNAVA",$J),^TMP("SDYNAVA",$J),^TMP("SDZNAVA",$J),^TMP("SDNAVA",$J),^TMP("SDNAVB",$J)
73 ;Iterate through 'date scheduled' xref
74 F S SDT=$O(^DPT("ASADM",SDT)) Q:SDOUT!'SDT!(SDT>SDEDT) S DFN=0 D
75 .F S DFN=$O(^DPT("ASADM",SDT,DFN)) Q:SDOUT!'DFN S SDADT=0 D
76 ..I $G(SDREPORT(5))=1 I '$D(^TMP("SDIPLST",$J,DFN)) Q ;only selected patient if (5)
77 ..Q:$E($P($G(^DPT(DFN,0)),U,9),1,5)="00000" ;exclude test patients
78 ..F S SDADT=$O(^DPT("ASADM",SDT,DFN,SDADT)) Q:SDOUT!'SDADT D
79 ...;Check for 'stop task' request
80 ...S SDCT=SDCT+1 I SDCT#1000=0 D STOP Q:SDOUT
81 ...;Get appointment node
82 ...S SDAP0=$G(^DPT(DFN,"S",SDADT,0)) Q:$P(SDAP0,U,19)'=SDT
83 ...I '$G(SDREPORT(5)) Q:$P(SDAP0,U,2)="C"!($P(SDAP0,U,2)="CA") ;quit if cancelled by clinic
84 ...S SDCL=+SDAP0 Q:SDCL<1 ;get clinic
85 ...;'next ava.' appointment indicator
86 ...S SDFLAG=+$P(SDAP0,U,26)
87 ...;'date desired' and 'follow up visit' indicator
88 ...S SDX=$G(^DPT(DFN,"S",SDADT,1))
89 ...S SDSDDT=+$P(SDX,U),SDSFU=$P(SDX,U,2),SDSDEV=""
90 ...;Calculate wait time 1 (transaction date to appointment)
91 ...S SDWAIT=$S(SDADT<SDT:0,1:$$FMDIFF^XLFDT(SDADT,SDT,1))
92 ...;Calculate wait time 2 (date desired to appointment)
93 ...S SDCWT3=$$CWT3(SDADT,SDFLAG,SDSDDT,SDSFU,.SDSDEV,.SDX,.SDY,.SDZ)
94 ...;Gather patient appointment list information
95 ...I $G(SDREPORT(4)),$D(^TMP("SDPLIST",$J,SDCL)) D
96 ....N SDPNAME,SDATA,SDSSN
97 ....S SDATA=$G(^DPT(DFN,0))
98 ....S SDSSN=$P(SDATA,U,9),SDPNAME=$P(SDATA,U) Q:'$L(SDPNAME)
99 ....S SDATA=SDSSN_U_$P(SDAP0,U,25)_U_SDFLAG_U_SDSDDT_U_SDSFU_U_SDWAIT_U_SDSDEV
100 ....S ^TMP("SDPLIST",$J,SDCL,SDT,SDPNAME,DFN,SDADT)=SDATA
101 ....Q
102 ...I $G(SDREPORT(5)) I $D(^TMP("SDIPLST",$J,DFN,SDCL)) D GEN5A^SCRPW78(SDAP0,DFN,SDADT,SDCL,SDWAIT,SDT,SDSFU,SDSDEV,SDSDDT,SDFLAG)
103 ...;Accrue phase II values ('next ava.' appts.)
104 ...S $P(^TMP("SDXNAVA",$J,SDCL),U,((SDFLAG*2)+1))=$P($G(^TMP("SDXNAVA",$J,SDCL)),U,((SDFLAG*2)+1))+1
105 ...S $P(^TMP("SDXNAVA",$J,SDCL),U,((SDFLAG*2)+2))=$P(^TMP("SDXNAVA",$J,SDCL),U,((SDFLAG*2)+2))+SDWAIT
106 ...I SDWAIT<31 S $P(^TMP("SDXNAVA",$J,SDCL),U,9+(SDFLAG#2))=$P(^TMP("SDXNAVA",$J,SDCL),U,9+(SDFLAG#2))+1
107 ...;Accrue sum of squared wait time for standard deviation
108 ...I SDFLAG#2 S $P(^TMP("SDWNAVA",$J,SDCL),U,5)=$P($G(^TMP("SDWNAVA",$J,SDCL)),U,5)+(SDWAIT*SDWAIT)
109 ...;Accrue phase III values ('date desired' deviation)
110 ...I SDCWT3 D
111 ....S $P(^TMP("SDYNAVA",$J,SDCL),U,SDX)=$P($G(^TMP("SDYNAVA",$J,SDCL)),U,SDX)+1
112 ....S $P(^TMP("SDYNAVA",$J,SDCL),U,SDY)=$P(^TMP("SDYNAVA",$J,SDCL),U,SDY)+SDSDEV
113 ....S:SDZ $P(^TMP("SDYNAVA",$J,SDCL),U,SDZ)=$P(^TMP("SDYNAVA",$J,SDCL),U,SDZ)+SDWAIT
114 ....;Gather additional information for non-follow-up appointments
115 ....I 'SDSFU D
116 .....;Accrue next ava. and non-next ava. appts. less than 31 days
117 .....N SDP S SDP=$S(SDFLAG#2:1,1:3)
118 .....I SDSDEV<31 S $P(^TMP("SDWNAVA",$J,SDCL),U,SDP)=$P($G(^TMP("SDWNAVA",$J,SDCL)),U,SDP)+1
119 .....I SDWAIT<31 S $P(^TMP("SDWNAVA",$J,SDCL),U,SDP+1)=$P($G(^TMP("SDWNAVA",$J,SDCL)),U,SDP+1)+1
120 .....;Accrue sum of squared wait time for standard deviation
121 .....S $P(^TMP("SDWNAVA",$J,SDCL),U,6)=$P($G(^TMP("SDWNAVA",$J,SDCL)),U,6)+(SDSDEV*SDSDEV)
122 .....S $P(^TMP("SDWNAVA",$J,SDCL),U,7)=$P(^TMP("SDWNAVA",$J,SDCL),U,7)+(SDWAIT*SDWAIT)
123 .....;Total of non-follow-up appointments
124 .....S $P(^TMP("SDWNAVA",$J,SDCL),U,8)=$P(^TMP("SDWNAVA",$J,SDCL),U,8)+1
125 .....Q
126 ....Q
127 ...;Accrue values for daily detail
128 ...Q:SDEX=1!(SDFMT'="D")
129 ...S $P(^TMP("SDXNAVA",$J,SDCL,SDT),U,((SDFLAG*2)+1))=$P($G(^TMP("SDXNAVA",$J,SDCL,SDT)),U,((SDFLAG*2)+1))+1
130 ...S $P(^TMP("SDXNAVA",$J,SDCL,SDT),U,((SDFLAG*2)+2))=$P(^TMP("SDXNAVA",$J,SDCL,SDT),U,((SDFLAG*2)+2))+SDWAIT
131 ...I SDWAIT<31 S $P(^TMP("SDXNAVA",$J,SDCL,SDT),U,9+(SDFLAG#2))=$P($G(^TMP("SDXNAVA",$J,SDCL,SDT)),U,9+(SDFLAG#2))+1
132 ...I SDCWT3 D
133 ....S $P(^TMP("SDYNAVA",$J,SDCL,SDT),U,SDX)=$P($G(^TMP("SDYNAVA",$J,SDCL,SDT)),U,SDX)+1
134 ....S $P(^TMP("SDYNAVA",$J,SDCL,SDT),U,SDY)=$P(^TMP("SDYNAVA",$J,SDCL,SDT),U,SDY)+SDSDEV
135 ....S:SDZ $P(^TMP("SDYNAVA",$J,SDCL,SDT),U,SDZ)=$P(^TMP("SDYNAVA",$J,SDCL,SDT),U,SDZ)+SDWAIT
136 ...Q
137 ..Q
138 .Q
139 Q:SDOUT S SDCL=0
140 D ACCRUE^SCRPW77
141 Q
142 ;
143STOP ;Check for stop task request
144 S:$D(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
145 ;
146CWT3(SDADT,SDFLAG,SDSDDT,SDSFU,SDSDEV,SDX,SDY,SDZ) ;Get phase III data
147 ;Input: SDADT=appointment date
148 ;Input: SDFLAG='next ava.' appointment indicator
149 ;Input: SDSDDT=desired date
150 ;Input: SDSFU=follow up indicator
151 ;Input: SDSDEV=deviation from desired date (pass by reference)
152 ;Input: SDX, SDY, SDZ=string locations to update (pass by reference)
153 ;Output: '1' if phase III data exists, '0' otherwise
154 ;
155 N SDDCAT
156 I '$L(SDSDDT)!'$L(SDSFU) Q 0 ;no phase III data
157 S SDSDEV=$S(SDADT<SDSDDT:0,1:$$FMDIFF^XLFDT(SDADT,SDSDDT,1)) ;wait time
158 S SDDCAT=$$DCAT(SDSDEV) ;date range category
159 ;follow-up next ava. appts.
160 I SDSFU,SDFLAG#2 S SDX=1,SDY=2,SDZ=0 Q 1
161 ;follow-up non-next ava. appts.
162 I SDSFU,'(SDFLAG#2) S SDX=SDDCAT*2+1,SDY=SDX+1,SDZ=0 Q 1
163 ;non-follow-up next ava. appts.
164 I 'SDSFU,SDFLAG#2 S SDX=13,SDY=14,SDZ=0 Q 1
165 ;non-follow-up non-next ava. appts.
166 I 'SDSFU,'(SDFLAG#2) S SDX=SDDCAT+4*3,SDY=SDX+1,SDZ=SDX+2
167 Q 1
168 ;
169DCAT(SDSDEV) ;Determine date range category
170 ;Input: SDSDEV=wait time
171 ;Output: category where '1' = <2 days
172 ; '2' = 2-7 days
173 ; '3' = 8-30 days
174 ; '4' = 31-60 days
175 ; '5' = >60 days
176 ;
177 Q:SDSDEV<2 1
178 Q:SDSDEV<8 2
179 Q:SDSDEV<31 3
180 Q:SDSDEV<61 4
181 Q 5
Note: See TracBrowser for help on using the repository browser.