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

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

initial load of WorldVistAEHR

File size: 6.5 KB
Line 
1IBJDB22 ;ALB/RB - REASONS NOT BILLABLE REPORT (PRINT) ;19-JUN-00
2 ;;2.0;INTEGRATED BILLING;**123,159**;21-MAR-94
3 ;
4EN ; - Entry point from IBJDB21.
5 ;
6 ; - Extract summary data.
7 I $G(IBXTRACT) D EXTMO(.IB) G ENQ
8 ;
9 S (IBQ,ECNT,ETOT,SCNT,STOT)=0 D NOW^%DTC S IBRUN=$$DAT2^IBOUTL(%)
10 ;
11 S IBDIV="" I 'IBSD S VAUTD(0)=""
12 F S IBDIV=$O(VAUTD(IBDIV)) Q:IBDIV="" D I IBQ Q
13 . F IBEP=1:1:4 I IBSEL[IBEP D I IBQ Q
14 . . D @($S(IBRPT="D":"DET",1:"SUM"))
15 ;
16 I IBQ G ENQ
17 ;
18 I 'IBQ,IBRPT="D" D
19 . S IBDIV="" I 'IBSD S VAUTD(0)=""
20 . F S IBDIV=$O(VAUTD(IBDIV)) Q:IBDIV="" D I IBQ Q
21 . . F IBEP=1:1:4 I IBSEL[IBEP D SUM I IBQ Q
22 ;
23ENQ K %,IB0,IBDH,IBDIV,IBEP,IBEPH,IBN,IBP,IBPAG,IBPT,IBQ,IBRT,IBRUN,IBSORT
24 K IBT1,IBU,GTOT,ECNT,ETOT,SCNT,STOT
25 Q
26 ;
27DET ; - Print detailed report.
28 I '$D(^TMP("IBJDB2",$J,IBDIV,IBEP)) D D PAUSE Q
29 . D HDR Q:IBQ W !!,"No entries for this episode.",!
30 S IBT1=0,(IBSORT1,IBPT,IB0)=""
31 F S IBSORT1=$O(^TMP("IBJDB2",$J,IBDIV,IBEP,IBSORT1)) Q:IBSORT1="" D Q:IBQ
32 . D HDR Q:IBQ
33 . F S IBPT=$O(^TMP("IBJDB2",$J,IBDIV,IBEP,IBSORT1,IBPT)) Q:IBPT="" S IBP=$G(^(IBPT)) D Q:IBQ
34 . . I $Y>(IOSL-8) D PAUSE Q:IBQ D HDR Q:IBQ
35 . . D WPAT
36 . . F S IB0=$O(^TMP("IBJDB2",$J,IBDIV,IBEP,IBSORT1,IBPT,IB0)) Q:IB0="" S IBN=$G(^(IB0)) D Q:IBQ
37 . . . I $Y>(IOSL-8) D PAUSE Q:IBQ D HDR Q:IBQ D WPAT
38 . . . W ?45,$$DTE(+IBN),?55,$$DTE($P(IBN,U,2))
39 . . . I $P(IBN,U,4)'="" W ?65,$$DTE($P(IBN,U,3)),?76,$E($P(IBN,U,4),1,19)
40 . . . E W ?65,$$DTE($P(IBN,U,2)) W ?76,"POSTMASTER"
41 . . . S IBU=5 S:12[IBEP IBU=$S(IBSORT="R":6,1:IBU)
42 . . . I 12[IBEP W ?97,$E($P(IBN,U,IBU),1,25),?124,$J($P(IBN,U,8),8,2),!
43 . . . I 34[IBEP W ?99,$J($P(IBN,U,8),8,2),!
44 . . . I $P(IBN,U,9)]"" W ?15,"Comments: ",$P(IBN,U,9) W:12'[IBEP !
45 . . . I 12[IBEP W ?97,$E($P(IBN,U,$S("PR"[IBSORT:7,1:6)),1,25),!
46 . . . S SCNT=SCNT+1,ECNT=ECNT+1
47 . . . S STOT=STOT+$P(IBN,U,8),ETOT=ETOT+$P(IBN,U,8)
48 . I 'IBQ D TOT2 I $O(^TMP("IBJDB2",$J,IBDIV,IBEP,IBSORT1))'="" D PAUSE Q
49 I 'IBQ D TOT1,PAUSE
50 ;
51DETQ Q
52 ;
53EXTMO(IBSM) ; Extract/transmit data to DM Extract Module
54 ; IBSM - Array containing the summary information
55 ;
56 N I,IB,IBI,IBJ,IBLST,IBR,IBRNB,IBSQ,IBTR,IBTP,IBZ,RNBC,RNBN
57 ;
58 F I=1:1 S RNBN=$P($T(RNB+I),";;",2,99) Q:RNBN="" D
59 . S RNBC=$O(^IBE(356.8,"B",RNBN,0)) Q:'RNBC
60 . S IBTR(RNBC)=I
61 ;
62 S IBRNB="",IBLST=$O(^IBE(356.8,999),-1)*2
63 F IBTP=1:1:4 D
64 . F IBJ=1:1:IBLST,999,1000 S IB(IBTP,IBJ)=$S(IBJ#2:0,1:"0.00")
65 . F S IBRNB=$O(IBSM(0,IBTP,IBRNB)) Q:IBRNB="" D
66 . . I '$D(IBTR(IBRNB)) Q
67 . . S IBSQ=$S(IBRNB<999:IBTR(IBRNB)*2-1,1:999)
68 . . S IBZ=$G(IBSM(0,IBTP,IBRNB))
69 . . S IB(IBTP,IBSQ)=+IBZ
70 . . S IB(IBTP,IBSQ+1)=$FN(+$P(IBZ,"^",2),"",2)
71 . F I=1:1:3 D E^IBJDE(21+(IBTP*3)+I,0)
72 . K IB(IBTP)
73 ;
74 Q
75 ;
76SUM ; - Print summary line(s).
77 I '$D(IB(IBDIV,IBEP)) D D PAUSE Q
78 . D SUMH W !!?14,"No statistics available."
79 D SUMH Q:IBQ
80 S IBRNB=0 F S IBRNB=$O(IB(IBDIV,IBEP,IBRNB)) Q:'IBRNB D Q:IBQ
81 . S IBN=IB(IBDIV,IBEP,IBRNB)
82 . W !?14,$P($G(^IBE(356.8,IBRNB,0)),U),?48,$J(+IBN,5),?57,$J($P(IBN,U,2),9,2)
83 . S $P(GTOT,U)=$P(GTOT,U)+IBN,$P(GTOT,U,2)=$P(GTOT,U,2)+$P(IBN,U,2)
84 D SUMT
85 ;
86 Q
87 ;
88SUMH ; - Print summary header.
89 I $E(IOST,1,2)="C-"!$G(IBPAG) W @IOF,*13
90 S IBPAG=$G(IBPAG)+1 W ?68,"Page: ",IBPAG
91 S IBEPH="REASONS NOT BILLABLE SUMMARY/"_IBEPS(IBEP)
92 W !!?(80-$L(IBEPH))\2,IBEPH
93 I IBDIV D
94 .S IBDH="Division: "_$P($G(^DG(40.8,IBDIV,0)),U)
95 .W !?(80-$L(IBDH)\2),IBDH
96 ;
97 W !?22,"Period : from ",$$DTE(IBBDT)," thru ",$$DTE(IBEDT),!
98 W !?24,"Run Date: ",IBRUN
99 W !!?46,"No. of",?61,"Total",!?14,"RNB Category",?46,"Entries"
100 W ?60,"Amount",!?14,$$DASH(52)
101 S GTOT="0^0",IBQ=$$STOP^IBOUTL("Reasons Not Billable Summary")
102 Q
103 ;
104SUMT ; - Print summary totals.
105 W !?47,"-------------------"
106 W !?33,"Grand Totals:",?47,$J(+GTOT,6),?56,$J($P(GTOT,U,2),10,2) D PAUSE
107 Q
108 ;
109HDR ; - Write the detailed report header.
110 I $E(IOST,1,2)="C-"!$G(IBPAG) W @IOF,*13
111 S IBPAG=$G(IBPAG)+1 W "Reasons Not Billable (RNB) Report "
112 W ?88,"Run Date: ",IBRUN,?123,"Page: ",$J(IBPAG,3)
113 S X=IBE(IBEP)_" events by "
114 I 1234[IBEP D
115 . S X=X_$S(IBSORT="P":"provider",IBSORT="S":"specialty",1:"RNB category")
116 . I $G(IBSORT1)'="" S X=X_" ("_IBSORT1_")"
117 E S X=X_"RNB category"
118 S X=X_" from "_$$DTE(IBBDT)_" thru "_$$DTE(IBEDT)_" ("_IBD_")"
119 I 12[IBEP D
120 . I IBSORT'="R" D
121 . . S X=X_" / "_$S(IBSRNB="S":"SPECIFIC",1:"ALL")_" REASONS NOT BILLABLE"
122 . I IBSORT'="P" D
123 . . S X=X_" / "_$S(IBSPRV="S":"SPECIFIC",1:"ALL")_" PROVIDERS"
124 . I IBSORT'="S",IBEP=1 D
125 . . S X=X_" / "_$S(IBSISP="S":"SPECIFIC",1:"ALL")_" SPECIALTIES"
126 . I IBSORT'="S",IBEP=2 D
127 . . S X=X_" / "_$S(IBSOSP="S":"SPECIFIC",1:"ALL")_" SPECIALTIES"
128 F I=1:1 W !,$E(X,1,132) S X=$E(X,133,999) I X="" Q
129 ;
130 I IBDIV W !,"Division: ",$P($G(^DG(40.8,IBDIV,0)),U)
131 W !!?26,"Last",?32,"Insurance",?45,"Episode Date Dte Last"
132 I 12[IBEP W ?97,$S("PS"[IBSORT:"RNB Category",1:"Provider")
133 W !,"Patient",?26,"4SSN",?32,"Carrier"
134 W ?45,"Date Entered Edited Last Edited By"
135 I 12[IBEP W ?97,$S("PR"[IBSORT:"Specialty",1:"Provider")
136 ;
137 I 34[IBEP W ?101,"Amount",!,$$DASH(IOM-25),!
138 E W ?126,"Amount",!,$$DASH(IOM),!
139 S IBQ=$$STOP^IBOUTL("Reasons Not Billable Report")
140 Q
141 ;
142WPAT ; - Write patient data.
143 W $P(IBPT,"@@"),?26,$P(IBPT,"@@",2),?32,$E($P(IBP,U),1,12)
144 Q
145 ;
146TOT1 ; - Print episode totals.
147 I 34[IBEP W !?97,"----------",!
148 E W !?122,"----------",!
149 I 34[IBEP W ?55
150 E W ?80
151 W "TOTAL FOR EPISODE - Count: ",$J(ECNT,5)," Amount: ",$J(ETOT,10,2)
152 S (ECNT,ETOT)=0
153 Q
154 ;
155TOT2 ; - Print sub-totals.
156 I 34[IBEP W ?98,"---------",!
157 E W ?123,"---------",!
158 I 34[IBEP W ?60
159 E W ?85
160 W "TOTAL EVENTS - Count: ",$J(SCNT,4)," Amount: ",$J(STOT,9,2),!
161 S (SCNT,STOT)=0
162 Q
163 ;
164DASH(X) ; - Return a dashed line.
165 Q $TR($J("",X)," ","=")
166 ;
167PAUSE ; - Page break.
168 I $E(IOST,1,2)'="C-" Q
169 N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
170 F IBX=$Y:1:(IOSL-3) W !
171 S DIR(0)="E" D ^DIR S:$D(DIRUT)!($D(DUOUT)) IBQ=1
172 Q
173 ;
174DTE(X) ; - Format the date.
175 Q $S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3),1:"")
176 ;
177RNB ; - Reasons Not Billable
178 ;;NOT INSURED
179 ;;SC TREATMENT
180 ;;AGENT ORANGE
181 ;;IONIZING RADIATION
182 ;;ENV. CONTAM.
183 ;;SERVICE NOT COVERED
184 ;;COVERAGE CANCELED
185 ;;NEEDS SC DETERMINATION
186 ;;NON-BILLABLE APPOINTMENT TYPE
187 ;;INVALID PRESCRIPTION ENTRY
188 ;;REFILL ON VISIT DATE
189 ;;PRESCRIPTION DELETED
190 ;;PRESCRIPTION NOT RELEASED
191 ;;DRUG NOT BILLABLE
192 ;;HMO POLICY
193 ;;REFUSES TO SIGN RELEASE (ROI)
194 ;;NON-BILLABLE STOP CODE
195 ;;RESEARCH VISIT
196 ;;BILL PURGED
197 ;;NON-BILLABLE CLINIC
198 ;;MILITARY SEXUAL TRAUMA
199 ;;CREDENTIALING ISSUE
200 ;;INSUFFICIENT DOCUMENTATION
201 ;;NO DOCUMENTATION
202 ;;NON-BILLABLE PROVIDER (RESID.)
203 ;;NON-BILLABLE PROVIDER (OTHER)
204 ;;OTHER COMPLIANCE
205 ;;OUT OF NETWORK (PPO)
Note: See TracBrowser for help on using the repository browser.