IBCD2 ;ALB/ARH - AUTOMATED BILLER (CREATE - SETUP/GATHER DATA FIELDS) ; 8/6/93
;;2.0;INTEGRATED BILLING;**4,55,91,106,384,458,592**;21-MAR-94;Build 58
;;Per VA Directive 6402, this routine should not be modified.
;
FIND ;
S IBX=$$CHKSYS^IBCD4 I 'IBX D TERR(0,0,$P(IBX,U,2)) G EXIT
S IBS="IBC0" F S IBS=$O(^TMP(IBS)) Q:IBS="" S IBX=$E(IBS,4,99) Q:$E(IBS,1,3)'="IBC"!'+IBX D
. N IBQUERY
. S IBDFN=0 F S IBDFN=$O(^TMP(IBS,$J,IBDFN)) Q:'IBDFN D
.. S IBSTDT="" F S IBSTDT=$O(^TMP(IBS,$J,IBDFN,IBSTDT)) Q:IBSTDT="" D I $D(IBCT)>9 D CREATE(.IBQUERY)
... K IBCT S IBTRN=0 F S IBTRN=$O(^TMP(IBS,$J,IBDFN,IBSTDT,IBTRN)) Q:'IBTRN S IBCT(IBTRN)="",IBTF=^TMP(IBS,$J,IBDFN,IBSTDT,IBTRN)
.I $G(IBQUERY) D CLOSE^IBSDU(IBQUERY)
EXIT K IBS,IBDFN,IBSTDT,IBCT,IBTRN,IBTF,IBX,X,DFN
Q
;
CREATE(IBQUERY) ;set up a bill, required: IBCT(IBTRN),IBDFN,IBSTDT
; IBQUERY, if defined, will be used to activate the outpt visit QUERY
Q:$D(IBCT)<9 K IB
S IBSP=$G(^IBE(350.9,1,1)),IBDIV=$P(IBSP,U,25),IBTRN=+$O(IBCT(0))
S IBTRND=$G(^IBT(356,IBTRN,0)) I 'IBTRND D TERR(+IBTRN,0,"Claims Tracking Record not found or not complete.") G QUIT
S IBTYPE=$P(IBTRND,U,18) S IBX=$$CHK I 'IBX D TERR(+IBTRN,0,$P(IBX,U,2)) G QUIT
;
S IBX=$$ARSET I 'IBX D TERR(IBTRN,0,$P(IBX,U,2)) G QUIT
S IBIFN=+IBX,IB(.01)=$P(IBX,U,2),IB(.17)=$P(IBX,U,3),IB(.2)=1,IB(.22)=IBDIV
S (IB(.02),DFN)=IBDFN,IB(.06)=IBTF
S IB(.07)=$O(^DGCR(399.3,"B","REIMBURSABLE INS.",0)) I 'IB(.07) S IB(.07)=8
S IBX=$O(^IBT(356.2,"ATRTP",IBTRN,1,"")) I +IBX S IB(163)=$E($P($G(^IBT(356.2,IBX,2)),U,2),1,18) ;pre-cert #
;
S IBX=$P($G(^IBE(356.6,+IBTYPE,0)),U,1)
I IBX="INPATIENT ADMISSION" D INPT^IBCD5 G CONT
I IBX="PRESCRIPTION REFILL" D RXRF G CONT
I IBX="OUTPATIENT VISIT" D OUTPT G CONT
G QUIT
;
CONT S IBX=$$BDT^IBCU3(IBDFN,IB(.03)) S IB(.17)=$S(+IBX:IBX,1:IBIFN) ; continuing episode of care
;Note if a primary bill is found for an outpatient bill then it allows them to choose the bill during bill creation, .17 is not editable on the screens
S IB(.18)=$$SC^IBCU3(IBDFN) ; SC at time of care
;
; Note: variable IBQUERY used in this call to ^IBCD3
D EN^IBCD3(.IBQUERY) ; create bill
;
S IBTRN=0 F S IBTRN=$O(IBCT(IBTRN)) Q:'IBTRN D
. D TERR(IBTRN,IBIFN,"") ; bill created
. I ",2,3,"'[+$G(IB(.06)) D TEABD(IBTRN,0) ; remove eabd for final bills
. D TBILL(IBTRN,IBIFN) ; set index for bill and event (356.399)
. I $O(IB(43,0)),$$NABSCT^IBCU81(IBTRN) D TERR(IBTRN,IBIFN,"Stop/Clinic flagged to be ignored by auto biller but another visit is billed on same date.")
. I $O(IB(43,0)),$$NBOE^IBCU81(+$P($G(^IBT(356,+IBTRN,0)),U,4)) D TERR(IBTRN,IBIFN,"Visit flagged as SC in source file but has no RNB.")
;
S IBTRN=$O(IBCT(IBTRN)) Q:'IBTRN D
. I $G(IB(.05))>2,$G(IB(.27))=1,+$G(^DGCR(399,IBIFN,"MP")),'$O(^DGCR(399,IBIFN,"RC",0)) D TERR(IBTRN,IBIFN,"This RC Opt bill appears to have no institutional charges but may have professional charges.")
;
S X=$$PRCDIV^IBCU71(IBIFN) ; reset bill division from site default to first procedures division
;
QUIT K X,Y,IBX,IBY,IBSP,IBDIV,IBTRN,IBTRND,IBTYPE,IB
Q
;
OUTPT S IB(.04)=$S(+$P($G(^DG(40.8,+IBDIV,0)),U,3):7,1:1) ;division outpatient only or hospital
S IB(.05)=3,IB(.06)=1,IB(.09)=4
;event dt is date of first visit, stmt from is first visit dt, stmt to is last visit dt on bill
S (IB(.03),IB(151))=9999999,IB(152)=""
S IBTRNX=0 F S IBTRNX=$O(IBCT(IBTRNX)) Q:'IBTRNX S IBX=$P($G(^IBT(356,IBTRNX,0)),U,6)\1 D
. S IB(43,+IBX)="" S:IB(152)<IBX IB(152)=IBX F IBI=.03,151 I IB(IBI)>IBX S IB(IBI)=IBX
I +$$BILLRATE^IBCRU3(+$G(IB(.07)),IB(.05),IB(.03),"RC") S IB(.27)=1 ; reasonable charges institutional bill
;JWS;IB*2.0*592;US1109;IA# 2056; Identify event as Dental event
S IBDENT=$F($$GET1^DIQ(9000010,$P(IBTRND,"^",3)_",",.08),"DENTAL")
;JWS;IB*2.0*592; for dental claims, default
; BILL CHARGE TYPE (.27) = 2 (PROFESSIONAL)
; FORM TYPE (.19) = 7
; TYPE OF ADMISSION (158) = 3 (ELECTIVE)
; PROCEDURE CODING METHOD (.09) = 5 (HCPCS)
I IBDENT S IB(.27)=2,IB(.19)=7,IB(158)=3,IB(.09)=5
;JWS;IB*2.0*592;US1109 - added IBDENT to kill
K IBI,IBX,IBTRNX,IBDENT
Q
RXRF S IB(.04)=$S(+$P($G(^DG(40.8,+IBDIV,0)),U,3):7,1:1) ;division outpatient only or hospital
S IB(.05)=3,IB(.06)=1
;event dt is date of first visit, stmt from is first visit dt, stmt to is last visit dt on bill
S (IB(.03),IB(151))=9999999,IB(152)=""
S IBTRNX=0 F S IBTRNX=$O(IBCT(IBTRNX)) Q:'IBTRNX S IBRX=$G(^IBT(356,IBTRNX,0)) D
. S IBX=$$RXRF^IBCD4(+$P(IBRX,U,8),+$P(IBRX,U,10)),IB(362.4,+$P(IBRX,U,8),+$P(IBRX,U,10))=IBX,IBX=$P(IBX,U,4)
. S:IB(152)<IBX IB(152)=IBX F IBI=.03,151 I IB(IBI)>IBX S IB(IBI)=IBX
. I $P(IBRX,U,31)>1 D ;special consent roi
.. S IB(155)=1,IB(157)=0 ; is dx sensitive
.. I $P(IBRX,U,31)=2 S IB(157)=1 ; ROI obtained
K IBI,IBX,IBTRNX,IBRX
Q
;
ARSET() ; set up entry for new bill in AR returns IFN, bill number
;otherwise "0^error meaasge"
N X S X="0^Can not set up bill in AR."
S PRCASV("SER")=$P($G(^IBE(350.9,1,1)),U,14),PRCASV("SITE")=+$P($$SITE^VASITE,U,3)
D SETUP^PRCASVC3
I $P(PRCASV("ARBIL"),U)=-1 S X="0^"_$P(PRCASV("ARBIL"),U,2)_" - "_$$ETXT^IBEFUNC($P(PRCASV("ARBIL"),U,2)) G ARSETQ
I $P(PRCASV("ARREC"),U)=-1 S X="0^"_$P(PRCASV("ARREC"),U,2)_" - "_$$ETXT^IBEFUNC($P(PRCASV("ARREC"),U,2)) G ARSETQ
S X=PRCASV("ARREC")_U_$P(PRCASV("ARBIL"),"-",2)
ARSETQ K PRCASV
Q X
;
CHK() ;other checks
N X S X=1 I $G(^DPT(+$G(IBDFN),0))="" S X="0^Patient information lacking."
Q X
;
TEABD(TRN,IBDT) ;
S IBDT=+$G(IBDT),^TMP("IBEABD",$J,+TRN,+IBDT)=""
Q
TERR(TRN,IFN,ER) ;
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) ;
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[HIBCD2 5904 printed Dec 13, 2024@02:09:13 Page 2
IBCD2 ;ALB/ARH - AUTOMATED BILLER (CREATE - SETUP/GATHER DATA FIELDS) ; 8/6/93
+1 ;;2.0;INTEGRATED BILLING;**4,55,91,106,384,458,592**;21-MAR-94;Build 58
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
FIND ;
+1 SET IBX=$$CHKSYS^IBCD4
IF 'IBX
DO TERR(0,0,$PIECE(IBX,U,2))
GOTO EXIT
+2 SET IBS="IBC0"
FOR
SET IBS=$ORDER(^TMP(IBS))
if IBS=""
QUIT
SET IBX=$EXTRACT(IBS,4,99)
if $EXTRACT(IBS,1,3)'="IBC"!'+IBX
QUIT
Begin DoDot:1
+3 NEW IBQUERY
+4 SET IBDFN=0
FOR
SET IBDFN=$ORDER(^TMP(IBS,$JOB,IBDFN))
if 'IBDFN
QUIT
Begin DoDot:2
+5 SET IBSTDT=""
FOR
SET IBSTDT=$ORDER(^TMP(IBS,$JOB,IBDFN,IBSTDT))
if IBSTDT=""
QUIT
Begin DoDot:3
+6 KILL IBCT
SET IBTRN=0
FOR
SET IBTRN=$ORDER(^TMP(IBS,$JOB,IBDFN,IBSTDT,IBTRN))
if 'IBTRN
QUIT
SET IBCT(IBTRN)=""
SET IBTF=^TMP(IBS,$JOB,IBDFN,IBSTDT,IBTRN)
End DoDot:3
IF $DATA(IBCT)>9
DO CREATE(.IBQUERY)
End DoDot:2
+7 IF $GET(IBQUERY)
DO CLOSE^IBSDU(IBQUERY)
End DoDot:1
EXIT KILL IBS,IBDFN,IBSTDT,IBCT,IBTRN,IBTF,IBX,X,DFN
+1 QUIT
+2 ;
CREATE(IBQUERY) ;set up a bill, required: IBCT(IBTRN),IBDFN,IBSTDT
+1 ; IBQUERY, if defined, will be used to activate the outpt visit QUERY
+2 if $DATA(IBCT)<9
QUIT
KILL IB
+3 SET IBSP=$GET(^IBE(350.9,1,1))
SET IBDIV=$PIECE(IBSP,U,25)
SET IBTRN=+$ORDER(IBCT(0))
+4 SET IBTRND=$GET(^IBT(356,IBTRN,0))
IF 'IBTRND
DO TERR(+IBTRN,0,"Claims Tracking Record not found or not complete.")
GOTO QUIT
+5 SET IBTYPE=$PIECE(IBTRND,U,18)
SET IBX=$$CHK
IF 'IBX
DO TERR(+IBTRN,0,$PIECE(IBX,U,2))
GOTO QUIT
+6 ;
+7 SET IBX=$$ARSET
IF 'IBX
DO TERR(IBTRN,0,$PIECE(IBX,U,2))
GOTO QUIT
+8 SET IBIFN=+IBX
SET IB(.01)=$PIECE(IBX,U,2)
SET IB(.17)=$PIECE(IBX,U,3)
SET IB(.2)=1
SET IB(.22)=IBDIV
+9 SET (IB(.02),DFN)=IBDFN
SET IB(.06)=IBTF
+10 SET IB(.07)=$ORDER(^DGCR(399.3,"B","REIMBURSABLE INS.",0))
IF 'IB(.07)
SET IB(.07)=8
+11 ;pre-cert #
SET IBX=$ORDER(^IBT(356.2,"ATRTP",IBTRN,1,""))
IF +IBX
SET IB(163)=$EXTRACT($PIECE($GET(^IBT(356.2,IBX,2)),U,2),1,18)
+12 ;
+13 SET IBX=$PIECE($GET(^IBE(356.6,+IBTYPE,0)),U,1)
+14 IF IBX="INPATIENT ADMISSION"
DO INPT^IBCD5
GOTO CONT
+15 IF IBX="PRESCRIPTION REFILL"
DO RXRF
GOTO CONT
+16 IF IBX="OUTPATIENT VISIT"
DO OUTPT
GOTO CONT
+17 GOTO QUIT
+18 ;
CONT ; continuing episode of care
SET IBX=$$BDT^IBCU3(IBDFN,IB(.03))
SET IB(.17)=$SELECT(+IBX:IBX,1:IBIFN)
+1 ;Note if a primary bill is found for an outpatient bill then it allows them to choose the bill during bill creation, .17 is not editable on the screens
+2 ; SC at time of care
SET IB(.18)=$$SC^IBCU3(IBDFN)
+3 ;
+4 ; Note: variable IBQUERY used in this call to ^IBCD3
+5 ; create bill
DO EN^IBCD3(.IBQUERY)
+6 ;
+7 SET IBTRN=0
FOR
SET IBTRN=$ORDER(IBCT(IBTRN))
if 'IBTRN
QUIT
Begin DoDot:1
+8 ; bill created
DO TERR(IBTRN,IBIFN,"")
+9 ; remove eabd for final bills
IF ",2,3,"'[+$GET(IB(.06))
DO TEABD(IBTRN,0)
+10 ; set index for bill and event (356.399)
DO TBILL(IBTRN,IBIFN)
+11 IF $ORDER(IB(43,0))
IF $$NABSCT^IBCU81(IBTRN)
DO TERR(IBTRN,IBIFN,"Stop/Clinic flagged to be ignored by auto biller but another visit is billed on same date.")
+12 IF $ORDER(IB(43,0))
IF $$NBOE^IBCU81(+$PIECE($GET(^IBT(356,+IBTRN,0)),U,4))
DO TERR(IBTRN,IBIFN,"Visit flagged as SC in source file but has no RNB.")
End DoDot:1
+13 ;
+14 SET IBTRN=$ORDER(IBCT(IBTRN))
if 'IBTRN
QUIT
Begin DoDot:1
+15 IF $GET(IB(.05))>2
IF $GET(IB(.27))=1
IF +$GET(^DGCR(399,IBIFN,"MP"))
IF '$ORDER(^DGCR(399,IBIFN,"RC",0))
DO TERR(IBTRN,IBIFN,"This RC Opt bill appears to have no institutional charges but may have professional charges.")
End DoDot:1
+16 ;
+17 ; reset bill division from site default to first procedures division
SET X=$$PRCDIV^IBCU71(IBIFN)
+18 ;
QUIT KILL X,Y,IBX,IBY,IBSP,IBDIV,IBTRN,IBTRND,IBTYPE,IB
+1 QUIT
+2 ;
OUTPT ;division outpatient only or hospital
SET IB(.04)=$SELECT(+$PIECE($GET(^DG(40.8,+IBDIV,0)),U,3):7,1:1)
+1 SET IB(.05)=3
SET IB(.06)=1
SET IB(.09)=4
+2 ;event dt is date of first visit, stmt from is first visit dt, stmt to is last visit dt on bill
+3 SET (IB(.03),IB(151))=9999999
SET IB(152)=""
+4 SET IBTRNX=0
FOR
SET IBTRNX=$ORDER(IBCT(IBTRNX))
if 'IBTRNX
QUIT
SET IBX=$PIECE($GET(^IBT(356,IBTRNX,0)),U,6)\1
Begin DoDot:1
+5 SET IB(43,+IBX)=""
if IB(152)<IBX
SET IB(152)=IBX
FOR IBI=.03,151
IF IB(IBI)>IBX
SET IB(IBI)=IBX
End DoDot:1
+6 ; reasonable charges institutional bill
IF +$$BILLRATE^IBCRU3(+$GET(IB(.07)),IB(.05),IB(.03),"RC")
SET IB(.27)=1
+7 ;JWS;IB*2.0*592;US1109;IA# 2056; Identify event as Dental event
+8 SET IBDENT=$FIND($$GET1^DIQ(9000010,$PIECE(IBTRND,"^",3)_",",.08),"DENTAL")
+9 ;JWS;IB*2.0*592; for dental claims, default
+10 ; BILL CHARGE TYPE (.27) = 2 (PROFESSIONAL)
+11 ; FORM TYPE (.19) = 7
+12 ; TYPE OF ADMISSION (158) = 3 (ELECTIVE)
+13 ; PROCEDURE CODING METHOD (.09) = 5 (HCPCS)
+14 IF IBDENT
SET IB(.27)=2
SET IB(.19)=7
SET IB(158)=3
SET IB(.09)=5
+15 ;JWS;IB*2.0*592;US1109 - added IBDENT to kill
+16 KILL IBI,IBX,IBTRNX,IBDENT
+17 QUIT
RXRF ;division outpatient only or hospital
SET IB(.04)=$SELECT(+$PIECE($GET(^DG(40.8,+IBDIV,0)),U,3):7,1:1)
+1 SET IB(.05)=3
SET IB(.06)=1
+2 ;event dt is date of first visit, stmt from is first visit dt, stmt to is last visit dt on bill
+3 SET (IB(.03),IB(151))=9999999
SET IB(152)=""
+4 SET IBTRNX=0
FOR
SET IBTRNX=$ORDER(IBCT(IBTRNX))
if 'IBTRNX
QUIT
SET IBRX=$GET(^IBT(356,IBTRNX,0))
Begin DoDot:1
+5 SET IBX=$$RXRF^IBCD4(+$PIECE(IBRX,U,8),+$PIECE(IBRX,U,10))
SET IB(362.4,+$PIECE(IBRX,U,8),+$PIECE(IBRX,U,10))=IBX
SET IBX=$PIECE(IBX,U,4)
+6 if IB(152)<IBX
SET IB(152)=IBX
FOR IBI=.03,151
IF IB(IBI)>IBX
SET IB(IBI)=IBX
+7 ;special consent roi
IF $PIECE(IBRX,U,31)>1
Begin DoDot:2
+8 ; is dx sensitive
SET IB(155)=1
SET IB(157)=0
+9 ; ROI obtained
IF $PIECE(IBRX,U,31)=2
SET IB(157)=1
End DoDot:2
End DoDot:1
+10 KILL IBI,IBX,IBTRNX,IBRX
+11 QUIT
+12 ;
ARSET() ; set up entry for new bill in AR returns IFN, bill number
+1 ;otherwise "0^error meaasge"
+2 NEW X
SET X="0^Can not set up bill in AR."
+3 SET PRCASV("SER")=$PIECE($GET(^IBE(350.9,1,1)),U,14)
SET PRCASV("SITE")=+$PIECE($$SITE^VASITE,U,3)
+4 DO SETUP^PRCASVC3
+5 IF $PIECE(PRCASV("ARBIL"),U)=-1
SET X="0^"_$PIECE(PRCASV("ARBIL"),U,2)_" - "_$$ETXT^IBEFUNC($PIECE(PRCASV("ARBIL"),U,2))
GOTO ARSETQ
+6 IF $PIECE(PRCASV("ARREC"),U)=-1
SET X="0^"_$PIECE(PRCASV("ARREC"),U,2)_" - "_$$ETXT^IBEFUNC($PIECE(PRCASV("ARREC"),U,2))
GOTO ARSETQ
+7 SET X=PRCASV("ARREC")_U_$PIECE(PRCASV("ARBIL"),"-",2)
ARSETQ KILL PRCASV
+1 QUIT X
+2 ;
CHK() ;other checks
+1 NEW X
SET X=1
IF $GET(^DPT(+$GET(IBDFN),0))=""
SET X="0^Patient information lacking."
+2 QUIT X
+3 ;
TEABD(TRN,IBDT) ;
+1 SET IBDT=+$GET(IBDT)
SET ^TMP("IBEABD",$JOB,+TRN,+IBDT)=""
+2 QUIT
TERR(TRN,IFN,ER) ;
+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) ;
+1 IF '$DATA(^IBT(356,+$GET(TRN),0))!('$DATA(^DGCR(399,+$GET(IFN),0)))
QUIT
+2 SET ^TMP("IBILL",$JOB,TRN,IFN)=""
+3 QUIT
