IBCREU1 ;ALB/ARH - RATES: CM ENTER/EDIT UTILITIES ; 16-MAY-1996
;;2.0;INTEGRATED BILLING;**52,106,138**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
RQCI(IBCIFN) ; check all required data defined for charge item
; either the item's Charge Set must have a Default Revenue Code or the Charge Item must have revenue code
; Charge Set and Effective Date are required
; returns: 0 or 1 ^ 1 (needs CS) ^ 1 (needs EF DT) ^ 1 (needs Revenue Code)
N IBCS0,IBCI0,IBX S IBX=0
S IBCI0=$G(^IBA(363.2,+$G(IBCIFN),0)),IBCS0=$G(^IBE(363.1,+$P(IBCI0,U,2),0))
I IBCS0="" S $P(IBX,U,1)=1,$P(IBX,U,2)=1
I '$P(IBCI0,U,2) S $P(IBX,U,1)=1,$P(IBX,U,2)=1
I '$P(IBCI0,U,3) S $P(IBX,U,1)=1,$P(IBX,U,3)=1
I '$P(IBCS0,U,5),'$P(IBCI0,U,6) S $P(IBX,U,1)=1,$P(IBX,U,4)=1
Q IBX
;
RQCS(CSFN) ; check that new charge set has all required fields
; Billing Rate is required to define the sets Charge Items
; Billable Event is required to link the sets charges to the items on the bills
; if the Billable Item of the Sets rate is not bedsection then Default Bedsection is required for the set
; if Charge Method of Sets rate is VA Cost then the Default Rev Code is required
; returns: 0 or 1 ^ 1 (needs BR) ^ 1 (needs BE) ^ 1 (needs bedsection)
N IBCS,IBBR,IBX S IBX=0
S IBCS=$G(^IBE(363.1,+$G(CSFN),0)),IBBR=$G(^IBE(363.3,+$P(IBCS,U,2),0))
I IBBR="" S $P(IBX,U,1)=1,$P(IBX,U,2)=1
I '$P(IBCS,U,2) S $P(IBX,U,1)=1,$P(IBX,U,2)=1
I '$P(IBCS,U,3) S $P(IBX,U,1)=1,$P(IBX,U,3)=1
I '$P(IBCS,U,6),+$P(IBBR,U,4)'=1 S $P(IBX,U,1)=1,$P(IBX,U,4)=1
I '$P(IBCS,U,5),+$P(IBBR,U,5)=2 S $P(IBX,U,1)=1,$P(IBX,U,5)=1
Q IBX
;
CHKBR(IBBRFN) ; check billing rate to determine if it can be edited (has CS or charge items or national)
; if the Rate is National or (since the Rate defines the items billed to a set)
; if the Rate has a Charge Set or a set of this Rate has Charge items, don't edit
; returns: 0 if editable or 1 ^ 1 (if national) ^ 1 (CS defined) ^ 1 (if charge items exist)
N IBX,IBY,IBCSFN S IBBRFN=+$G(IBBRFN),IBX=0
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
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
. S $P(IBX,U,1)=1,$P(IBX,U,3)=1
. S IBY="AIVDTS"_IBCSFN I $O(^IBA(363.2,IBY,0)) S $P(IBX,U,1)=1,$P(IBX,U,4)=1
Q IBX
;
CHKCS(IBCSFN) ; check charge set to determine if/what can be edited
; if the set was exported nationally (ie. any set not created locally) Name, Rate, and Event not editable
; if the Set has Charge Items defined then the Rate should not be changed since it defines the type of Item
; returns: 0 if editable or 1 ^ 1 (if charge items exist for the set) ^ 1 (not created locally)
;
N IBX,IBY S IBCSFN=+$G(IBCSFN),IBX=0
S IBY="AIVDTS"_IBCSFN I $O(^IBA(363.2,IBY,0)) S IBX=1,IBX=IBX_"^1"
I +IBCSFN<1000 S $P(IBX,U,1)=1,$P(IBX,U,3)=1
Q IBX
;
CHKSG(IBSGFN) ; check special groups to determine if it can be edited
; returns: 0 if editable or 1 ^ 1 (if exported nationally) ^ 1 (has rv cd links) ^ 1 (has PD links)
N IBX,IBY S IBSGFN=+$G(IBSGFN),IBX=0,IBY=$G(^IBE(363.32,IBSGFN,0))
I IBY'="",+IBSGFN<1000 S $P(IBX,U,1)=1,$P(IBX,U,2)=1
I $P(IBY,U,2)=1,$O(^IBE(363.33,"C",+IBSGFN,0)) S $P(IBX,U,1)=1,$P(IBX,U,3)=1
I $P(IBY,U,2)=2,$O(^IBE(363.34,"C",+IBSGFN,0)) S $P(IBX,U,1)=1,$P(IBX,U,4)=1
Q IBX
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCREU1 3418 printed Apr 09, 2024@21:11:21 Page 2
IBCREU1 ;ALB/ARH - RATES: CM ENTER/EDIT UTILITIES ; 16-MAY-1996
+1 ;;2.0;INTEGRATED BILLING;**52,106,138**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
RQCI(IBCIFN) ; check all required data defined for charge item
+1 ; either the item's Charge Set must have a Default Revenue Code or the Charge Item must have revenue code
+2 ; Charge Set and Effective Date are required
+3 ; returns: 0 or 1 ^ 1 (needs CS) ^ 1 (needs EF DT) ^ 1 (needs Revenue Code)
+4 NEW IBCS0,IBCI0,IBX
SET IBX=0
+5 SET IBCI0=$GET(^IBA(363.2,+$GET(IBCIFN),0))
SET IBCS0=$GET(^IBE(363.1,+$PIECE(IBCI0,U,2),0))
+6 IF IBCS0=""
SET $PIECE(IBX,U,1)=1
SET $PIECE(IBX,U,2)=1
+7 IF '$PIECE(IBCI0,U,2)
SET $PIECE(IBX,U,1)=1
SET $PIECE(IBX,U,2)=1
+8 IF '$PIECE(IBCI0,U,3)
SET $PIECE(IBX,U,1)=1
SET $PIECE(IBX,U,3)=1
+9 IF '$PIECE(IBCS0,U,5)
IF '$PIECE(IBCI0,U,6)
SET $PIECE(IBX,U,1)=1
SET $PIECE(IBX,U,4)=1
+10 QUIT IBX
+11 ;
RQCS(CSFN) ; check that new charge set has all required fields
+1 ; Billing Rate is required to define the sets Charge Items
+2 ; Billable Event is required to link the sets charges to the items on the bills
+3 ; if the Billable Item of the Sets rate is not bedsection then Default Bedsection is required for the set
+4 ; if Charge Method of Sets rate is VA Cost then the Default Rev Code is required
+5 ; returns: 0 or 1 ^ 1 (needs BR) ^ 1 (needs BE) ^ 1 (needs bedsection)
+6 NEW IBCS,IBBR,IBX
SET IBX=0
+7 SET IBCS=$GET(^IBE(363.1,+$GET(CSFN),0))
SET IBBR=$GET(^IBE(363.3,+$PIECE(IBCS,U,2),0))
+8 IF IBBR=""
SET $PIECE(IBX,U,1)=1
SET $PIECE(IBX,U,2)=1
+9 IF '$PIECE(IBCS,U,2)
SET $PIECE(IBX,U,1)=1
SET $PIECE(IBX,U,2)=1
+10 IF '$PIECE(IBCS,U,3)
SET $PIECE(IBX,U,1)=1
SET $PIECE(IBX,U,3)=1
+11 IF '$PIECE(IBCS,U,6)
IF +$PIECE(IBBR,U,4)'=1
SET $PIECE(IBX,U,1)=1
SET $PIECE(IBX,U,4)=1
+12 IF '$PIECE(IBCS,U,5)
IF +$PIECE(IBBR,U,5)=2
SET $PIECE(IBX,U,1)=1
SET $PIECE(IBX,U,5)=1
+13 QUIT IBX
+14 ;
CHKBR(IBBRFN) ; check billing rate to determine if it can be edited (has CS or charge items or national)
+1 ; if the Rate is National or (since the Rate defines the items billed to a set)
+2 ; if the Rate has a Charge Set or a set of this Rate has Charge items, don't edit
+3 ; returns: 0 if editable or 1 ^ 1 (if national) ^ 1 (CS defined) ^ 1 (if charge items exist)
+4 NEW IBX,IBY,IBCSFN
SET IBBRFN=+$GET(IBBRFN)
SET IBX=0
+5 SET IBY=$GET(^IBE(363.3,IBBRFN,0))
IF +IBBRFN<1000!($PIECE(IBY,U,3)=1)
SET $PIECE(IBX,U,1)=1
SET $PIECE(IBX,U,2)=1
+6 SET IBCSFN=0
FOR
SET IBCSFN=$ORDER(^IBE(363.1,IBCSFN))
if 'IBCSFN
QUIT
IF +$PIECE($GET(^IBE(363.1,IBCSFN,0)),U,2)=IBBRFN
Begin DoDot:1
+7 SET $PIECE(IBX,U,1)=1
SET $PIECE(IBX,U,3)=1
+8 SET IBY="AIVDTS"_IBCSFN
IF $ORDER(^IBA(363.2,IBY,0))
SET $PIECE(IBX,U,1)=1
SET $PIECE(IBX,U,4)=1
End DoDot:1
+9 QUIT IBX
+10 ;
CHKCS(IBCSFN) ; check charge set to determine if/what can be edited
+1 ; if the set was exported nationally (ie. any set not created locally) Name, Rate, and Event not editable
+2 ; if the Set has Charge Items defined then the Rate should not be changed since it defines the type of Item
+3 ; returns: 0 if editable or 1 ^ 1 (if charge items exist for the set) ^ 1 (not created locally)
+4 ;
+5 NEW IBX,IBY
SET IBCSFN=+$GET(IBCSFN)
SET IBX=0
+6 SET IBY="AIVDTS"_IBCSFN
IF $ORDER(^IBA(363.2,IBY,0))
SET IBX=1
SET IBX=IBX_"^1"
+7 IF +IBCSFN<1000
SET $PIECE(IBX,U,1)=1
SET $PIECE(IBX,U,3)=1
+8 QUIT IBX
+9 ;
CHKSG(IBSGFN) ; check special groups to determine if it can be edited
+1 ; returns: 0 if editable or 1 ^ 1 (if exported nationally) ^ 1 (has rv cd links) ^ 1 (has PD links)
+2 NEW IBX,IBY
SET IBSGFN=+$GET(IBSGFN)
SET IBX=0
SET IBY=$GET(^IBE(363.32,IBSGFN,0))
+3 IF IBY'=""
IF +IBSGFN<1000
SET $PIECE(IBX,U,1)=1
SET $PIECE(IBX,U,2)=1
+4 IF $PIECE(IBY,U,2)=1
IF $ORDER(^IBE(363.33,"C",+IBSGFN,0))
SET $PIECE(IBX,U,1)=1
SET $PIECE(IBX,U,3)=1
+5 IF $PIECE(IBY,U,2)=2
IF $ORDER(^IBE(363.34,"C",+IBSGFN,0))
SET $PIECE(IBX,U,1)=1
SET $PIECE(IBX,U,4)=1
+6 QUIT IBX
