- 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 Feb 18, 2025@23:35:38 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