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

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

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1IBCU62 ;ALB/AAS - UTILITY ROUTINE TO SET BEDSECTION/REVENUE CODES FROM PTF DATA ; 29-OCT-90
2 ;;2.0;INTEGRATED BILLING;**133**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;MAP TO DGCRU62
6 ;
7SETREV ;find current active revenue codes for bedsection
8 S (DGREV,DGBR)=0,DGACTDT=-(IBIDS(151)+.01) K DGFND
9 F S DGACTDT=$O(^DGCR(399.5,"AIVDT",DGBSI,DGACTDT)) Q:'DGACTDT!($D(DGFND)) D
10 . F S DGREV=$O(^DGCR(399.5,"AIVDT",DGBSI,DGACTDT,DGREV)) Q:'DGREV D
11 .. F S DGBR=$O(^DGCR(399.5,"AIVDT",DGBSI,DGACTDT,DGREV,DGBR)) Q:'DGBR D CHKREV,STORREV:IBCHK
12 Q
13CHKREV ;check if billing rate (dgbr) is active, and use with payer.
14 S IBCHK=0
15 S DGBRN=^DGCR(399.5,DGBR,0) I '$P(DGBRN,"^",5) Q ;quit if inactive
16 I IBIDS(.11)="i",$P(DGINPAR,"^",2)="",+$P(DGBRN,"^",7) Q ;quit if non-standard rate
17 I IBIDS(.11)'="i",+$P(DGBRN,"^",7) Q ;non-standard rates only for ins.
18 S DGREV00="00"_DGREV I IBIDS(.11)="i",$P(DGINPAR,"^",2)]"",$P(DGINPAR,"^",2)'[$E(DGREV00,$L(DGREV00)-2,$L(DGREV00)) Q ;quit if revenue code not in exception list
19 I $P(DGBRN,U,6)[IBIDS(.11) S:'$D(DGFND) DGFND="" S IBCHK=1 Q
20 Q
21STORREV ;store revenue code in revenue code file
22 S X=$P(^DGCR(399.5,DGBR,0),"^",3),DGAMNT=$P(^(0),"^",4),DA(1)=IBIFN,DIC(0)="L",DIC="^DGCR(399,IBIFN,""RC"",",DGFUNC="Adding"
23 I $D(^DGCR(399,IBIFN,"RC","ABS",X,DGBSI)) S DA=$O(^DGCR(399,IBIFN,"RC","ABS",X,DGBSI,0)),DGFUNC="Editing" G EDITREV
24 D FILE,WRT
25 Q
26 ;
27FILE ;manually file entry, index with ix1^dik to use compiled x-ref
28 I '$D(DGREVHDR) D REVHDR
29 I IBIDS(.11)="c",IBIDS(.05)<3 S DGBSLOS=1
30 L ^DGCR(399,IBIFN):1
31 S DA=$P(^DGCR(399,IBIFN,"RC",0),"^",3)
32 F DGLL=0:0 S DA=DA+1 Q:'$D(^DGCR(399,IBIFN,"RC",DA,0))
33 ;S ^DGCR(399,IBIFN,"RC",DA,0)=X_"^"_DGAMNT_"^"_DGBSLOS_"^^"_DGBSI_$S($D(DGPROC)&($D(DGDIV)):"^"_DGPROC_"^"_DGDIV,1:"")
34 S ^DGCR(399,IBIFN,"RC",DA,0)=X_"^"_DGAMNT_"^"_DGBSLOS_"^^"_DGBSI_"^"_$G(DGPROC)_"^"_$G(DGDIV)_"^"_1
35 S ^DGCR(399,IBIFN,"RC",0)=$P(^DGCR(399,IBIFN,"RC",0),"^",1,2)_"^"_DA_"^"_($P(^DGCR(399,IBIFN,"RC",0),"^",4)+1)
36 S DIK="^DGCR(399,"_DA(1)_",""RC""," D IX1^DIK L ^DGCR(399,IBIFN):1
37 Q
38 ;
39EDITREV ;edit revenue code data.
40 I '$D(DGREVHDR) D REVHDR
41 I IBIDS(.11)="c",IBIDS(.05)<3 S DGBSLOS=1
42 S DIE=DIC,DA(1)=IBIFN,DR=".02///"_DGAMNT_";.03///"_DGBSLOS_";.05///"_DGBS D ^DIE
43 ;
44WRT ;S Z="00"_$P(^DGCR(399.5,DGBR,0),"^",3) W:'$G(IBAUTO) !,DGFUNC,?12,$E(Z,($L(Z)-2),$L(Z)),?24,DGBSLOS,?31,"$",$J(DGAMNT,8,2),?44,DGBS
45 S Z="00"_$P(^DGCR(399.5,DGBR,0),"^",3)
46 W:'$G(IBAUTO) !,DGFUNC,?12,$E(Z,($L(Z)-2),$L(Z)),?24,DGBSLOS,?31,"$",$J(DGAMNT,8,2),?44,DGBS I +$G(DGPROC) W ?65,$P($$CPT^ICPTCOD(+DGPROC),U,2)
47 Q
48REVHDR S DGREVHDR=1 W:'$G(IBAUTO) !,"Updating Revenue Codes",!?10,"REV. CODE",?22,"UNITS",?31,"CHARGE",?44,"BEDSECTION" I $D(DGPROC) W:'$G(IBAUTO) ?65,"PROCEDURE"
Note: See TracBrowser for help on using the repository browser.