- 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
