- IBCD1 ;ALB/ARH - AUTOMATED BILLER ; 8/6/93
- ;;2.0;INTEGRATED BILLING;**55,81,592**;21-MAR-94;Build 58
- ;;Per VA Directive 6402, 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 NABOUTP
- 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
- ;JWS;IB*592 - add 6th parameter to DUPCHK call below for Claims Tracking entry
- S IBX=$$DUPCHK^IBCU41(IBEVDT,0,0,IBDFN,0,IBTRN) 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 N IBXX S IBXX=$S(+$P($G(^IBT(356,IBTRN,1)),U,1)]"":+$P(^IBT(356,IBTRN,1),U,1)\1,1:$P(IBSTDT,U,1)),IBXX=$$EABD^IBCU81(IBTYP,IBXX) D TEABD(IBTRN,+IBXX) G OUTPQ
- I $$NABSCT^IBCU81(IBTRN) S ^TMP("IBNAB",$J,IBS,IBDFN,(IBEVDT\1),IBTRN)="" G OUTPQ
- S ^TMP(IBS,$J,IBDFN,IBSTDT,IBTRN)=1,^TMP("IBNAB1",$J,IBS,IBDFN,(IBEVDT\1))=IBSTDT
- 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 N IBXX S IBXX=$S(+$P($G(^IBT(356,IBTRN,1)),U,1)]"":+$P(^IBT(356,IBTRN,1),U,1)\1,1:$P(IBSTDT,U,1)),IBXX=$$EABD^IBCU81(IBTYP,IBXX) D TEABD(IBTRN,+IBXX) G RXRFQ
- S ^TMP(IBS,$J,IBDFN,IBSTDT,IBTRN)=1
- RXRFQ K IBSTDT,IBX,IBRXRF
- Q
- ;
- NABOUTP ; add opt visits that should not be auto billed but date has been billed
- N IBDFN,IBS,IBEVDT,IBSTDT,IBTRN S IBS=$O(^TMP("IBNAB",$J,0))
- I IBS'="" S IBDFN=0 F S IBDFN=$O(^TMP("IBNAB",$J,IBS,IBDFN)) Q:'IBDFN D
- . S IBEVDT=0 F S IBEVDT=$O(^TMP("IBNAB",$J,IBS,IBDFN,IBEVDT)) Q:'IBEVDT D
- .. S IBSTDT=$G(^TMP("IBNAB1",$J,IBS,IBDFN,IBEVDT))
- .. S IBTRN=0 F S IBTRN=$O(^TMP("IBNAB",$J,IBS,IBDFN,IBEVDT,IBTRN)) Q:'IBTRN D
- ... I IBSTDT'?7N1"^"7N D TEABD(IBTRN,0) Q
- ... S ^TMP(IBS,$J,IBDFN,IBSTDT,IBTRN)=1
- K ^TMP("IBNAB",$J),^TMP("IBNAB1",$J)
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCD1 4259 printed Feb 18, 2025@23:35:37 Page 2
- IBCD1 ;ALB/ARH - AUTOMATED BILLER ; 8/6/93
- +1 ;;2.0;INTEGRATED BILLING;**55,81,592**;21-MAR-94;Build 58
- +2 ;;Per VA Directive 6402, 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 NABOUTP
- +12 DO ^IBCD2
- +13 QUIT
- +14 ;
- 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 ;JWS;IB*592 - add 6th parameter to DUPCHK call below for Claims Tracking entry
- +6 SET IBX=$$DUPCHK^IBCU41(IBEVDT,0,0,IBDFN,0,IBTRN)
- IF +IBX
- DO TEABD(IBTRN,0)
- DO TERR(IBTRN,0,$PIECE(IBX,U,2))
- GOTO OUTPQ
- +7 SET IBX=$$EABD^IBCU81(IBTYP,$PIECE(IBSTDT,U,2))
- IF +IBX>DT
- NEW IBXX
- SET IBXX=$SELECT(+$PIECE($GET(^IBT(356,IBTRN,1)),U,1)]"":+$PIECE(^IBT(356,IBTRN,1),U,1)\1,1:$PIECE(IBSTDT,U,1))
- SET IBXX=$$EABD^IBCU81(IBTYP,IBXX)
- DO TEABD(IBTRN,+IBXX)
- GOTO OUTPQ
- +8 IF $$NABSCT^IBCU81(IBTRN)
- SET ^TMP("IBNAB",$JOB,IBS,IBDFN,(IBEVDT\1),IBTRN)=""
- GOTO OUTPQ
- +9 SET ^TMP(IBS,$JOB,IBDFN,IBSTDT,IBTRN)=1
- SET ^TMP("IBNAB1",$JOB,IBS,IBDFN,(IBEVDT\1))=IBSTDT
- 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
- NEW IBXX
- SET IBXX=$SELECT(+$PIECE($GET(^IBT(356,IBTRN,1)),U,1)]"":+$PIECE(^IBT(356,IBTRN,1),U,1)\1,1:$PIECE(IBSTDT,U,1))
- SET IBXX=$$EABD^IBCU81(IBTYP,IBXX)
- DO TEABD(IBTRN,+IBXX)
- GOTO RXRFQ
- +8 SET ^TMP(IBS,$JOB,IBDFN,IBSTDT,IBTRN)=1
- RXRFQ KILL IBSTDT,IBX,IBRXRF
- +1 QUIT
- +2 ;
- NABOUTP ; add opt visits that should not be auto billed but date has been billed
- +1 NEW IBDFN,IBS,IBEVDT,IBSTDT,IBTRN
- SET IBS=$ORDER(^TMP("IBNAB",$JOB,0))
- +2 IF IBS'=""
- SET IBDFN=0
- FOR
- SET IBDFN=$ORDER(^TMP("IBNAB",$JOB,IBS,IBDFN))
- if 'IBDFN
- QUIT
- Begin DoDot:1
- +3 SET IBEVDT=0
- FOR
- SET IBEVDT=$ORDER(^TMP("IBNAB",$JOB,IBS,IBDFN,IBEVDT))
- if 'IBEVDT
- QUIT
- Begin DoDot:2
- +4 SET IBSTDT=$GET(^TMP("IBNAB1",$JOB,IBS,IBDFN,IBEVDT))
- +5 SET IBTRN=0
- FOR
- SET IBTRN=$ORDER(^TMP("IBNAB",$JOB,IBS,IBDFN,IBEVDT,IBTRN))
- if 'IBTRN
- QUIT
- Begin DoDot:3
- +6 IF IBSTDT'?7N1"^"7N
- DO TEABD(IBTRN,0)
- QUIT
- +7 SET ^TMP(IBS,$JOB,IBDFN,IBSTDT,IBTRN)=1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +8 KILL ^TMP("IBNAB",$JOB),^TMP("IBNAB1",$JOB)
- +9 QUIT
- +10 ;
- 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