Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBTRKR

IBTRKR.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1. INP ; -- Inpatient Tracker
  1.  ;    called by ibamtd  from DGPM MOVEMENT EVENTS
  1.  ;                                               add   edit   delete
  1.  ;  dgpma = after movement 0th node file 405  : data   data   null
  1.  ;  dgpmp = prior movement 0th node file 405  : null   data   data
  1.  ;  dfn   = ien of patient
  1.  ;  
  1.  N %,%H,%I,IBMVAD,IBMVTP,IBTRKR
  1.  ;
  1.  ;  inpatient claims tracking turned off
  1.  S IBTRKR=$G(^IBE(350.9,1,6)) I '$P(IBTRKR,"^",2) Q
  1.  ;
  1.  ;  movement type 1=admission, 2=transfer, 3=discharge, 6=specialty chg
  1.  S IBMVTP=$S($P(DGPMA,"^",2):$P(DGPMA,"^",2),1:$P(DGPMP,"^",2)) I 'IBMVTP Q
  1.  ;
  1.  ;  $p(14)=admission movement ptr entry in file 405
  1.  S IBMVAD=$S(DGPMA'="":$P(DGPMA,"^",14),1:$P(DGPMP,"^",14)) I 'IBMVAD Q
  1.  ;
  1.  D WRITE("Updating claims tracking ... ",2)
  1.  ;
  1.  I '$D(VAIN(1)) D INP^VADPT
  1.  ;
  1.  ;  add/edit admission
  1.  I IBMVTP=1 D ADMIT Q
  1.  ;
  1.  ;  transfer to asih (patch 23)
  1.  I $P($G(^DGPM(+$P(DGPMA,"^",15),0)),"^",2)=1 S IBMVAD=$P(DGPMA,"^",15) D ADMIT Q
  1.  ;
  1.  ;  specialty change
  1.  I IBMVTP=6 D SPECIAL Q
  1.  ;
  1.  D WRITE("completed.")
  1.  Q
  1.  ;
  1.  ;
  1. WRITE(MSG,FF)         ;  write message on screen if not silent
  1.  ;  write 'F'orm 'F'eeds count followed by msg (optional)
  1.  N %
  1.  I '$D(IB20),'$G(DGQUIET) D
  1.  .   F %=1:1:$G(FF) W !
  1.  .   W MSG
  1.  Q
  1.  ;
  1.  ;
  1. ADMIT ; -- process admission movements
  1.  ;  ibmvad is admission movement pointer to file 405
  1.  ;  dgpma  is movement entry from file 405
  1.  N %,%H,%I,IBCTFLAG,IBNEW,IBRANDOM,IBTRN,LASTADM,LASTDA,LASTDATA
  1.  ;
  1.  ;  this is a deleted admission from file 405, dgpma=null
  1.  I DGPMA="" D DELADMIT Q
  1.  ;
  1.  ;  try and relink to existing entry if already there
  1.  ;  find the last admission, check to make sure its inactive and there
  1.  ;  is not a pointer to the movement file ($p(5)).  if the current
  1.  ;  admission date is within 5 days, update the entry.
  1.  S LASTADM=$O(^IBT(356,"APTY",DFN,+$O(^IBE(356.6,"AC",1,0)),9999999),-1)
  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)
  1.  .   S %=$$FMDIFF^XLFDT($P(DGPMA,"."),$P(LASTADM,"."))
  1.  .   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
  1.  ;
  1.  ;  random sampler, admission date must equal today (dt)
  1.  I +$G(VAIN(3)),($E(+DGPMA,1,7)=DT) S IBRANDOM=$$RANDOM^IBTRKR1(+VAIN(3))
  1.  ;
  1.  N D,D0,DI,DIG,DIH,DIU,DIV,DQ,IBADMDT,IBETYP  ; variables left by ibtutl
  1.  ;  inpatient claims tracking = all patients
  1.  ;  no visit date/time for inpatient events - IB*2.0*565
  1.  I $P(IBTRKR,"^",2)=2 D  Q
  1.  .   D ADM^IBTUTL(IBMVAD,+$E(+DGPMA,1,12),$G(IBRANDOM))
  1.  .   D WRITE("entry "_$S($G(IBNEW):"added.",1:"edited."))
  1.  .   I $G(IBRANDOM),$G(IBTRN) D ADMTBULL^IBTRKRBA(DFN,IBTRN,DGPMA,+$G(VAIN(3)))
  1.  ;
  1.  ;  inpatient claims tracking = insured and ur only
  1.  I $P(IBTRKR,"^",2)=1,$S($G(IBRANDOM):1,'$$INSURED^IBCNS1(DFN,+DGPMA):0,1:$$PTCOV^IBCNSU3(DFN,+DGPMA,"INPATIENT")) D  Q
  1.  .   D ADM^IBTUTL(IBMVAD,+$E(+DGPMA,1,12),$G(IBRANDOM))
  1.  .   D WRITE("entry "_$S($G(IBNEW):"added.",1:"edited."))
  1.  .   I $G(IBRANDOM),$G(IBTRN) D ADMTBULL^IBTRKRBA(DFN,IBTRN,DGPMA,+$G(VAIN(3)))
  1.  ;
  1.  ;  inpatient claims tracking = insured and ur only, but not insurred
  1.  ;  need to send off RDV in background
  1.  N IBT
  1.  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
  1.  ;
  1.  ;
  1.  D WRITE("no action taken.")
  1.  Q
  1.  ;
  1.  ;
  1. DELADMIT ;  deleted admission
  1.  N DA,FILE,IBDATE,IBTRN,SPECALTY
  1.  S IBTRN=$O(^IBT(356,"AD",+IBMVAD,0)) I IBTRN D  Q
  1.  .   S SPECALTY=+$P($G(^UTILITY($J,"ATS",+$P(DGPMP,"^"),+$O(^UTILITY($J,"ATS",+$P(DGPMP,"^"),0)))),"^",9)
  1.  .   ;  send information bulletin
  1.  .   D DELBULL^IBTRKRBD(DFN,IBTRN,DGPMP,SPECALTY)
  1.  .   ;  clean up files pointing to 405
  1.  .   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)
  1.  .   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)
  1.  .   ;  inactivate entry in ct 356
  1.  .   D INACTIVE^IBTRKRU(IBTRN)
  1.  .   D WRITE("entry inactivated.")
  1.  D WRITE("no action taken.")
  1.  Q
  1.  ;
  1.  ;
  1. SPECIAL ;  specialty change
  1.  ;  deleted movement
  1.  I DGPMA="" D WRITE("no action taken.") Q
  1.  ;
  1.  ;  if specialty change is past 7 days, quit
  1.  I +DGPMA<$$FMADD^XLFDT(+DT,-7) D WRITE("no action taken.") Q
  1.  ;
  1.  N IBDT,IBTSA,IBTSP,IBTRC,IBTRN,IBTRV
  1.  ;  treating specialty after
  1.  S IBTSA=$P($G(^DIC(42.4,+$P($G(^DIC(45.7,+$P(DGPMA,"^",9),0)),"^",2),0)),"^",3)
  1.  ;
  1.  ;  treating specialty before
  1.  I DGPMP'="" S IBTSP=$P($G(^DIC(42.4,+$P($G(^DIC(45.7,+$P(DGPMP,"^",9),0)),"^",2),0)),"^",3)
  1.  ;
  1.  I DGPMP="" D
  1.  .   S IBDT=9999999.9999999-$P(DGPMA,"^")
  1.  .   S IBTSP=$P($G(^DIC(45.7,+$O(^(+$O(^DGPM("ATS",+DFN,+IBMVAD,+IBDT)),0)),0)),"^",2)
  1.  .   S IBTSP=$P($G(^DIC(42.4,+IBTSP,0)),"^",3)
  1.  ;
  1.  ;  no change in major bed section
  1.  I IBTSA=IBTSP D WRITE("no action taken.") Q
  1.  ;
  1.  S IBTRN=$O(^IBT(356,"AD",+IBMVAD,0))
  1.  ;
  1.  ;  tracked as hospital review
  1.  I $O(^IBT(356.1,"C",+IBTRN,0)) D
  1.  .   I $$ALREADY(356.1,+DGPMA) Q
  1.  .   D PRE^IBTUTL2($E(+DGPMA,1,7),IBTRN,30)
  1.  .   I $G(IBTRV) D COMMENT^IBTRKRU(356.1,+IBTRV)
  1.  ;
  1.  ;  tracked as insurance review
  1.  I $O(^IBT(356.2,"C",+IBTRN,0)) D
  1.  .   I $$ALREADY(356.2,+DGPMA) Q
  1.  .   I $P($G(^IBT(356,+IBTRN,0)),"^",24) D COM^IBTUTL3($E(+DGPMA,1,12),IBTRN,30)
  1.  .   I $G(IBTRC) D COMMENT^IBTRKRU(356.2,+IBTRC)
  1.  ;
  1.  D WRITE("completed.")
  1.  Q
  1.  ;
  1.  ;
  1. ALREADY(FILE,DATE) ; -- see if already is review for date
  1.  N X,Y,IBX
  1.  S IBX=0
  1.  S X=$P(DATE,".")+.25
  1.  S Y=$O(^IBT(FILE,"ATIDT",+IBTRN,-X)) S Y=-Y I Y,$P(Y,".")=$P(DATE,".") S IBX=1
  1.  Q IBX
  1.  ;
  1.  ;
  1. NIGHTLY ; -- nightly job for claims tracking, called by IBAMTC
  1.  ;
  1.  D PURG^IBRFIHL1  ; purge RFAI file (#368) - IB*2.0*547
  1.  D PURGWL^IBRFIWLA  ; purge Out of Date WLs of RFAI file (#368) - IB*2.0*547
  1.  D UPDATE^IBTRKR1 ; pdate claims tracking site parameters (random sampler)
  1.  D ^IBTRKR2 ;       add scheduled admissions to tracking
  1.  D ^IBTRKR3 ;       add rx refill to outpatient encounters
  1.  D ^IBTRKR4 ;       add outpatient encounters to tracking
  1.  D ^IBTRKR5 ;       add outpatient prosthetics item to tracking
  1.  Q