source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJDI7.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.4 KB
Line 
1IBJDI7 ;ALB/CPM - OUTPATIENT WORKLOAD REPORT ; 19-DEC-96
2 ;;2.0;INTEGRATED BILLING;**69,91,98,100,118,133,339**;21-MAR-94;Build 2
3 ;
4EN ; - Option entry point.
5 ;
6 W !!,"This report provides a measure of the number and types of"
7 W !,"Outpatient Services that are provided in the Medical Center.",!
8 ;
9DATE D DATE^IBOUTL I IBBDT=""!(IBEDT="") G ENQ
10 ;
11 ; - Sort by division?
12 S DIR(0)="Y",DIR("B")="NO"
13 S DIR("A")="Do you wish to sort this report by division"
14 S DIR("?")="^D DHLP^IBJDI7" W !
15 D ^DIR S IBSORT=+Y I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
16 K DIR,DIROUT,DTOUT,DUOUT,DIRUT
17 ;
18 ; - Select division(s).
19 I IBSORT D PSDR^IBODIV G:Y<0 ENQ
20 ;
21 W !!,"This report only requires an 80 column printer."
22 ;
23 W !!,"Note: This report may take a while to run."
24 W !?6,"You should queue this report to run after normal business hours.",!
25 ;
26 ; - Select a device.
27 S %ZIS="QM" D ^%ZIS G:POP ENQ
28 I $D(IO("Q")) D G ENQ
29 .S ZTRTN="DQ^IBJDI7",ZTDESC="IB - OUTPATIENT WORKLOAD REPORT"
30 .F I="IBBDT","IBEDT","IBSORT","VAUTD","VAUTD(" S ZTSAVE(I)=""
31 .D ^%ZTLOAD
32 .W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
33 .K ZTSK,IO("Q") D HOME^%ZIS
34 ;
35 U IO
36 ;
37DQ ; - Tasked entry point.
38 ;
39 I $G(IBXTRACT) D E^IBJDE(7,1) ; Change extract status.
40 ;
41 N IBQUERY K IB
42 S IBC="TOT^NSC^SC^SCS^SCN",IBQ=0
43 I IBSORT D
44 .S I=0 F S I=$S(VAUTD:$O(^DG(40.8,I)),1:$O(VAUTD(I))) Q:'I D
45 ..S J=$P(^DG(40.8,I,0),U),IB(J,"GTOT")=0
46 ..F K=1:1:5 S IB(J,$P(IBC,U,K)_"-A")=0 S:K<4 IB(J,$P(IBC,U,K)_"-I")=0
47 S IB("ZZALL","GTOT")=0
48 F I=1:1:5 D
49 .S IB("ZZALL",$P(IBC,U,I)_"-A")=0 S:I<4 IB("ZZALL",$P(IBC,U,I)_"-I")=0
50 ;
51 ; - Find outpatient encounters within the user-specified date range.
52 D OUTPT^IBJDI21("",IBBDT,IBEDT,"S:IBQ SDSTOP=1 D:'IBQ ENC^IBJDI7(Y,Y0)","Outpatient Workload Report",.IBQ,"",.IBQUERY)
53 D CLOSE^IBSDU(.IBQUERY)
54 ;
55 I IBQ G ENQ
56 ;
57 I $G(IBXTRACT) D E^IBJDE(7,0) G ENQ ; Extract summary data.
58 ;
59 ; - Print the report.
60 S (IBPAG,IBQ)=0 D NOW^%DTC S IBRUN=$$DAT2^IBOUTL(%)
61 S IBDIV="" F S IBDIV=$O(IB(IBDIV)) Q:IBDIV="" D SUM Q:IBQ
62 ;
63ENQ I $D(ZTQUEUED) S ZTREQ="@" G ENQ1
64 ;
65 D ^%ZISC
66ENQ1 K IB,IBC,IBH,IBQ,IBBDT,IBEDT,IBD,IBDIV,IBOE,IBOED,IBPAG,IBRUN,IBSORT
67 K IBPER,IBINS,IBSC,%,%ZIS,DFN,POP,I,J,K,X,Y,VA,VAEL,VAERR,VAUTD
68 K ZTDESC,ZTRTN,ZTSAVE
69 Q
70 ;
71ENC(IBOE,IBOED) ; - Extract encounter - must be called from DQ above.
72 I $$TESTP^IBJDI1(+$P(IBOED,U,2)) G ENCQ ; Test patient.
73 ;
74 I IBSORT D G:'$D(IB(IBDIV,"TOT-A")) ENCQ
75 .S IBDIV=+$P(IBOED,U,11)
76 .S IBDIV=$P($G(^DG(40.8,$S('IBDIV:+$$PRIM^VASITE(),1:IBDIV),0)),U)
77 ;
78 S IBINS=$$INS(IBOE,IBOED) ; Check if insured encounter.
79 ;
80 ; - Set main totals.
81 S IB("ZZALL","GTOT")=IB("ZZALL","GTOT")+1
82 S IB("ZZALL","TOT-A")=IB("ZZALL","TOT-A")+1
83 I IBINS S IB("ZZALL","TOT-I")=IB("ZZALL","TOT-I")+1
84 I IBSORT D
85 .S IB(IBDIV,"GTOT")=IB(IBDIV,"GTOT")+1
86 .S IB(IBDIV,"TOT-A")=IB(IBDIV,"TOT-A")+1
87 .I IBINS S IB(IBDIV,"TOT-I")=IB(IBDIV,"TOT-I")+1
88 ;
89 ; - Set NSC totals.
90 S DFN=+$P(IBOED,U,2) D ELIG^VADPT S IBSC=+VAEL(3)
91 I 'IBSC D G ENCQ
92 .S IB("ZZALL","NSC-A")=IB("ZZALL","NSC-A")+1
93 .I IBINS S IB("ZZALL","NSC-I")=IB("ZZALL","NSC-I")+1
94 .I IBSORT D
95 ..S IB(IBDIV,"NSC-A")=IB(IBDIV,"NSC-A")+1
96 ..I IBINS S IB(IBDIV,"NSC-I")=IB(IBDIV,"NSC-I")+1
97 ;
98 ; - Set SC totals.
99 S IB("ZZALL","SC-A")=IB("ZZALL","SC-A")+1
100 I IBINS S IB("ZZALL","SC-I")=IB("ZZALL","SC-I")+1
101 I IBSORT D
102 .S IB(IBDIV,"SC-A")=IB(IBDIV,"SC-A")+1
103 .I IBINS S IB(IBDIV,"SC-I")=IB(IBDIV,"SC-I")+1
104 ;
105 ; - If care related to an SC condition, set SCS totals.
106 I $$SC(IBOE) D G ENCQ
107 .S IB("ZZALL","SCS-A")=IB("ZZALL","SCS-A")+1
108 .I IBSORT S IB(IBDIV,"SCS-A")=IB(IBDIV,"SCS-A")+1
109 ;
110 ; - Set SCN totals.
111 S IB("ZZALL","SCN-A")=IB("ZZALL","SCN-A")+1
112 I IBSORT S IB(IBDIV,"SCN-A")=IB(IBDIV,"SCN-A")+1
113 ;
114ENCQ Q
115 ;
116SUM ; - Print the summary report.
117 F X="-A","-I" D Q:IBQ
118 .I X["A" W @IOF,*13
119 .I X["I",$E(IOST,1,2)="C-" W @IOF,*13
120 .E W:X["I" !!
121 .;
122 .; - Print summary header.
123 .W !!?$S(X["A":17,1:12),"OUTPATIENT ENCOUNTER WORKLOAD - "
124 .W $S(X["A":"ALL ENCOUNTERS",1:"INSURED ENCOUNTERS ONLY")
125 .S IBH="SUMMARY REPORT FOR "_$S(IBDIV="ZZALL":"ALL DIVISIONS",1:IBDIV)
126 .S IBC=(80-$L(IBH)/2)\1 W !?IBC,IBH
127 .W !!?$S(X["A":15,1:11),"For ",$S(X["I":"Insured ",1:""),"Outpatient Encounters from ",$$DAT1^IBOUTL(IBBDT)," - ",$$DAT1^IBOUTL(IBEDT)
128 .I $E(IOST,1,2)="C-" W !!?24,"Run Date: ",IBRUN
129 .S IBC=$S(X["A":"17^46",1:"12^55") W !?+IBC,$$DASH($P(IBC,U,2)),!!
130 .;
131 .; - Print summary statistics.
132 .S IBPER(1)=$J($S('IB(IBDIV,"TOT"_X):0,1:IB(IBDIV,"NSC"_X)/IB(IBDIV,"TOT"_X)*100),0,2),IBPER(2)=$J($S('IB(IBDIV,"TOT"_X):0,1:100-IBPER(1)),0,2)
133 .W ?$S(X["A":27,1:21),"Number of Outpatient Encounters:",?$S(X["A":60,1:54),$J(IB(IBDIV,"TOT"_X),7)
134 .W !?$S(X["A":21,1:15),"Number of Encounters for NSC Veterans:",?$S(X["A":60,1:54),$J(IB(IBDIV,"NSC"_X),7)," (",IBPER(1),"%)"
135 .W !?$S(X["A":22,1:16),"Number of Encounters for SC Veterans:",?$S(X["A":60,1:54),$J(IB(IBDIV,"SC"_X),7)," (",IBPER(2),"%)"
136 .I X["A" D
137 ..S IBPER(3)=$J($S('IB(IBDIV,"SC-A"):0,1:IB(IBDIV,"SCS-A")/IB(IBDIV,"SC-A")*100),0,2),IBPER(4)=$J($S('IB(IBDIV,"SC-A"):0,1:100-IBPER(3)),0,2)
138 ..W !?4,"Number of Service Connected Encounters for SC Veterans:",?60,$J(IB(IBDIV,"SCS-A"),7)," (",IBPER(3),"%)"
139 ..W !?3,"Number of Non-Svc. Connected Encounters for SC Veterans:",?60,$J(IB(IBDIV,"SCN-A"),7)," (",IBPER(4),"%)"
140 .E D
141 ..S IBPER(5)=$J($S('IB(IBDIV,"GTOT"):0,1:IB(IBDIV,"TOT-I")/IB(IBDIV,"GTOT")*100),0,2)
142 ..W !!?5,"Percentage of Insured Outpatient Encounters for ",$S(IBDIV="ZZALL":"All Divisions",1:"This Division"),": ",IBPER(5),"%"
143 .D PAUSE
144 Q
145 ;
146DASH(X) ; - Return a dashed line.
147 Q $TR($J("",X)," ","=")
148 ;
149PAUSE ; - Page break.
150 I $E(IOST,1,2)'="C-" Q
151 N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
152 F IBX=$Y:1:(IOSL-3) W !
153 S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S IBQ=1
154 Q
155 ;
156INS(IBOE,IBOED) ; - Is this an insured encounter?
157 ; Input: IBOE = IEN of outpatient encounter in file #409.68
158 ; IBOED = Outpatient encounter in file #409.68
159 ; Output: 1 = Insured encounter
160 ; 0 = Not an insured encounter
161 ;
162 N DFN,IBCK,IBPB,VA,VAEL,VAERR,X0
163 S DFN=+$P(IBOED,U,2)
164 I $G(^DPT(DFN,"VET"))'="Y" G INSQ ; Patient not a veteran.
165 I '$$INSURED^IBCNS1(DFN,+IBOED\1) G INSQ ; Patient not insured.
166 ;
167 ; - Check if encounter was made non-billable in Claims Tracking.
168 I $P($G(^IBT(356,+$O(^IBT(356,"ASCE",IBOE,0)),0)),U,19) G INSQ
169 ;
170 ; - Check encounter for non-billable appt. type (1), non-count
171 ; clinic (2), non-billable clinic (3,12), admission by 11:59pm of
172 ; encounter date (5), non-billable stop code (7,8), non-billable
173 ; disposition (10), and parent encounter (11). If IBPB equals one
174 ; of these numbers, Y will be set to 0 (Not an insured encounter).
175 F X0=1,2,3,5,7,8,10,11,12 S IBCK(X0)=""
176 S X0=$$BILLCK^IBAMTEDU(IBOE,IBOED,.IBCK,.IBPB)
177 I $G(IBPB) G INSQ
178 ;
179 I $$ENCL^IBAMTS2(IBOE)[1 G INSQ ; Care is related to AO/IR/SWA/SC/MST/HNC/CV/SHAD.
180 ;
181 S Y=1 Q Y
182INSQ S Y=0 Q Y
183 ;
184SC(OE) ; - Is the encounter related to the veteran's SC condition?
185 ; Input: OE = IEN of outpatient encounter in file #409.68
186 ; Output: SC = 1 (Encounter related to SC condition)
187 ; 0 (Encounter NOT related to SC condition)
188 ;
189 N CL,CLD,SC
190 S (CL,SC)=0 F S CL=$O(^SDD(409.42,"OE",+$G(OE),CL)) Q:'CL D Q:SC
191 .S CLD=$G(^SDD(409.42,CL,0)) I +CLD=3,$P(CLD,U,3) S SC=1
192 Q SC
193 ;
194DHLP ; - Display 'Sort by division' help.
195 W !,"Enter RETURN to summarize all outpt. encounters without regard to"
196 W !,"division, or 'Yes' to select those divisions for which a separate"
197 W !,"summary report should be created."
198 Q
Note: See TracBrowser for help on using the repository browser.