Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBACVA1

IBACVA1.m

Go to the documentation of this file. 
  1. IBACVA1	;ALB/CPM - BILL CHAMPVA SUBSISTENCE CHARGE ; 29-JUL-93
  1. 	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. 	;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. 	;
  1. BILL	; Create the CHAMPVA inpatient subsistence charge.
  1. 	S IBY=1 I '$$CHECK^IBECEAU(0) D ERRMSG^IBACVA2(1) G BILLQ
  1. 	S (IBCHGT,IBBILLED)=0
  1. 	;
  1. 	; - loop through each day of the admission, or until limit reached.
  1. 	F IBD=IBBDT:1:IBEDT S %H=IBD D YMD^%DTC S IBDT=X D  Q:IBY<0!(IBBILLED)
  1. 	.I IBBDT'=IBEDT S VAIP("D")=IBDT_.2359 D IN5^VADPT Q:'VAIP(10)  ; on leave
  1. 	.D LIM(IBDT) Q:IBY<0  ; can't find maximum limit
  1. 	.D PD(IBDT) Q:IBY<0  ; can't find daily per diem
  1. 	.S:'IBCHGT IBFR=IBDT ; set 'from date' on 1st pass
  1. 	.S IBCHGT=IBCHGT+IBCHG,IBTO=IBDT ; build cumulative charge/set 'to date'
  1. 	.I IBCHGT'<IBLIM S IBCHGT=IBLIM,IBBILLED=1 ; quit if max limit reached
  1. 	;
  1. 	; - quit if there is no error, no charge to bill.
  1. 	I IBY=1,'IBCHGT W:$G(IBJOB)=4 !!,"There are no charges to be billed for this admission!" G BILLQ
  1. 	;
  1. 	; - send error message if error occurs.
  1. 	I $G(IBJOB)'=4,IBY<0 D ERRMSG^IBACVA2(1) G BILLQ
  1. 	;
  1. 	; - display message and get confirmation for Cancel/Edit/Add.
  1. 	I $G(IBJOB)=4 D  G:IBY<0 BILLQ
  1. 	.W !!,"The following billing parameters have been calculated:"
  1. 	.W !!,"    Bill From: ",$$DAT1^IBOUTL(IBFR)
  1. 	.W !,"      Bill To: ",$$DAT1^IBOUTL(IBTO)
  1. 	.W !,"       Charge: $",IBCHGT,!
  1. 	.D PROC^IBECEAU4("add")
  1. 	;
  1. 	; - bill the charge
  1. 	W !,"Billing the CHAMPVA inpatient subsistence charge..."
  1. 	S IBUNIT=1,IBDESC="CHAMPVA SUBSISTENCE",IBCHG=IBCHGT,IBSL="405:"_IBSL
  1. 	D ADD^IBECEAU3 W "completed."
  1. 	;
  1. 	; - need to pass to AR when I get an AR Category...
  1. 	; - AND, set IBCOMMIT=1 for C/E/A
  1. 	;
  1. BILLQ	Q
  1. 	;
  1. LIM(DATE)	; Find the CHAMPVA subsistence limit on DATE.
  1. 	;  Input:    DATE  --  The date on which to determine the limit
  1. 	;  Output:  IBLIM  --  The maximum subsistence charge for an episode
  1. 	N X S IBLIM=0
  1. 	S X=$O(^IBE(350.1,"E","CHAMPVA LIMIT",0)) I 'X S IBY="-1^IB083" G LIMQ
  1. 	S X=$O(^IBE(350.2,"AIVDT",+X,-(DATE+.1))),X=$O(^(+X,0))
  1. 	S IBLIM=$P($G(^IBE(350.2,+X,0)),"^",4) I 'IBLIM S IBY="-1^IB084"
  1. LIMQ	Q
  1. 	;
  1. PD(IBDT)	; Find the CHAMPVA per diem charge on IBDT.
  1. 	;  Input:    IBDT  --  The date on which to determine the per diem
  1. 	;  Output:  IBCHG  --  The CHAMPVA per diem charge on IBDT
  1. 	;          IBATYP  --  CHAMPVA Action Type
  1. 	S IBATYP=$O(^IBE(350.1,"E","CHAMPVA SUBSISTENCE",0)),IBCHG=0
  1. 	I 'IBATYP S IBY="-1^IB008" G PDQ
  1. 	D COST^IBAUTL2 I 'IBCHG S IBY="-1^IB029"
  1. PDQ	Q
  1. 	;
  1. PREV(DFN,DATE,LINK)	; Billed an admission the CHAMPVA subsistence charge?
  1. 	;  Input:     DFN  --  Pointer to patient in file #2
  1. 	;            DATE  --  Event (admission) date
  1. 	;            LINK  --  Pointer to mvmt in file #405
  1. 	;  Output:      0  --  Admission has not been billed, or
  1. 	;              >0  --  ien of billed charge in file #350
  1. 	I '$G(DFN)!'$G(DATE)!'$G(LINK) G PREVQ
  1. 	N IBN,IBND,IBP
  1. 	S IBP=0 F  S IBP=$O(^IB("ACVA",DFN,DATE,IBP)) Q:'IBP  S IBN=$$LAST^IBECEAU(IBP),IBND=$G(^IB(IBN,0)) I $P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^",5)'=2,$P(IBND,"^",4)=("405:"_LINK),"^3^4^"[("^"_+$P(IBND,"^",5)_"^") S Y=IBN Q
  1. PREVQ	Q +$G(Y)