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

IBTRKR2.m

Go to the documentation of this file.
  1. IBTRKR2 ;ALB/AAS - ADD/TRACK SCHEDULED ADMISSION ;9-AUG-93
  1. ;;2.0;INTEGRATED BILLING;**43,62,214,312**;21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. % ;
  1. EN ; -- add scheduled admissions to claims tracking file
  1. N I,J,X,Y,IBTRKR,IBI,IBJ,DFN,IBDATA
  1. N IBSWINFO S IBSWINFO=$$SWSTAT^IBBAPI() ;IB*2.0*312
  1. S IBTRKR=$G(^IBE(350.9,1,6))
  1. G:'$P(IBTRKR,"^",2) ENQ ; inpatient tracking off
  1. S:'$G(IBTSBDT) IBTSBDT=$$FMADD^XLFDT(DT,-3)-.1
  1. S:'$G(IBTSEDT) IBTSEDT=$$FMADD^XLFDT(DT,7)+.9
  1. I IBTSBDT<+IBTRKR S IBTSBDT=+IBTRKR-.1 ; start date can't be before ct start date
  1. S IBI=IBTSBDT-.0001
  1. F S IBI=$O(^DGS(41.1,"C",IBI)) Q:'IBI!(IBI>IBTSEDT) S IBJ="" F S IBJ=$O(^DGS(41.1,"C",IBI,IBJ)) Q:'IBJ D
  1. .;
  1. .;Do NOT PROCESS on VistA if IBI/Sched DT>=Switch Eff Dt ;CCR-930
  1. .I +IBSWINFO,(IBI+1)>$P(IBSWINFO,"^",2) Q ;IB*2.0*312
  1. .;
  1. .S IBDATA=$G(^DGS(41.1,IBJ,0))
  1. .S DFN=+IBDATA
  1. .Q:'DFN ; no patient
  1. .Q:$P(IBDATA,"^",17) ; already admitted
  1. .;
  1. .S IBTRN=$O(^IBT(356,"ASCH",IBJ,0))
  1. .I $P(IBDATA,"^",13) D:IBTRN INACTIVE^IBTRKRU(IBTRN) Q ; canceled
  1. .;
  1. .; - if not in ct add
  1. .I 'IBTRN D Q
  1. ..I $P(IBTRKR,"^",2)=2 D SCH^IBTUTL2(DFN,IBI,IBJ) Q
  1. ..I $P(IBTRKR,"^",2)=1,$S('$$INSURED^IBCNS1(DFN,+IBI):0,1:$$PTCOV^IBCNSU3(DFN,+IBI,"INPATIENT")) D SCH^IBTUTL2(DFN,IBI,IBJ) Q
  1. ..D TRKR^IBCNRDV(DFN,IBI,IBJ,$P(IBDATA,"^",11))
  1. ..Q
  1. .;
  1. .; - if inactive re-activate
  1. .I '$P(^IBT(356,+IBTRN,0),"^",20) D
  1. ..N X,Y,I,J,DA,DR,DIE,DIC
  1. ..S DA=IBTRN,DR=".2////1",DIE="^IBT(356," D ^DIE
  1. .Q
  1. ;
  1. ENQ K IBTSEDT,IBTSBDT
  1. ; add cleanup of ARDV
  1. S X=0 F S X=$O(^IBT(356,"ARDV",X)) Q:X<1 S Y=0 F S Y=$O(^IBT(356,"ARDV",X,Y)) Q:Y<1 I Y<DT K ^IBT(356,"ARDV",X,Y)
  1. Q
  1. ;
  1. SCH(DGPMCA) ; -- is this admission movement a scheduled admission
  1. ; -- output scheduled admission pointer
  1. ;
  1. N IBTSA S IBTSA=0
  1. I '$G(DGPMCA) G SCHQ
  1. S IBTSA=+$O(^DGS(41.1,"AMVT",DGPMCA,0))
  1. SCHQ Q IBTSA