IBCD1 ;ALB/ARH - AUTOMATED BILLER ; 8/6/93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
SETB ;set up bills (sort by event date required by types where multiple events can be on one bill)
S IBDFN=0 F S IBDFN=$O(^TMP("IBCAB",$J,IBDFN)) Q:'IBDFN D
. S IBTYP=0 F S IBTYP=$O(^TMP("IBCAB",$J,IBDFN,IBTYP)) Q:'IBTYP S IBS="IBC"_IBTYP D
.. S IBEVDT=0 F S IBEVDT=$O(^TMP("IBCAB",$J,IBDFN,IBTYP,IBEVDT)) Q:'IBEVDT D
... S IBTRN=0 F S IBTRN=$O(^TMP("IBCAB",$J,IBDFN,IBTYP,IBEVDT,IBTRN)) Q:'IBTRN D
.... S IBX=$P($G(^IBE(356.6,+IBTYP,0)),U,1)
.... I IBX="INPATIENT ADMISSION" D INP^IBCD5 Q
.... I IBX="PRESCRIPTION REFILL" D RXRF Q
.... I IBX="OUTPATIENT VISIT" D OUTP Q
.... D TEABD(IBTRN,0),TERR(IBTRN,0,"Event type can not be auto billed.")
K IBDFN,IBTYP,IBEVDT,IBTRN,IBS,IBX,IBSTDT,IBTF
D ^IBCD2
Q
;
OUTP ;Outpatient Bills (IBTRN,IBTYP,IBDFN,IBEVDT)
;get statement from and to dates, based on event date and billing cycle of event type then try to match event to an existing bill cycle, check that event is not already billed and that BC+DD is greater than current date
;^TMP("IBC2",$J, PATIENT , START DT ^ TO DT , EVENT IFN)= TIMEFRAME
S IBSTDT=(IBEVDT\1)_"^"_$$BCDT^IBCU8(IBEVDT,IBTYP)
S IBX=0 F S IBX=$O(^TMP(IBS,$J,IBDFN,IBX)) Q:IBX=""!(+IBSTDT<+IBX) I +IBSTDT'>$P(IBX,U,2) S IBSTDT=IBX Q
S IBX=$$DUPCHK^IBCU41(IBEVDT,0,0,IBDFN,0) I +IBX D TEABD(IBTRN,0),TERR(IBTRN,0,$P(IBX,U,2)) G OUTPQ
S IBX=$$EABD^IBCU81(IBTYP,$P(IBSTDT,U,2)) I +IBX>DT D TEABD(IBTRN,+IBX) G OUTPQ
S ^TMP(IBS,$J,IBDFN,IBSTDT,IBTRN)=1
OUTPQ K IBSTDT,IBX
Q
RXRF ;RX Refill (Outpatient) Bills (IBTRN,IBTYP,IBDFN,IBEVDT)
;get statement from and to dates, based on event date and billing cycle of event type then try to match event to an existing bill cycle, check that event is not already billed and that BC+DD is greater than current date
;^TMP("IBC4",$J, PATIENT , START DT ^ TO DT , EVENT IFN)= TIMEFRAME
S IBRXRF=$$RXRF^IBCU81(IBTRN) I IBRXRF="" D TEABD(IBTRN,0),TERR(IBTRN,0,"Can not find rx refill in Pharmacy.") G RXRFQ
S IBSTDT=($P(IBRXRF,U,2)\1)_"^"_$$BCDT^IBCU8(+$P(IBRXRF,U,2),IBTYP)
S IBX=0 F S IBX=$O(^TMP(IBS,$J,IBDFN,IBX)) Q:IBX=""!(+IBSTDT<+IBX) I +IBSTDT'>$P(IBX,U,2) S IBSTDT=IBX Q
S IBX=$$RXDUP^IBCU3($P(IBRXRF,U,1),+$P(IBRXRF,U,2),0,0,IBDFN,0) I +IBX D TEABD(IBTRN,0),TERR(IBTRN,0,$P(IBX,U,2)) G RXRFQ
S IBX=$$EABD^IBCU81(IBTYP,$P(IBSTDT,U,2)) I +IBX>DT D TEABD(IBTRN,+IBX) G RXRFQ
S ^TMP(IBS,$J,IBDFN,IBSTDT,IBTRN)=1
RXRFQ K IBSTDT,IBX,IBRXRF
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
IBCD1 ;ALB/ARH - AUTOMATED BILLER ; 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 ;
SETB ;set up bills (sort by event date required by types where multiple events can be on one bill)
+1 SET IBDFN=0
FOR
SET IBDFN=$ORDER(^TMP("IBCAB",$JOB,IBDFN))
IF 'IBDFN
QUIT
Begin DoDot:1
+2 SET IBTYP=0
FOR
SET IBTYP=$ORDER(^TMP("IBCAB",$JOB,IBDFN,IBTYP))
IF 'IBTYP
QUIT
SET IBS="IBC"_IBTYP
Begin DoDot:2
+3 SET IBEVDT=0
FOR
SET IBEVDT=$ORDER(^TMP("IBCAB",$JOB,IBDFN,IBTYP,IBEVDT))
IF 'IBEVDT
QUIT
Begin DoDot:3
+4 SET IBTRN=0
FOR
SET IBTRN=$ORDER(^TMP("IBCAB",$JOB,IBDFN,IBTYP,IBEVDT,IBTRN))
IF 'IBTRN
QUIT
Begin DoDot:4
+5 SET IBX=$PIECE($GET(^IBE(356.6,+IBTYP,0)),U,1)
+6 IF IBX="INPATIENT ADMISSION"
DO INP^IBCD5
QUIT
+7 IF IBX="PRESCRIPTION REFILL"
DO RXRF
QUIT
+8 IF IBX="OUTPATIENT VISIT"
DO OUTP
QUIT
+9 DO TEABD(IBTRN,0)
DO TERR(IBTRN,0,"Event type can not be auto billed.")
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+10 KILL IBDFN,IBTYP,IBEVDT,IBTRN,IBS,IBX,IBSTDT,IBTF
+11 DO ^IBCD2
+12 QUIT
+13 ;
OUTP ;Outpatient Bills (IBTRN,IBTYP,IBDFN,IBEVDT)
+1 ;get statement from and to dates, based on event date and billing cycle of event type then try to match event to an existing bill cycle, check that event is not already billed and that BC+DD is greater than current date
+2 ;^TMP("IBC2",$J, PATIENT , START DT ^ TO DT , EVENT IFN)= TIMEFRAME
+3 SET IBSTDT=(IBEVDT\1)_"^"_$$BCDT^IBCU8(IBEVDT,IBTYP)
+4 SET IBX=0
FOR
SET IBX=$ORDER(^TMP(IBS,$JOB,IBDFN,IBX))
IF IBX=""!(+IBSTDT<+IBX)
QUIT
IF +IBSTDT'>$PIECE(IBX,U,2)
SET IBSTDT=IBX
QUIT
+5 SET IBX=$$DUPCHK^IBCU41(IBEVDT,0,0,IBDFN,0)
IF +IBX
DO TEABD(IBTRN,0)
DO TERR(IBTRN,0,$PIECE(IBX,U,2))
GOTO OUTPQ
+6 SET IBX=$$EABD^IBCU81(IBTYP,$PIECE(IBSTDT,U,2))
IF +IBX>DT
DO TEABD(IBTRN,+IBX)
GOTO OUTPQ
+7 SET ^TMP(IBS,$JOB,IBDFN,IBSTDT,IBTRN)=1
OUTPQ KILL IBSTDT,IBX
+1 QUIT
RXRF ;RX Refill (Outpatient) Bills (IBTRN,IBTYP,IBDFN,IBEVDT)
+1 ;get statement from and to dates, based on event date and billing cycle of event type then try to match event to an existing bill cycle, check that event is not already billed and that BC+DD is greater than current date
+2 ;^TMP("IBC4",$J, PATIENT , START DT ^ TO DT , EVENT IFN)= TIMEFRAME
+3 SET IBRXRF=$$RXRF^IBCU81(IBTRN)
IF IBRXRF=""
DO TEABD(IBTRN,0)
DO TERR(IBTRN,0,"Can not find rx refill in Pharmacy.")
GOTO RXRFQ
+4 SET IBSTDT=($PIECE(IBRXRF,U,2)\1)_"^"_$$BCDT^IBCU8(+$PIECE(IBRXRF,U,2),IBTYP)
+5 SET IBX=0
FOR
SET IBX=$ORDER(^TMP(IBS,$JOB,IBDFN,IBX))
IF IBX=""!(+IBSTDT<+IBX)
QUIT
IF +IBSTDT'>$PIECE(IBX,U,2)
SET IBSTDT=IBX
QUIT
+6 SET IBX=$$RXDUP^IBCU3($PIECE(IBRXRF,U,1),+$PIECE(IBRXRF,U,2),0,0,IBDFN,0)
IF +IBX
DO TEABD(IBTRN,0)
DO TERR(IBTRN,0,$PIECE(IBX,U,2))
GOTO RXRFQ
+7 SET IBX=$$EABD^IBCU81(IBTYP,$PIECE(IBSTDT,U,2))
IF +IBX>DT
DO TEABD(IBTRN,+IBX)
GOTO RXRFQ
+8 SET ^TMP(IBS,$JOB,IBDFN,IBSTDT,IBTRN)=1
RXRFQ KILL IBSTDT,IBX,IBRXRF
+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
