| 1 | IBTUTL ;ALB/AAS - CLAIMS TRACKING UTILITY ROUTINE ; 21-JUN-93
 | 
|---|
| 2 |  ;;Version 2.0 ; INTEGRATED BILLING ;**23,62**; 21-MAR-94
 | 
|---|
| 3 |  ;;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
| 4 |  ;
 | 
|---|
| 5 | ADM(DGPMCA,VAINDT,RANDOM,IBVSIT) ; -- set up info for adding a current admission
 | 
|---|
| 6 |  ; -- Input DGPMCA   = pointer for an admission to patient movement file
 | 
|---|
| 7 |  ;          VAINDT   = optional date for admission (default is dt)
 | 
|---|
| 8 |  ;          RANDOM   = whether or not this is a random sample
 | 
|---|
| 9 |  ;          IBVSIT   = Pointer to visit file (optional)
 | 
|---|
| 10 |  ;
 | 
|---|
| 11 |  N DA,DIC,DIE,DR,X,VAIN,VA,IBSCHED,IBSCH
 | 
|---|
| 12 |  I '$G(VAINDT) K VAINDT
 | 
|---|
| 13 |  I '$G(DGPMCA) S VA200="" D INP^VADPT S DGPMCA=VAIN(1)
 | 
|---|
| 14 |  Q:DGPMCA=""
 | 
|---|
| 15 |  S RANDOM=$S($G(RANDOM):1,1:0)
 | 
|---|
| 16 |  S X=$O(^IBT(356,"ADM",DFN,DGPMCA,0)) I X S IBTRN=X G ADMQ
 | 
|---|
| 17 |  S IBADMDT=$P(^DGPM(DGPMCA,0),"^")
 | 
|---|
| 18 |  ;S IBETYP=+$O(^IBE(356.6,"B","INPATIENT ADMISSION",0))
 | 
|---|
| 19 |  S IBETYP=+$O(^IBE(356.6,"AC",1,0))
 | 
|---|
| 20 |  S (IBSCH,IBTRN)=$O(^IBT(356,"ASCH",+$$SCH^IBTRKR2(DGPMCA),0))
 | 
|---|
| 21 |  D:'IBTRN ADDT
 | 
|---|
| 22 |  I IBTRN<1 G ADMQ
 | 
|---|
| 23 |  S DA=IBTRN,DIE="^IBT(356,"
 | 
|---|
| 24 |  L +^IBT(356,+IBTRN):10 I '$T G ADMQ
 | 
|---|
| 25 |  S DR=$$ADMDR(IBADMDT,IBETYP,DGPMCA,RANDOM)
 | 
|---|
| 26 |  D ^DIE K DA,DR,DIE
 | 
|---|
| 27 |  I $P($G(^IBT(356,IBTRN,0)),"^",32) S DA=IBTRN,DR=".32///@",DIE="^IBT(356," D ^DIE K DA,DR,DIE
 | 
|---|
| 28 |  L -^IBT(356,+IBTRN)
 | 
|---|
| 29 |  ;
 | 
|---|
| 30 |  S IBSCHED=$S($P(^DGPM(DGPMCA,0),U,25):10,1:20)
 | 
|---|
| 31 |  ;
 | 
|---|
| 32 |  ; -- if random sample add hospital review
 | 
|---|
| 33 |  I $P(^IBT(356,IBTRN,0),U,25) D PRE^IBTUTL2(DT,IBTRN,IBSCHED)
 | 
|---|
| 34 |  ;
 | 
|---|
| 35 |  ; -- if scheduled admission entry converted to admission, don't add
 | 
|---|
| 36 |  ;    second insurance review
 | 
|---|
| 37 |  I $G(IBSCH) G ADMQ
 | 
|---|
| 38 |  ;
 | 
|---|
| 39 |  ; -- if insured add ins review
 | 
|---|
| 40 |  I $P(^IBT(356,IBTRN,0),U,24) D COM^IBTUTL3(DT,IBTRN,IBSCHED,$G(IBTRV))
 | 
|---|
| 41 |  ;
 | 
|---|
| 42 | ADMQ Q
 | 
|---|
| 43 |  ;
 | 
