IBCD ;ALB/ARH - AUTOMATED BILLER ;8/6/93
;;2.0;INTEGRATED BILLING;**312,554,592**;21-MAR-94;Build 58
;Per VA Directive 6402, this routine should not be modified.
;
;This routine is the begining of the auto biller. No variables are required on entry. It is be called by the
;IB nightly job routine IBAMTC. It first checks to see if it should run based on the auto biller frequency
;site parameter. It then gathers the Claims Tracking events with an EABD into a temporary file by patient,
;event type, and episode date. This temporary file ("IBACAB") is then used to sort the events into groups
;that should be added to individual bills based on the individual event type billing cycle parameters. This
;second temporary file is then used to create the actual bills in IBCD1-2.
;
EN ;begin process of finding and creating bills
;determine if auto biller should run, check site parameters (350.9,7.01-7.02)
N IBSWINFO,IBPFSS S IBSWINFO=$$SWSTAT^IBBAPI() ;IB*2.0*312
;
;add nightly process for Non VA Care (IB*2.0*554) Currently disabled
;D NRUN^IBFBNP1
; End changes by (IB*2.0*554)
S IBPAR7=$G(^IBE(350.9,1,7)) G:'$P(IBPAR7,U,1) EXIT
I +IBPAR7,+$P(IBPAR7,U,2),$$FMADD^XLFDT(+$P(IBPAR7,U,2),+IBPAR7)>DT G EXIT
S IBAUTO=1
;begin search for events to bill, create array of events by patient
;^TMP("IBCAB",$J, PATIENT, EVENT TYPE, EPISODE DATE, EVENT IFN)=""
;adds all events in Claims Tracking that have an EABD not after today
S IBDFN=0 F S IBDFN=$O(^IBT(356,"ATOBIL",IBDFN)) Q:'IBDFN D
. S IBTYP=0 F S IBTYP=$O(^IBT(356,"ATOBIL",IBDFN,IBTYP)) Q:'IBTYP D
.. S IBEABD=0 F S IBEABD=$O(^IBT(356,"ATOBIL",IBDFN,IBTYP,IBEABD)) Q:'IBEABD!(IBEABD>DT) D
... S IBTRN=0 F S IBTRN=$O(^IBT(356,"ATOBIL",IBDFN,IBTYP,IBEABD,IBTRN)) Q:'IBTRN D
.... S IBX=$$EVBILL^IBCU81(IBTRN) I 'IBX!(IBX>DT) D TEABD(IBTRN,+IBX) D:$P(IBX,U,2)'="" TERR(IBTRN,0,$P(IBX,U,2)) Q
.... S IBX=$$EVNTCHK^IBCU82(IBTRN) I +IBX D TEABD(IBTRN,0) D TERR(IBTRN,0,$P(IBX,U,2)) Q
.... S IBTRND=$G(^IBT(356,IBTRN,0))
.... I +IBSWINFO D Q:IBPFSS ;IB*2.0*312
..... S IBPFSS=1 ;IB*2.0*312
..... ; Do NOT PROCESS on VistA if DT>=Switch Eff Date ;CCR-930
..... I ($P(IBTRND,"^",6)+1)>$P(IBSWINFO,"^",2) Q ;IB*2.0*312
..... I $P($G(^DPT(IBDFN,.1)),"^")'="" Q ;IB*2.0*312
..... Q:$$CHKDIS() ;CCR-1081
..... S IBPFSS=0 ;Before EffDt & Discharged ;IB*2.0*312
.... ;
.... ;JWS;IB*2.0*592;US1109; IA# 2056 ;If Dental and Plan Coverage Limitation is NO skip, or DO NOT PROCESS Flag set in site parameters
.... I $F($$GET1^DIQ(9000010,$P(IBTRND,"^",3)_",",.08),"DENTAL"),'$$PTCOV^IBCNSU3(IBDFN,+$P(IBTRND,U,6),"DENTAL")!(+$P(^IBE(350.9,1,8),U,20)=0) Q
.... S ^TMP("IBCAB",$J,IBDFN,IBTYP,+$P(IBTRND,U,6),IBTRN)=""
K IBDFN,IBTYP,IBEABD,IBTRN,IBTRND,IBX
;
I $D(^TMP("IBCAB",$J)) D ^IBCD1 ; consolidate events into bills, create bills
D ^IBCDC ; set comments into file
S DIE="^IBE(350.9,",DA=1,DR="7.02////"_DT D ^DIE ;reset last date auto biller run
K ^TMP("IBCAB",$J),^TMP("IBEABD",$J),^TMP("IBCE",$J),^TMP("IBILL",$J)
F IBX=1:1:10 K ^TMP(("IBC"_IBX),$J)
EXIT K IBX,IBPAR7,DIE,DA,DR,IBAUTO,IBBS,IBSC,IBT
Q
CHKDIS() ; Returns 1 if discharge was on or after effective date ;CCR-1081
N IBADMLNK,IBDISLNK
S IBADMLNK=$P(IBTRND,"^",5) G:'IBADMLNK CHKDISQ
S IBDISLNK=$P($G(^DGPM(IBADMLNK,0)),"^",17) G:'IBDISLNK CHKDISQ
;
I (^DGPM(IBDISLNK,0)+1)>$P(IBSWINFO,"^",2) Q 1
CHKDISQ Q 0
;
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[HIBCD 4204 printed Apr 09, 2024@21:11:30 Page 2
IBCD ;ALB/ARH - AUTOMATED BILLER ;8/6/93
+1 ;;2.0;INTEGRATED BILLING;**312,554,592**;21-MAR-94;Build 58
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;This routine is the begining of the auto biller. No variables are required on entry. It is be called by the
+5 ;IB nightly job routine IBAMTC. It first checks to see if it should run based on the auto biller frequency
+6 ;site parameter. It then gathers the Claims Tracking events with an EABD into a temporary file by patient,
+7 ;event type, and episode date. This temporary file ("IBACAB") is then used to sort the events into groups
+8 ;that should be added to individual bills based on the individual event type billing cycle parameters. This
+9 ;second temporary file is then used to create the actual bills in IBCD1-2.
+10 ;
EN ;begin process of finding and creating bills
+1 ;determine if auto biller should run, check site parameters (350.9,7.01-7.02)
+2 ;IB*2.0*312
NEW IBSWINFO,IBPFSS
SET IBSWINFO=$$SWSTAT^IBBAPI()
+3 ;
+4 ;add nightly process for Non VA Care (IB*2.0*554) Currently disabled
+5 ;D NRUN^IBFBNP1
+6 ; End changes by (IB*2.0*554)
+7 SET IBPAR7=$GET(^IBE(350.9,1,7))
if '$PIECE(IBPAR7,U,1)
GOTO EXIT
+8 IF +IBPAR7
IF +$PIECE(IBPAR7,U,2)
IF $$FMADD^XLFDT(+$PIECE(IBPAR7,U,2),+IBPAR7)>DT
GOTO EXIT
+9 SET IBAUTO=1
+10 ;begin search for events to bill, create array of events by patient
+11 ;^TMP("IBCAB",$J, PATIENT, EVENT TYPE, EPISODE DATE, EVENT IFN)=""
+12 ;adds all events in Claims Tracking that have an EABD not after today
+13 SET IBDFN=0
FOR
SET IBDFN=$ORDER(^IBT(356,"ATOBIL",IBDFN))
if 'IBDFN
QUIT
Begin DoDot:1
+14 SET IBTYP=0
FOR
SET IBTYP=$ORDER(^IBT(356,"ATOBIL",IBDFN,IBTYP))
if 'IBTYP
QUIT
Begin DoDot:2
+15 SET IBEABD=0
FOR
SET IBEABD=$ORDER(^IBT(356,"ATOBIL",IBDFN,IBTYP,IBEABD))
if 'IBEABD!(IBEABD>DT)
QUIT
Begin DoDot:3
+16 SET IBTRN=0
FOR
SET IBTRN=$ORDER(^IBT(356,"ATOBIL",IBDFN,IBTYP,IBEABD,IBTRN))
if 'IBTRN
QUIT
Begin DoDot:4
+17 SET IBX=$$EVBILL^IBCU81(IBTRN)
IF 'IBX!(IBX>DT)
DO TEABD(IBTRN,+IBX)
if $PIECE(IBX,U,2)'=""
DO TERR(IBTRN,0,$PIECE(IBX,U,2))
QUIT
+18 SET IBX=$$EVNTCHK^IBCU82(IBTRN)
IF +IBX
DO TEABD(IBTRN,0)
DO TERR(IBTRN,0,$PIECE(IBX,U,2))
QUIT
+19 SET IBTRND=$GET(^IBT(356,IBTRN,0))
+20 ;IB*2.0*312
IF +IBSWINFO
Begin DoDot:5
+21 ;IB*2.0*312
SET IBPFSS=1
+22 ; Do NOT PROCESS on VistA if DT>=Switch Eff Date ;CCR-930
+23 ;IB*2.0*312
IF ($PIECE(IBTRND,"^",6)+1)>$PIECE(IBSWINFO,"^",2)
QUIT
+24 ;IB*2.0*312
IF $PIECE($GET(^DPT(IBDFN,.1)),"^")'=""
QUIT
+25 ;CCR-1081
if $$CHKDIS()
QUIT
+26 ;Before EffDt & Discharged ;IB*2.0*312
SET IBPFSS=0
End DoDot:5
if IBPFSS
QUIT
+27 ;
+28 ;JWS;IB*2.0*592;US1109; IA# 2056 ;If Dental and Plan Coverage Limitation is NO skip, or DO NOT PROCESS Flag set in site parameters
+29 IF $FIND($$GET1^DIQ(9000010,$PIECE(IBTRND,"^",3)_",",.08),"DENTAL")
IF '$$PTCOV^IBCNSU3(IBDFN,+$PIECE(IBTRND,U,6),"DENTAL")!(+$PIECE(^IBE(350.9,1,8),U,20)=0)
QUIT
+30 SET ^TMP("IBCAB",$JOB,IBDFN,IBTYP,+$PIECE(IBTRND,U,6),IBTRN)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+31 KILL IBDFN,IBTYP,IBEABD,IBTRN,IBTRND,IBX
+32 ;
+33 ; consolidate events into bills, create bills
IF $DATA(^TMP("IBCAB",$JOB))
DO ^IBCD1
+34 ; set comments into file
DO ^IBCDC
+35 ;reset last date auto biller run
SET DIE="^IBE(350.9,"
SET DA=1
SET DR="7.02////"_DT
DO ^DIE
+36 KILL ^TMP("IBCAB",$JOB),^TMP("IBEABD",$JOB),^TMP("IBCE",$JOB),^TMP("IBILL",$JOB)
+37 FOR IBX=1:1:10
KILL ^TMP(("IBC"_IBX),$JOB)
EXIT KILL IBX,IBPAR7,DIE,DA,DR,IBAUTO,IBBS,IBSC,IBT
+1 QUIT
CHKDIS() ; Returns 1 if discharge was on or after effective date ;CCR-1081
+1 NEW IBADMLNK,IBDISLNK
+2 SET IBADMLNK=$PIECE(IBTRND,"^",5)
if 'IBADMLNK
GOTO CHKDISQ
+3 SET IBDISLNK=$PIECE($GET(^DGPM(IBADMLNK,0)),"^",17)
if 'IBDISLNK
GOTO CHKDISQ
+4 ;
+5 IF (^DGPM(IBDISLNK,0)+1)>$PIECE(IBSWINFO,"^",2)
QUIT 1
CHKDISQ QUIT 0
+1 ;
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
+4 ;
