IBCD5 ;ALB/ARH - AUTOMATED BILLER (INPT DT RANGE) ; 8/6/93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;
;continuation of IBCD1
INP ;Inpatient Admissions (IBTRN,IBTYP,IBDFN,IBEVDT)
;get statement from and to dates based on previous non-final bills or event date and billing cycle, check that range is within admit-discharge, not previously billed, and BC + DD is not greater than current date, PTF status
;^TMP("IBC1",$J, PATIENT , START DT ^ TO DT , EVENT IFN)= TIMEFRAME
;
S IBX=$P($G(^IBT(356,IBTRN,0)),U,5),IBAD=$$AD^IBCU64(IBX),IBDIS=+$P(IBAD,U,2)\1 I 'IBAD!('$P(IBAD,U,4)) D G INPQ
. I 'IBAD D TERR(IBTRN,0,"Patient Admission Movement Data not found.")
. D TERR(IBTRN,0,"Admission movement missing PTF number.")
;
S IBX=$G(^DGPT(+$P(IBAD,U,4),0)) I 'IBX D TERR(IBTRN,0,"PTF record for Admission movement was not found.") G INPQ
I '$P(IBX,U,6)!(+$P(IBPAR7,U,3)>+$P(IBX,U,6)) G INPQ ; check PTF status, PTF record must be at least closed or status entered by site before and auto bill can be created
;
; find latest bill dates for record, if a final bill or a non riemb. ins bill exit
S IBLBDT=$$BILLED^IBCU3($P(IBAD,U,4)) I +IBLBDT,('$P(IBLBDT,U,2)!($P(IBLBDT,U,3)'=8)) D G INPQ
. S IBX=$P($G(^DGCR(399,+IBLBDT,0)),U,1)
. I '$P(IBLBDT,U,2) D TBILL(IBTRN,+IBLBDT),TERR(IBTRN,0,"Event already has a final bill ("_IBX_").")
. I $P(IBLBDT,U,3)'=8 S IBX=$P($G(^DGCR(399.3,+$P(IBLBDT,U,3),0)),U,1) D TERR(IBTRN,0,"May not be Reimbursable Ins.: A "_IBX_" bill already exists for this event.")
;
; begin calculation of bill dates, begin date based on end of last bill, otherwise event date (admission dt)
S IBSTDT=$P(IBLBDT,U,2)\1,IBTF=3 I +IBSTDT S IBSTDT=$$FMADD^XLFDT(+IBSTDT,1)
I 'IBSTDT S IBSTDT=IBEVDT\1,IBTF=2
S $P(IBSTDT,U,2)=$$BCDT^IBCU8(+IBSTDT,IBTYP) ; end date based on pre^defined length of bill cycle
;
; force date range to within admit-discharge dates
S:+IBSTDT<+IBAD $P(IBSTDT,U,1)=+IBAD\1 I +IBDIS,$P(IBSTDT,U,2)>+IBDIS S $P(IBSTDT,U,2)=+IBDIS
I $P(IBSTDT,U,2)=IBDIS S IBTF=4 I +IBSTDT=(+IBAD\1) S IBTF=1
;
S IBX=$$DUPCHKI^IBCU64(+IBSTDT,$P(IBSTDT,U,2),$P(IBAD,U,4),0,0) I +IBX D TEABD(IBTRN,0),TERR(IBTRN,0,$P(IBX,U,2)) G INPQ
S IBX=$$EABD^IBCU81(IBTYP,$P(IBSTDT,U,2)) I +IBX>DT D TEABD(IBTRN,+IBX) G INPQ
S ^TMP(IBS,$J,IBDFN,IBSTDT,IBTRN)=IBTF
INPQ K IBSTDT,IBAD,IBLBDT,IBDIS,IBX,IBTF
Q
;
INPT ;
N PTF S IBADMT=$P(IBTRND,U,5),IBAD=$$AD^IBCU64(IBADMT),IB(.03)=+IBAD,IB(.05)=1
;check ptf movements for service connected care, see enddis^ibca0
S IB(.08)=$P(IBAD,U,4),PTF=IB(.08)
S IB(.04)=1,IBX=$P($G(^DIC(45.7,+$P(IBAD,U,5),0)),U,2) I $P($G(^DIC(42.4,+IBX,0)),U,3)="NH" S IB(.04)=2 ; treating specialty NHCU
S IBDISDT=$P(IBAD,U,2) ; discharge date
S IB(151)=+IBSTDT,IB(152)=$P(IBSTDT,U,2)
S IBIDS(.08)=IB(.08) D SPEC^IBCU4 S IB(161)=$G(IBIDS(161)) K IBIDS ; discharge bedsection
I +IBDISDT,'IB(161) D TERR(IBTRN,IBIFN,"Non-Billable Discharge Bedsection.")
S IB(165)=$$LOS^IBCU64(IB(151),IB(152),IB(.06),IBADMT) I IB(165)'>0 D TERR(IBTRN,IBIFN,"No billable Days.")
S IB(.09)=9 D IDX^IBCD4(+IB(.08),+IB(151),+IB(152)) I $D(IBMSG)>2 D
. S IBX=0 F S IBX=$O(IBMSG(IBX)) Q:'IBX D TERR(IBTRN,IBIFN,IBMSG(IBX))
INPTE K IBADMT,IBADMTD,IBDISDT,IBLBDT,IBSCM,IBM,IBAD,IBX
Q
;
TEABD(TRN,IBDT) ;array contains the list of claims tracking events that need EABD updated, and the new date
S IBDT=+$G(IBDT),^TMP("IBEABD",$J,TRN,+IBDT)=""
Q
TERR(TRN,IFN,ER) ;array contains events or bills that need entries created in the comments file, and the comment
N X S TRN=+$G(TRN),IFN=+$G(IFN),X=+$G(^TMP("IBCE",$J,DT,TRN,IFN))+1
S ^TMP("IBCE",$J,DT,TRN,IFN,X)=$G(ER),^TMP("IBCE",$J,DT,TRN,IFN)=X
Q
TBILL(TRN,IFN) ;array contains list of events and bills to be inserted into 356.399
I '$D(^IBT(356,+$G(TRN),0))!('$D(^DGCR(399,+$G(IFN),0))) Q
S ^TMP("IBILL",$J,TRN,IFN)=""
Q
IBCD5 ;ALB/ARH - AUTOMATED BILLER (INPT DT RANGE) ; 8/6/93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;
+5 ;continuation of IBCD1
INP ;Inpatient Admissions (IBTRN,IBTYP,IBDFN,IBEVDT)
+1 ;get statement from and to dates based on previous non-final bills or event date and billing cycle, check that range is within admit-discharge, not previously billed, and BC + DD is not greater than current date, PTF status
+2 ;^TMP("IBC1",$J, PATIENT , START DT ^ TO DT , EVENT IFN)= TIMEFRAME
+3 ;
+4 SET IBX=$PIECE($GET(^IBT(356,IBTRN,0)),U,5)
SET IBAD=$$AD^IBCU64(IBX)
SET IBDIS=+$PIECE(IBAD,U,2)\1
IF 'IBAD!('$PIECE(IBAD,U,4))
Begin DoDot:1
+5 IF 'IBAD
DO TERR(IBTRN,0,"Patient Admission Movement Data not found.")
+6 DO TERR(IBTRN,0,"Admission movement missing PTF number.")
End DoDot:1
GOTO INPQ
+7 ;
+8 SET IBX=$GET(^DGPT(+$PIECE(IBAD,U,4),0))
IF 'IBX
DO TERR(IBTRN,0,"PTF record for Admission movement was not found.")
GOTO INPQ
+9 ; check PTF status, PTF record must be at least closed or status entered by site before and auto bill can be created
IF '$PIECE(IBX,U,6)!(+$PIECE(IBPAR7,U,3)>+$PIECE(IBX,U,6))
GOTO INPQ
+10 ;
+11 ; find latest bill dates for record, if a final bill or a non riemb. ins bill exit
+12 SET IBLBDT=$$BILLED^IBCU3($PIECE(IBAD,U,4))
IF +IBLBDT
IF ('$PIECE(IBLBDT,U,2)!($PIECE(IBLBDT,U,3)'=8))
Begin DoDot:1
+13 SET IBX=$PIECE($GET(^DGCR(399,+IBLBDT,0)),U,1)
+14 IF '$PIECE(IBLBDT,U,2)
DO TBILL(IBTRN,+IBLBDT)
DO TERR(IBTRN,0,"Event already has a final bill ("_IBX_").")
+15 IF $PIECE(IBLBDT,U,3)'=8
SET IBX=$PIECE($GET(^DGCR(399.3,+$PIECE(IBLBDT,U,3),0)),U,1)
DO TERR(IBTRN,0,"May not be Reimbursable Ins.: A "_IBX_" bill already exists for this event.")
End DoDot:1
GOTO INPQ
+16 ;
+17 ; begin calculation of bill dates, begin date based on end of last bill, otherwise event date (admission dt)
+18 SET IBSTDT=$PIECE(IBLBDT,U,2)\1
SET IBTF=3
IF +IBSTDT
SET IBSTDT=$$FMADD^XLFDT(+IBSTDT,1)
+19 IF 'IBSTDT
SET IBSTDT=IBEVDT\1
SET IBTF=2
+20 ; end date based on pre^defined length of bill cycle
SET $PIECE(IBSTDT,U,2)=$$BCDT^IBCU8(+IBSTDT,IBTYP)
+21 ;
+22 ; force date range to within admit-discharge dates
+23 IF +IBSTDT<+IBAD
SET $PIECE(IBSTDT,U,1)=+IBAD\1
IF +IBDIS
IF $PIECE(IBSTDT,U,2)>+IBDIS
SET $PIECE(IBSTDT,U,2)=+IBDIS
+24 IF $PIECE(IBSTDT,U,2)=IBDIS
SET IBTF=4
IF +IBSTDT=(+IBAD\1)
SET IBTF=1
+25 ;
+26 SET IBX=$$DUPCHKI^IBCU64(+IBSTDT,$PIECE(IBSTDT,U,2),$PIECE(IBAD,U,4),0,0)
IF +IBX
DO TEABD(IBTRN,0)
DO TERR(IBTRN,0,$PIECE(IBX,U,2))
GOTO INPQ
+27 SET IBX=$$EABD^IBCU81(IBTYP,$PIECE(IBSTDT,U,2))
IF +IBX>DT
DO TEABD(IBTRN,+IBX)
GOTO INPQ
+28 SET ^TMP(IBS,$JOB,IBDFN,IBSTDT,IBTRN)=IBTF
INPQ KILL IBSTDT,IBAD,IBLBDT,IBDIS,IBX,IBTF
+1 QUIT
+2 ;
INPT ;
+1 NEW PTF
SET IBADMT=$PIECE(IBTRND,U,5)
SET IBAD=$$AD^IBCU64(IBADMT)
SET IB(.03)=+IBAD
SET IB(.05)=1
+2 ;check ptf movements for service connected care, see enddis^ibca0
+3 SET IB(.08)=$PIECE(IBAD,U,4)
SET PTF=IB(.08)
+4 ; treating specialty NHCU
SET IB(.04)=1
SET IBX=$PIECE($GET(^DIC(45.7,+$PIECE(IBAD,U,5),0)),U,2)
IF $PIECE($GET(^DIC(42.4,+IBX,0)),U,3)="NH"
SET IB(.04)=2
+5 ; discharge date
SET IBDISDT=$PIECE(IBAD,U,2)
+6 SET IB(151)=+IBSTDT
SET IB(152)=$PIECE(IBSTDT,U,2)
+7 ; discharge bedsection
SET IBIDS(.08)=IB(.08)
DO SPEC^IBCU4
SET IB(161)=$GET(IBIDS(161))
KILL IBIDS
+8 IF +IBDISDT
IF 'IB(161)
DO TERR(IBTRN,IBIFN,"Non-Billable Discharge Bedsection.")
+9 SET IB(165)=$$LOS^IBCU64(IB(151),IB(152),IB(.06),IBADMT)
IF IB(165)'>0
DO TERR(IBTRN,IBIFN,"No billable Days.")
+10 SET IB(.09)=9
DO IDX^IBCD4(+IB(.08),+IB(151),+IB(152))
IF $DATA(IBMSG)>2
Begin DoDot:1
+11 SET IBX=0
FOR
SET IBX=$ORDER(IBMSG(IBX))
IF 'IBX
QUIT
DO TERR(IBTRN,IBIFN,IBMSG(IBX))
End DoDot:1
INPTE KILL IBADMT,IBADMTD,IBDISDT,IBLBDT,IBSCM,IBM,IBAD,IBX
+1 QUIT
+2 ;
TEABD(TRN,IBDT) ;array contains the list of claims tracking events that need EABD updated, and the new date
+1 SET IBDT=+$GET(IBDT)
SET ^TMP("IBEABD",$JOB,TRN,+IBDT)=""
+2 QUIT
TERR(TRN,IFN,ER) ;array contains events or bills that need entries created in the comments file, and the comment
+1 NEW X
SET TRN=+$GET(TRN)
SET IFN=+$GET(IFN)
SET X=+$GET(^TMP("IBCE",$JOB,DT,TRN,IFN))+1
+2 SET ^TMP("IBCE",$JOB,DT,TRN,IFN,X)=$GET(ER)
SET ^TMP("IBCE",$JOB,DT,TRN,IFN)=X
+3 QUIT
TBILL(TRN,IFN) ;array contains list of events and bills to be inserted into 356.399
+1 IF '$DATA(^IBT(356,+$GET(TRN),0))!('$DATA(^DGCR(399,+$GET(IFN),0)))
QUIT
+2 SET ^TMP("IBILL",$JOB,TRN,IFN)=""
+3 QUIT
