IBCD2 ;ALB/ARH - AUTOMATED BILLER (CREATE - SETUP/GATHER DATA FIELDS) ; 8/6/93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, 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
. 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
... 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)
EXIT K IBS,IBDFN,IBSTDT,IBCT,IBTRN,IBTF,IBX,X,DFN
Q
;
CREATE ;set up a bill, required: IBCT(IBTRN),IBDFN,IBSTDT
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
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)=$P($G(^IBT(356.2,IBX,0)),U,28) ;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
;
D ^IBCD3 ; create bill
;
S IBTRN=0 F S IBTRN=$O(IBCT(IBTRN)) Q:'IBTRN D
. D TERR(IBTRN,IBIFN,"") ; bill created
. D TEABD(IBTRN,0) ; remove eabd
. D TBILL(IBTRN,IBIFN) ; set index for bill and event (356.399)
;
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
K IBI,IBX,IBTRNX
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
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
IBCD2 ;ALB/ARH - AUTOMATED BILLER (CREATE - SETUP/GATHER DATA FIELDS) ; 8/6/93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, 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 SET IBDFN=0
FOR
SET IBDFN=$ORDER(^TMP(IBS,$JOB,IBDFN))
IF 'IBDFN
QUIT
Begin DoDot:2
+4 SET IBSTDT=""
FOR
SET IBSTDT=$ORDER(^TMP(IBS,$JOB,IBDFN,IBSTDT))
IF IBSTDT=""
QUIT
Begin DoDot:3
+5 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
End DoDot:2
End DoDot:1
EXIT KILL IBS,IBDFN,IBSTDT,IBCT,IBTRN,IBTF,IBX,X,DFN
+1 QUIT
+2 ;
CREATE ;set up a bill, required: IBCT(IBTRN),IBDFN,IBSTDT
+1 IF $DATA(IBCT)<9
QUIT
KILL IB
+2 SET IBSP=$GET(^IBE(350.9,1,1))
SET IBDIV=$PIECE(IBSP,U,25)
SET IBTRN=+$ORDER(IBCT(0))
+3 SET IBTRND=$GET(^IBT(356,IBTRN,0))
IF 'IBTRND
DO TERR(+IBTRN,0,"Claims Tracking Record not found or not complete.")
GOTO QUIT
+4 SET IBTYPE=$PIECE(IBTRND,U,18)
SET IBX=$$CHK
IF 'IBX
DO TERR(+IBTRN,0,$PIECE(IBX,U,2))
GOTO QUIT
+5 ;
+6 SET IBX=$$ARSET
IF 'IBX
DO TERR(IBTRN,0,$PIECE(IBX,U,2))
GOTO QUIT
+7 SET IBIFN=+IBX
SET IB(.01)=$PIECE(IBX,U,2)
SET IB(.17)=$PIECE(IBX,U,3)
SET IB(.2)=1
+8 SET (IB(.02),DFN)=IBDFN
SET IB(.06)=IBTF
+9 SET IB(.07)=$ORDER(^DGCR(399.3,"B","REIMBURSABLE INS.",0))
IF 'IB(.07)
SET IB(.07)=8
+10 ;pre-cert #
SET IBX=$ORDER(^IBT(356.2,"ATRTP",IBTRN,1,""))
IF +IBX
SET IB(163)=$PIECE($GET(^IBT(356.2,IBX,0)),U,28)
+11 ;
+12 SET IBX=$PIECE($GET(^IBE(356.6,+IBTYPE,0)),U,1)
+13 IF IBX="INPATIENT ADMISSION"
DO INPT^IBCD5
GOTO CONT
+14 IF IBX="PRESCRIPTION REFILL"
DO RXRF
GOTO CONT
+15 IF IBX="OUTPATIENT VISIT"
DO OUTPT
GOTO CONT
+16 GOTO QUIT
+17 ;
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 ; create bill
DO ^IBCD3
+5 ;
+6 SET IBTRN=0
FOR
SET IBTRN=$ORDER(IBCT(IBTRN))
IF 'IBTRN
QUIT
Begin DoDot:1
+7 ; bill created
DO TERR(IBTRN,IBIFN,"")
+8 ; remove eabd
DO TEABD(IBTRN,0)
+9 ; set index for bill and event (356.399)
DO TBILL(IBTRN,IBIFN)
End DoDot:1
+10 ;
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 KILL IBI,IBX,IBTRNX
+7 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
End DoDot:1
+7 KILL IBI,IBX,IBTRNX,IBRX
+8 QUIT
+9 ;
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
