source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPW76.m@ 1742

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

initial load of FOIAVistA 6/30/08 version
File size: 8.6 KB
Line 
1SCRPW76 ;BP-OIFO/KEITH,ESW - Clinic appointment availability extract (cont.) ; 5/28/03 4:02pm
2 ;;5.3;Scheduling;**223,291**;AUG 13, 1993
3 ;
4HINI ;Initialize header variables
5 N %,%H,%I,X,X1,X2
6 S SDLINE="",$P(SDLINE,"-",$S(SDPAST:133,1:(SDIOM+1)))="",SDPAGE=1,SDPG=0
7 D NOW^%DTC S Y=% X ^DD("DD") S SDPNOW=$P(Y,":",1,2)
8 S SDTITL="<*> Clinic Appointment Availability Report <*>"
9 Q
10 ;
11HDR(SDTY,SDREPORT,SDIV,SDCP,SC) ;Print header
12 ;Input: SDTY=type of header where:
13 ; '0'=negative report
14 ; '1'=detailed report
15 ; '2'=division summary
16 ; '3'=facility summary
17 ;Input: SDREPORT=report output element where:
18 ; '1'='next ava.' appt. information
19 ; '2'='follow up' appt. information
20 ; '3'='non-follow up' appt. information
21 ;Input: SDIV=division name^division number
22 ;Input: SDCP=credit pair
23 ;Input: SC=clinic ifn
24 ;
25 Q:SDOUT
26 I $G(SDXM) D HDRXM(SDREPORT) Q
27 I $E(IOST)="C",SDPG N DIR S DIR(0)="E" W ! D ^DIR S SDOUT=Y'=1 Q:SDOUT
28 N SDX,SDI D STOP Q:SDOUT
29 W:SDPG!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) W:$X $$XY^SCRPW50("",0,0)
30 W SDLINE,!?(SDIOM-$L(SDTITL)\2),SDTITL
31 I SDREPORT=1,'SDPAST S SDX="Clinic availability data"
32 I SDREPORT=1,SDPAST S SDX="Clinic availability and 'next available' appointment data"
33 I SDREPORT=2 S SDX="'Follow up' appointment data"
34 I SDREPORT=3 S SDX="'Non-follow up' appointment data"
35 I SDREPORT=4 S SDX="Listing of patient appointments"
36 I SDREPORT=5 S SDX="Listing of appointments for selected patient"
37 W !?(SDIOM-$L(SDX)\2),SDX
38 D HDRX(SDTY) Q:SDOUT S SDI=0
39 I $G(SDREPORT)'=5 F S SDI=$O(SDTIT(SDI)) Q:'SDI W !?(SDIOM-$L(SDTIT(SDI))\2),SDTIT(SDI)
40 I $G(SDREPORT)=5 Q:'$O(SDTIT("")) D
41 .N SD F SD=1,2 W !?(SDIOM-$L(SDTIT(SD))\2),SDTIT(SD)
42 .W !,SDTIT(3),?100,SDTIT(4),!,SDTIT(5),?100,SDTIT(6)
43 W !,SDLINE
44 W !,"For clinic availability dates ",SDPBDT," through ",SDPEDT
45 W !,"Date printed: ",SDPNOW,?(IOM-6-$L(SDPAGE)),"Page: ",SDPAGE
46 W !,SDLINE
47 S SDPAGE=SDPAGE+1,SDPG=1 D:SDTY SUBT(SDTY,SDREPORT) Q
48 ;
49HDRX(SDTY) ;Extra header lines
50 K SDTIT
51 Q:SDTY=0 S SDIV=$G(SDIV)
52 I SDTY=3 S SDTIT(1)="Facility Summary" Q
53 N SDDV S SDDV=$P(SDIV,U)_" ("_$P(SDIV,U,2)_")"
54 I SDTY=2 S SDTIT(1)="Summary for division: "_SDDV Q
55 S SDTIT(1)="Division: "_SDDV
56 S:SDSORT="CP" SDTIT(2)="For clinics with credit pair: "_$$OTX^SCRPW73("CP")
57 I $G(SDREPORT)=5 D
58 .S:SDSORT="CP" SDTIT(2)="For clinics with selected credit pair"
59 .S:SDSORT="CA" SDTIT(2)="For all clinics"
60 .S:SDSORT="CL" SDTIT(2)="For clinics selected by name"
61 .N DA,DIC,DIQ,DR
62 .S DIC=2,SDPT=DIC,DA=$G(DFN) F DR=.01,.09 N SDPT,SDARR S DIQ="SDARR(",DIQ(0)="I" D EN^DIQ1 D
63 ..I DR=.01 S SDTIT(3)="Patient: "_SDARR(2,DA,.01,"I")
64 ..I DR=.09 S SDTIT(4)="SSN: "_SDARR(2,DA,.09,"I")
65 .S SDTIT(5)="Clinic: "_$P(^SC(SC,0),U)
66 .S SDTIT(6)="Clinic Stop Code Pair: "_SDCP
67 E S SDTIT(3)="Detail for clinic: "_$$OTX^SCRPW73("CL")
68 Q
69 ;
70SUBT(SDTY,SDREPORT) ;Print subtitles
71 D:SDREPORT=1 SUBT1 D:SDREPORT=2 SUBT2
72 D:SDREPORT=3 SUBT3 D:SDREPORT=4 SUBT4
73 D:SDREPORT=5 SUBT5
74 Q
75 ;
76SUBT1 N SDI
77 W !?(SDCOL+44),"Ava.",?(SDCOL+51),"Pct."
78 I SDPAST D
79 .F SDI=0:1:3 W ?(SDCOL+63+(14*SDI)),"--Type '",SDI,"'---"
80 .W ?120,"% NNA % NA" Q
81 W ! W:SDTY>1 ?(SDCOL),"Credit Pair"
82 W ?(SDCOL+35),"Clinic",?(SDCOL+43),"Appt.",?(SDCOL+50),"Slots"
83 I SDPAST D
84 .W ?(SDCOL+56),"Clinic"
85 .F SDI=0:1:3 W ?(SDCOL+65+(14*SDI)),"Sch. Wait"
86 .W ?122,"<31 <31" Q
87 W !?(SDCOL+4),$S(SDTY=1:"Availability Date",1:"Clinic Name")
88 W ?(SDCOL+33),"Capacity",?(SDCOL+43),"Slots",?(SDCOL+51),"Ava."
89 I SDPAST D
90 .W ?(SDCOL+58),"Enc."
91 .F SDI=0:1:3 W ?(SDCOL+64+(14*SDI)),"Appts Time"
92 .W ?121,"Days Days"
93 W !?(SDCOL),$E(SDLINE,1,($S(SDPAST:132,1:58)))
94 Q
95 ;
96SUBT2 N SDI
97 W !?48,"Next",?54,$E(SDLINE,1,24),"Non-next Available Appointments",$E(SDLINE,1,23)
98 W !?40,"Next Ava. 0-1 0-1 2-7 2-7 8-30 8-30 31-60 31-60 >60 >60"
99 W ! W:SDTY>1 "Credit Pair" W ?40,"Ava. Wait"
100 F SDI=56:16:121 W ?(SDI),"Days Wait"
101 W !?4,$S(SDTY=1:"Availability Date",1:"Clinic Name")
102 F SDI=39:16:120 W ?(SDI),"Appts Time"
103 W !,SDLINE
104 Q
105 ;
106SUBT3 N SDI
107 W !?38,"Next",?43,$E(SDLINE,1,29),"Non-next Available Appointments",$E(SDLINE,1,29)
108 W !?32,"Next Ava. 0-1 0-1 0-1 2-7 2-7 2-7 8-30 8-30 8-30 31-60 31-60 31-60 >60 >60 >60"
109 W ! W:SDTY>1 "Credit Pair" W ?32,"Ava. Wait"
110 F SDI=44:18:117 W ?(SDI),"Days Wait Wait"
111 W !?4,$S(SDTY=1:"Availability Date",1:"Clinic Name"),?31,"Appts Time1"
112 F SDI=43:18:116 W ?(SDI),"Appts Time1 Time2"
113 W !,SDLINE
114 Q
115 ;
116SUBT4 W !?96,"Next",!,"Date",?96,"Ava. Date Wait Wait"
117 W !,"Scheduled Patient Name SSN Appointment Date Scheduling Request Type Ind. Desired F/U Time1 Time2"
118 W !,SDLINE
119 Q
120 ;
121SUBT5 W !?11,"SCHEDULING",?63,"TIME",!,"DATE",?11,"REQUEST",?31,"DATE",?58,"WAIT",?63,"TO",?68,"APPT",?96,"APPT",?102,"COMPLETION"
122 W !,"SCHEDULED",?11,"TYPE",?31,"DESIRED",?42,"APPT DATE/TIME",?58,"TIME",?63,"APPT",?68,"TYPE",?73,"F/U",?79,"REBOOK DATE",?96,"STAT",?102,"DATE",?113,"SCHEDULER"
123 W !,SDLINE
124 Q
125HDRXM(SDREPORT) ;Create header in mail message
126 ;Input: SDREPORT=report element to print
127 ;
128 N SDX,SDI,SDZ
129 I SDPAGE>1 F SDI=1:1:5 D XMTX("")
130 D XMTX($E(SDLINE,1,$S('SDPAST:79,1:132)))
131 S SDZ="",$E(SDZ,($S(SDPAST:132,1:79)-$L(SDTITL)\2))=SDTITL D XMTX(SDZ)
132 I SDREPORT=1,'SDPAST S SDX="Clinic availability data"
133 I SDREPORT=1,SDPAST S SDX="Clinic availability and 'next available' appointment data"
134 I SDREPORT=2 S SDX="'Follow up' appointment data"
135 I SDREPORT=3 S SDX="'Non-follow up' appointment data"
136 I SDREPORT=4 S SDX="Listing of patient appointments"
137 I SDREPORT=5 S SDX="Listing of appointments for selected patient"
138 S SDZ="",$E(SDZ,($S(SDPAST:132,1:79)-$L(SDX)\2))=SDX D XMTX(SDZ)
139 D HDRX(SDTY) S SDI=0
140 F S SDI=$O(SDTIT(SDI)) Q:'SDI S SDZ="" D
141 .S $E(SDZ,($S(SDPAST:130,1:79)-$L(SDTIT(SDI))\2))=SDTIT(SDI) D XMTX(SDZ)
142 .Q
143 D XMTX($E(SDLINE,1,$S('SDPAST:79,1:132)))
144 D XMTX("For clinic availability dates "_SDPBDT_" through "_SDPEDT)
145 S SDZ="Date extracted: "_SDPNOW
146 D XMTX(SDZ),XMTX($E(SDLINE,1,$S('SDPAST:79,1:132)))
147 S SDPAGE=SDPAGE+1 D:SDTY SUBTXM(SDTY,SDREPORT) Q
148 ;
149SUBTXM(SDTY,SDREPORT) ;Create message header subtitles
150 N SDZ
151 D:SDREPORT=1 STXM1 D:SDREPORT=2 STXM2
152 D:SDREPORT=3 STXM3 D:SDREPORT=4 STXM4
153 Q
154 ;
155STXM1 N SDI
156 S SDZ="",$E(SDZ,45)="Ava.",$E(SDZ,52)="Pct."
157 I SDPAST D
158 .F SDI=0:1:3 D
159 ..S $E(SDZ,(SDCOL+64+(14*SDI)))="--Type '"_SDI_"'---"
160 ..Q
161 .S $E(SDZ,121)="% NNA % NA"
162 .Q
163 D XMTX(SDZ)
164 S SDZ="" I SDTY>1 S SDZ="Credit Pair"
165 S $E(SDZ,36)="Clinic",$E(SDZ,44)="Appt.",$E(SDZ,51)="Slots"
166 I SDPAST D
167 .S $E(SDZ,57)="Clinic"
168 .F SDI=0:1:3 S $E(SDZ,(SDCOL+66+(14*SDI)))="Sch. Wait"
169 .S $E(SDZ,123)="<31 <31"
170 .Q
171 D XMTX(SDZ)
172 S SDZ="",$E(SDZ,4)=$S(SDTY=1:"Availability Date",1:"Clinic Name")
173 S $E(SDZ,34)="Capacity",$E(SDZ,44)="Slots",$E(SDZ,52)="Ava."
174 I SDPAST D
175 .S $E(SDZ,59)="Enc."
176 .F SDI=0:1:3 S $E(SDZ,(SDCOL+65+(14*SDI)))="Appts Time"
177 .S $E(SDZ,122)="Days Days"
178 .Q
179 D XMTX(SDZ)
180 S SDZ="",$E(SDZ,$S(SDTY>1:1,1:4))=$E(SDLINE,1,$S(SDPAST:132,1:58))
181 D XMTX(SDZ)
182 Q
183 ;
184STXM2 N SDI S SDZ=""
185 S $E(SDZ,49)="Next"
186 S $E(SDZ,55)=$E(SDLINE,1,24)_"Non-next Available Appointments"_$E(SDLINE,1,23)
187 D XMTX(SDZ) S SDZ=""
188 S $E(SDZ,41)="Next Ava. 0-1 0-1 2-7 2-7 8-30 8-30 31-60 31-60 >60 >60"
189 D XMTX(SDZ) S SDZ=""
190 S:SDTY>1 SDZ="Credit Pair" S $E(SDZ,41)="Ava. Wait"
191 F SDI=57:16:121 S $E(SDZ,SDI)="Days Wait"
192 D XMTX(SDZ) S SDZ=""
193 S $E(SDZ,4)=$S(SDTY=1:"Availability Date",1:"Clinic Name")
194 F SDI=40:16:120 S $E(SDZ,SDI)="Appts Time"
195 D XMTX(SDZ) S SDZ=""
196 S SDZ=SDLINE D XMTX(SDZ)
197 Q
198 ;
199STXM3 N SDI S SDZ=""
200 S $E(SDZ,39)="Next"
201 S $E(SDZ,44)=$E(SDLINE,1,29)_"Non-next Available Appointments"_$E(SDLINE,1,29)
202 D XMTX(SDZ) S SDZ=""
203 S $E(SDZ,33)="Next Ava. 0-1 0-1 0-1 2-7 2-7 2-7 8-30 8-30 8-30 31-60 31-60 31-60 >60 >60 >60"
204 D XMTX(SDZ) S SDZ=""
205 S:SDTY>1 SDZ="Credit Pair" S $E(SDZ,33)="Ava. Wait"
206 F SDI=45:18:117 S $E(SDZ,SDI)="Days Wait Wait"
207 D XMTX(SDZ) S SDZ=""
208 S $E(SDZ,4)=$S(SDTY=1:"Availability Date",1:"Clinic Name") S $E(SDZ,32)="Appts Time1"
209 F SDI=44:18:116 S $E(SDZ,SDI)="Appts Time1 Time2"
210 D XMTX(SDZ) S SDZ=""
211 S SDZ=SDLINE D XMTX(SDZ)
212 Q
213 ;
214STXM4 S SDZ=""
215 S $E(SDZ,96)="Next"
216 D XMTX(SDZ) S SDZ=""
217 S SDZ="Date",$E(SDZ,96)="Ava. Date Wait Wait"
218 D XMTX(SDZ) S SDZ=""
219 S SDZ="Scheduled Patient Name SSN Appointment Date Scheduling Request Type Ind. Desired F/U Time1 Time2"
220 D XMTX(SDZ) S SDZ=""
221 S SDZ=SDLINE D XMTX(SDZ)
222 Q
223 ;
224STOP ;Check for stop task request
225 S:$D(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
226 ;
227XMTX(SDX) ;Set mail message text line
228 ;Input: SDX=text value
229 S ^TMP("SDXM",$J,SDXM)=SDX,SDXM=SDXM+1 Q
Note: See TracBrowser for help on using the repository browser.