|---|
| 44 | ADDT ; -- add new entry to tracking, ibt(356
 | 
|---|
| 45 |  ;
 | 
|---|
| 46 |  N %DT,DD,DO,DIC,DR,DIE,DLAYGO,IBTR1,DINUM
 | 
|---|
| 47 |  L +^IBT(356,0):0 ;I '$T S Y="-1^IB085" G ADDTQ
 | 
|---|
| 48 |  ;I $G(^IBT(356,0))="" S Y="-1^IB086" G ADDTQ
 | 
|---|
| 49 |  S X=$P($G(^IBT(356,0)),"^",3)+1 L -^IBT(356,0)
 | 
|---|
| 50 |  S DIC="^IBT(356,",DIC(0)="L",DLAYGO=356
 | 
|---|
| 51 |  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
 | 
|---|
| 52 |  L -^IBT(356,IBTR1)
 | 
|---|
| 53 |  I +Y<1  S Y="-1^IB087"
 | 
|---|
| 54 | ADDTQ ;I +Y<0 D ^IBTERR
 | 
|---|
| 55 |  S IBTRN=+Y,IBNEW=1
 | 
|---|
| 56 |  Q
 | 
|---|
| 57 |  ;
 | 
|---|
| 58 | OTH(DFN,IBETYP,IBTDT) ; -- add miscellaneous entries, care may not be in data base
 | 
|---|
| 59 |  ; -- input   dfn  := patient pointer to 2
 | 
|---|
| 60 |  ;          ibetyp := pointer to type entry in 356.6
 | 
|---|
| 61 |  ;          ibtdt  := episode date
 | 
|---|
| 62 |  ;
 | 
|---|
| 63 |  N X,Y,DA,DR,DIE,DIC
 | 
|---|
| 64 |  S X=$O(^IBT(356,"APTY",DFN,IBETYP,IBTDT,0)) I X S IBTRN=X G OTHQ
 | 
|---|
| 65 |  D ADDT
 | 
|---|
| 66 |  I IBTRN<1 G OTHQ
 | 
|---|
| 67 |  S DA=IBTRN,DIE="^IBT(356,"
 | 
|---|
| 68 |  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)
 | 
|---|
| 69 |  L +^IBT(356,+IBTRN):10 I '$T G OTHQ
 | 
|---|
| 70 |  D ^DIE K DA,DR,DIE
 | 
|---|
| 71 |  L -^IBT(356,+IBTRN)
 | 
|---|
| 72 | OTHQ Q
 | 
|---|
| 73 |  ;
 | 
|---|
| 74 | IBSITE() ; -- calculate site from site parameters
 | 
|---|
| 75 |  ; --  output ibsite = station number
 | 
|---|
| 76 |  ;
 | 
|---|
| 77 |  N IBFAC,IBSITE
 | 
|---|
| 78 |  D SITE^IBAUTL
 | 
|---|
| 79 |  Q IBSITE
 | 
|---|
| 80 |  ;
 | 
|---|
| 81 | ADMDR(IBADMDT,IBETYP,DGPMCA,RANDOM) ; -- set up dr string for admissions
 | 
|---|
| 82 |  S DR=""
 | 
|---|
| 83 |  I '$G(IBETYP)!'$G(IBADMDT) G ADMDRQ
 | 
|---|
| 84 |  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
 | 
|---|
| 85 |  .I $G(DGPMCA),$G(RANDOM) S DR=DR_";.25////1" Q
 | 
|---|
| 86 | ADMDRQ Q DR
 | 
|---|
| 87 |  ;
 | 
|---|
| 88 | EABD(IBETYP,IBTDT) ; -- compute earliest auto bill date: date entered plus days delay for event type
 | 
|---|
| 89 |  ; -- input   IBETYPE = pointer to type of entry file
 | 
|---|
| 90 |  ;            IBTDT   = episode date, if not passed in uses DT
 | 
|---|
| 91 |  ;
 | 
|---|
| 92 |  N X,X1,X2,Y,IBETYPD S Y="" I '$G(IBETYP) G EABDQ
 | 
|---|
| 93 |  S IBETYPD=$G(^IBE(356.6,+IBETYP,0)) I '$G(IBTDT) S IBTDT=DT
 | 
|---|
| 94 |  I '$P(IBETYPD,"^",4) G EABDQ ; automated billing turned off
 | 
|---|
| 95 |  S X2=+$P(IBETYPD,"^",6) ;set earliest autobill date to entered date plus days delay
 | 
|---|
| 96 |  S X1=IBTDT D C^%DTC S Y=X\1
 | 
|---|
| 97 | EABDQ Q Y
 | 
|---|
| 98 |  ;
 | 
|---|
| 99 | BILL(IBTRN) ;check if event is billable, return EABD if it is
 | 
|---|
| 100 |  N X,Y,Z,IBTRND S (X,Y)="" S IBTRND=$G(^IBT(356,+$G(IBTRN),0)) I IBTRND="" G BILLQ
 | 
|---|
| 101 |  ;
 | 
|---|
| 102 |  ; -- billed and bill not cancelled and not inpt interim first or continuous
 | 
|---|
| 103 |  I +$P(IBTRND,U,11) S Z=$$BILLED^IBCU8(IBTRN),Y=$P(Z,U,2) I +Z,'Y G BILLQ
 | 
|---|
| 104 |  ;
 | 
|---|
| 105 |  ; -- special type (not riem. ins), not billable, inactive
 | 
|---|
| 106 |  I +$P(IBTRND,U,12)!(+$P(IBTRND,U,19))!('$P(IBTRND,U,20)) G BILLQ
 | 
|---|
| 107 |  I 'Y S Y=+$G(^IBT(356,+$G(IBTRN),1)) I 'Y S Y=DT
 | 
|---|
| 108 |  S X=$$EABD(+$P(IBTRND,U,18),Y)
 | 
|---|
| 109 | BILLQ Q X
 | 
|---|
| 110 |  ;
 | 
|---|
| 111 | STOBIL Q
 | 
|---|
| 112 | KTOBIL Q
 | 
|---|