- 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
