IBTRKR ;ALB/AAS - CLAIMS TRACKER - AUTO-ENROLLER ; 4-AUG-93
;;2.0;INTEGRATED BILLING;**23,43,45,56,214,547,565**;21-MAR-94;Build 41
;;Per VA Directive 6402, this routine should not be modified.
;
INP ; -- Inpatient Tracker
; called by ibamtd from DGPM MOVEMENT EVENTS
; add edit delete
; dgpma = after movement 0th node file 405 : data data null
; dgpmp = prior movement 0th node file 405 : null data data
; dfn = ien of patient
;
N %,%H,%I,IBMVAD,IBMVTP,IBTRKR
;
; inpatient claims tracking turned off
S IBTRKR=$G(^IBE(350.9,1,6)) I '$P(IBTRKR,"^",2) Q
;
; movement type 1=admission, 2=transfer, 3=discharge, 6=specialty chg
S IBMVTP=$S($P(DGPMA,"^",2):$P(DGPMA,"^",2),1:$P(DGPMP,"^",2)) I 'IBMVTP Q
;
; $p(14)=admission movement ptr entry in file 405
S IBMVAD=$S(DGPMA'="":$P(DGPMA,"^",14),1:$P(DGPMP,"^",14)) I 'IBMVAD Q
;
D WRITE("Updating claims tracking ... ",2)
;
I '$D(VAIN(1)) D INP^VADPT
;
; add/edit admission
I IBMVTP=1 D ADMIT Q
;
; transfer to asih (patch 23)
I $P($G(^DGPM(+$P(DGPMA,"^",15),0)),"^",2)=1 S IBMVAD=$P(DGPMA,"^",15) D ADMIT Q
;
; specialty change
I IBMVTP=6 D SPECIAL Q
;
D WRITE("completed.")
Q
;
;
WRITE(MSG,FF) ; write message on screen if not silent
; write 'F'orm 'F'eeds count followed by msg (optional)
N %
I '$D(IB20),'$G(DGQUIET) D
. F %=1:1:$G(FF) W !
. W MSG
Q
;
;
ADMIT ; -- process admission movements
; ibmvad is admission movement pointer to file 405
; dgpma is movement entry from file 405
N %,%H,%I,IBCTFLAG,IBNEW,IBRANDOM,IBTRN,LASTADM,LASTDA,LASTDATA
;
; this is a deleted admission from file 405, dgpma=null
I DGPMA="" D DELADMIT Q
;
; try and relink to existing entry if already there
; find the last admission, check to make sure its inactive and there
; is not a pointer to the movement file ($p(5)). if the current
; admission date is within 5 days, update the entry.
S LASTADM=$O(^IBT(356,"APTY",DFN,+$O(^IBE(356.6,"AC",1,0)),9999999),-1)
I LASTADM S LASTDA=+$O(^IBT(356,"APTY",DFN,1,LASTADM,0)),LASTDATA=$G(^IBT(356,LASTDA,0)) I $P(LASTDATA,"^",20)=0,$P(LASTDATA,"^",5)="" D Q:$G(IBCTFLAG)
. S %=$$FMDIFF^XLFDT($P(DGPMA,"."),$P(LASTADM,"."))
. I %>-5,%<5 D RELINK^IBTRKRU(LASTDA,IBMVAD,$P(DGPMA,"^")),RELBULL^IBTRKRBR(DFN,LASTDA,DGPMA,+$G(VAIN(3))),WRITE("entry re-linked.") S IBCTFLAG=1
;
; random sampler, admission date must equal today (dt)
I +$G(VAIN(3)),($E(+DGPMA,1,7)=DT) S IBRANDOM=$$RANDOM^IBTRKR1(+VAIN(3))
;
N D,D0,DI,DIG,DIH,DIU,DIV,DQ,IBADMDT,IBETYP ; variables left by ibtutl
; inpatient claims tracking = all patients
; no visit date/time for inpatient events - IB*2.0*565
I $P(IBTRKR,"^",2)=2 D Q
. D ADM^IBTUTL(IBMVAD,+$E(+DGPMA,1,12),$G(IBRANDOM))
. D WRITE("entry "_$S($G(IBNEW):"added.",1:"edited."))
. I $G(IBRANDOM),$G(IBTRN) D ADMTBULL^IBTRKRBA(DFN,IBTRN,DGPMA,+$G(VAIN(3)))
;
; inpatient claims tracking = insured and ur only
I $P(IBTRKR,"^",2)=1,$S($G(IBRANDOM):1,'$$INSURED^IBCNS1(DFN,+DGPMA):0,1:$$PTCOV^IBCNSU3(DFN,+DGPMA,"INPATIENT")) D Q
. D ADM^IBTUTL(IBMVAD,+$E(+DGPMA,1,12),$G(IBRANDOM))
. D WRITE("entry "_$S($G(IBNEW):"added.",1:"edited."))
. I $G(IBRANDOM),$G(IBTRN) D ADMTBULL^IBTRKRBA(DFN,IBTRN,DGPMA,+$G(VAIN(3)))
;
; inpatient claims tracking = insured and ur only, but not insurred
; need to send off RDV in background
N IBT
I $P(IBTRKR,"^",2)=1,'$$INSURED^IBCNS1(DFN,+DGPMA),$$TFL^IBARXMU(DFN,.IBT),'$D(^IBT(356,"ARDV",DFN)) D ADM^IBCNRDV(DFN,IBMVAD,+$E(+DGPMA,1,12),$G(IBRANDOM)) D WRITE("Remote Query for insurance sent.") Q
;
;
D WRITE("no action taken.")
Q
;
;
DELADMIT ; deleted admission
N DA,FILE,IBDATE,IBTRN,SPECALTY
S IBTRN=$O(^IBT(356,"AD",+IBMVAD,0)) I IBTRN D Q
. S SPECALTY=+$P($G(^UTILITY($J,"ATS",+$P(DGPMP,"^"),+$O(^UTILITY($J,"ATS",+$P(DGPMP,"^"),0)))),"^",9)
. ; send information bulletin
. D DELBULL^IBTRKRBD(DFN,IBTRN,DGPMP,SPECALTY)
. ; clean up files pointing to 405
. F FILE=356.9,356.91,356.94 S DA=0 F S DA=$O(^IBT(FILE,"C",+IBMVAD,DA)) Q:'DA D DELETE^IBTRKRU(FILE,DA)
. S IBDATE=0 F S IBDATE=$O(^IBT(356.93,"AMVD",+IBMVAD,IBDATE)) Q:'IBDATE S DA=0 F S DA=$O(^IBT(356.93,"AMVD",+IBMVAD,IBDATE,DA)) Q:'DA D DELETE^IBTRKRU(356.93,DA)
. ; inactivate entry in ct 356
. D INACTIVE^IBTRKRU(IBTRN)
. D WRITE("entry inactivated.")
D WRITE("no action taken.")
Q
;
;
SPECIAL ; specialty change
; deleted movement
I DGPMA="" D WRITE("no action taken.") Q
;
; if specialty change is past 7 days, quit
I +DGPMA<$$FMADD^XLFDT(+DT,-7) D WRITE("no action taken.") Q
;
N IBDT,IBTSA,IBTSP,IBTRC,IBTRN,IBTRV
; treating specialty after
S IBTSA=$P($G(^DIC(42.4,+$P($G(^DIC(45.7,+$P(DGPMA,"^",9),0)),"^",2),0)),"^",3)
;
; treating specialty before
I DGPMP'="" S IBTSP=$P($G(^DIC(42.4,+$P($G(^DIC(45.7,+$P(DGPMP,"^",9),0)),"^",2),0)),"^",3)
;
I DGPMP="" D
. 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)
;
; no change in major bed section
I IBTSA=IBTSP D WRITE("no action taken.") Q
;
S IBTRN=$O(^IBT(356,"AD",+IBMVAD,0))
;
; tracked as hospital review
I $O(^IBT(356.1,"C",+IBTRN,0)) D
. I $$ALREADY(356.1,+DGPMA) Q
. D PRE^IBTUTL2($E(+DGPMA,1,7),IBTRN,30)
. I $G(IBTRV) D COMMENT^IBTRKRU(356.1,+IBTRV)
;
; tracked as insurance review
I $O(^IBT(356.2,"C",+IBTRN,0)) D
. 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) D COMMENT^IBTRKRU(356.2,+IBTRC)
;
D WRITE("completed.")
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 PURG^IBRFIHL1 ; purge RFAI file (#368) - IB*2.0*547
D PURGWL^IBRFIWLA ; purge Out of Date WLs of RFAI file (#368) - IB*2.0*547
D UPDATE^IBTRKR1 ; pdate 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRKR 6569 printed Sep 23, 2025@20:04:56 Page 2
IBTRKR ;ALB/AAS - CLAIMS TRACKER - AUTO-ENROLLER ; 4-AUG-93
+1 ;;2.0;INTEGRATED BILLING;**23,43,45,56,214,547,565**;21-MAR-94;Build 41
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
INP ; -- Inpatient Tracker
+1 ; called by ibamtd from DGPM MOVEMENT EVENTS
+2 ; add edit delete
+3 ; dgpma = after movement 0th node file 405 : data data null
+4 ; dgpmp = prior movement 0th node file 405 : null data data
+5 ; dfn = ien of patient
+6 ;
+7 NEW %,%H,%I,IBMVAD,IBMVTP,IBTRKR
+8 ;
+9 ; inpatient claims tracking turned off
+10 SET IBTRKR=$GET(^IBE(350.9,1,6))
IF '$PIECE(IBTRKR,"^",2)
QUIT
+11 ;
+12 ; movement type 1=admission, 2=transfer, 3=discharge, 6=specialty chg
+13 SET IBMVTP=$SELECT($PIECE(DGPMA,"^",2):$PIECE(DGPMA,"^",2),1:$PIECE(DGPMP,"^",2))
IF 'IBMVTP
QUIT
+14 ;
+15 ; $p(14)=admission movement ptr entry in file 405
+16 SET IBMVAD=$SELECT(DGPMA'="":$PIECE(DGPMA,"^",14),1:$PIECE(DGPMP,"^",14))
IF 'IBMVAD
QUIT
+17 ;
+18 DO WRITE("Updating claims tracking ... ",2)
+19 ;
+20 IF '$DATA(VAIN(1))
DO INP^VADPT
+21 ;
+22 ; add/edit admission
+23 IF IBMVTP=1
DO ADMIT
QUIT
+24 ;
+25 ; transfer to asih (patch 23)
+26 IF $PIECE($GET(^DGPM(+$PIECE(DGPMA,"^",15),0)),"^",2)=1
SET IBMVAD=$PIECE(DGPMA,"^",15)
DO ADMIT
QUIT
+27 ;
+28 ; specialty change
+29 IF IBMVTP=6
DO SPECIAL
QUIT
+30 ;
+31 DO WRITE("completed.")
+32 QUIT
+33 ;
+34 ;
WRITE(MSG,FF) ; write message on screen if not silent
+1 ; write 'F'orm 'F'eeds count followed by msg (optional)
+2 NEW %
+3 IF '$DATA(IB20)
IF '$GET(DGQUIET)
Begin DoDot:1
+4 FOR %=1:1:$GET(FF)
WRITE !
+5 WRITE MSG
End DoDot:1
+6 QUIT
+7 ;
+8 ;
ADMIT ; -- process admission movements
+1 ; ibmvad is admission movement pointer to file 405
+2 ; dgpma is movement entry from file 405
+3 NEW %,%H,%I,IBCTFLAG,IBNEW,IBRANDOM,IBTRN,LASTADM,LASTDA,LASTDATA
+4 ;
+5 ; this is a deleted admission from file 405, dgpma=null
+6 IF DGPMA=""
DO DELADMIT
QUIT
+7 ;
+8 ; try and relink to existing entry if already there
+9 ; find the last admission, check to make sure its inactive and there
+10 ; is not a pointer to the movement file ($p(5)). if the current
+11 ; admission date is within 5 days, update the entry.
+12 SET LASTADM=$ORDER(^IBT(356,"APTY",DFN,+$ORDER(^IBE(356.6,"AC",1,0)),9999999),-1)
+13 IF LASTADM
SET LASTDA=+$ORDER(^IBT(356,"APTY",DFN,1,LASTADM,0))
SET LASTDATA=$GET(^IBT(356,LASTDA,0))
IF $PIECE(LASTDATA,"^",20)=0
IF $PIECE(LASTDATA,"^",5)=""
Begin DoDot:1
+14 SET %=$$FMDIFF^XLFDT($PIECE(DGPMA,"."),$PIECE(LASTADM,"."))
+15 IF %>-5
IF %<5
DO RELINK^IBTRKRU(LASTDA,IBMVAD,$PIECE(DGPMA,"^"))
DO RELBULL^IBTRKRBR(DFN,LASTDA,DGPMA,+$GET(VAIN(3)))
DO WRITE("entry re-linked.")
SET IBCTFLAG=1
End DoDot:1
if $GET(IBCTFLAG)
QUIT
+16 ;
+17 ; random sampler, admission date must equal today (dt)
+18 IF +$GET(VAIN(3))
IF ($EXTRACT(+DGPMA,1,7)=DT)
SET IBRANDOM=$$RANDOM^IBTRKR1(+VAIN(3))
+19 ;
+20 ; variables left by ibtutl
NEW D,D0,DI,DIG,DIH,DIU,DIV,DQ,IBADMDT,IBETYP
+21 ; inpatient claims tracking = all patients
+22 ; no visit date/time for inpatient events - IB*2.0*565
+23 IF $PIECE(IBTRKR,"^",2)=2
Begin DoDot:1
+24 DO ADM^IBTUTL(IBMVAD,+$EXTRACT(+DGPMA,1,12),$GET(IBRANDOM))
+25 DO WRITE("entry "_$SELECT($GET(IBNEW):"added.",1:"edited."))
+26 IF $GET(IBRANDOM)
IF $GET(IBTRN)
DO ADMTBULL^IBTRKRBA(DFN,IBTRN,DGPMA,+$GET(VAIN(3)))
End DoDot:1
QUIT
+27 ;
+28 ; inpatient claims tracking = insured and ur only
+29 IF $PIECE(IBTRKR,"^",2)=1
IF $SELECT($GET(IBRANDOM):1,'$$INSURED^IBCNS1(DFN,+DGPMA):0,1:$$PTCOV^IBCNSU3(DFN,+DGPMA,"INPATIENT"))
Begin DoDot:1
+30 DO ADM^IBTUTL(IBMVAD,+$EXTRACT(+DGPMA,1,12),$GET(IBRANDOM))
+31 DO WRITE("entry "_$SELECT($GET(IBNEW):"added.",1:"edited."))
+32 IF $GET(IBRANDOM)
IF $GET(IBTRN)
DO ADMTBULL^IBTRKRBA(DFN,IBTRN,DGPMA,+$GET(VAIN(3)))
End DoDot:1
QUIT
+33 ;
+34 ; inpatient claims tracking = insured and ur only, but not insurred
+35 ; need to send off RDV in background
+36 NEW IBT
+37 IF $PIECE(IBTRKR,"^",2)=1
IF '$$INSURED^IBCNS1(DFN,+DGPMA)
IF $$TFL^IBARXMU(DFN,.IBT)
IF '$DATA(^IBT(356,"ARDV",DFN))
DO ADM^IBCNRDV(DFN,IBMVAD,+$EXTRACT(+DGPMA,1,12),$GET(IBRANDOM))
DO WRITE("Remote Query for insurance sent.")
QUIT
+38 ;
+39 ;
+40 DO WRITE("no action taken.")
+41 QUIT
+42 ;
+43 ;
DELADMIT ; deleted admission
+1 NEW DA,FILE,IBDATE,IBTRN,SPECALTY
+2 SET IBTRN=$ORDER(^IBT(356,"AD",+IBMVAD,0))
IF IBTRN
Begin DoDot:1
+3 SET SPECALTY=+$PIECE($GET(^UTILITY($JOB,"ATS",+$PIECE(DGPMP,"^"),+$ORDER(^UTILITY($JOB,"ATS",+$PIECE(DGPMP,"^"),0)))),"^",9)
+4 ; send information bulletin
+5 DO DELBULL^IBTRKRBD(DFN,IBTRN,DGPMP,SPECALTY)
+6 ; clean up files pointing to 405
+7 FOR FILE=356.9,356.91,356.94
SET DA=0
FOR
SET DA=$ORDER(^IBT(FILE,"C",+IBMVAD,DA))
if 'DA
QUIT
DO DELETE^IBTRKRU(FILE,DA)
+8 SET IBDATE=0
FOR
SET IBDATE=$ORDER(^IBT(356.93,"AMVD",+IBMVAD,IBDATE))
if 'IBDATE
QUIT
SET DA=0
FOR
SET DA=$ORDER(^IBT(356.93,"AMVD",+IBMVAD,IBDATE,DA))
if 'DA
QUIT
DO DELETE^IBTRKRU(356.93,DA)
+9 ; inactivate entry in ct 356
+10 DO INACTIVE^IBTRKRU(IBTRN)
+11 DO WRITE("entry inactivated.")
End DoDot:1
QUIT
+12 DO WRITE("no action taken.")
+13 QUIT
+14 ;
+15 ;
SPECIAL ; specialty change
+1 ; deleted movement
+2 IF DGPMA=""
DO WRITE("no action taken.")
QUIT
+3 ;
+4 ; if specialty change is past 7 days, quit
+5 IF +DGPMA<$$FMADD^XLFDT(+DT,-7)
DO WRITE("no action taken.")
QUIT
+6 ;
+7 NEW IBDT,IBTSA,IBTSP,IBTRC,IBTRN,IBTRV
+8 ; treating specialty after
+9 SET IBTSA=$PIECE($GET(^DIC(42.4,+$PIECE($GET(^DIC(45.7,+$PIECE(DGPMA,"^",9),0)),"^",2),0)),"^",3)
+10 ;
+11 ; treating specialty before
+12 IF DGPMP'=""
SET IBTSP=$PIECE($GET(^DIC(42.4,+$PIECE($GET(^DIC(45.7,+$PIECE(DGPMP,"^",9),0)),"^",2),0)),"^",3)
+13 ;
+14 IF DGPMP=""
Begin DoDot:1
+15 SET IBDT=9999999.9999999-$PIECE(DGPMA,"^")
+16 SET IBTSP=$PIECE($GET(^DIC(45.7,+$ORDER(^(+$ORDER(^DGPM("ATS",+DFN,+IBMVAD,+IBDT)),0)),0)),"^",2)
+17 SET IBTSP=$PIECE($GET(^DIC(42.4,+IBTSP,0)),"^",3)
End DoDot:1
+18 ;
+19 ; no change in major bed section
+20 IF IBTSA=IBTSP
DO WRITE("no action taken.")
QUIT
+21 ;
+22 SET IBTRN=$ORDER(^IBT(356,"AD",+IBMVAD,0))
+23 ;
+24 ; tracked as hospital review
+25 IF $ORDER(^IBT(356.1,"C",+IBTRN,0))
Begin DoDot:1
+26 IF $$ALREADY(356.1,+DGPMA)
QUIT
+27 DO PRE^IBTUTL2($EXTRACT(+DGPMA,1,7),IBTRN,30)
+28 IF $GET(IBTRV)
DO COMMENT^IBTRKRU(356.1,+IBTRV)
End DoDot:1
+29 ;
+30 ; tracked as insurance review
+31 IF $ORDER(^IBT(356.2,"C",+IBTRN,0))
Begin DoDot:1
+32 IF $$ALREADY(356.2,+DGPMA)
QUIT
+33 IF $PIECE($GET(^IBT(356,+IBTRN,0)),"^",24)
DO COM^IBTUTL3($EXTRACT(+DGPMA,1,12),IBTRN,30)
+34 IF $GET(IBTRC)
DO COMMENT^IBTRKRU(356.2,+IBTRC)
End DoDot:1
+35 ;
+36 DO WRITE("completed.")
+37 QUIT
+38 ;
+39 ;
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 ;
+7 ;
NIGHTLY ; -- nightly job for claims tracking, called by IBAMTC
+1 ;
+2 ; purge RFAI file (#368) - IB*2.0*547
DO PURG^IBRFIHL1
+3 ; purge Out of Date WLs of RFAI file (#368) - IB*2.0*547
DO PURGWL^IBRFIWLA
+4 ; pdate claims tracking site parameters (random sampler)
DO UPDATE^IBTRKR1
+5 ; add scheduled admissions to tracking
DO ^IBTRKR2
+6 ; add rx refill to outpatient encounters
DO ^IBTRKR3
+7 ; add outpatient encounters to tracking
DO ^IBTRKR4
+8 ; add outpatient prosthetics item to tracking
DO ^IBTRKR5
+9 QUIT
