- 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
