IBTUTL ;ALB/AAS - CLAIMS TRACKING UTILITY ROUTINE ; 21-JUN-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
ADM(DGPMCA,VAINDT,RANDOM,IBVSIT) ; -- set up info for adding a current admission
; -- Input DGPMCA = pointer for an admission to patient movement file
; VAINDT = optional date for admission (default is dt)
; RANDOM = whether or not this is a random sample
; IBVSIT = Pointer to visit file (optional)
;
N DA,DIC,DIE,DR,X,VAIN,VA,IBSCHED,IBSCH
I '$G(VAINDT) K VAINDT
I '$G(DGPMCA) S VA200="" D INP^VADPT S DGPMCA=VAIN(1)
Q:DGPMCA=""
S RANDOM=$S($G(RANDOM):1,1:0)
S X=$O(^IBT(356,"ADM",DFN,DGPMCA,0)) I X S IBTRN=X G ADMQ
S IBADMDT=$P(^DGPM(DGPMCA,0),"^")
;S IBETYP=+$O(^IBE(356.6,"B","INPATIENT ADMISSION",0))
S IBETYP=+$O(^IBE(356.6,"AC",1,0))
S (IBSCH,IBTRN)=$O(^IBT(356,"ASCH",+$$SCH^IBTRKR2(DGPMCA),0))
D:'IBTRN ADDT
I IBTRN<1 G ADMQ
S DA=IBTRN,DIE="^IBT(356,"
L +^IBT(356,+IBTRN):10 I '$T G ADMQ
S DR=$$ADMDR(IBADMDT,IBETYP,DGPMCA,RANDOM)
D ^DIE K DA,DR,DIE
L -^IBT(356,+IBTRN)
;
S IBSCHED=$S($P(^DGPM(DGPMCA,0),U,25):10,1:20)
;
; -- if random sample add hospital review
I $P(^IBT(356,IBTRN,0),U,25) D PRE^IBTUTL2(DT,IBTRN,IBSCHED)
;
; -- if scheduled admission entry converted to admission, don't add
; second insurance review
I $G(IBSCH) G ADMQ
;
; -- if insured add ins review
I $P(^IBT(356,IBTRN,0),U,24) D COM^IBTUTL3(DT,IBTRN,IBSCHED,$G(IBTRV))
;
ADMQ Q
;
ADDT ; -- add new entry to tracking, ibt(356
;
N %DT,DD,DO,DIC,DR,DIE,DLAYGO,IBTR1
L +^IBT(356,0):10 I '$T S Y="-1^IB014" G ADDTQ
S X=$P($G(^IBT(356,0)),"^",3)+1 L -^IBT(356,0) I 'X S Y="-1^IB015" G ADDTQ
K DD,DO,DIC,DR S DIC="^IBT(356,",DIC(0)="L",DLAYGO=356
F X=X:1 L:$D(IBTR1) -^IBT(356,IBTR1) I X>0,'$D(^IBT(356,X)) S IBTR1=X L +^IBT(356,IBTR1):1 I $T,'$D(^IBT(356,X)) S DINUM=X,X=($$IBSITE())_X D FILE^DICN I +Y>0 Q
L -^IBT(356,IBTR1)
ADDTQ S IBTRN=+Y,IBNEW=1
Q
;
OTH(DFN,IBETYP,IBTDT) ; -- add miscellaneous entries, care may not be in data base
; -- input dfn := patient pointer to 2
; ibetyp := pointer to type entry in 356.6
; ibtdt := episode date
;
N X,Y,DA,DR,DIE,DIC
S X=$O(^IBT(356,"APTY",DFN,IBETYP,IBTDT,0)) I X S IBTRN=X G OTHQ
D ADDT
I IBTRN<1 G OTHQ
S DA=IBTRN,DIE="^IBT(356,"
S DR=".02////"_$G(DFN)_";.06////"_+$G(IBTDT)_";.18////"_IBETYP_";.2////1;.24////"_$$INSURED^IBCNS1(DFN)_";1.01///NOW;1.02////"_DUZ_";.17////"_$$EABD(IBETYP,IBTDT)
L +^IBT(356,+IBTRN):10 I '$T G OTHQ
D ^DIE K DA,DR,DIE
L -^IBT(356,+IBTRN)
OTHQ Q
;
IBSITE() ; -- calculate site from site parameters
; -- output ibsite = station number
;
N IBFAC,IBSITE
D SITE^IBAUTL
Q IBSITE
;
ADMDR(IBADMDT,IBETYP,DGPMCA,RANDOM) ; -- set up dr string for admissions
S DR=""
I '$G(IBETYP)!'$G(IBADMDT) G ADMDRQ
S DR=".02////"_$G(DFN)_";.03////"_$G(IBVSIT)_";.05////"_$G(DGPMCA)_";.06////"_+$G(IBADMDT)_";.18////"_$G(IBETYP)_";.2////1;.24////"_$$INSURED^IBCNS1(DFN)_";1.01///NOW;1.02////"_DUZ_";.17////"_$$EABD(IBETYP,$G(IBADMDT)) D
.I $G(DGPMCA),$G(RANDOM) S DR=DR_";.25////1" Q
ADMDRQ Q DR
;
EABD(IBETYP,IBTDT) ; -- compute earliest auto bill date: date entered plus days delay for event type
; -- input IBETYPE = pointer to type of entry file
; IBTDT = episode date, if not passed in uses DT
;
N X,X1,X2,Y,IBETYPD S Y="" I '$G(IBETYP) G EABDQ
S IBETYPD=$G(^IBE(356.6,+IBETYP,0)) I '$G(IBTDT) S IBTDT=DT
I '$P(IBETYPD,"^",4) G EABDQ ; automated billing turned off
S X2=+$P(IBETYPD,"^",6) ;set earliest autobill date to entered date plus days delay
S X1=IBTDT D C^%DTC S Y=X\1
EABDQ Q Y
;
BILL(IBTRN) ;check if event is billable, return EABD if it is
N X,Y,Z,IBTRND S (X,Y)="" S IBTRND=$G(^IBT(356,+$G(IBTRN),0)) I IBTRND="" G BILLQ
;
; -- billed and bill not cancelled and not inpt interim first or continuous
I +$P(IBTRND,U,11) S Z=$$BILLED^IBCU8(IBTRN),Y=$P(Z,U,2) I +Z,'Y G BILLQ
;
; -- special type (not riem. ins), not billable, inactive
I +$P(IBTRND,U,12)!(+$P(IBTRND,U,19))!('$P(IBTRND,U,20)) G BILLQ
I 'Y S Y=+$G(^IBT(356,+$G(IBTRN),1)) I 'Y S Y=DT
S X=$$EABD(+$P(IBTRND,U,18),Y)
BILLQ Q X
;
STOBIL Q
KTOBIL Q
IBTUTL ;ALB/AAS - CLAIMS TRACKING UTILITY ROUTINE ; 21-JUN-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
ADM(DGPMCA,VAINDT,RANDOM,IBVSIT) ; -- set up info for adding a current admission
+1 ; -- Input DGPMCA = pointer for an admission to patient movement file
+2 ; VAINDT = optional date for admission (default is dt)
+3 ; RANDOM = whether or not this is a random sample
+4 ; IBVSIT = Pointer to visit file (optional)
+5 ;
+6 NEW DA,DIC,DIE,DR,X,VAIN,VA,IBSCHED,IBSCH
+7 IF '$GET(VAINDT)
KILL VAINDT
+8 IF '$GET(DGPMCA)
SET VA200=""
DO INP^VADPT
SET DGPMCA=VAIN(1)
+9 IF DGPMCA=""
QUIT
+10 SET RANDOM=$SELECT($GET(RANDOM):1,1:0)
+11 SET X=$ORDER(^IBT(356,"ADM",DFN,DGPMCA,0))
IF X
SET IBTRN=X
GOTO ADMQ
+12 SET IBADMDT=$PIECE(^DGPM(DGPMCA,0),"^")
+13 ;S IBETYP=+$O(^IBE(356.6,"B","INPATIENT ADMISSION",0))
+14 SET IBETYP=+$ORDER(^IBE(356.6,"AC",1,0))
+15 SET (IBSCH,IBTRN)=$ORDER(^IBT(356,"ASCH",+$$SCH^IBTRKR2(DGPMCA),0))
+16 IF 'IBTRN
DO ADDT
+17 IF IBTRN<1
GOTO ADMQ
+18 SET DA=IBTRN
SET DIE="^IBT(356,"
+19 LOCK +^IBT(356,+IBTRN):10
IF '$TEST
GOTO ADMQ
+20 SET DR=$$ADMDR(IBADMDT,IBETYP,DGPMCA,RANDOM)
+21 DO ^DIE
KILL DA,DR,DIE
+22 LOCK -^IBT(356,+IBTRN)
+23 ;
+24 SET IBSCHED=$SELECT($PIECE(^DGPM(DGPMCA,0),U,25):10,1:20)
+25 ;
+26 ; -- if random sample add hospital review
+27 IF $PIECE(^IBT(356,IBTRN,0),U,25)
DO PRE^IBTUTL2(DT,IBTRN,IBSCHED)
+28 ;
+29 ; -- if scheduled admission entry converted to admission, don't add
+30 ; second insurance review
+31 IF $GET(IBSCH)
GOTO ADMQ
+32 ;
+33 ; -- if insured add ins review
+34 IF $PIECE(^IBT(356,IBTRN,0),U,24)
DO COM^IBTUTL3(DT,IBTRN,IBSCHED,$GET(IBTRV))
+35 ;
ADMQ QUIT
+1 ;
ADDT ; -- add new entry to tracking, ibt(356
+1 ;
+2 NEW %DT,DD,DO,DIC,DR,DIE,DLAYGO,IBTR1
+3 LOCK +^IBT(356,0):10
IF '$TEST
SET Y="-1^IB014"
GOTO ADDTQ
+4 SET X=$PIECE($GET(^IBT(356,0)),"^",3)+1
LOCK -^IBT(356,0)
IF 'X
SET Y="-1^IB015"
GOTO ADDTQ
+5 KILL DD,DO,DIC,DR
SET DIC="^IBT(356,"
SET DIC(0)="L"
SET DLAYGO=356
+6 FOR X=X:1
IF $DATA(IBTR1)
LOCK -^IBT(356,IBTR1)
IF X>0
IF '$DATA(^IBT(356,X))
SET IBTR1=X
LOCK +^IBT(356,IBTR1):1
IF $TEST
IF '$DATA(^IBT(356,X))
SET DINUM=X
SET X=($$IBSITE())_X
DO FILE^DICN
IF +Y>0
QUIT
+7 LOCK -^IBT(356,IBTR1)
ADDTQ SET IBTRN=+Y
SET IBNEW=1
+1 QUIT
+2 ;
OTH(DFN,IBETYP,IBTDT) ; -- add miscellaneous entries, care may not be in data base
+1 ; -- input dfn := patient pointer to 2
+2 ; ibetyp := pointer to type entry in 356.6
+3 ; ibtdt := episode date
+4 ;
+5 NEW X,Y,DA,DR,DIE,DIC
+6 SET X=$ORDER(^IBT(356,"APTY",DFN,IBETYP,IBTDT,0))
IF X
SET IBTRN=X
GOTO OTHQ
+7 DO ADDT
+8 IF IBTRN<1
GOTO OTHQ
+9 SET DA=IBTRN
SET DIE="^IBT(356,"
+10 SET DR=".02////"_$GET(DFN)_";.06////"_+$GET(IBTDT)_";.18////"_IBETYP_";.2////1;.24////"_$$INSURED^IBCNS1(DFN)_";1.01///NOW;1.02////"_DUZ_";.17////"_$$EABD(IBETYP,IBTDT)
+11 LOCK +^IBT(356,+IBTRN):10
IF '$TEST
GOTO OTHQ
+12 DO ^DIE
KILL DA,DR,DIE
+13 LOCK -^IBT(356,+IBTRN)
OTHQ QUIT
+1 ;
IBSITE() ; -- calculate site from site parameters
+1 ; -- output ibsite = station number
+2 ;
+3 NEW IBFAC,IBSITE
+4 DO SITE^IBAUTL
+5 QUIT IBSITE
+6 ;
ADMDR(IBADMDT,IBETYP,DGPMCA,RANDOM) ; -- set up dr string for admissions
+1 SET DR=""
+2 IF '$GET(IBETYP)!'$GET(IBADMDT)
GOTO ADMDRQ
+3 SET DR=".02////"_$GET(DFN)_";.03////"_$GET(IBVSIT)_";.05////"_$GET(DGPMCA)_";.06////"_+$GET(IBADMDT)_";.18////"_$GET(IBETYP)_";.2////1;.24////"_$$INSURED^IBCNS1(DFN)_";1.01///NOW;1.02////"_DUZ_";.17////"_$$EABD(IBETYP,$GET(IBADMDT))
Begin DoDot:1
+4 IF $GET(DGPMCA)
IF $GET(RANDOM)
SET DR=DR_";.25////1"
QUIT
End DoDot:1
ADMDRQ QUIT DR
+1 ;
EABD(IBETYP,IBTDT) ; -- compute earliest auto bill date: date entered plus days delay for event type
+1 ; -- input IBETYPE = pointer to type of entry file
+2 ; IBTDT = episode date, if not passed in uses DT
+3 ;
+4 NEW X,X1,X2,Y,IBETYPD
SET Y=""
IF '$GET(IBETYP)
GOTO EABDQ
+5 SET IBETYPD=$GET(^IBE(356.6,+IBETYP,0))
IF '$GET(IBTDT)
SET IBTDT=DT
+6 ; automated billing turned off
IF '$PIECE(IBETYPD,"^",4)
GOTO EABDQ
+7 ;set earliest autobill date to entered date plus days delay
SET X2=+$PIECE(IBETYPD,"^",6)
+8 SET X1=IBTDT
DO C^%DTC
SET Y=X\1
EABDQ QUIT Y
+1 ;
BILL(IBTRN) ;check if event is billable, return EABD if it is
+1 NEW X,Y,Z,IBTRND
SET (X,Y)=""
SET IBTRND=$GET(^IBT(356,+$GET(IBTRN),0))
IF IBTRND=""
GOTO BILLQ
+2 ;
+3 ; -- billed and bill not cancelled and not inpt interim first or continuous
+4 IF +$PIECE(IBTRND,U,11)
SET Z=$$BILLED^IBCU8(IBTRN)
SET Y=$PIECE(Z,U,2)
IF +Z
IF 'Y
GOTO BILLQ
+5 ;
+6 ; -- special type (not riem. ins), not billable, inactive
+7 IF +$PIECE(IBTRND,U,12)!(+$PIECE(IBTRND,U,19))!('$PIECE(IBTRND,U,20))
GOTO BILLQ
+8 IF 'Y
SET Y=+$GET(^IBT(356,+$GET(IBTRN),1))
IF 'Y
SET Y=DT
+9 SET X=$$EABD(+$PIECE(IBTRND,U,18),Y)
BILLQ QUIT X
+1 ;
STOBIL QUIT
KTOBIL QUIT
