source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBEBR.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: 3.8 KB
Line 
1IBEBR ;ALB/AAS - Add/Edit IB ACTION CHARGE FILE; 3-MAR-92
2 ;;Version 2.0 ; INTEGRATED BILLING ;**34,52**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% ; entry point
6 D HOME^%ZIS W @IOF
7EN W !!,?28,"Enter/Edit Billing Rates",!!
8 S IBX="MAIN" D CHOOSE I $D(DIRUT)!('Y) G END
9 I Y>0,Y<7 D @Y
10 G EN
11 Q
121 ;enter edit revenue code rates
13 ;D EN1^IBCBR
14 ;D ENR^IBEMTO ; bill MT OPT charges awaiting the new copay rate
15 ;D END
16 W !!," ******* This option is no longer active.",!,?10,"Please use the Enter/Edit Charge Master option.",!
17 Q
18 ;
192 ;enter per diem rate
20 S IBX="PERDIEM" D CHOOSE Q:$D(DIRUT)
21 D EFFDT,END
22 G 2
23 ;
243 ;enter medicare deductable
25 S IBX="MEDIC",IBPD="MEDICARE DEDUCTIBLE" ;D CHOOSE Q:$D(DIRUT)
26 D EFFDT,END Q:$G(Y)<1
27 G 3
28 ;
294 ;enter hcfa amb. surg. rates
30 S IBX="HCFA" D CHOOSE Q:$D(DIRUT)
31 D EFFDT,END
32 G 4
33 ;
345 ;enter rx copay rates
35 S IBX="COPAY" D CHOOSE Q:$D(DIRUT)
36 D EFFDT,END
37 G 5
38 ;
396 ;enter champva subsistence rates
40 S IBX="CHMPVA" D CHOOSE Q:$D(DIRUT)
41 D EFFDT,END
42 G 6
43 ;
44CHOOSE S IBSEL=$P($T(@IBX),";;",2,99),IB=""
45 F I=1:1 Q:$P($T(@IBX+I),";;",2,99)="" S IB=IB_I_":"_$P($P($T(@IBX+I),";;",2,99),"^",$S($P($P($T(@IBX+1),";;",2,99),"^",5)="":1,1:5))_";"
46 W !!,"CHOOSE FROM:"
47 F I=1:1 S X=$P(IB,";",I) Q:'X W !?4,+X,?20,$P(X,":",2)
48 S DIR("?")="^D 1^IBEBRH",DIR("??")="^D 2^IBEBRH"
49 W !! S DIR(0)="SOA^"_IB,DIR("A")="Select "_IBSEL_": " D ^DIR K DIR I $D(DIRUT) G CHOOSEQ
50 S IBP=$P($T(@IBX+Y),";;",2,99) S IBPD=$P(IBP,"^",1) F I=2:1 Q:$P(IBP,"^",I)="" S IBPD(I)=$P(IBP,"^",I)
51CHOOSEQ Q
52 ;
53EFFDT S %DT="EX"
54 R !!," Select Effective Date: ",X:DTIME Q:X="" D:X["?" 3^IBEBRH I X=" ",$D(IBEFDT) S X=IBEFDT
55 D ^%DT K %DT G:X["?" EFFDT Q:Y<1 S IBEFDT=+Y
56 D FILE G EFFDT
57 Q
58 ;
59FILE ; -add new entries in 350.2 and edit
60 S DLAYGO=350.2,X=IBPD,DIC="^IBE(350.2,",DIC(0)="ELMQ",DIC("S")="I $P(^(0),U,2)=IBEFDT",DIC("DR")=".02///"_IBEFDT D ^DIC K DIC G:+Y<0 FILEQ
61 ;
62 ; -if a new entry
63 S IBNEW=$P(Y,"^",3)
64 K DR S DR="" S IBORIG=$O(^IBE(350.2,"B",IBPD,0)) I IBNEW S DR=".02///"_IBEFDT_";.03///"_$P($G(^IBE(350.2,+IBORIG,0)),"^",3)_";"
65 ;
66 S DIE="^IBE(350.2,",DA=+Y,DR=DR_".04;.06;.05;" D ^DIE K DIE
67 ;
68 ; -delete if no charge or not inactive
69 S X=$G(^IBE(350.2,DA,0)) I '$P(X,"^",4)&('$P(X,"^",5)) W !!,*7,"Deleting - no charge, not inactive" S DIK="^IBE(350.2," D ^DIK Q
70 ;
71 ; -set computed logic for new entry if needed
72 S IB10=$G(^IBE(350.2,+IBORIG,10)) I IB10]"" S ^IBE(350.2,DA,10)=IB10
73 ;
74 ; -logic for rx3-rx6
75 S IB=0,IB0=$G(^IBE(350.2,DA,0)) F S IB=$O(IBPD(IB)) Q:'IB D
76 . S IBORIG=$O(^IBE(350.2,"B",IBPD(IB),0)),IBATYP=+$P($G(^IBE(350.2,+IBORIG,0)),"^",3)
77 . I 'IBNEW S DA=$O(^IBE(350.2,"AIVDT",IBATYP,-IBEFDT,0)) Q:'DA
78 . I IBNEW S X=IBPD(IB),DIC="^IBE(350.2,",DIC(0)="L" K DD,DO D FILE^DICN Q:Y<0 S DA=+Y
79 . S DIE="^IBE(350.2,",DR=".02////"_IBEFDT_";.03////"_IBATYP_";.04////"_$P(IB0,"^",4)_";.05////"_$S($P(IB0,"^",5)]"":$P(IB0,"^",5),1:"@")_";.06////"_$S($P(IB0,"^",6)]"":$P(IB0,"^",6),1:"@") D ^DIE
80 ;
81FILEQ K IB10,DIC,DIE,DR,DA,IBNEW,IBORIG,DIK Q
82 ;
83END ;Kill vars
84 K I,X,Y,IBNOD,IBPD,DIR,DIC,DIE,DIK,DA,DR,DA,IB10,IBORIG,IB,IB0,IBP,IBEFDT,IBSEL,IBX,IBRUN
85 Q
86 ;
87 ;;
88COPAY ;;Co-pay Type
89NSC ;;RX1^RX3^RX4^^NSC RX CO-PAY (RX1)
90SC ;;RX2^RX5^RX6^^SC RX CO-PAY (RX2)
91 ;;
92PERDIEM ;;Per Diem
93 ;;INPT PER DIEM
94 ;;NHCU PER DIEM
95 ;;
96HCFA ;;HCFA Amb. Surg. Rate
97 ;;MEDICARE 1^^^^AMB SURG RATE 1
98 ;;MEDICARE 2^^^^AMB SURG RATE 2
99 ;;MEDICARE 3^^^^AMB SURG RATE 3
100 ;;MEDICARE 4^^^^AMB SURG RATE 4
101 ;;MEDICARE 5^^^^AMB SURG RATE 5
102 ;;MEDICARE 6^^^^AMB SURG RATE 6
103 ;;MEDICARE 7^^^^AMB SURG RATE 7
104 ;;MEDICARE 8^^^^AMB SURG RATE 8
105 ;;MEDICARE 9^^^^AMB SURG RATE 9
106 ;;
107CHMPVA ;;CHAMPVA Rate Type
108 ;;CHAMPVA PER DIEM
109 ;;CHAMPVA SUBSISTENCE LIMIT
110 ;;
111MEDIC ;;Medicare Deductible
112 ;;MEDICARE DEDUCTIBLE
113 ;;
114MAIN ;;Billing Rate Type
115 ;;REVENUE CODE RATES
116 ;;PER DIEM RATES
117 ;;MEDICARE DEDUCTIBLE
118 ;;HCFA AMB. SURG. RATES
119 ;;RX CO-PAYMENT
120 ;;CHAMPVA SUBSISTENCE RATES
Note: See TracBrowser for help on using the repository browser.