source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPW77.m@ 1423

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

initial load of FOIAVistA 6/30/08 version

File size: 9.5 KB
Line 
1SCRPW77 ;BP-CIOFO/KEITH,ESW - Clinic Appointment Availability Extract (cont.) ; 5/28/03 4:49pm
2 ;;5.3;Scheduling;**223,241,291**;AUG 13, 1993
3 ;
4ACCRUE ;Accrue counts and averages to division and division/credit pair totals
5 F S SDCL=$O(^TMP("SDXNAVA",$J,SDCL)) Q:'SDCL D
6 .S SC0=$G(^SC(SDCL,0)) Q:'$L(SC0) Q:'$$CPAIR^SCRPW71(SC0,.SDCP)
7 .S SDIV=$$DIV^SCRPW71(SC0) Q:'$L(SDIV)
8 .Q:'$D(^TMP("SD",$J,SDIV,SDCP,SDCL))
9 .S:'$D(^TMP("SDNAVA",$J,SDIV,SDCP)) ^TMP("SDNAVA",$J,SDIV,SDCP)=""
10 .I SDMD S:'$D(^TMP("SDNAVA",$J,0,SDCP)) ^TMP("SDNAVA",$J,0,SDCP)=""
11 .S SDX=$P(^TMP("SDXNAVA",$J,SDCL),U,1,8)
12 .S $P(SDX,U,9)=$G(^TMP("SDYNAVA",$J,SDCL))
13 .S $P(SDX,U,38)=$P(^TMP("SDXNAVA",$J,SDCL),U,9,10)
14 .S SDAVE=$$AVE(SDX),^TMP("SDNAVA",$J,SDIV,SDCP,SDCL)=SDAVE
15 .S:$$AVE2(SDCL,.SDAVE2) ^TMP("SDNAVB",$J,SDIV,SDCP,SDCL)=SDAVE2
16 .I SDMD S ^TMP("SDNAVA",$J,0,SDCP,SDCL)=SDAVE
17 .F SDI=1:1:18 S $P(^TMP("SDNAVA",$J,SDIV),U,SDI)=$P($G(^TMP("SDNAVA",$J,SDIV)),U,SDI)+$P(SDX,U,SDI)
18 .F SDI=19:1:39 S $P(^TMP("SDZNAVA",$J,SDIV),U,SDI)=$P($G(^TMP("SDZNAVA",$J,SDIV)),U,SDI)+$P(SDX,U,SDI)
19 .I SDMD D
20 ..F SDI=1:1:18 S $P(^TMP("SDNAVA",$J,0),U,SDI)=$P($G(^TMP("SDNAVA",$J,0)),U,SDI)+$P(SDX,U,SDI)
21 ..F SDI=19:1:39 S $P(^TMP("SDZNAVA",$J,0),U,SDI)=$P($G(^TMP("SDNZAVA",$J,0)),U,SDI)+$P(SDX,U,SDI)
22 ..Q
23 .F SDI=1:1:18 S $P(^TMP("SDNAVA",$J,SDIV,SDCP),U,SDI)=$P(^TMP("SDNAVA",$J,SDIV,SDCP),U,SDI)+$P(SDX,U,SDI)
24 .F SDI=19:1:39 S $P(^TMP("SDZNAVA",$J,SDIV,SDCP),U,SDI)=$P($G(^TMP("SDZNAVA",$J,SDIV,SDCP)),U,SDI)+$P(SDX,U,SDI)
25 .I SDMD D
26 ..F SDI=1:1:18 S $P(^TMP("SDNAVA",$J,0,SDCP),U,SDI)=$P(^TMP("SDNAVA",$J,0,SDCP),U,SDI)+$P(SDX,U,SDI)
27 ..F SDI=19:1:39 S $P(^TMP("SDZNAVA",$J,0,SDCP),U,SDI)=$P($G(^TMP("SDZNAVA",$J,0,SDCP)),U,SDI)+$P(SDX,U,SDI)
28 ..Q
29 .S SDT=0 F S SDT=$O(^TMP("SDXNAVA",$J,SDCL,SDT)) Q:SDOUT!'SDT D
30 ..S SDX=$P(^TMP("SDXNAVA",$J,SDCL,SDT),U,1,8)
31 ..S $P(SDX,U,9)=$G(^TMP("SDYNAVA",$J,SDCL,SDT))
32 ..S $P(SDX,U,38)=$P(^TMP("SDXNAVA",$J,SDCL,SDT),U,9,10)
33 ..S ^TMP("SDNAVA",$J,SDIV,SDCP,SDCL,SDT)=$$AVE(SDX)
34 ..Q
35 .Q
36 S SDIV="" F S SDIV=$O(^TMP("SDNAVA",$J,SDIV)) Q:'$L(SDIV) D
37 .S SDX=^TMP("SDNAVA",$J,SDIV)_U_$P($G(^TMP("SDZNAVA",$J,SDIV)),U,19,39)
38 .S ^TMP("SDNAVA",$J,SDIV)=$$AVE(SDX)
39 .S SDCP=0 F S SDCP=$O(^TMP("SDNAVA",$J,SDIV,SDCP)) Q:'SDCP D
40 ..S SDX=^TMP("SDNAVA",$J,SDIV,SDCP)_U_$P($G(^TMP("SDZNAVA",$J,SDIV,SDCP)),U,19,39)
41 ..S ^TMP("SDNAVA",$J,SDIV,SDCP)=$$AVE(SDX)
42 ..Q
43 .Q
44 K ^TMP("SDWNAVA",$J),^TMP("SDXNAVA",$J),^TMP("SDYNAVA",$J),^TMP("SDZNAVA",$J)
45 Q
46 ;
47AVE(SDX) ;Calculate averages
48 ;Input: SDX=string of appointment totals and total waiting time
49 ;Output: string of appointment totals and average waiting time
50 N SDI,SDY,SDZ
51 F SDI=2:2:22,24:3:36 D
52 .S SDY=+$P(SDX,U,(SDI-1)),$P(SDX,U,(SDI-1))=SDY
53 .S $P(SDX,U,SDI)=$FN($S(SDY=0:0,1:$P(SDX,U,SDI)/SDY),"",1)
54 .Q:SDI<24
55 .S $P(SDX,U,SDI+1)=$FN($S(SDY=0:0,1:$P(SDX,U,SDI+1)/SDY),"",1)
56 .Q
57 S SDY=$P(SDX,U)+$P(SDX,U,5),SDZ=+$P(SDX,U,38)*100
58 S $P(SDX,U,38)=$FN($S(SDY=0:0,1:(SDZ/SDY)),"",1)
59 S SDY=$P(SDX,U,3)+$P(SDX,U,7),SDZ=+$P(SDX,U,39)*100
60 S $P(SDX,U,39)=$FN($S(SDY=0:0,1:(SDZ/SDY)),"",1)
61 Q SDX
62 ;
63AVE2(SDCL,SDAVE2) ;Format additional fields
64 ;Input: SDCL=clinic ifn
65 ;Input: SDAVE2=variable to return values (pass by reference)
66 N SDX,SDY,SDI
67 S SDAVE2=$G(^TMP("SDWNAVA",$J,SDCL))
68 Q:'$L(SDAVE2) 0
69 S SDY=+$P(SDAVE2,U,8)
70 F SDI=1:1:4 D
71 .S SDX=$P(SDAVE2,U,SDI)*100
72 .S $P(SDAVE2,U,SDI)=$FN($S(SDY=0:0,1:(SDX/SDY)),"",1)
73 .Q
74 Q 1
75 ;
76STOP ;Check for stop task request
77 S:$D(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
78 ;
79OUT4 ;Output patient list
80 N SDY,SDI,SDPNAME,DFN,SDADT
81 I '$O(^TMP("SDPLIST",$J,SC,0)) D Q
82 .S SDY="No appointments scheduled during this date range were found."
83 .W !!?(IOM-$L(SDY)\2),SDY Q
84 S SDI=0 F S SDI=$O(^TMP("SDPLIST",$J,SC,SDI)) Q:SDOUT!'SDI D
85 .S SDPNAME=""
86 .F S SDPNAME=$O(^TMP("SDPLIST",$J,SC,SDI,SDPNAME)) Q:SDOUT!(SDPNAME="") D
87 ..S DFN=0
88 ..F S DFN=$O(^TMP("SDPLIST",$J,SC,SDI,SDPNAME,DFN)) Q:SDOUT!(DFN="") D
89 ...S SDADT=0
90 ...F S SDADT=$O(^TMP("SDPLIST",$J,SC,SDI,SDPNAME,DFN,SDADT)) Q:SDOUT!'SDADT D
91 ....S SDATA=^TMP("SDPLIST",$J,SC,SDI,SDPNAME,DFN,SDADT)
92 ....I 'SDXM,$Y>(IOSL-SDFLEN) D FOOTER(SDREPORT),HDR^SCRPW76(1,SDREPORT,SDIV,SDCP,SC)
93 ....Q:SDOUT
94 ....W !,$$DTX(SDI),?13,$E(SDPNAME,1,23),?38,$P(SDATA,U)
95 ....W ?50,$$DTX(SDADT),?69,$$SRTY($P(SDATA,U,2))
96 ....W ?98,$P(SDATA,U,3),?102,$$DTX($P(SDATA,U,4))
97 ....W ?115,$S($P(SDATA,U,5)=0:"NO",$P(SDATA,U,5)=1:"YES",1:"")
98 ....W ?120,$J($P(SDATA,U,7),5,0),?127,$J($P(SDATA,U,6),5,0)
99 ....Q
100 ...Q
101 ..Q
102 .Q
103 Q:SDOUT D FOOTER(SDREPORT)
104 Q
105OUT5(DFN,SC) ;Output patient list
106 N SDY,SDI,SDPNAME,SDADT
107 I '$O(^TMP("SDIPLST",$J,DFN,SC,0)) D Q
108 .S SDY="No appointments scheduled during this date range were found."
109 .W !!?(IOM-$L(SDY)\2),SDY Q
110 S SDI=0 F S SDI=$O(^TMP("SDIPLST",$J,DFN,SC,SDI)) Q:SDOUT!'SDI D
111 .S SDPNAME=""
112 .F S SDPNAME=$O(^TMP("SDIPLST",$J,DFN,SC,SDI,SDPNAME)) Q:SDOUT!(SDPNAME="") D
113 ..S SDADT=0
114 ..F S SDADT=$O(^TMP("SDIPLST",$J,DFN,SC,SDI,SDPNAME,SDADT)) Q:SDOUT!'SDADT D
115 ...S SDATA=^TMP("SDIPLST",$J,DFN,SC,SDI,SDPNAME,SDADT)
116 ...I 'SDXM,$Y>(IOSL-SDFLEN) D FOOTER(SDREPORT),HDR^SCRPW76(1,SDREPORT,SDIV,SDCP,SC)
117 ...Q:SDOUT
118 ...W !,$$DTXN(SDI),?11,$$SRTY($P(SDATA,U,2)),?31,$$DTXN($P(SDATA,U,4))
119 ...W ?42,$$DTXN(SDADT),?52,$J($P(SDATA,U,7),5,0)
120 ...W ?59,$J($P(SDATA,U,6),5,0),?69,$P(SDATA,U,3)
121 ...W ?73,$S($P(SDATA,U,5)=0:"NO",$P(SDATA,U,5)=1:"YES",1:"")
122 ...W ?79,$$DTXN($P(SDATA,U,8)),?96,$P(SDATA,U,9),?102,$P($$DTXN($P(SDATA,U,10)),"@")
123 ...I +$P(SDATA,U,11)>0 N SDFN,SDARR,DR,DIQ,DIC,DA D W ?113,$G(SDARR(SDFN,DA,DR,"I"))
124 ....S DR=".01",DIQ="SDARR(",DIQ(0)="I",DIC=200,SDFN=200,DA=$P(SDATA,U,11) D EN^DIQ1
125 ...Q
126 ..Q
127 .Q
128 Q:SDOUT D FOOTER(SDREPORT)
129 Q
130 ;
131SRTY(SDSRTY) ;Externalize scheduling request type
132 ;Input: SDSRTY=internal value for request type
133 Q:'$L(SDSRTY) ""
134 Q:SDSRTY="N" "Next available"
135 Q:SDSRTY="C" "Not-next ava-C/R" ;Clinician Request
136 Q:SDSRTY="P" "Not-next ava-P/R" ;Patient Request
137 Q:SDSRTY="W" "Walk in appoint"
138 Q:SDSRTY="M" "Multi booking"
139 Q:SDSRTY="A" "Auto rebook"
140 Q "Not-next available"
141 ;
142DTX(Y) ;Externalize date
143 X ^DD("DD")
144 Q Y
145 ;
146DTXN(Y) ;External date formated to abbreviate
147 I +Y=0 S Y="" Q Y
148 X ^DD("DD")
149 N SDSTR S Y=$P(Y,",")_","_$E($P(Y,",",2),3,10)
150 I $L(Y)#2=0 S Y=$E(Y,1,3)_" "_$P(Y," ",2)
151 Q Y
152 ;
153FOOTER(SDREPORT) ;Print footer
154 ;Input: SDREPORT=report element to print
155 N SDI,SDFL S SDFL=$S(SDREPORT=1:10,SDREPORT=2:8,SDREPORT=5:13,1:9)
156 I SDXM D Q
157 .D XMTX^SCRPW73(" ") S SDI=0
158 .F S SDI=$O(SDFOOT(SDREPORT,SDI)) Q:'SDI D XMTX^SCRPW73(SDFOOT(SDREPORT,SDI))
159 .Q
160 F SDI=1:1:80 Q:$Y>(IOSL-SDFL) W !
161 S SDI=0
162 F S SDI=$O(SDFOOT(SDREPORT,SDI)) Q:'SDI W !,SDFOOT(SDREPORT,SDI)
163 Q
164 ;
165FOOT(SDTX) ;Report footer for retrospective report
166 ;Input: SDTX=array to return text
167 I $G(SDREPORT(1)) D
168 .S SDTX(1,1)=SDLINE
169 .S SDTX(1,2)="NOTE: TYPE '0' represents appointments scheduled during the report time frame not indicated by the user or by calculation to be"
170 .S SDTX(1,3)="'next available' appointments. TYPE '1' represents appointments defined by the user as being 'next available' appointments. TYPE"
171 .S SDTX(1,4)="'2' represents appointments calculated to be 'next available' appointments. TYPE '3' represents appointments indicated both by the"
172 .S SDTX(1,5)="user and by calculation to be 'next available' appointments. WAIT TIME is the average number of days from the date an appointment"
173 .S SDTX(1,6)="was scheduled to the date it is to be performed. The '% NNA' and '% NA' columns reflect percentage of appointments scheduled within"
174 .S SDTX(1,7)="30 days for 'non-next available' appointments (types 0 & 2) and 'next available' appointments (types 1 & 3), respectively."
175 .S SDTX(1,8)=SDLINE Q
176 I $G(SDREPORT(2)) D
177 .S SDTX(2,1)=SDLINE
178 .S SDTX(2,2)="NOTE: The date range categories ('0-1', '2-7', '8-30', etc.) are based on the difference between the 'desired date' defined for the"
179 .S SDTX(2,3)="appointment and the date the appointment was performed. 'Wait Time' reflects the average of this difference for all appointments in"
180 .S SDTX(2,4)="each category. 'Follow up' status is determined by encounter activity to the same DSS ID credit pair as the appointment clinic"
181 .S SDTX(2,5)="within the previous 24 months."
182 .S SDTX(2,6)=SDLINE Q
183 I $G(SDREPORT(3)) D
184 .S SDTX(3,1)=SDLINE
185 .S SDTX(3,2)="NOTE: The date range categories ('0-1', '2-7', '8-30', etc.) are based on the difference between the 'desired date' defined for the"
186 .S SDTX(3,3)="appointment and the date the appointment was performed. 'Wait Time1' reflects the average difference between the 'desired date' and"
187 .S SDTX(3,4)="the date the appointment was performed. 'Wait Time2' reflects the average difference between the transaction date (the date the"
188 .S SDTX(3,5)="appointment was entered by the Scheduling package user) and the date the appointment was performed. 'Non-follow up' status is"
189 .S SDTX(3,6)="determined by the absence of encounter activity to the same DSS ID credit pair as the appointment clinic in the previous 24 months."
190 .S SDTX(3,7)=SDLINE Q
191 I $G(SDREPORT(4)) D
192 .S SDTX(4,1)=SDLINE
193 .S SDTX(4,2)="NOTE: 'Next Ava. Ind.' Values--'0' = not indicated by the user or calculation to be a 'next available' appointment, '1' = defined"
194 .S SDTX(4,3)="by the user as a 'next available' appointment, '2' = indicated by calculation to be a 'next available' appointment, '3' = indicated"
195 .S SDTX(4,4)="by the user and by calculation to be a 'next available' appointment. 'Wait Time1' = the difference between the 'date desired' and"
196 .S SDTX(4,5)="the date of the appointment. 'Wait Time2' = the difference between the 'date scheduled' and the date of the appointment."
197 .S SDTX(4,6)=SDLINE Q
198 I $G(SDREPORT(5)) D FOOT^SCRPW78(.SDTX,SDLINE) Q
199 Q
Note: See TracBrowser for help on using the repository browser.