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

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1IBCRBF ;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 ;
5ADDRC(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 ;
31ADDRCQ Q IBDA
32 ;
33DELALLRC(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 ;
Note: See TracBrowser for help on using the repository browser.