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 Apr 09, 2024@21:07:36 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
