source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXRRWLPR.m@ 1000

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

initial load of WorldVistAEHR

File size: 7.6 KB
Line 
1PXRRWLPR ;ISL/PKR - Print the encounter summary report. ;12/1/97
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**20,61**;Aug 12, 1996
3 ;
4 N BMARG,C1S,C2S,C3S,C1HS,C2HS,C3HS,DONE,HEAD
5 N INDENT,PAGE
6 N BY,BYCLOC,EMCODE,EMIND,EMMAX,IC,JC,KC
7 N FACILITY,FACPNAME,LOCOPRV,NEM,NOCOUNT,NOEM
8 N PCL1,PCL2,POV,POVIND,POVMAX,PRVLOC
9 N STOIND,STOP,TEMP,TOTCPT,TOTEM,TOTENC
10 N VACODE
11 ;
12 ;These are the variables used to accumulate the totals. We want
13 ;totals for each facility and a grand total.
14 N FTCON,FTEST,FTINP,FTOTH,FTNEW,FTNOCPT,FTNOEM,FTOP,FTSSN,FTTENC
15 N GTCON,GTEST,GTINP,GTNEW,GTNOCPT,GTNOEM,GTOP,GTOTH,GTSSN,GTTENC
16 N FTCP,FTSCH,FTTEN,FTTVIS,FTUNS
17 N GTCP,GTNS,GTSCH,GTTEN,GTTVIS,GTUNS
18 ;
19 ;Allow the task to be cleaned up upon successful completion.
20 S ZTREQ="@"
21 ;Check for multiple provider encounters.
22 S:$D(^XTMP(PXRRXTMP,"PXRRMPR")) PXRRMPR=1
23 ;
24 U IO
25 S DONE=0
26 ;
27 ;See if the report is by location or by provider.
28 S BY=$O(^XTMP(PXRRXTMP,"STOIND",""))
29 ;
30 ;See if the report is by clinic location.
31 I $P($G(PXRRLCSC),U,1)["C" S BYCLOC=$S($P(PXRRLCSC,U,3):1,1:0)
32 E S BYCLOC=0
33 ;
34 ;Build a list of the E&M codes. Use the first 3 characters as an
35 ;abbreviation.
36 D RETSOC^PXRRWLPF(357.69,.05,.EMCODE)
37 S EMMAX=0
38 S IC=""
39 S JC=0
40 F S IC=$O(EMCODE(IC)) Q:IC="" D
41 . S EMMAX=$$MAX^XLFMTH(EMMAX,$L(EMCODE(IC)))
42 . S EMCODE(IC)=EMCODE(IC)_U_$E(EMCODE(IC),1,3)
43 . S JC=JC+1
44 . S EMIND(JC)=IC
45 S NEM=JC
46 S EMCODE(0)="TOTAL"_U_"TOTAL"
47 ;
48 ;Build a list of appointment purposes of visit. Use the first 4
49 ;characters as an abbreviation.
50 D RETSOC^PXRRWLPF(2.98,9,.POV)
51 S POVMAX=15
52 S POV(1)=POV(1)_U_$E(POV(1),1,3)
53 S POV(2)=POV(2)_U_$E(POV(2),1,5)
54 S POV(3)=POV(3)_U_$E(POV(3),1,3)
55 S POV(4)=POV(4)_U_$E(POV(4),1,3)
56 S POVIND(1)=1
57 S POVIND(2)=2
58 S POVIND(3)=3
59 S POVIND(4)=4
60 ;
61 ;Setup initial formatting parameters.
62 S INDENT=3
63 S (HEAD,PAGE)=1
64 S BMARG=2
65 D HDR^PXRRGPRT(PAGE)
66 W !!,"Criteria for Encounter Summary Report"
67 I $P(PXRRWLSC,U,1)="L" D OLRCRIT^PXRRGPRT(INDENT)
68 I $P($G(PXRRWLSC),U,1)="P" D OPRCRIT^PXRRGPRT(INDENT)
69 ;
70 ;Give the abbreviations legend.
71 S C1S=0
72 S C2S=C1S+EMMAX+5
73 S C3S=C2S
74 W:PXRRMPR=0 !
75 W !,?24,"Abbreviations Used in this Report"
76 W !,?C1S,"E&M Codes"
77 W ?C2S,"Appointment Type"
78 W !,?C1S,"---------"
79 ;W ?C2S,"------------------"
80 ;W ?C3S,"----------------"
81 W ?C2S,"----------------"
82 S STOP=0
83 S IC=$O(EMCODE(0))
84 S KC=$O(POV(""))
85 F D Q:STOP
86 . I $L(IC_KC)=0 S STOP=1 Q
87 . E W !
88 . I $L(IC)>0 D
89 .. W $P(EMCODE(IC),U,2),"=",$P(EMCODE(IC),U,1)
90 .. S IC=$O(EMCODE(IC))
91 . I $L(KC)>0 D
92 .. W ?C2S,$P(POV(KC),U,2),"=",$P(POV(KC),U,1)
93 .. S KC=$O(POV(KC))
94 W !,"___________________________________________________________________"
95 W:PXRRMPR=1 !,"Note: Encounters with multiple providers are counted once in the totals below"
96 ;
97 ;Setup the final formatting parameters.
98 S C1HS=INDENT+3
99 S C1S=0
100 S C2HS=C1S+2
101 S C2S=C2HS
102 S C3HS=C2HS+5
103 S C3S=C3HS
104 S HEAD=1
105 S INDENT=0
106 ;
107 ;Initialize the grand totals.
108 S (GTCON,GTEST,GTINP,GTNEW,GTNOCPT,GTNOEM,GTOP,GTOTH,GTSSN,GTTENC)=0
109 S (GTCP,GTNS,GTSCH,GTTEN,GTTVIS,GTUNS)=0
110 ;
111 S NOCOUNT=0
112 S FACILITY=0
113NFAC S FACILITY=$O(^XTMP(PXRRXTMP,FACILITY))
114 I +FACILITY=0 G DONE
115 ;Initialize the facility totals.
116 S (FTCON,FTEST,FTINP,FTOTH,FTNEW,FTNOCPT,FTNOEM,FTOP,FTSSN,FTTENC)=0
117 S (FTCP,FTSCH,FTTEN,FTUNS)=0
118 ;Keep track of the facilities that were found.
119 F IC=1:1:NFAC I $P(PXRRFAC(IC),U,1)=FACILITY D Q
120 . S $P(PXRRFAC(IC),U,4)="M"
121 S FACPNAME=$P(PXRRFACN(FACILITY),U,1)_" "_$P(PXRRFACN(FACILITY),U,2)
122 ;
123 S STOIND="&&"
124NSTO S STOIND=$O(^XTMP(PXRRXTMP,FACILITY,STOIND))
125 I STOIND="" D G NFAC
126 . S FTSSN=+$G(^XTMP(PXRRXTMP,FACILITY,"&","TOTUNIQ"))
127 . S FTINP=+$G(^XTMP(PXRRXTMP,FACILITY,"&","TOTINOUT",1))
128 . S FTOP=+$G(^XTMP(PXRRXTMP,FACILITY,"&","TOTINOUT",0))
129 . S FTTVIS=+$G(^XTMP(PXRRXTMP,FACILITY,"&","TOTVIS"))
130 . ;Subtract multiple provider encounters from facility total
131 . I PXRRMPR=1 D NCSUB
132 . D WFACTOT^PXRRWLPF
133 . D GTOTAL^PXRRWLPF
134 D HEAD^PXRRWLPF(0)
135 I DONE G DONE
136 I '$D(PXRRPRLL) S PXRRPRLL=0
137 S LOCOPRV=" "
138 I BY="LOCATION" D
139 . S LOCOPRV=$P(STOIND,U,1)_" ("_$P(STOIND,U,3)_")"
140 . S NOCOUNT=0
141 . S INDENT=0
142 .;If we have clinic stops split out by clinic location do not include
143 .;the individual locations in the totals.
144 . I (BYCLOC)&($L(STOIND,U)=4) D
145 .. S LOCOPRV=$P(STOIND,U,4)_" ("_$P(STOIND,U,3)_")"
146 .. S NOCOUNT=1
147 .. S INDENT=2
148 I BY="PROVIDER" D
149 . S VACODE=$P(STOIND,U,3)
150 . S TEMP=$$ABBRV^PXRRPECU(VACODE)
151 . K PCL1,PCL2
152 . D FMTPCL^PXRRPRSP(TEMP,$L($P(STOIND,U,1))+1,80,.PCL1,.PCL2)
153 . S LOCOPRV=$P(STOIND,U,1)_" "_PCL1
154 . I PXRRPRLL S PRVLOC=$P(STOIND,U,4)_" ("_$P(STOIND,U,6)_")"
155 ;
156 ;Write out the PCE encounter data.
157 S TOTCPT=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"CPT"))
158 S TOTENC=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"TOTENC"))
159 S NOEM=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",0))
160 I $Y>(IOSL-BMARG-5) D HEAD^PXRRWLPF(1)
161 I DONE G DONE
162 W !!,?INDENT,LOCOPRV
163 I PXRRPRLL W !,?C1HS,PRVLOC
164 I $D(PCL2) W !," ",PCL2
165 W !,?C2HS,"PCE:"
166 S TOTEM=0
167 ;E&M new.
168 S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",EMIND(1)))
169 W ?C3S,$J(TEMP,6)
170 D NCSUM(.FTNEW,TEMP,NOCOUNT)
171 D NCSUM(.TOTEM,TEMP,NOCOUNT)
172 ;E&M established.
173 S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",EMIND(2)))
174 W $J(TEMP,6)
175 D NCSUM(.FTEST,TEMP,NOCOUNT)
176 D NCSUM(.TOTEM,TEMP,NOCOUNT)
177 ;E&M consult.
178 S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",EMIND(3)))
179 W $J(TEMP,6)
180 D NCSUM(.FTCON,TEMP,NOCOUNT)
181 D NCSUM(.TOTEM,TEMP,NOCOUNT)
182 ;E&M other
183 S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",EMIND(4)))
184 W $J(TEMP,6)
185 D NCSUM(.FTOTH,TEMP,NOCOUNT)
186 D NCSUM(.TOTEM,TEMP,NOCOUNT)
187 W $J(NOEM,6)
188 D NCSUM(.FTNOEM,NOEM,NOCOUNT)
189 S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"NOCPT"))
190 W $J(TEMP,6)
191 D NCSUM(.FTNOCPT,TEMP,NOCOUNT)
192 W $J(TOTENC,7)
193 S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"TOTVIS"))
194 W $J(TEMP,6)
195 S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"UPAT"))
196 W $J(TEMP,6)
197 S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"VISITS",1))
198 W $J(TEMP,6)
199 S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"VISITS",0))
200 W $J(TEMP,6)
201 ;
202 D NCSUM(.FTTENC,TOTENC,NOCOUNT)
203 ;
204 ;Write the appointment info.
205 W !,?C2HS F IC=C2HS+1:1:80 W "-"
206 W !,?C2HS,"SCH:"
207 ;Purpose of Visit C&P.
208 S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"POV",POVIND(1)))
209 W ?C3S,$J(TEMP,6)
210 D NCSUM(.FTCP,TEMP,NOCOUNT)
211 ;Purpose of Visit 10-10.
212 S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"POV",POVIND(2)))
213 W $J(TEMP,6)
214 D NCSUM(.FTTEN,TEMP,NOCOUNT)
215 ;Purpose of Visit scheduled.
216 S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"POV",POVIND(3)))
217 W $J(TEMP,6)
218 D NCSUM(.FTSCH,TEMP,NOCOUNT)
219 ;Purpose of Visit unscheduled.
220 S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"POV",POVIND(4)))
221 W $J(TEMP,6)
222 D NCSUM(.FTUNS,TEMP,NOCOUNT)
223 ;
224 G NSTO
225DONE ;
226 I DONE G EXIT
227 I $Y>(IOSL-BMARG-3) D PAGE^PXRRGPRT
228 I DONE G EXIT
229 I GTTENC>0 D WGTOTAL^PXRRWLPF
230 I $Y>(IOSL-BMARG-3) D PAGE^PXRRGPRT
231 I DONE G EXIT
232 D FACNE^PXRRGPRT(INDENT)
233EXIT ;
234 ;Clean up
235 D EXIT^PXRRGUT
236 D EOR^PXRRGUT
237 Q
238 ;
239 ;=======================================================================
240NCSUM(VAR,ADD,NOCOUNT) ;No Count summation function. Only add to VAR if
241 ; NOCOUNT is false.
242 I NOCOUNT Q
243 S VAR=VAR+ADD
244 Q
245 ;
246NCSUB ;Subtract multiple provider totals from facility totals
247 ;Totals are built in PXRRWLS2,PXRRWLSE and PXRRWLSA
248 N FTFLDS,FTFLD,FTEMP
249 ;E&M codes
250 S EMIND(0)=0
251 S FTFLDS="FTNOEM;FTNEW;FTEST;FTCON;FTOTH"
252 F JJ=0:1:4 D
253 . S FTFLD=$P(FTFLDS,";",JJ+1)
254 . S FTEMP=+$G(^XTMP(PXRRXTMP,FACILITY,"&&","EM",EMIND(JJ)))
255 . S @FTFLD=@FTFLD-FTEMP
256 ;Purpose of visit codes
257 S FTFLDS="FTCP;FTTEN;FTSCH;FTUNS"
258 F JJ=1:1:4 D
259 . S FTFLD=$P(FTFLDS,";",JJ)
260 . S FTEMP=+$G(^XTMP(PXRRXTMP,FACILITY,"&&","POV",POVIND(JJ)))
261 . S @FTFLD=@FTFLD-FTEMP
262 ;Miscellaneous
263 S FTEMP=+$G(^XTMP(PXRRXTMP,FACILITY,"&&","TOTENC"))
264 S FTTENC=FTTENC-FTEMP
265 S FTEMP=+$G(^XTMP(PXRRXTMP,FACILITY,"&&","NOCPT"))
266 S FTNOCPT=FTNOCPT-FTEMP
267 Q
Note: See TracBrowser for help on using the repository browser.