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

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

initial load of WorldVistAEHR
File size: 3.3 KB
Line 
1IBCREU1 ;ALB/ARH - RATES: CM ENTER/EDIT UTILITIES ; 16-MAY-1996
2 ;;2.0;INTEGRATED BILLING;**52,106,138**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5RQCI(IBCIFN) ; check all required data defined for charge item
6 ; either the item's Charge Set must have a Default Revenue Code or the Charge Item must have revenue code
7 ; Charge Set and Effective Date are required
8 ; returns: 0 or 1 ^ 1 (needs CS) ^ 1 (needs EF DT) ^ 1 (needs Revenue Code)
9 N IBCS0,IBCI0,IBX S IBX=0
10 S IBCI0=$G(^IBA(363.2,+$G(IBCIFN),0)),IBCS0=$G(^IBE(363.1,+$P(IBCI0,U,2),0))
11 I IBCS0="" S $P(IBX,U,1)=1,$P(IBX,U,2)=1
12 I '$P(IBCI0,U,2) S $P(IBX,U,1)=1,$P(IBX,U,2)=1
13 I '$P(IBCI0,U,3) S $P(IBX,U,1)=1,$P(IBX,U,3)=1
14 I '$P(IBCS0,U,5),'$P(IBCI0,U,6) S $P(IBX,U,1)=1,$P(IBX,U,4)=1
15 Q IBX
16 ;
17RQCS(CSFN) ; check that new charge set has all required fields
18 ; Billing Rate is required to define the sets Charge Items
19 ; Billable Event is required to link the sets charges to the items on the bills
20 ; if the Billable Item of the Sets rate is not bedsection then Default Bedsection is required for the set
21 ; if Charge Method of Sets rate is VA Cost then the Default Rev Code is required
22 ; returns: 0 or 1 ^ 1 (needs BR) ^ 1 (needs BE) ^ 1 (needs bedsection)
23 N IBCS,IBBR,IBX S IBX=0
24 S IBCS=$G(^IBE(363.1,+$G(CSFN),0)),IBBR=$G(^IBE(363.3,+$P(IBCS,U,2),0))
25 I IBBR="" S $P(IBX,U,1)=1,$P(IBX,U,2)=1
26 I '$P(IBCS,U,2) S $P(IBX,U,1)=1,$P(IBX,U,2)=1
27 I '$P(IBCS,U,3) S $P(IBX,U,1)=1,$P(IBX,U,3)=1
28 I '$P(IBCS,U,6),+$P(IBBR,U,4)'=1 S $P(IBX,U,1)=1,$P(IBX,U,4)=1
29 I '$P(IBCS,U,5),+$P(IBBR,U,5)=2 S $P(IBX,U,1)=1,$P(IBX,U,5)=1
30 Q IBX
31 ;
32CHKBR(IBBRFN) ; check billing rate to determine if it can be edited (has CS or charge items or national)
33 ; if the Rate is National or (since the Rate defines the items billed to a set)
34 ; if the Rate has a Charge Set or a set of this Rate has Charge items, don't edit
35 ; returns: 0 if editable or 1 ^ 1 (if national) ^ 1 (CS defined) ^ 1 (if charge items exist)
36 N IBX,IBY,IBCSFN S IBBRFN=+$G(IBBRFN),IBX=0
37 S IBY=$G(^IBE(363.3,IBBRFN,0)) I +IBBRFN<1000!($P(IBY,U,3)=1) S $P(IBX,U,1)=1,$P(IBX,U,2)=1
38 S IBCSFN=0 F S IBCSFN=$O(^IBE(363.1,IBCSFN)) Q:'IBCSFN I +$P($G(^IBE(363.1,IBCSFN,0)),U,2)=IBBRFN D
39 . S $P(IBX,U,1)=1,$P(IBX,U,3)=1
40 . S IBY="AIVDTS"_IBCSFN I $O(^IBA(363.2,IBY,0)) S $P(IBX,U,1)=1,$P(IBX,U,4)=1
41 Q IBX
42 ;
43CHKCS(IBCSFN) ; check charge set to determine if/what can be edited
44 ; if the set was exported nationally (ie. any set not created locally) Name, Rate, and Event not editable
45 ; if the Set has Charge Items defined then the Rate should not be changed since it defines the type of Item
46 ; returns: 0 if editable or 1 ^ 1 (if charge items exist for the set) ^ 1 (not created locally)
47 ;
48 N IBX,IBY S IBCSFN=+$G(IBCSFN),IBX=0
49 S IBY="AIVDTS"_IBCSFN I $O(^IBA(363.2,IBY,0)) S IBX=1,IBX=IBX_"^1"
50 I +IBCSFN<1000 S $P(IBX,U,1)=1,$P(IBX,U,3)=1
51 Q IBX
52 ;
53CHKSG(IBSGFN) ; check special groups to determine if it can be edited
54 ; returns: 0 if editable or 1 ^ 1 (if exported nationally) ^ 1 (has rv cd links) ^ 1 (has PD links)
55 N IBX,IBY S IBSGFN=+$G(IBSGFN),IBX=0,IBY=$G(^IBE(363.32,IBSGFN,0))
56 I IBY'="",+IBSGFN<1000 S $P(IBX,U,1)=1,$P(IBX,U,2)=1
57 I $P(IBY,U,2)=1,$O(^IBE(363.33,"C",+IBSGFN,0)) S $P(IBX,U,1)=1,$P(IBX,U,3)=1
58 I $P(IBY,U,2)=2,$O(^IBE(363.34,"C",+IBSGFN,0)) S $P(IBX,U,1)=1,$P(IBX,U,4)=1
59 Q IBX
Note: See TracBrowser for help on using the repository browser.