source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCROR.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: 2.8 KB
Line 
1IBCROR ;ALB/ARH - RATES: REPORTS ; 5/23/96
2 ;;2.0;INTEGRATED BILLING;**52,106,287**;21-MAR-94
3 ;
4 ;
5OPTION ;
6 W !!!,"Charge Master Reports:",!
7 S DIR(0)="SO^R:RATE SCHEDULES;C:CHARGE SETS;I:CHARGE ITEMS;IP:CHARGE ITEMS - PROCEDURES;B:BILLING RATES;T:RATE TYPES;G:BILLING REGIONS;V:REV CD LINKS;D:PROVIDER DISCOUNTS;O:OTHER BILLABLE ITEMS;X:(OLD RATES FILE)"
8 S DIR("A")="Select Report" D ^DIR K DIR
9 I Y="R" D RS G OPTION
10 I Y="C" D CS G OPTION
11 I Y="I" D CI G OPTION
12 I Y="IP" D CIP G OPTION
13 I Y="B" D BR G OPTION
14 I Y="T" D RT G OPTION
15 I Y="G" D RG G OPTION
16 I Y="V" D RL G OPTION
17 I Y="D" D PD G OPTION
18 I Y="O" D BI G OPTION
19 I Y="X" D OLD G OPTION
20 K DIR,X,Y,DIRUT
21 Q
22RS ;
23 W !,"Report requires 120 columns."
24 S FLDS=".01,.03;L5,.04;L10;""BILL SERVICE"",.05,.06,W:$$RSADJ^IBCROR($G(D0)) ""YES"";""CHARGES ADJUSTED"";L10,11,.01,.02"
25 S L=0,DIC="^IBE(363,",BY=".02;S1,.03"
26 D EN1^DIP
27 K FLDS,BY,FR,TO,L,DIC
28 Q
29CS ;
30 W !,"Report requires 132 columns."
31 S L=0,DIC="^IBE(363.1,",FLDS=".01,.03;L26,.04,.05,.06;L15,.07",BY=".02;S1,.03",FR="",TO=""
32 D EN1^DIP
33 K FLDS,BY,FR,TO,L,DIC
34 Q
35CI ;
36 ;
37 W !!,"Caution: This report may be extremely long for some Charge Sets.",!,"Some Charge Sets, such as CMAC or AWP, may have many thousands of Charge Items.",!
38 ;
39 D ^IBCROI
40 Q
41CIP ;
42 ;
43 W !!,"Caution: This report may be extremely long if many procedures are selected.",!
44 ;
45 D ^IBCROIP
46 Q
47BR ;
48 S L=0,DIC="^IBE(363.3,",FLDS=".01,.02,.03,.04,.05",BY=".03;S1,.01",FR="",TO=""
49 D EN1^DIP
50 K FLDS,BY,FR,TO,L,DIC
51 Q
52RT ;
53 W !,"Report requires 132 columns."
54 S FLDS=".01;L20,.02;L20,.03;L5,.04;L8,.05;L5;""THIRD PARTY BILL?"",.06;L20,.07;L11,.08;L5;""REIMB INS?"",.09;L4"
55 S L=0,DIC="^DGCR(399.3,",BY="",FR="",TO=""
56 D EN1^DIP
57 K FLDS,BY,FR,TO,L,DIC
58 Q
59RG ;
60 S L=0,DIC="^IBE(363.31,",FLDS=".01,11,.01,",BY=".01;S1",(FR,TO)=""
61 D EN1^DIP
62 K FLDS,BY,FR,TO,L,DIC
63 Q
64BI ;
65 S L=0,DIC="^IBA(363.21,",FLDS=".01,.02,",BY=".02;S1,.01"
66 D EN1^DIP
67 K FLDS,BY,FR,TO,L,DIC
68 Q
69RL ;
70 N IBX,DIR,X,Y,DTOUT,DUOUT,DIRUT
71 S DIR(0)="SO^1:SORT BY REVENUE CODE;2:SORT BY PROCEDURE" D ^DIR Q:Y'>0
72 I Y=1 S L=0,DIC="^IBE(363.33,",FLDS=".01,.03,.04,.02",BY=".01,.02"
73 I Y=2 S L=0,DIC="^IBE(363.33,",FLDS=".03,.04,.01,.02",BY=".03;TXT,.02",(FR,TO)=",?"
74 D EN1^DIP
75 K FLDS,BY,FR,TO,L,DIC
76 Q
77 ;
78PD ;
79 D ^IBCRON
80 Q
81 ;
82OLD ; prints old rates in 399.5, provided for reference only
83 ; (these rates are no longer used and the orginal report (IBORAT2) was deleted)
84 W !!,"This report is for reference only, the rates and charges in this report are no",!,"longer used. They have been replace by the rates in the Charge Master.",!
85 S L=0,DIC="^DGCR(399.5,",FLDS=".01,.04,"" "";"""",.03,.05;L3,.06,.07",BY=".02;S1,.01;S1,.06,.03",FR=",?",TO=",?"
86 D EN1^DIP
87 K FLDS,BY,FR,TO,L,DIC
88 Q
89 ;
90RSADJ(D0) ; returns true if RS has an Adjustment
91 N IBX S IBX=0 I $G(^IBE(363,+$G(D0),10))'="" S IBX=1
92 Q IBX
Note: See TracBrowser for help on using the repository browser.