IBCA3 ;ALB/AAS - MCCR SINGLE LINE DISPLAY OF BILL ; 12/22/89
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;MAP TO DGCRA3
;
EN1 ;entry for one bill, must pass IBIFN
K DGSELNO D HDR,ONE
G END
;
EN2 ;Find all bills for a patient must pass dfn
S IBQUIT=0 D UTIL S:'$D(IBPAUS) IBPAUS=5
I 'IBCNT W !,"No Bills On File for this Patient!" G EN2Q
K DGSELNO D HDR S (IBDT,IBIFN)="",IBCNT=0
F K=0:0 S IBDT=$O(^UTILITY($J,IBDT)) Q:IBDT=""!(IBQUIT) F J=0:0 S IBIFN=$O(^UTILITY($J,IBDT,IBIFN)) Q:IBIFN=""!(IBQUIT) S IBCNT=IBCNT+1 D ONE,PAUSE:'(IBCNT#IBPAUS)
EN2Q D END Q
;
EN3 ;Find all bills for a patient on one episode date. must pass dfn, episode date in x
S IBQUIT=0 D UTIL,UTIL1
I 'IBCNT W !,"No Other Bills for this Episode Date on File!" G EN3Q
K DGSELNO S IBIFN="",IBCNT=0,IBDT=-(X+.99),IBDT1=X
F K=0:0 S IBDT=$O(^UTILITY($J,IBDT)) Q:IBDT=""!(IBQUIT)!(IBDT>-IBDT1) F J=0:0 S IBIFN=$O(^UTILITY($J,IBDT,IBIFN)) Q:IBIFN=""!(IBQUIT) S IBCNT=IBCNT+1 D HDR:IBCNT=1,ONE,PAUSE:'(IBCNT#5)
F K=0:0 S K=$O(^UTILITY($J,"IB",K)) Q:'K!(IBQUIT) S IBCNT=IBCNT+1 D HDR1:IBCNT=1,ONE1,PAUSE:'(IBCNT#5)
I 'IBCNT W !,"No Other Bills for this Episode Date on File!" G EN3Q
EN3Q D END Q
EN4 ;Find all bills beginning a CEOC and allow selection by number, pass dfn
K ^UTILITY($J) S (DGSELNO,IBQUIT)=0 D UTIL
I 'IBCNT W !,"No Other Bills for this Episode Date on File!" G EN4Q
S (IBDT,IBIFN)="",IBCNT=0,IBPAUS=5
F K=0:0 S IBDT=$O(^UTILITY($J,IBDT)) Q:'IBDT!(IBQUIT) D 41
D:'IBQUIT PAUSE:'$D(IBIDS(.17))
EN4Q K DIC,DGSELNO D END Q
;
41 F J=0:0 S IBIFN=$O(^UTILITY($J,IBDT,IBIFN)) Q:'IBIFN!(IBQUIT) D SCRN ;S IBCNT=IBCNT+1 D ONE,PAUSE:'(IBCNT#IBPAUS)
Q
SCRN S A=$P(^DGCR(399,IBIFN,0),"^",17)
I A=IBIFN S DGSELNO=DGSELNO+1,^UTILITY($J,"IBSEL",DGSELNO)=IBIFN,^UTILITY($J,"IBSEL",$P(^DGCR(399,A,0),"^"))=IBIFN D HDR:DGSELNO=1,ONE,PAUSE:'(DGSELNO#IBPAUS)
Q
;
ONE D GVAR^IBCBB W !
S DGTAB="?0" I $D(DGSELNO) W ?3,DGSELNO S DGTAB="?8" ;write selection numbers here
W @DGTAB,IBBNO," ",$S(IBCL=1:"Inpat. ",IBCL=3:"Outpt. ",IBCL=2:"HE Inpt",1:"HE Opt.")," ",$S(IBWHO="p":"Patnt",IBWHO="i":"Insur",1:"Other")," "
F I=IBEVDT,IBFDT,IBTDT W $E(I,4,5)_"/"_$E(I,6,7)_"/"_$E(I,2,3)," "
W $S(IBST=1:"Enterd",IBST=2:"Revwed",IBST=3:"Auth. ",IBST=4:"Printd",1:"Cancel")," "
W IBTF," ",$S(IBTF=1:"Ad - Ds",IBTF=2:"Int FC ",IBTF=3:"Int CC ",IBTF=4:"Int LC ",IBTF=5:"Late Ch",IBTF=6:"Adjust ",1:"Replace")
Q
;
ONE1 ; Display IB Actions. Input: K, X
N C,D,I,Y S D=$G(^IB(K,0))
W !,$P($P(D,"^",11),"-",2),?8,$S($P($G(^IBE(350.1,+$P(D,"^",3),0)),"^")["OPT":"Outpt.",1:"Inpat.")," Patnt "
F I=X,$P(D,"^",14),$P(D,"^",15) W $$DAT1^IBOUTL(I)," "
S C=$P(^DD(350,.05,0),"^",2),Y=$P(D,"^",5) D Y^DIQ W $E(Y,1,7)," ",$E($$ACTNM^IBOUTL($P(D,"^",3)),1,18)
Q
;
HDR S DGTAB=$S($D(DGSELNO):"!?8",1:"!") W @DGTAB,"Bill # Classif Payer Event DT From Dat To Date Status Timeframe"
S DGTAB=$S($D(DGSELNO):"!?8",1:"!") W @DGTAB,"------ ------- ----- -------- -------- -------- ------ ----------"
Q
;
HDR1 ; Write header to dislay IB Actions.
W !,"Bill # Classf Payer Event DT From Dat To Date Status IB Action Type"
W !,"------ ------ ----- -------- -------- -------- ------- --------------"
Q
;
PAUSE I '$D(DGSELNO),$E(IOST,1,2)["C-" R !!,"Enter ""^"" to quit display, return to continue",IBX1:DTIME S IBQUIT=$S(IBX1["^":1,'$T:1,1:0) Q
ASK I '$D(DGSELNO),DGSELNO<1 Q
W !!,"CHOOSE 1" W:DGSELNO>1 "-",DGSELNO W " or ENTER BILL NUMBER: " R IBX:DTIME I IBX="^"!('$T) S IBQUIT=1 Q
Q:IBX=""
I $D(^UTILITY($J,"IBSEL",IBX)) S Y=^(IBX) I $D(^DGCR(399,Y,0)) S Y(0)=^(0) W " ",$P(Y(0),"^") S IBIDS(.17)=$P(Y(0),"^",17),IBQUIT=1 Q
;
HELPSEL W !!,"Enter 1-",DGSELNO," to select that entry or enter the Bill Number" G ASK
Q
;
UTIL S IBIFN1="",IBCNT=0 K ^UTILITY($J)
F J=0:0 S IBIFN1=$O(^DGCR(399,"C",DFN,IBIFN1)) Q:IBIFN1="" S IBCNT=IBCNT+1,IBEVDT=$P(^DGCR(399,IBIFN1,0),"^",3),^UTILITY($J,-IBEVDT,IBIFN1)=""
Q
;
UTIL1 ; Get IB charges for a patient for a single event date. Input: DFN, X
N Y,Y1
S Y=0 F S Y=$O(^IB("AFDT",DFN,-X,Y)) Q:'Y S Y1=0 F S Y1=$O(^IB("AF",Y,Y1)) Q:'Y1 I $D(^IB(Y1,0)),$P(^(0),"^",8)'["ADMISSION" S IBCNT=IBCNT+1,^UTILITY($J,"IB",Y1)=""
Q
;
END D END^IBCBB1
K A,DGTAB,IBIFN1,IBPAUS,IBQUIT,IBX1,IBDT,IBDT1,IBCNT,^UTILITY($J)
Q
IBCA3 ;ALB/AAS - MCCR SINGLE LINE DISPLAY OF BILL ; 12/22/89
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;MAP TO DGCRA3
+5 ;
EN1 ;entry for one bill, must pass IBIFN
+1 KILL DGSELNO
DO HDR
DO ONE
+2 GOTO END
+3 ;
EN2 ;Find all bills for a patient must pass dfn
+1 SET IBQUIT=0
DO UTIL
IF '$DATA(IBPAUS)
SET IBPAUS=5
+2 IF 'IBCNT
WRITE !,"No Bills On File for this Patient!"
GOTO EN2Q
+3 KILL DGSELNO
DO HDR
SET (IBDT,IBIFN)=""
SET IBCNT=0
+4 FOR K=0:0
SET IBDT=$ORDER(^UTILITY($JOB,IBDT))
IF IBDT=""!(IBQUIT)
QUIT
FOR J=0:0
SET IBIFN=$ORDER(^UTILITY($JOB,IBDT,IBIFN))
IF IBIFN=""!(IBQUIT)
QUIT
SET IBCNT=IBCNT+1
DO ONE
IF '(IBCNT#IBPAUS)
DO PAUSE
EN2Q DO END
QUIT
+1 ;
EN3 ;Find all bills for a patient on one episode date. must pass dfn, episode date in x
+1 SET IBQUIT=0
DO UTIL
DO UTIL1
+2 IF 'IBCNT
WRITE !,"No Other Bills for this Episode Date on File!"
GOTO EN3Q
+3 KILL DGSELNO
SET IBIFN=""
SET IBCNT=0
SET IBDT=-(X+.99)
SET IBDT1=X
+4 FOR K=0:0
SET IBDT=$ORDER(^UTILITY($JOB,IBDT))
IF IBDT=""!(IBQUIT)!(IBDT>-IBDT1)
QUIT
FOR J=0:0
SET IBIFN=$ORDER(^UTILITY($JOB,IBDT,IBIFN))
IF IBIFN=""!(IBQUIT)
QUIT
SET IBCNT=IBCNT+1
IF IBCNT=1
DO HDR
DO ONE
IF '(IBCNT#5)
DO PAUSE
+5 FOR K=0:0
SET K=$ORDER(^UTILITY($JOB,"IB",K))
IF 'K!(IBQUIT)
QUIT
SET IBCNT=IBCNT+1
IF IBCNT=1
DO HDR1
DO ONE1
IF '(IBCNT#5)
DO PAUSE
+6 IF 'IBCNT
WRITE !,"No Other Bills for this Episode Date on File!"
GOTO EN3Q
EN3Q DO END
QUIT
EN4 ;Find all bills beginning a CEOC and allow selection by number, pass dfn
+1 KILL ^UTILITY($JOB)
SET (DGSELNO,IBQUIT)=0
DO UTIL
+2 IF 'IBCNT
WRITE !,"No Other Bills for this Episode Date on File!"
GOTO EN4Q
+3 SET (IBDT,IBIFN)=""
SET IBCNT=0
SET IBPAUS=5
+4 FOR K=0:0
SET IBDT=$ORDER(^UTILITY($JOB,IBDT))
IF 'IBDT!(IBQUIT)
QUIT
DO 41
+5 IF 'IBQUIT
IF '$DATA(IBIDS(.17))
DO PAUSE
EN4Q KILL DIC,DGSELNO
DO END
QUIT
+1 ;
41 ;S IBCNT=IBCNT+1 D ONE,PAUSE:'(IBCNT#IBPAUS)
FOR J=0:0
SET IBIFN=$ORDER(^UTILITY($JOB,IBDT,IBIFN))
IF 'IBIFN!(IBQUIT)
QUIT
DO SCRN
+1 QUIT
SCRN SET A=$PIECE(^DGCR(399,IBIFN,0),"^",17)
+1 IF A=IBIFN
SET DGSELNO=DGSELNO+1
SET ^UTILITY($JOB,"IBSEL",DGSELNO)=IBIFN
SET ^UTILITY($JOB,"IBSEL",$PIECE(^DGCR(399,A,0),"^"))=IBIFN
IF DGSELNO=1
DO HDR
DO ONE
IF '(DGSELNO#IBPAUS)
DO PAUSE
+2 QUIT
+3 ;
ONE DO GVAR^IBCBB
WRITE !
+1 ;write selection numbers here
SET DGTAB="?0"
IF $DATA(DGSELNO)
WRITE ?3,DGSELNO
SET DGTAB="?8"
+2 WRITE @DGTAB,IBBNO," ",$SELECT(IBCL=1:"Inpat. ",IBCL=3:"Outpt. ",IBCL=2:"HE Inpt",1:"HE Opt.")," ",$SELECT(IBWHO="p":"Patnt",IBWHO="i":"Insur",1:"Other")," "
+3 FOR I=IBEVDT,IBFDT,IBTDT
WRITE $EXTRACT(I,4,5)_"/"_$EXTRACT(I,6,7)_"/"_$EXTRACT(I,2,3)," "
+4 WRITE $SELECT(IBST=1:"Enterd",IBST=2:"Revwed",IBST=3:"Auth. ",IBST=4:"Printd",1:"Cancel")," "
+5 WRITE IBTF," ",$SELECT(IBTF=1:"Ad - Ds",IBTF=2:"Int FC ",IBTF=3:"Int CC ",IBTF=4:"Int LC ",IBTF=5:"Late Ch",IBTF=6:"Adjust ",1:"Replace")
+6 QUIT
+7 ;
ONE1 ; Display IB Actions. Input: K, X
+1 NEW C,D,I,Y
SET D=$GET(^IB(K,0))
+2 WRITE !,$PIECE($PIECE(D,"^",11),"-",2),?8,$SELECT($PIECE($GET(^IBE(350.1,+$PIECE(D,"^",3),0)),"^")["OPT":"Outpt.",1:"Inpat.")," Patnt "
+3 FOR I=X,$PIECE(D,"^",14),$PIECE(D,"^",15)
WRITE $$DAT1^IBOUTL(I)," "
+4 SET C=$PIECE(^DD(350,.05,0),"^",2)
SET Y=$PIECE(D,"^",5)
DO Y^DIQ
WRITE $EXTRACT(Y,1,7)," ",$EXTRACT($$ACTNM^IBOUTL($PIECE(D,"^",3)),1,18)
+5 QUIT
+6 ;
HDR SET DGTAB=$SELECT($DATA(DGSELNO):"!?8",1:"!")
WRITE @DGTAB,"Bill # Classif Payer Event DT From Dat To Date Status Timeframe"
+1 SET DGTAB=$SELECT($DATA(DGSELNO):"!?8",1:"!")
WRITE @DGTAB,"------ ------- ----- -------- -------- -------- ------ ----------"
+2 QUIT
+3 ;
HDR1 ; Write header to dislay IB Actions.
+1 WRITE !,"Bill # Classf Payer Event DT From Dat To Date Status IB Action Type"
+2 WRITE !,"------ ------ ----- -------- -------- -------- ------- --------------"
+3 QUIT
+4 ;
PAUSE IF '$DATA(DGSELNO)
IF $EXTRACT(IOST,1,2)["C-"
READ !!,"Enter ""^"" to quit display, return to continue",IBX1:DTIME
SET IBQUIT=$SELECT(IBX1["^":1,'$TEST:1,1:0)
QUIT
ASK IF '$DATA(DGSELNO)
IF DGSELNO<1
QUIT
+1 WRITE !!,"CHOOSE 1"
IF DGSELNO>1
WRITE "-",DGSELNO
WRITE " or ENTER BILL NUMBER: "
READ IBX:DTIME
IF IBX="^"!('$TEST)
SET IBQUIT=1
QUIT
+2 IF IBX=""
QUIT
+3 IF $DATA(^UTILITY($JOB,"IBSEL",IBX))
SET Y=^(IBX)
IF $DATA(^DGCR(399,Y,0))
SET Y(0)=^(0)
WRITE " ",$PIECE(Y(0),"^")
SET IBIDS(.17)=$PIECE(Y(0),"^",17)
SET IBQUIT=1
QUIT
+4 ;
HELPSEL WRITE !!,"Enter 1-",DGSELNO," to select that entry or enter the Bill Number"
GOTO ASK
+1 QUIT
+2 ;
UTIL SET IBIFN1=""
SET IBCNT=0
KILL ^UTILITY($JOB)
+1 FOR J=0:0
SET IBIFN1=$ORDER(^DGCR(399,"C",DFN,IBIFN1))
IF IBIFN1=""
QUIT
SET IBCNT=IBCNT+1
SET IBEVDT=$PIECE(^DGCR(399,IBIFN1,0),"^",3)
SET ^UTILITY($JOB,-IBEVDT,IBIFN1)=""
+2 QUIT
+3 ;
UTIL1 ; Get IB charges for a patient for a single event date. Input: DFN, X
+1 NEW Y,Y1
+2 SET Y=0
FOR
SET Y=$ORDER(^IB("AFDT",DFN,-X,Y))
IF 'Y
QUIT
SET Y1=0
FOR
SET Y1=$ORDER(^IB("AF",Y,Y1))
IF 'Y1
QUIT
IF $DATA(^IB(Y1,0))
IF $PIECE(^(0),"^",8)'["ADMISSION"
SET IBCNT=IBCNT+1
SET ^UTILITY($JOB,"IB",Y1)=""
+3 QUIT
+4 ;
END DO END^IBCBB1
+1 KILL A,DGTAB,IBIFN1,IBPAUS,IBQUIT,IBX1,IBDT,IBDT1,IBCNT,^UTILITY($JOB)
+2 QUIT
