| [613] | 1 | IBCRBF ;ALB/ARH - RATES: BILL FILE CHARGES ;22-MAY-1996
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**52,106,51**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ADDRC(IBIFN,IBRVCD,IBBS,IBCHG,IBUNITS,IBCPT,IBDIV,IBAA,IBITYP,IBIPTR,IBCMPNT) ; add a revenue code charge entry to a bill (399,42)
|
|---|
| 6 | ; returns DA of new entry or -1
|
|---|
| 7 | N X,Y,DA,DLAYGO,DIC,DIE,DR,IBDA,DGXRF1,Z,Z1 S IBDA=-1
|
|---|
| 8 | ;
|
|---|
| 9 | I ($G(IBCHG)'>0)!('$G(IBUNITS)) G ADDRCQ
|
|---|
| 10 | I $G(^DGCR(399,+$G(IBIFN),0))="" G ADDRCQ
|
|---|
| 11 | I '$P($G(^DGCR(399.2,+$G(IBRVCD),0)),U,3) G ADDRCQ
|
|---|
| 12 | I '$P($G(^DGCR(399.1,+$G(IBBS),0)),U,5) G ADDRCQ
|
|---|
| 13 | S IBCPT=$G(IBCPT) I +IBCPT,$$CPT^ICPTCOD(+IBCPT,DT)<1 G ADDRCQ
|
|---|
| 14 | S IBDIV=$G(IBDIV) I +IBDIV,'$D(^DG(40.8,+IBDIV,0)) G ADDRCQ
|
|---|
| 15 | S IBCHG=+$FN(IBCHG,"",2)
|
|---|
| 16 | ;
|
|---|
| 17 | K DD,DO S DIC("P")=$P(^DD(399,42,0),U,2)
|
|---|
| 18 | S DLAYGO=399,DA(1)=IBIFN,DIC="^DGCR(399,"_DA(1)_",""RC"",",DIC(0)="L",X=IBRVCD D FILE^DICN G:Y<1 ADDRCQ
|
|---|
| 19 | ;
|
|---|
| 20 | S DR=".02////"_IBCHG_";.03////"_IBUNITS_";.05////"_IBBS
|
|---|
| 21 | I +IBCPT S DR=DR_";.06////"_IBCPT I +IBDIV S DR=DR_";.07////"_IBDIV
|
|---|
| 22 | I +$G(IBAA) S DR=DR_";.08////1"
|
|---|
| 23 | I +$G(IBITYP)>0,IBITYP<10 S DR=DR_";.1////"_IBITYP I +$G(IBIPTR) S DR=DR_";.11////"_IBIPTR
|
|---|
| 24 | I +$G(IBCMPNT)>0,IBCMPNT<3 S DR=DR_";.12////"_IBCMPNT
|
|---|
| 25 | I IBITYP=3,IBIPTR D
|
|---|
| 26 | . N Z
|
|---|
| 27 | . S Z=+$O(^TMP("IBCRRX",$J,IBIPTR,0))
|
|---|
| 28 | . I Z S DR=DR_";.15////"_Z K ^TMP("IBCRRX",$J,IBIPTR,Z)
|
|---|
| 29 | S (DA,IBDA)=+Y,DIE=DIC D ^DIE
|
|---|
| 30 | ;
|
|---|
| 31 | ADDRCQ Q IBDA
|
|---|
| 32 | ;
|
|---|
| 33 | DELALLRC(IBIFN) ; delete all charges on the bill that were automatically calculated and added
|
|---|
| 34 | ;
|
|---|
| 35 | N IBI,DA,DIK,X,Y,DGXRF1,Z,Z1
|
|---|
| 36 | K ^TMP("IBCRRX",$J)
|
|---|
| 37 | I +$G(IBIFN) S IBI=0 F S IBI=$O(^DGCR(399,+IBIFN,"RC",IBI)) Q:'IBI D
|
|---|
| 38 | . N Z0
|
|---|
| 39 | . S Z0=$G(^DGCR(399,+IBIFN,"RC",IBI,0))
|
|---|
| 40 | . I '$P(Z0,U,8) Q
|
|---|
| 41 | . ; Capture revenue codes and their relation to prescriptions
|
|---|
| 42 | . I $P(Z0,U,15) S ^TMP("IBCRRX",$J,+$P(Z0,U,11),$P(Z0,U,15))=""
|
|---|
| 43 | . ; Be careful changing the name of this array - this is used in index
|
|---|
| 44 | . ; ADPR - file 399.042, fields .01 and .03 to determine if the RX
|
|---|
| 45 | . ; procedures should be deleted when the revenue codes are
|
|---|
| 46 | . S DA(1)=+IBIFN,DA=IBI,DIK="^DGCR(399,"_DA(1)_",""RC""," D ^DIK K DIK
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
