source: FOIAVistA/tag/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXRRMDR.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 9.4 KB
Line 
1PXRRMDR ;BP/WLC - PCE Missing Data Report ;11 Feb 04 10:10 AM
2 ;;1.0;PCE;**124,174**;FEB 11, 2004
3 ; 04/11/05 WLC changed to check for AO, IR and EC, only if SC'=YES
4 Q
5 ;
6EN N PX,PXPAGE,PXLOC,PXPROV,SDDIV,ZTSAVE,%DT,DIR,DTOUT,DUOUT,X,Y,POP,PXDT,PXDS,RPTYP,EDT,PAT,SSN,DT,TY,CBU,VDT,LOC,PROV,SORT,SORTHDR,CNT,PRIO
7 S (POP,PXPAGE)=0
8 K PXDS
9 D HOME^%ZIS S:'$D(IOF) IOF=FF W @IOF,!!
10 S X=$$CTR("PCE Missing Data Report")
11 W !! D DATASRC^PXRRMDR1 G:POP EXIT ; sets PXDS() PX*1.0*174
12 W @IOF,!! S X=$$CTR("**** Date Range Selection ****")
13 W !!! S %DT="AEPX",%DT("A")="Beginning date: " D ^%DT G:Y<1 EXIT S PX("BDT")=Y
14EDT S %DT("A")=" Ending date: " W ! D ^%DT G:Y<1 EXIT
15 I Y<PX("BDT") W !!,$C(7),"End date cannot be before begin date!",! G EDT
16 S PX("EDT")=Y_.999999
17 W @IOF,!! S X=$$CTR("*** Report Sort Selection ***")
18 W !!! K DIR S SORTHDR="DATA SOURCE^CPT^ICD9^PATIENT^ELIGIBILITY"
19 F LOOP=1:1:$L(SORTHDR,U) S DESC=$P(SORTHDR,U,LOOP) W !,"("_LOOP_") "_DESC
20 W ! S DIR(0)="N^^I X<1!(X>5) K X",DIR("A")="Enter number between 1 and 5" D ^DIR Q:$D(DIRUT) S PXSRT=+X
21 S DIR(0)="S^D:DETAILED REPORT;S:STATISTICS ONLY",DIR("A")="Select report type",DIR("B")="DETAILED REPORT" D ^DIR Q:$D(DIRUT)
22 S RPTYP=Y
23 W !!,"This report requires 132 column output.",!
24 S %ZIS="QM" D ^%ZIS Q:POP
25 I $D(IO("Q")) D G EXIT
26 . S ZTRTN="RUN^PXRRMDR",ZTDESC="PCE MISSING DATA REPORT"
27 . S ZTSAVE("PX*")=""
28 . S ZTSAVE("RPTYP")="",ZTSAVE("SORTHDR")=""
29 . D ^%ZTLOAD W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
30 .K ZTSK,IO("Q"),ZTSAVE D HOME^%ZIS
31 ;
32RUN ;
33 U IO
34 K ^TMP("PXCRPW",$J),DIR S (PXOUT)=""
35 N LOOP,PXDT,I,VSN,VISITS,CLASSIF
36 S PXDT=(PX("BDT")-1)_.99999 K ^TMP("PXCRPW",$J)
37 F S PXDT=$O(^AUPNVSIT("ADEL",PXDT)) Q:PXDT>PX("EDT")!('PXDT) D
38 . S VSN=0 F S VSN=$O(^AUPNVSIT("ADEL",PXDT,VSN)) Q:'VSN D
39 . . S VISITS=$P($G(^AUPNVSIT(VSN,812)),U,3) S:VISITS="" VISITS="Unknown"
40 . . Q:'$D(PXDS(VISITS))
41 . . D ENCEVENT^PXKENC(VSN,0)
42 . . Q:$P($G(^TMP("PXKENC",$J,VSN,"VST",VSN,0)),U,7)="E" ;Historic encounter PX*1.0*174
43 . . Q:$$TESTPAT^VADPT($P($G(^TMP("PXKENC",$J,VSN,"VST",VSN,0)),U,5)) ;Test patient PX*1.0*174
44 . . N OE S OE=$O(^SCE("AVSIT",VSN,0)) Q:'OE Q:$P(^SCE(OE,0),U,6)]"" Q:$P(^SCE(OE,0),U,12)=12 ;Check if a child encounter, non-count PX*1.0*174
45 . . I '$D(^TMP("PXKENC",$J,VSN,"CPT")) D SET("Visit is missing a Procedure Code",1) Q
46 . . I $$EXOE^SDCOU2(OE) Q ;Determine if Encounter is Exempt from Outpatient Classifications and Diagnoses PX*1.0*174
47 . . N I,J S (I,CNT)=0 F S I=$O(^TMP("PXKENC",$J,VSN,"CPT",I)) Q:'I D
48 . . . S CNT=0 F J=5,9,10,11,12,13,14,15 I $P(^TMP("PXKENC",$J,VSN,"CPT",I,0),U,J) S CNT=CNT+1
49 . . . I CNT=0 D SET("Procedure: "_$$DISPLYP($P(^TMP("PXKENC",$J,VSN,"CPT",I,0),U))_" missing assoc. DXs",1)
50 . . S (I,J)=0 F S I=$O(^TMP("PXKENC",$J,VSN,"POV",I)) Q:'I D
51 . . . K CLASSIF S DFN=$$GET1^DIQ(9000010,VSN_",",.05,"I")
52 . . . I $$AO^SDCO22(DFN) S CLASSIF(1)=""
53 . . . I $$IR^SDCO22(DFN) S CLASSIF(2)=""
54 . . . I $$SC^SDCO22(DFN) S CLASSIF(3)=""
55 . . . I $$EC^SDCO22(DFN) S CLASSIF(4)=""
56 . . . I $$MST^SDCO22(DFN) S CLASSIF(5)=""
57 . . . I $$HNC^SDCO22(DFN) S CLASSIF(6)=""
58 . . . I +$P($$CVEDT^DGCV(DFN,PXDT),"^",3) S CLASSIF(7)=""
59 . . . I $D(CLASSIF),'$D(^TMP("PXKENC",$J,VSN,"POV",I,800)) D SET("Diagnosis: "_$$DISPLYDX($P(^TMP("PXKENC",$J,VSN,"POV",I,0),U))_" missing SC/EI",1) Q
60 . . . S J="" F S J=$O(CLASSIF(J)) Q:'J D
61 . . . . N SCEIREC S SCEIREC=$G(^TMP("PXKENC",$J,VSN,"POV",I,800))
62 . . . . I J=3&($P(SCEIREC,U,1)="") D SET("Diagnosis: "_$$DISPLYDX($P(^TMP("PXKENC",$J,VSN,"POV",I,0),U))_" missing Service Connect.",1)
63 . . . . I J=1&($P(SCEIREC,U,2)="")&($P(SCEIREC,U,1)'=1) D SET("Diagnosis: "_$$DISPLYDX($P(^TMP("PXKENC",$J,VSN,"POV",I,0),U))_" missing Agent Orange",3)
64 . . . . I J=2&($P(SCEIREC,U,3)="")&($P(SCEIREC,U,1)'=1) D SET("Diagnosis: "_$$DISPLYDX($P(^TMP("PXKENC",$J,VSN,"POV",I,0),U))_" missing Ion. Rad.",4)
65 . . . . I J=4&($P(SCEIREC,U,4)="")&($P(SCEIREC,U,1)'=1) D SET("Diagnosis: "_$$DISPLYDX($P(^TMP("PXKENC",$J,VSN,"POV",I,0),U))_" missing Env. Contam.",5)
66 . . . . I J=5&($P(SCEIREC,U,5)="") D SET("Diagnosis: "_$$DISPLYDX($P(^TMP("PXKENC",$J,VSN,"POV",I,0),U))_" missing MST",6)
67 . . . . I J=6&($P(SCEIREC,U,6)="") D SET("Diagnosis: "_$$DISPLYDX($P(^TMP("PXKENC",$J,VSN,"POV",I,0),U))_" missing Head/Neck Cancer",6)
68 . . . . I J=7&($P(SCEIREC,U,7)="") D SET("Diagnosis: "_$$DISPLYDX($P(^TMP("PXKENC",$J,VSN,"POV",I,0),U))_" missing Combat Vet",2)
69 U IO D PRINT,^%ZISC
70 K ^TMP("PXCRPW",$J)
71EXIT Q
72 ;
73STOP ;Check for stop task request
74 S:$G(ZTQUEUED) (PXOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0)
75 Q
76 ;
77EVAL ;
78 S PXLOC=$$GET1^DIQ(9000010,VSN_",",.22)
79 S:$G(PXLOC)="" PXLOC="Unknown"
80 N PXPTR S PXPTR=$O(^AUPNVPRV("AD",VSN,""))
81 S PXPRV=$$GET1^DIQ(9000010.06,PXPTR_",",.01)
82 S:$G(PRPRV)="" PXPRV="Unknown"
83 Q
84 ;
85DISPLYDX(PXCEPOV) ;
86 N ICDSTR
87 S ICDSTR=$$ICDDX^ICDCODE($P(PXCEPOV,"^"),$P(^AUPNVSIT(VSN,0),"^"))
88 Q $P(ICDSTR,"^",2) ;code
89 ;
90DISPLYP(PXCECPT) ;
91 N CPTSTR
92 S CPTSTR=$$CPT^ICPTCOD($P(PXCECPT,U),$P(^AUPNVSIT(VSN,0),"^"))
93 Q $P(CPTSTR,U,2) ;code
94 ;
95SET(SDX,PRIO) ;
96 N A1
97 S PRIO=$G(PRIO)
98 D EVAL
99 I PXSRT="" S A1="Unknown" D SET1(PRIO) Q
100 D @PXSRT
101 Q
102 ;
1031 ; Data Source
104 S A1=$$GET1^DIQ(9000010,VSN_",",81203)
105 S:A1="" A1=" "
106 D SET1(PRIO)
107 Q
108 ;
1092 ; CPT
110 N CPT,CPT1
111 S CPT=$O(^AUPNVCPT("AD",VSN,""))
112 S:CPT'="" CPT1=$$GET1^DIQ(9000010.18,CPT_",",.01)
113 S A1=$G(CPT1) D SET1(PRIO)
114 Q
115 ;
1163 ; ICD-9
117 N ICD,ICD9 S ICD="",ICD9="Unknown"
118 F S ICD=$O(^AUPNVPOV("AD",VSN,ICD)) Q:'ICD D
119 . S ICD9=$$GET1^DIQ(9000010.07,ICD,.01)
120 S A1=ICD9 D SET1(PRIO)
121 Q
122 ;
1234 S A1=$$GET1^DIQ(9000010,VSN_",",.05)
124 S:A1="" A1="Unknown"
125 D SET1(PRIO)
126 Q
127 ;
1285 ; Eligibility
129 S A1=$$GET1^DIQ(9000010,VSN_",",.21)
130 S:A1="" A1="Unknown"
131 D SET1(PRIO)
132 Q
133 ;
1346 ; Default Sort
135 S A1="Default" D SET1(PRIO)
136 Q
137 ;
138SET1(PR) ; set temp global
139 I A1="" S A1="Unknown"
140 S Y=$$GET1^DIQ(9000010,VSN_",",.01) X ^DD("DD") S VDT=Y
141 S:VDT="" VDT="Unknown" S VDT=$P(VDT,"@",1)
142 S ^TMP("PXCRPW",$J,PXLOC,PXPRV,A1,VDT,VSN,PR,SDX)=VSN
143 Q
144PRINT ; Print Report
145 N A,I,REC,TOT,TOTE,Y,SHDR
146 N PAT,SSN,SSND,TYP,VIN,DEFD,ENCD
147 K TOT,TOTE
148 S DEFD="TOTAL DEFECTS FOR ",ENCD="TOTAL ENCOUNTERS FOR "
149 S (TOT(1),TOTE(1))=0
150 S LOC="" F S LOC=$O(^TMP("PXCRPW",$J,LOC)),HDR=0 Q:LOC=""!(POP) D
151 . S (TOT(2),TOTE(2))=0
152 . S PROV="" F S PROV=$O(^TMP("PXCRPW",$J,LOC,PROV)) Q:PROV=""!(POP) D
153 . . S (TOT(3),TOTE(3))=0
154 . . S SORT="" F S SORT=$O(^TMP("PXCRPW",$J,LOC,PROV,SORT)) Q:SORT=""!(POP) D
155 . . . S (TOT(4),TOTE(4))=0
156 . . . S VDT="" F S VDT=$O(^TMP("PXCRPW",$J,LOC,PROV,SORT,VDT)) Q:VDT=""!(POP) D
157 . . . . S (TOT(5),TOTE(5))=0
158 . . . . S VIN="" F S VIN=$O(^TMP("PXCRPW",$J,LOC,PROV,SORT,VDT,VIN)),HDR1=0 Q:VIN=""!(POP) D
159 . . . . . S TOT(6)=0
160 . . . . . S TOTE(5)=TOTE(5)+1
161 . . . . . S PR="" F S PR=$O(^TMP("PXCRPW",$J,LOC,PROV,SORT,VDT,VIN,PR)) Q:PR="" D
162 . . . . . . S SHDR=0
163 . . . . . . S SDX="" F S SDX=$O(^TMP("PXCRPW",$J,LOC,PROV,SORT,VDT,VIN,PR,SDX)) Q:SDX=""!(POP) D
164 . . . . . . . S REC=^TMP("PXCRPW",$J,LOC,PROV,SORT,VDT,VIN,PR,SDX)
165 . . . . . . . S PAT=$$GET1^DIQ(9000010,REC_",",.05)
166 . . . . . . . S SSN=$$GET1^DIQ(2,$$GET1^DIQ(9000010,REC_",",.05,"I"),.09)
167 . . . . . . . S SSND=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
168 . . . . . . . S EDT=$$GET1^DIQ(9000010,REC_",",.01)
169 . . . . . . . S TYP=$$GET1^DIQ(9000010,REC_",",15001)
170 . . . . . . . S USR=$$GET1^DIQ(9000010,REC_",",.23)
171 . . . . . . . D:HDR=0 HEADER Q:POP
172 . . . . . . . I RPTYP="D" D
173 . . . . . . . . I HDR1=0 D
174 . . . . . . . . . W ! S $P(HLINE,"-",132)="" W HLINE
175 . . . . . . . . . W !,$E(PAT,1,25),?26,SSND,?39,EDT,?59,$E(TYP,1,15),?75,$E(USR,1,15) S HDR1=1
176 . . . . . . . . W ?94,$E(SDX,1,37),!
177 . . . . . . . S TOT(6)=TOT(6)+1
178 . . . . . . . I $Y>(IOSL-4) S HDR=0
179 . . . . . . Q:POP
180 . . . . . Q:POP
181 . . . . . I $Y>(IOSL-4) D HEADER Q:POP
182 . . . . . S SHDR=1
183 . . . . . W:RPTYP="D" !?94,DEFD_TYP_": ",TOT(6),!
184 . . . . . S TOT(5)=TOT(5)+TOT(6)
185 . . . . Q:POP
186 . . . . W !?6,DEFD_VDT_": ",TOT(5)
187 . . . . W !?6,ENCD_VDT_": ",TOTE(5)
188 . . . . S TOT(4)=TOT(4)+TOT(5)
189 . . . . S TOTE(4)=TOTE(4)+TOTE(5)
190 . . . Q:POP
191 . . . W !?4,DEFD_"SORT VALUE - "_SORT_": ",TOT(4)
192 . . . W !?4,ENCD_"SORT VALUE - "_SORT_": ",TOTE(4)
193 . . . S TOT(3)=TOT(3)+TOT(4)
194 . . . S TOTE(3)=TOTE(3)+TOTE(4)
195 . . Q:POP
196 . . W !?2,DEFD_PROV_": ",TOT(3)
197 . . W !?2,ENCD_PROV_": ",TOTE(3)
198 . . S TOT(2)=TOT(2)+TOT(3)
199 . . S TOTE(2)=TOTE(2)+TOTE(3)
200 . Q:POP
201 . W !,DEFD_LOC_": ",TOT(2)
202 . W !,ENCD_LOC_": ",TOTE(2)
203 . S TOT(1)=TOT(1)+TOT(2)
204 . S TOTE(1)=TOTE(1)+TOTE(2)
205 Q:POP
206 I TOT(1)+TOTE(1)=0 W !!,"No Data to print",! Q
207 W !!,"GRAND TOTAL NUMBER OF DEFECTS: ",TOT(1)
208 W !,"GRAND TOTAL NUMBER OF ENCOUNTERS = ",TOTE(1)
209 Q
210 ;
211HEADER ;print header
212 N %,X,Y,MSG,HLINE,DLINE
213 I (PXPAGE>0)&(($E(IOST)="C")&(IO=IO(0))) D
214 . S DIR(0)="E"
215 . W !
216 . D ^DIR K DIR
217 I $D(DUOUT)!($D(DTOUT)) D Q
218 . S POP=1
219 I PXPAGE>0 W:$D(IOF) @IOF
220 S PXPAGE=PXPAGE+1
221 W !
222 S X=$$CTR132("PCE MISSING DATA REPORT") W !
223 D NOW^%DTC S Y=% X ^DD("DD") S X=$$CTR(Y) W !
224 S X=$$CTR132("By Clinic, Provider, and Date") W !
225 S Y=PX("BDT") X ^DD("DD") S STDT=$P(Y,"@",1)
226 S Y=PX("EDT") X ^DD("DD") S ENDT=$P(Y,"@",1)
227 S MSG=STDT_" through "_ENDT
228 S X=$$CTR(MSG) W !
229 S X=$$CTR132("Page "_PXPAGE) W !
230 W !!,"Patient",?26,"SSN",?39,"Date/Time",?59,"Enc. ID",?75,"Created by User",?94,"Defect",!
231 S $P(HLINE,"=",132)="" W HLINE,!
232 Q:SHDR
233 W !,LOC
234 W !?2,PROV
235 N SORTD S SORTD=SORT
236 S:SORTD=" " SORTD="Unknown"
237 W !?4,"SORT VALUE: ",$P(SORTHDR,U,PXSRT),"= ",SORTD
238 S:VDT="" VDT="Unknown"
239 W !?6,$P(VDT,"@",1),":"
240 S HDR=1
241 Q
242 ;
243CTR(X) ;
244 W ?(IOM-$L(X))\2,X
245 Q 1
246 ;
247CTR132(X) ;
248 W ?(132-$L(X))\2,X
249 Q 1
250 ;
Note: See TracBrowser for help on using the repository browser.