source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXRRFDP.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 7.8 KB
Line 
1PXRRFDP ;ISL/PKR - Final sort and print of frequency of diagnosis report. ;9/5/97
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**3,10,12,18,31,121**;Aug 12, 1996
3 ;
4PRINT ;
5 N ANS,BD,BMARG,C1E,C1S,C2E,C2S,C3E,C3S,C1HS,C2HS,C3HS,CMAX,INDENT,MID
6 N HEAD,LEN,NUM,PAGE
7 N BYLOC,BYPC,BYPRV,DCIEN,DONE,DTOT,ED,ETOT,FOUND,HLOC,IC,ICD9IEN
8 N FACILITY,FACPNAME,IC,INFOTYPE,LOCPNAM,NEWPAGE,PCLASS,PRV
9 N RATIO,STOIND,TEMP,TOTAL,VACODE,ICDSTR
10 ;
11 ;Allow the task to be cleaned up upon successful completion.
12 S ZTREQ="@"
13 ;
14 U IO
15 S BMARG=2
16 S INDENT=3,PAGE=1,C1S=INDENT+29
17 ;
18 S DONE=0
19 D HDR^PXRRGPRT(PAGE)
20 W !!,"Criteria for Frequency of Diagnoses Report"
21 W !,?INDENT,"Encounter diagnoses:",?C1S,$P(PXRRFDDC,U,2)
22 S BD=$$FMTE^XLFDT(PXRRBDT)
23 S ED=$$FMTE^XLFDT(PXRREDT)
24 W !,?INDENT,"Encounter date range:",?C1S,BD," through ",ED
25 I PXRRECAT="" D G MAXP
26 . W !,?INDENT,"Selected encounters:",?C1S,"ALL"
27 ;
28 I $D(PXRRPRSC) W !,?INDENT,"Selected Providers:",?C1S,$P(PXRRPRSC,U,2)
29 I $D(PXRRCS) S ANS="YES"
30 E S ANS="ALL"
31 I $D(PXRRLCSC) W !,?INDENT,$P(PXRRLCSC,U,2)
32 I $D(PXRRETYP) W !,?INDENT,"Encounter type:",?C1S,PXRRETYP
33 ;
34 I $D(PXRRDOB) D
35 . I (PXRRDOBE'=DT)&(PXRRDOBS'=0) D
36 .. W !,?INDENT,"Patient age range:",?C1S,PXRRMINA," to ",PXRRMAXA
37 .. S BD=$$FMTE^XLFDT(PXRRDOBS),ED=$$FMTE^XLFDT(PXRRDOBE)
38 .. W !,?INDENT,"Patient date of birth:",?C1S,BD," through ",ED
39 . I (PXRRDOBS=0) D
40 .. W !,?INDENT,"Patient age range:",?C1S,PXRRMINA," or more"
41 .. S ED=$$FMTE^XLFDT(PXRRDOBE)
42 .. W !,?INDENT,"Patient date of birth:",?C1S,ED," or before"
43 . I (PXRRDOBE=DT) D
44 .. W !,?INDENT,"Patient age range:",?C1S,"Up to ",PXRRMAXA
45 .. S BD=$$FMTE^XLFDT(PXRRDOBS),ED=$$FMTE^XLFDT(DT)
46 .. W !,?INDENT,"Patient date of birth:",?C1S,BD," through ",ED
47 E W !,?INDENT,"Patient age range:",?C1S,"ALL"
48 ;
49 I $D(PXRRRACE) D
50 . N RACE
51 . S RACE="race"
52 . I NRACE>1 S RACE="races"
53 . W !?INDENT,"Patient ",RACE,":",?C1S,$P(PXRRRACE(1),U,2)
54 . F IC=2:1:NRACE W !,?C1S,$P(PXRRRACE(IC),U,2)
55 E W !?INDENT,"Patient race(s):",?C1S,"ALL"
56 ;
57 I $D(PXRRSEX) W !?INDENT,"Patient sex:",?C1S,$P(PXRRSEX,U,2)
58 E W !?INDENT,"Patient sex:",?C1S,"BOTH"
59 ;
60 I $D(PXRRSCAT) D OSCAT^PXRRGPRT(PXRRSCAT,INDENT)
61 ;
62 I $P($G(PXRRPRSC),U,1)="C" D PECLASS^PXRRGPRT(INDENT)
63 ;
64MAXP W !!,?INDENT,"Maximum number of diagnoses to be displayed: ",PXRRDMAX
65 ;
66 S CMAX=70
67 ;
68 I $D(PXRRLCSC) D
69 . I PXRRLCSC["C" S PLOCNAM="Clinic Stop: "
70 . I PXRRLCSC["H" S PLOCNAM="Hospital Location: "
71 ;
72 S FACILITY=""
73NFAC S INFOTYPE="FACILITY"
74 S FACILITY=$O(^XTMP(PXRRXTMP,"INFO",INFOTYPE,FACILITY))
75 I +FACILITY=0 G END
76 ;Mark the facility as being found.
77 F IC=1:1:NFAC I $P(PXRRFAC(IC),U,1)=FACILITY D Q
78 . S $P(PXRRFAC(IC),U,4)="M"
79 S FACPNAME=$P(PXRRFACN(FACILITY),U,1)_" "_$P(PXRRFACN(FACILITY),U,2)
80 ;
81 ;Check for a user request to stop the task.
82 I $$S^%ZTLOAD S ZTSTOP=1 D EXIT^PXRRFDD
83 ;
84NINFO S INFOTYPE=$O(^XTMP(PXRRXTMP,"INFO",INFOTYPE))
85 I INFOTYPE="" G NFAC
86 ;
87 I INFOTYPE["LOC" S BYLOC=1
88 E S BYLOC=0
89 I INFOTYPE["PC" S BYPC=1
90 E S BYPC=0
91 I INFOTYPE["PRV" S BYPRV=1
92 E S BYPRV=0
93 ;
94 S PRV=""
95NPRV ;
96 S PRV=$O(^XTMP(PXRRXTMP,"INFO",INFOTYPE,FACILITY,PRV))
97 I PRV="" G NINFO
98 ;
99 S VACODE=""
100NVACODE ;
101 S VACODE=$O(^XTMP(PXRRXTMP,"INFO",INFOTYPE,FACILITY,PRV,VACODE))
102 I VACODE="" G NPRV
103 ;
104 S HLOC=""
105NLOC ;
106 S HLOC=$O(^XTMP(PXRRXTMP,"INFO",INFOTYPE,FACILITY,PRV,VACODE,HLOC))
107 I HLOC="" G NVACODE
108 ;
109 S STOIND=^XTMP(PXRRXTMP,"INFO",INFOTYPE,FACILITY,PRV,VACODE,HLOC)
110 ;
111 ;If the report is by provider get a person class for the provider.
112 I BYPRV D
113 . S TEMP=$P(PRV,U,4)
114 . I $L(TEMP)>0 S PCLASS=$$ABBRV^PXRRPECU(TEMP)
115 . E S PCLASS="Unknown"
116 ;
117 ;If the report is by person class get the person class.
118 I BYPC D
119 . S PCLASS=$$ABBRV^PXRRPECU(VACODE)
120 ;
121 S HEAD=1
122 D HEAD(0)
123 I DONE G EXIT
124 S C1S=INDENT+60
125 I $Y>(IOSL-BMARG-4) D HEAD(1)
126 I DONE G EXIT
127 I $P(PXRRFDDC,U,1)="P" S TEMP="Total number of Primary Diagnoses for these Encounters:"
128 E S TEMP="Total number of Diagnoses for these Encounters:"
129 I $D(^XTMP(PXRRXTMP,"TOTALS","ENCTOT",STOIND)) S ETOT=^XTMP(PXRRXTMP,"TOTALS","ENCTOT",STOIND)
130 E S ETOT=0
131 I $D(^XTMP(PXRRXTMP,"TOTALS","DIAGTOT",STOIND)) S DTOT=^XTMP(PXRRXTMP,"TOTALS","DIAGTOT",STOIND)
132 E S DTOT=0
133 S LEN=$$MAX^XLFMTH($L(DTOT),$L(ETOT))
134 W !!,?INDENT,"Total number of Encounters meeting the selection criteria:",?C1S,$J(ETOT,LEN)
135 W !,?INDENT,TEMP,?C1S,$J(DTOT,LEN)
136 S RATIO=$S(ETOT>0:(DTOT/ETOT),1:0)
137 W !,?INDENT,"Diagnoses/Encounter ratio:",?C1S,$J(RATIO,LEN,2)
138 ;
139 S C1S=INDENT+8,C2S=INDENT+16,C2E=INDENT+46
140 S C1HS=INDENT+9,C2HS=INDENT+25
141 S TOTAL=""
142 S NUM=0
143NTOTICD S TOTAL=$O(^XTMP(PXRRXTMP,"PRINT",STOIND,"ICD9",TOTAL),-1)
144 I TOTAL="" G DIAGCAT
145 S TEMP=TOTAL
146 S ICD9IEN=""
147NICD9 S ICD9IEN=$O(^XTMP(PXRRXTMP,"PRINT",STOIND,"ICD9",TOTAL,ICD9IEN),-1)
148 I ICD9IEN="" G NTOTICD
149 S NUM=NUM+1
150 I NUM=1 S HEAD=1
151 I $Y>(IOSL-BMARG-5) S NEWPAGE=1
152 E S NEWPAGE=0
153 D DHEAD(NEWPAGE)
154 I DONE G EXIT
155 S C3S=C3E-$L(TEMP)
156 ;W !,?INDENT,$J(NUM,5),".",?C1S,$P(^ICD9(ICD9IEN,0),U,1),?C2S,$P(^ICD9(ICD9IEN,0),U,3),?C3S,TEMP
157 S ICDSTR=$$ICDDX^ICDCODE(ICD9IEN)
158 W !,?INDENT,$J(NUM,5),".",?C1S,$P(ICDSTR,U,2),?C2S,$P(ICDSTR,U,4),?C3S,TEMP
159 I NUM<PXRRDMAX G NICD9
160DIAGCAT ;
161 S C1S=INDENT+8,C1E=INDENT+38
162 S C1HS=14
163 S TOTAL=""
164 S NUM=0
165NTOTDC S TOTAL=$O(^XTMP(PXRRXTMP,"PRINT",STOIND,"DC",TOTAL),-1)
166 I TOTAL="" G NLOC
167 S TEMP=TOTAL
168 S DCIEN=""
169NDC S DCIEN=$O(^XTMP(PXRRXTMP,"PRINT",STOIND,"DC",TOTAL,DCIEN),-1)
170 I DCIEN="" G NTOTDC
171 S NUM=NUM+1
172 I NUM=1 S HEAD=1
173 I $Y>(IOSL-BMARG-5) S NEWPAGE=1
174 E S NEWPAGE=0
175 D DCHEAD(NEWPAGE)
176 I DONE G EXIT
177 S C2S=C2E-$L(TEMP)
178 ;We will need a DBIA to read ICM. Some sites have had a corrupted ICM
179 ;file. Check for this problem, if found print an error message and
180 ;quit.
181 I (DCIEN>0)&('$D(^ICM(DCIEN,0))) D G EXIT
182 . W !!,"CANNOT CONTINUE, File 80.3 Major Diagnostic Category is corrupted!"
183 . W !,"^ICM(",DCIEN,",0) is missing."
184 . W !,"Please contact customer service for help."
185 I DCIEN>0 W !,?INDENT,$J(NUM,5),".",?C1S,$P(^ICM(DCIEN,0),U,1),?C2S,TEMP
186 E W !,?INDENT,$J(NUM,5),".",?C1S,"Unknown",?C2S,TEMP
187 I NUM<PXRRDMAX G NDC
188 ;
189 ;Get the next location.
190 G NLOC
191END ;
192 ;Check for facilities that were listed but had no encounters.
193 D FACNE^PXRRGPRT(INDENT)
194EXIT ;
195 D EXIT^PXRRGUT
196 D EOR^PXRRGUT
197 Q
198 ;
199 ;=======================================================================
200DHEAD(NEWPAGE) ;
201 I NEWPAGE D PAGE^PXRRGPRT
202 E I $Y>(IOSL-BMARG) D PAGE^PXRRGPRT
203 I DONE Q
204 I (HEAD)&(RATIO>0) D
205 . S LEN=$$MAX^XLFMTH(9,$L(TEMP))
206 . S MID=C2E+3+(LEN/2)
207 . S C3HS=MID-5
208 . S C3E=MID+($L(TEMP)/2)
209 . W !!,?INDENT,PXRRDMAX," Most Frequent ICD Diagnoses:"
210 . W !,?C1HS,"Code",?C2HS,"Description",?C3HS,"Frequency"
211 . W !,?C1S,"------",?C2S,"------------------------------",?C3HS,"---------"
212 . S HEAD=0
213 Q
214 ;
215 ;=======================================================================
216DCHEAD(NEWPAGE) ;
217 I NEWPAGE D PAGE^PXRRGPRT
218 E I $Y>(IOSL-BMARG) D PAGE^PXRRGPRT
219 I DONE Q
220 I (HEAD)&(RATIO>0) D
221 . S LEN=$$MAX^XLFMTH(9,$L(TEMP))
222 . S MID=C1E+3+(LEN/2)
223 . S C2HS=MID-5
224 . S C2E=MID+($L(TEMP)/2)
225 . W !!,?INDENT,PXRRDMAX," Most Frequent Diagnostic Categories:"
226 . W !,?C1HS,"Diagnostic Category",?C2HS,"Frequency"
227 . W !,?C1S,"------------------------------",?C2HS,"---------"
228 . S HEAD=0
229 Q
230 ;
231 ;=======================================================================
232HEAD(NEWPAGE) ;
233 N LEN,TEMP
234 I NEWPAGE D PAGE^PXRRGPRT
235 E I $Y>(IOSL-BMARG-8) D PAGE^PXRRGPRT
236 I DONE Q
237 I HEAD D
238 . W !!,"___________________________________________________________________"
239 . W !,"Facility: ",FACPNAME
240 . I BYLOC W !,PLOCNAM,$P(HLOC,U,1)_" (",$P(HLOC,U,3)_")"
241 . I BYPRV D
242 .. S TEMP="Provider: "_$P(PRV,U,1)_" ("_PCLASS_")"
243 .. S LEN=$L(TEMP)
244 .. I LEN>CMAX D
245 ... W !,$E(TEMP,1,CMAX)
246 ... W !," ",$E(TEMP,CMAX+1,LEN)
247 .. E W !,TEMP
248 . I BYPC D
249 .. W !,"Person Class (Occupation+Specialty+Subspecialty): "
250 .. S LEN=INDENT+$L(PCLASS)
251 .. I LEN>CMAX D
252 ... W !,?INDENT,$E(PCLASS,1,CMAX)
253 ... W !,?(INDENT+1),$E(PCLASS,CMAX+1,LEN)
254 .. E W !,?INDENT,PCLASS
255 . S HEAD=0
256 Q
257 ;
Note: See TracBrowser for help on using the repository browser.