IBTRKR ;ALB/AAS - CLAIMS TRACKER - AUTO-ENROLLER ; 4-AUG-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
INP ; -- Inpatient Tracker
; called by ibamtd from DGPM MOVEMENT EVENTS
;
W:'$D(IB20) !,"Updating Claims Tracking"
;
N X,Y,DA,DR,DIE,DIC,IBTRN,IBRANDOM,IBTRKR,IBMVTYP,IBMVA,IBMVP,IBMVDA
S IBTRKR=$G(^IBE(350.9,1,6))
G:'$P(IBTRKR,"^",2) INPQ ; tracking off
I '$D(VAIN(1)) D INP^VADPT
;
S IBMVTP=$S($P(DGPMA,"^",2):$P(DGPMA,"^",2),1:$P(DGPMP,"^",2)) ;movement type
S IBMVAD=$S(DGPMA'="":$P(DGPMA,"^",14),1:$P(DGPMP,"^",14)) ; admission movement
Q:'IBMVTP!('IBMVAD)
;
I IBMVTP=1 D 1 ; is add/edit admission
I IBMVTP=3 D 3
I IBMVTP=6 D 6
INPQ I $G(IBTRN) W:'$D(IB20) ".... Entry ",$S($G(IBNEW):"Added.",1:"Edited."),!
Q
1 ;
ADMIT ; -- process admission movements
Q:IBMVTP'=1
;
I DGPMA="" D G ADMITQ ; is deleted admission
.S IBTRN=$O(^IBT(356,"AD",+IBMVAD,0)) Q:'IBTRN
.;inactivate record
.S DA=IBTRN,DR=".2////0",DIE="^IBT(356,"
.D ^DIE K DA,DR,DIC,DIE
.Q
;
I DFN=$P($G(^IBT(356,+$O(^IBT(356,"AD",+IBMVAD,0)),0)),"^",2) D G ADMITQ ;see if already there
.; -- if different dates or inactive, update
.S IBTRN=$O(^IBT(356,"AD",+IBMVAD,0))
.I $P($G(^IBT(356,+IBTRN,0)),U,6)'=+$E(+DGPMA,1,12)!('$P($G(^IBT(356,+IBTRN,0)),U,20)) D
..N DA,DR,DIC,DIE
..S DA=IBTRN,DIE="^IBT(356,",DR=".06////"_+$E(+DGPMA,1,12)_";.2////1"
..D ^DIE
;
I +$G(VAIN(3)) S IBRANDOM=$$RANDOM^IBTRKR1(+VAIN(3))
;
I $P(IBTRKR,"^",2)=2 D ADM^IBTUTL(IBMVAD,+$E(+DGPMA,1,12),$G(IBRANDOM),$P(DGPMA,"^",27))
I $P(IBTRKR,"^",2)=1,($$INSURED^IBCNS1(DFN,+DGPMA)!($G(IBRANDOM))) D ADM^IBTUTL(IBMVAD,+$E(+DGPMA,1,12),$G(IBRANDOM),$P(DGPMA,"^",27))
ADMITQ Q
;
3 ; -- if discharge and is tracked, set up discharge reviews
;I IBMVTP=3 D
;.S IBTRN=$O(^IBT(356,"AD",+IBMVAD,0)) Q:'IBTRN
;.I '$P($G(^IBT(356,+IBTRN,0)),"^",16) Q ;hospital ur not required
;.I $O(^IBT(356,"AD",+IBMVAD,0)) D PRE^IBTUTL2($E(+DGPMA,1,7),IBTRN,30)
DSQ Q
;
6 ; -- specialty change
I DGPMA="" G SPQ ;is deleted movement, don't worry
I +DGPMA<$$FMADD^XLFDT(+DT,-7) G SPQ ; past spec change don't worry
;
N IBTSA,IBTSP,IBTRN
S IBTSA=$P($G(^DIC(42.4,+$P($G(^DIC(45.7,+$P(DGPMA,"^",9),0)),"^",2),0)),"^",3)
;
I DGPMP'="" D ;is changed
.S IBTSP=$P($G(^DIC(42.4,+$P($G(^DIC(45.7,+$P(DGPMP,"^",9),0)),"^",2),0)),"^",3)
.Q
;
I DGPMP="" D
.N IBDT S IBDT=9999999.9999999-$P(DGPMA,"^")
.S IBTSP=$P($G(^DIC(45.7,+$O(^(+$O(^DGPM("ATS",+DFN,+IBMVAD,+IBDT)),0)),0)),"^",2)
.S IBTSP=$P($G(^DIC(42.4,+IBTSP,0)),"^",3)
.Q
;
G:IBTSA=IBTSP SPQ ; is not a change in major bed section
;
; -- add hr and ir if it is being tracked
S IBTRN=$O(^IBT(356,"AD",+IBMVAD,0))
;
I $O(^IBT(356.1,"C",+IBTRN,0)) D ; tracked as a hosp. review
.I $$ALREADY(356.1,+DGPMA) Q
.D PRE^IBTUTL2($E(+DGPMA,1,7),IBTRN,30)
.I $G(IBTRV) S DA=IBTRV,DIE="^IBT(356.1,",DR="11///Entry created by major change in specialty." D ^DIE K DA,DR,DIC,DIE
.Q
;
I $O(^IBT(356.2,"C",+IBTRN,0)) D ;tracked as an ins. review
.I $$ALREADY(356.2,+DGPMA) Q
.I $P($G(^IBT(356,+IBTRN,0)),"^",24) D COM^IBTUTL3($E(+DGPMA,1,12),IBTRN,30)
.I $G(IBTRC) S DA=IBTRC,DIE="^IBT(356.2,",DR="11///Entry created by major change in specialty." D ^DIE K DA,DR,DIC,DIE
.Q
SPQ Q
;
ALREADY(FILE,DATE) ; -- see if already is review for date
N X,Y,IBX
S IBX=0
S X=$P(DATE,".")+.25
S Y=$O(^IBT(FILE,"ATIDT",+IBTRN,-X)) S Y=-Y I Y,$P(Y,".")=$P(DATE,".") S IBX=1
Q IBX
;
NIGHTLY ; -- nightly job for claims tracking, called by IBAMTC
;
D UPDATE^IBTRKR1 ; update claims tracking site parameters (random sampler)
D ^IBTRKR2 ; add scheduled admissions to tracking
D ^IBTRKR3 ; add rx refill to outpatient encounters
D ^IBTRKR4 ; add outpatient encounters to tracking
D ^IBTRKR5 ; add outpatient prosthetics item to tracking
Q
IBTRKR ;ALB/AAS - CLAIMS TRACKER - AUTO-ENROLLER ; 4-AUG-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
INP ; -- Inpatient Tracker
+1 ; called by ibamtd from DGPM MOVEMENT EVENTS
+2 ;
+3 IF '$DATA(IB20)
WRITE !,"Updating Claims Tracking"
+4 ;
+5 NEW X,Y,DA,DR,DIE,DIC,IBTRN,IBRANDOM,IBTRKR,IBMVTYP,IBMVA,IBMVP,IBMVDA
+6 SET IBTRKR=$GET(^IBE(350.9,1,6))
+7 ; tracking off
IF '$PIECE(IBTRKR,"^",2)
GOTO INPQ
+8 IF '$DATA(VAIN(1))
DO INP^VADPT
+9 ;
+10 ;movement type
SET IBMVTP=$SELECT($PIECE(DGPMA,"^",2):$PIECE(DGPMA,"^",2),1:$PIECE(DGPMP,"^",2))
+11 ; admission movement
SET IBMVAD=$SELECT(DGPMA'="":$PIECE(DGPMA,"^",14),1:$PIECE(DGPMP,"^",14))
+12 IF 'IBMVTP!('IBMVAD)
QUIT
+13 ;
+14 ; is add/edit admission
IF IBMVTP=1
DO 1
+15 IF IBMVTP=3
DO 3
+16 IF IBMVTP=6
DO 6
INPQ IF $GET(IBTRN)
IF '$DATA(IB20)
WRITE ".... Entry ",$SELECT($GET(IBNEW):"Added.",1:"Edited."),!
+1 QUIT
1 ;
ADMIT ; -- process admission movements
+1 IF IBMVTP'=1
QUIT
+2 ;
+3 ; is deleted admission
IF DGPMA=""
Begin DoDot:1
+4 SET IBTRN=$ORDER(^IBT(356,"AD",+IBMVAD,0))
IF 'IBTRN
QUIT
+5 ;inactivate record
+6 SET DA=IBTRN
SET DR=".2////0"
SET DIE="^IBT(356,"
+7 DO ^DIE
KILL DA,DR,DIC,DIE
+8 QUIT
End DoDot:1
GOTO ADMITQ
+9 ;
+10 ;see if already there
IF DFN=$PIECE($GET(^IBT(356,+$ORDER(^IBT(356,"AD",+IBMVAD,0)),0)),"^",2)
Begin DoDot:1
+11 ; -- if different dates or inactive, update
+12 SET IBTRN=$ORDER(^IBT(356,"AD",+IBMVAD,0))
+13 IF $PIECE($GET(^IBT(356,+IBTRN,0)),U,6)'=+$EXTRACT(+DGPMA,1,12)!('$PIECE($GET(^IBT(356,+IBTRN,0)),U,20))
Begin DoDot:2
+14 NEW DA,DR,DIC,DIE
+15 SET DA=IBTRN
SET DIE="^IBT(356,"
SET DR=".06////"_+$EXTRACT(+DGPMA,1,12)_";.2////1"
+16 DO ^DIE
End DoDot:2
End DoDot:1
GOTO ADMITQ
+17 ;
+18 IF +$GET(VAIN(3))
SET IBRANDOM=$$RANDOM^IBTRKR1(+VAIN(3))
+19 ;
+20 IF $PIECE(IBTRKR,"^",2)=2
DO ADM^IBTUTL(IBMVAD,+$EXTRACT(+DGPMA,1,12),$GET(IBRANDOM),$PIECE(DGPMA,"^",27))
+21 IF $PIECE(IBTRKR,"^",2)=1
IF ($$INSURED^IBCNS1(DFN,+DGPMA)!($GET(IBRANDOM)))
DO ADM^IBTUTL(IBMVAD,+$EXTRACT(+DGPMA,1,12),$GET(IBRANDOM),$PIECE(DGPMA,"^",27))
ADMITQ QUIT
+1 ;
3 ; -- if discharge and is tracked, set up discharge reviews
+1 ;I IBMVTP=3 D
+2 ;.S IBTRN=$O(^IBT(356,"AD",+IBMVAD,0)) Q:'IBTRN
+3 ;.I '$P($G(^IBT(356,+IBTRN,0)),"^",16) Q ;hospital ur not required
+4 ;.I $O(^IBT(356,"AD",+IBMVAD,0)) D PRE^IBTUTL2($E(+DGPMA,1,7),IBTRN,30)
DSQ QUIT
+1 ;
6 ; -- specialty change
+1 ;is deleted movement, don't worry
IF DGPMA=""
GOTO SPQ
+2 ; past spec change don't worry
IF +DGPMA<$$FMADD^XLFDT(+DT,-7)
GOTO SPQ
+3 ;
+4 NEW IBTSA,IBTSP,IBTRN
+5 SET IBTSA=$PIECE($GET(^DIC(42.4,+$PIECE($GET(^DIC(45.7,+$PIECE(DGPMA,"^",9),0)),"^",2),0)),"^",3)
+6 ;
+7 ;is changed
IF DGPMP'=""
Begin DoDot:1
+8 SET IBTSP=$PIECE($GET(^DIC(42.4,+$PIECE($GET(^DIC(45.7,+$PIECE(DGPMP,"^",9),0)),"^",2),0)),"^",3)
+9 QUIT
End DoDot:1
+10 ;
+11 IF DGPMP=""
Begin DoDot:1
+12 NEW IBDT
SET IBDT=9999999.9999999-$PIECE(DGPMA,"^")
+13 SET IBTSP=$PIECE($GET(^DIC(45.7,+$ORDER(^(+$ORDER(^DGPM("ATS",+DFN,+IBMVAD,+IBDT)),0)),0)),"^",2)
+14 SET IBTSP=$PIECE($GET(^DIC(42.4,+IBTSP,0)),"^",3)
+15 QUIT
End DoDot:1
+16 ;
+17 ; is not a change in major bed section
IF IBTSA=IBTSP
GOTO SPQ
+18 ;
+19 ; -- add hr and ir if it is being tracked
+20 SET IBTRN=$ORDER(^IBT(356,"AD",+IBMVAD,0))
+21 ;
+22 ; tracked as a hosp. review
IF $ORDER(^IBT(356.1,"C",+IBTRN,0))
Begin DoDot:1
+23 IF $$ALREADY(356.1,+DGPMA)
QUIT
+24 DO PRE^IBTUTL2($EXTRACT(+DGPMA,1,7),IBTRN,30)
+25 IF $GET(IBTRV)
SET DA=IBTRV
SET DIE="^IBT(356.1,"
SET DR="11///Entry created by major change in specialty."
DO ^DIE
KILL DA,DR,DIC,DIE
+26 QUIT
End DoDot:1
+27 ;
+28 ;tracked as an ins. review
IF $ORDER(^IBT(356.2,"C",+IBTRN,0))
Begin DoDot:1
+29 IF $$ALREADY(356.2,+DGPMA)
QUIT
+30 IF $PIECE($GET(^IBT(356,+IBTRN,0)),"^",24)
DO COM^IBTUTL3($EXTRACT(+DGPMA,1,12),IBTRN,30)
+31 IF $GET(IBTRC)
SET DA=IBTRC
SET DIE="^IBT(356.2,"
SET DR="11///Entry created by major change in specialty."
DO ^DIE
KILL DA,DR,DIC,DIE
+32 QUIT
End DoDot:1
SPQ QUIT
+1 ;
ALREADY(FILE,DATE) ; -- see if already is review for date
+1 NEW X,Y,IBX
+2 SET IBX=0
+3 SET X=$PIECE(DATE,".")+.25
+4 SET Y=$ORDER(^IBT(FILE,"ATIDT",+IBTRN,-X))
SET Y=-Y
IF Y
IF $PIECE(Y,".")=$PIECE(DATE,".")
SET IBX=1
+5 QUIT IBX
+6 ;
NIGHTLY ; -- nightly job for claims tracking, called by IBAMTC
+1 ;
+2 ; update claims tracking site parameters (random sampler)
DO UPDATE^IBTRKR1
+3 ; add scheduled admissions to tracking
DO ^IBTRKR2
+4 ; add rx refill to outpatient encounters
DO ^IBTRKR3
+5 ; add outpatient encounters to tracking
DO ^IBTRKR4
+6 ; add outpatient prosthetics item to tracking
DO ^IBTRKR5
+7 QUIT
