close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJDIPR.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJDIPR.m@ 846

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

initial load of WorldVistAEHR
File size: 8.8 KB
RevLine 
1IBJDIPR ;ALB/HMC - PERCENTAGE OF PATIENTS PREREGISTERED REPORT ;10-MAY-2004
2 ;;2.0;INTEGRATED BILLING;**272,305**;21-MAR-1994
3 ;
4EN ; - Option entry point.
5 ;
6 D ENQ1
7 W !!,"This report provides number of patients treated, the number of"
8 W !,"patients pre-registered, % of patients pre-registered, number of"
9 W !,"patients pre-registered past the pre-registration time frame,"
10 W !,"number of patients never pre-registered, the clinic exclusions,"
11 W !,"and the eligibility exclusions.",!!
12 ;
13DATE D DATE^IBOUTL I IBBDT=""!(IBEDT="") G ENQ
14 ;
15 ;
16TIME ;Pre-Registration time frame, default is 180 days
17 ;
18 S DIR(0)="N^^I X'>0 K X"
19 S DIR("A")="Pre-Registration time frame (days)" W !
20 S DIR("B")=180
21 S DIR("?")="^D THLP^IBJDIPR"
22 D ^DIR
23 S IBPRF=Y
24 I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
25 ;
26 K DIR,DIROUT,DTOUT,DUOUT,DIRUT
27 S DIR(0)="Y",DIR("B")="NO",DIR("?")="^D EHLP^IBJDIPR"
28 S DIR("A")="Detailed list of Exclusions (Y/N)"
29 D ^DIR
30 S IBEXC=+Y
31 I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
32 K DIR,DIROUT,DTOUT,DUOUT,DIRUT
33 ;
34 W !!,"This report only requires an 80 column printer."
35 W !!,"Note: This report may take a while to run."
36 W !!,"You should queue this report to run after normal business hours.",!
37 ;
38 ; - Select a device.
39 S %ZIS="QM" D ^%ZIS G:POP ENQ
40 I $D(IO("Q")) D G ENQ
41 .S ZTRTN="DQ^IBJDIPR",ZTDESC="IB - PERCENTAGE OF PATIENTS PREREGISTERED"
42 .S ZTSAVE("IB*")=""
43 .D ^%ZTLOAD
44 .W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
45 .K ZTSK,IO("Q") D HOME^%ZIS
46 ;
47 U IO
48 ;
49DQ ; - Tasked entry point.
50 ;
51 N IBQUERY,IBQUERY1,DGNAM
52 K IB,^TMP("IBJDIPR",$J),^TMP("IBJDIPR1",$J)
53 ;
54 ;Temporary global IBJDIPR contains outpatients found for date range in the outpatient encounter file"
55 ;Temporary global IBJDIPR1 contains the clinic exclusions found in the MAS parameter file"
56 ;
57 S (IBQ,DGPREC,DGPREE)=0
58 F I="TOT","PRE","PAST","NEVR" S IB(I)=0
59 ;
60 ;Build exclusion temporary file from MAS parameter file,
61 ; ^DG(43 - dbia 4242
62 ;
63 ;Get clinic exclusions and clinic name from ^SC (Hospital location file)
64 ;dbia 401
65 S X="" F S X=$O(^DG(43,1,"DGPREC","B",X)) Q:X="" D
66 . S DGNAM=$P($G(^SC(X,0)),U,1) I DGNAM="" Q
67 . S ^TMP("IBJDIPR1",$J,"DGPREC",X)=""
68 . S ^TMP("IBJDIPR1",$J,"DGPRECA",DGNAM_U_X)=X ;index sorted by name
69 . S DGPREC=DGPREC+1
70 ;
71 ;Get eligibility exclusions and eligibility name from ^DIC(8 dbia 427
72 ;
73 S X="" F S X=$O(^DG(43,1,"DGPREE","B",X)) Q:X="" D
74 . S DGNAM=$P($G(^DIC(8,X,0)),U,1) I DGNAM="" Q
75 . S ^TMP("IBJDIPR1",$J,"DGPREE",X)=""
76 . S ^TMP("IBJDIPR1",$J,"DGPREEA",DGNAM_U_X)=X ;index sorted by name
77 . S DGPREE=DGPREE+1
78 ;
79 ; - Find outpatients treated within the user-specified date range.
80 D OUTPT("",IBBDT,IBEDT,"S:IBQ SDSTOP=1 I 'IBQ,$$ENCHK^IBJDI5(Y0) D ENC^IBJDIPR(Y0)","Percentage of Patients Pre-registered",.IBQ,"IBJDIPR",.IBQUERY)
81 D CLOSE^IBSDU(.IBQUERY),CLOSE^IBSDU(.IBQUERY1) I IBQ G ENQ
82 ;
83 ;Find pre-registered patients
84 ;Use file 41.41 (^DGS), Pre-registration audit file
85 ;dbia 4425
86 ;
87 S DFN=""
88 F S DFN=$O(^TMP("IBJDIPR",$J,DFN)) Q:DFN="" D
89 . S TRDAT=^TMP("IBJDIPR",$J,DFN) ;Get treatment date
90 . S IB("TOT")=IB("TOT")+1 ;Total unique patients treated
91 . S PRDAT=TRDAT+.0000001
92 . S PRDAT=$O(^DGS(41.41,"ADC",DFN,PRDAT),-1) ;Most recent pre-reg date
93 . I PRDAT="" S IB("NEVR")=IB("NEVR")+1 Q ;never pre-registered
94 . I PRDAT<$$FMADD^XLFDT(TRDAT,-IBPRF) S IB("PAST")=IB("PAST")+1 Q ;past time frame
95 . S IB("PRE")=IB("PRE")+1 ;pre-registered
96 ;
97 ; - Print the reports.
98 ; QUIT if this is a electronic transmission to the ARC -IB patch 305
99 Q:$G(IBARFLAG)
100 S (IBQ,IBPAG)=0 D NOW^%DTC S IBRUN=$$DAT2^IBOUTL(%)
101 I 'IBQ D SUM,PAUSE
102ENQ K ^TMP("IBJDIPR",$J),^TMP("IBJDIPR1",$J)
103 I $D(ZTQUEUED) S ZTREQ="@" G ENQ1
104 ;
105 D ^%ZISC
106ENQ1 K IB,IBQ,IBBDT,IBEDT,IBD,IBPAG,IBRUN,IBOED,IBPRF
107 K DFN,POP,I,X,X1,X2,Y,%,%ZIS,ZTDESC,ZTRTN,ZTSAVE,ZTREQ,ZTQUEUED
108 K DIR,DIROUT,DTOUT,DUOUT,DIRUT
109 K DGPREC,DGPREE,PRDAT,TRDAT,IBEXC,DGEE,DGEC,PCENT,TAB,DGNAM
110 Q
111 ;
112OUTPT(DFN,IBBDT,IBEDT,IBCBK,IBMSG,IBQ,IBSUBSCR,IBQUERY,IBDIR) ;
113 ; Input: DFN = IEN of patient if using PATIENT/DATE index, otherwise,
114 ; if null or 0, DATE/TIME index will be used
115 ; IBCBK = The MUMPS code to execute when valid enctr found
116 ; IBBDT/IBEDT = The start/end dates
117 ; IBMSG = The text to send to STOP PROCESSING CALL (if null, no
118 ; call made)
119 ; IBQ = Flag that says whether or not the process was stopped
120 ; by user
121 ; IBQUERY = The # of the QUERY OBJECT to be used to extract outpt
122 ; visits
123 ; IBDIR = Null to look forward, 'B' to look backward thru file
124 ;
125 N IBVAL,IBFILTER
126 S IBVAL("BDT")=IBBDT,IBVAL("EDT")=IBEDT_".99" S:$G(DFN) IBVAL("DFN")=DFN
127 ;
128 ; - Look at parent encounters, completely checked out, check user
129 ; requested to quit, process each pt only once if IBSUBSCR'=null
130 S IBFILTER=""
131 S IBCBK="I '$P(Y0,U,6),$P(Y0,U,7),$S((Y#100)'=0:1,$G(IBMSG)="""":1,1:'$$STOP^IBJDI21(.IBQ,IBMSG))"_" "_IBCBK
132 S IBDIR=$S($G(IBDIR)="":"",1:"BACKWARD")
133 ;
134 ;ibsdu will use ^SD(409.1), Standard encounter query, to process
135 ;file 409.68 (^SCE) - dbia402 for outpatient encounter data.
136 ;
137 D SCAN^IBSDU($S($G(DFN):"PATIENT/DATE",1:"DATE/TIME"),.IBVAL,IBFILTER,IBCBK,0,.IBQUERY,IBDIR) K ^TMP("DIERR",$J)
138 Q
139 ;
140ENC(IBOED) ; - Encounter extract.
141 ; Input: IBOED = Data from outpatient encounter file, ^SCE.
142 ;
143 S DFN=+$P(IBOED,U,2) I 'DFN Q
144 ;Check exclusions
145 I $P(IBOED,U,4)]"",$D(^TMP("IBJDIPR1",$J,"DGPREC",$P(IBOED,U,4))) Q ;Clinic exclusion
146 I $P(IBOED,U,13)]"",$D(^TMP("IBJDIPR1",$J,"DGPREE",$P(IBOED,U,13))) Q ;Eligibility exclusion
147 D PROC(DFN,IBOED) ; Process patient.
148 Q
149 ;
150PROC(DFN,IBOED) ; - Process each specific patient.
151 ; Input: DFN = Pointer to the patient in file #2
152 ; IBOED = Data from outpatient encounter file, ^SCE.
153 ;
154 ; Pre-set variables IB array, IBBDT, IBEDT are required.
155 ;
156 I $$TESTP^IBJDI1(DFN) Q ; Test patient.
157 D ELIG^VADPT G:'VAEL(4) PRCQ ; Patient is not a vet.
158 ;
159 ; - Set patient index
160 S ^TMP("IBJDIPR",$J,DFN)=$P(IBOED,U,1)
161 ;
162PRCQ K VA,VAERR,VAEL
163 Q
164 ;
165SUM ; - Print the summary report.
166 D HEAD Q:IBQ
167 W !!?15,"Patients pre-registered from ",$$DAT1^IBOUTL(IBBDT)," - ",$$DAT1^IBOUTL(IBEDT)
168 W !!?17,"Pre-registration time frame: ",$J(IBPRF,5)," days"
169 W !!?24,"Run Date: ",IBRUN,!?10,$$DASH(55),!!
170 ;
171 W ?35,"*Number of Unique Patients Treated: ",$J(IB("TOT"),5)
172 W !?1,"Unique Outpatients Pre-registered within pre-registration time frame: ",$J(IB("PRE"),5)
173 S PCENT=0 I IB("TOT") S PCENT=(IB("PRE")/IB("TOT"))*100
174 W !?47,"Percent Pre-registered: ",$J(PCENT,5,2),"%"
175 W !!?3,"Unique Outpatients Pre-registered past pre-registration time frame: ",$J(IB("PAST"),5)
176 W !?30,"Unique Outpatients never Pre-registered: ",$J(IB("NEVR"),5)
177 W !!?8,"*Counts may not include all patients because of exclusions."
178 W !!?37,"Number of Eligibility Exclusions: ",$J(DGPREE,5)
179 W !!?42,"Number of Clinic Exclusions: ",$J(DGPREC,5)
180 I 'IBEXC Q
181 I DGPREE D
182 .S DGEE=1
183 .D PAUSE Q:IBQ D HEAD Q:IBQ
184 .S X="" F I=1:1 S X=$O(^TMP("IBJDIPR1",$J,"DGPREEA",X)) Q:X="" D Q:IBQ
185 ..I $Y>(IOSL-4) D PAUSE Q:IBQ D HEAD Q:IBQ
186 ..S TAB=$S((I#2):10,1:45)
187 ..W ?TAB,$E($P(X,U,1),1,30) W:'(I#2) !
188 I DGPREC D
189 .S DGEC=1,DGEE=0
190 .S X="" F I=1:1 S X=$O(^TMP("IBJDIPR1",$J,"DGPRECA",X)) Q:X="" D Q:IBQ
191 ..I I=1 D Q:IBQ
192 ...I ($Y+4)>(IOSL-4) D PAUSE Q:IBQ D HEAD Q
193 ...W !!?10,"Clinic Exclusions",!?9,$$DASH(19),!
194 ..I $Y>(IOSL-4) D PAUSE Q:IBQ D HEAD Q:IBQ
195 ..S TAB=$S((I#2):10,1:45)
196 ..W ?TAB,$E($P(X,U,1),1,30) W:'(I#2) !
197 Q
198 ;
199HEAD ; - Report Header
200 ;
201 I $E(IOST,1,2)="C-"!(IBPAG) W @IOF,*13
202 S IBPAG=IBPAG+1
203 W !?21,"PERCENTAGE OF PATIENTS PRE-REGISTERED",?71,"Page: ",IBPAG
204 I IBPAG=1 W !!?33,"SUMMARY REPORT" Q
205 W !!?24,"Run Date: ",IBRUN,!?10,$$DASH(55),!!
206 W !?10,"Listing of all Exclusions: ",!
207 I $G(DGEE) W !!?10,"Eligibility Exclusions",!?9,$$DASH(24),!
208 I $G(DGEC) W !!?10,"Clinic Exclusions",!?9,$$DASH(19),!
209 S IBQ=$$STOP^IBOUTL("Percentage of Patients Pre-registered")
210 Q
211 ;
212DASH(X) ; - Return a dashed line.
213 Q $TR($J("",X)," ","=")
214 ;
215PAUSE ; - Page break.
216 I $E(IOST,1,2)'="C-" Q
217 N DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
218 S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S IBQ=1
219 Q
220 ;
221THLP ; - 'Pre-Registration time frame (days)' prompt
222 ;
223 W !!,"Number of days to search for pre-registered patients."
224 W !,"Number of days must be greater that zero."
225 W !,"Select '<CR>' to accept the default 180 days."
226 W !?11,"'^' to quit."
227 Q
228 ;
229EHLP ; - 'Detailed list of Exclusions' prompt
230 ;
231 W !!,"Select '<CR>' to print only the number of eligibility and clinic exclusions."
232 W !!?11,"'Y' to print list of all eligibility and clinic exclusions."
233 W !?11,"'^' to quit."
234 Q
235IBAR(IBBDT,IBEDT) ;Entry point for Vista IB AR data to ARC
236 ;patch 305 - called by IBRFN4
237 N IBPRF,IBEXC,IBARFLAG,IB,IBPERC,IBARDATA
238 S IBPRF=180,IBEXC=0,IBARFLAG=1
239 D DQ
240 I 'IB("TOT") S IBPERC=0 G IBARD
241 S IBPERC=IB("PRE")/IB("TOT")*100,IBPERC=$FN(IBPERC,"",2)
242IBARD S IBARDATA=IB("TOT")_U_IB("PRE")_U_IBPERC_U_IB("PAST")_U_IB("NEVR")
243 Q IBARDATA
Note: See TracBrowser for help on using the repository browser.