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

IBTUTL.m

Go to the documentation of this file.
  1. IBTUTL ;ALB/AAS - CLAIMS TRACKING UTILITY ROUTINE ;21-JUN-93
  1. ;;2.0;INTEGRATED BILLING;**23,62,517**;21-MAR-94;Build 240
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ADM(DGPMCA,VAINDT,RANDOM,IBVSIT) ; -- set up info for adding a current admission
  1. ; -- Input DGPMCA = pointer for an admission to patient movement file
  1. ; VAINDT = optional date for admission (default is dt)
  1. ; RANDOM = whether or not this is a random sample
  1. ; IBVSIT = Pointer to visit file (optional)
  1. ;
  1. N DA,DIC,DIE,DR,X,VAIN,VA,IBSCHED,IBSCH,HCSRIEN
  1. I '$G(VAINDT) K VAINDT
  1. I '$G(DGPMCA) S VA200="" D INP^VADPT S DGPMCA=VAIN(1)
  1. Q:DGPMCA=""
  1. S RANDOM=$S($G(RANDOM):1,1:0)
  1. S X=$O(^IBT(356,"ADM",DFN,DGPMCA,0)) I X S IBTRN=X G ADMQ
  1. S IBADMDT=$P(^DGPM(DGPMCA,0),"^")
  1. ;S IBETYP=+$O(^IBE(356.6,"B","INPATIENT ADMISSION",0))
  1. S IBETYP=+$O(^IBE(356.6,"AC",1,0))
  1. S (IBSCH,IBTRN)=$O(^IBT(356,"ASCH",+$$SCH^IBTRKR2(DGPMCA),0))
  1. D:'IBTRN ADDT
  1. I IBTRN<1 G ADMQ
  1. S DA=IBTRN,DIE="^IBT(356,"
  1. L +^IBT(356,+IBTRN):10 I '$T G ADMQ
  1. S DR=$$ADMDR(IBADMDT,IBETYP,DGPMCA,RANDOM)
  1. D ^DIE K DA,DR,DIE
  1. I $P($G(^IBT(356,IBTRN,0)),"^",32) S DA=IBTRN,DR=".32///@",DIE="^IBT(356," D ^DIE K DA,DR,DIE
  1. L -^IBT(356,+IBTRN)
  1. I "^1^5^"[(U_IBETYP_U) S HCSRIEN=+$$FNDHCSR(DFN,IBADMDT) D:HCSRIEN HCSRCPY(HCSRIEN,IBTRN,DFN,IBADMDT)
  1. ;
  1. S IBSCHED=$S($P(^DGPM(DGPMCA,0),U,25):10,1:20)
  1. ;
  1. ; -- if random sample add hospital review
  1. I $P(^IBT(356,IBTRN,0),U,25) D PRE^IBTUTL2(DT,IBTRN,IBSCHED)
  1. ;
  1. ; -- if scheduled admission entry converted to admission, don't add
  1. ; second insurance review
  1. I $G(IBSCH) G ADMQ
  1. ;
  1. ; -- if insured add ins review
  1. I $P(^IBT(356,IBTRN,0),U,24) D COM^IBTUTL3(DT,IBTRN,IBSCHED,$G(IBTRV))
  1. ;
  1. ADMQ Q
  1. ;
  1. ADDT ; -- add new entry to tracking, ibt(356
  1. ;
  1. N %DT,DD,DO,DIC,DR,DIE,DLAYGO,IBTR1,DINUM
  1. L +^IBT(356,0):0 ;I '$T S Y="-1^IB085" G ADDTQ
  1. ;I $G(^IBT(356,0))="" S Y="-1^IB086" G ADDTQ
  1. S X=$P($G(^IBT(356,0)),"^",3)+1 L -^IBT(356,0)
  1. S DIC="^IBT(356,",DIC(0)="L",DLAYGO=356
  1. 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
  1. L -^IBT(356,IBTR1)
  1. I +Y<1 S Y="-1^IB087"
  1. ADDTQ ;I +Y<0 D ^IBTERR
  1. S IBTRN=+Y,IBNEW=1
  1. Q
  1. ;
  1. OTH(DFN,IBETYP,IBTDT) ; -- add miscellaneous entries, care may not be in data base
  1. ; -- input dfn := patient pointer to 2
  1. ; ibetyp := pointer to type entry in 356.6
  1. ; ibtdt := episode date
  1. ;
  1. N X,Y,DA,DR,DIE,DIC
  1. S X=$O(^IBT(356,"APTY",DFN,IBETYP,IBTDT,0)) I X S IBTRN=X G OTHQ
  1. D ADDT
  1. I IBTRN<1 G OTHQ
  1. S DA=IBTRN,DIE="^IBT(356,"
  1. 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)
  1. L +^IBT(356,+IBTRN):10 I '$T G OTHQ
  1. D ^DIE K DA,DR,DIE
  1. L -^IBT(356,+IBTRN)
  1. OTHQ Q
  1. ;
  1. IBSITE() ; -- calculate site from site parameters
  1. ; -- output ibsite = station number
  1. ;
  1. N IBFAC,IBSITE
  1. D SITE^IBAUTL
  1. Q IBSITE
  1. ;
  1. ADMDR(IBADMDT,IBETYP,DGPMCA,RANDOM) ; -- set up dr string for admissions
  1. S DR=""
  1. I '$G(IBETYP)!'$G(IBADMDT) G ADMDRQ
  1. 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
  1. .I $G(DGPMCA),$G(RANDOM) S DR=DR_";.25////1" Q
  1. ADMDRQ Q DR
  1. ;
  1. EABD(IBETYP,IBTDT) ; -- compute earliest auto bill date: date entered plus days delay for event type
  1. ; -- input IBETYPE = pointer to type of entry file
  1. ; IBTDT = episode date, if not passed in uses DT
  1. ;
  1. N X,X1,X2,Y,IBETYPD S Y="" I '$G(IBETYP) G EABDQ
  1. S IBETYPD=$G(^IBE(356.6,+IBETYP,0)) I '$G(IBTDT) S IBTDT=DT
  1. I '$P(IBETYPD,"^",4) G EABDQ ; automated billing turned off
  1. S X2=+$P(IBETYPD,"^",6) ;set earliest autobill date to entered date plus days delay
  1. S X1=IBTDT D C^%DTC S Y=X\1
  1. EABDQ Q Y
  1. ;
  1. BILL(IBTRN) ;check if event is billable, return EABD if it is
  1. N X,Y,Z,IBTRND S (X,Y)="" S IBTRND=$G(^IBT(356,+$G(IBTRN),0)) I IBTRND="" G BILLQ
  1. ;
  1. ; -- billed and bill not cancelled and not inpt interim first or continuous
  1. I +$P(IBTRND,U,11) S Z=$$BILLED^IBCU8(IBTRN),Y=$P(Z,U,2) I +Z,'Y G BILLQ
  1. ;
  1. ; -- special type (not riem. ins), not billable, inactive
  1. I +$P(IBTRND,U,12)!(+$P(IBTRND,U,19))!('$P(IBTRND,U,20)) G BILLQ
  1. I 'Y S Y=+$G(^IBT(356,+$G(IBTRN),1)) I 'Y S Y=DT
  1. S X=$$EABD(+$P(IBTRND,U,18),Y)
  1. BILLQ Q X
  1. ;
  1. STOBIL Q
  1. KTOBIL Q
  1. ;
  1. FNDHCSR(DFN,IBADMDT) ; find matching HCSR response in file 356.22
  1. ; DFN - file 2 ien
  1. ; IBADMDT - event date
  1. ;
  1. ; returns file 356.22 ien of matching response or null if no match found
  1. ;
  1. N EVDT,HCSRIEN,RES,STOPFLG
  1. S RES=""
  1. I +$G(DFN)>0,+$G(IBADMDT)>0 D
  1. .; loop through D-xref (by patient and event date)
  1. .S STOPFLG=0,EVDT="" F S EVDT=$O(^IBT(356.22,"D",DFN,EVDT)) Q:EVDT=""!STOPFLG D
  1. ..; if match found, loop through entries for that patient and event date
  1. ..I $P(EVDT,"-")=IBADMDT S HCSRIEN=0 F S HCSRIEN=$O(^IBT(356.22,"D",DFN,EVDT,HCSRIEN)) Q:'HCSRIEN!STOPFLG D
  1. ...; check if this entry is a response
  1. ...I $$GET1^DIQ(356.22,HCSRIEN_",",.13,"I") S RES=HCSRIEN,STOPFLG=1
  1. ...Q
  1. ..Q
  1. .Q
  1. Q RES
  1. ;
  1. HCSRCPY(HCSRIEN,IBTRN,DFN,EVNTDT) ; copy ref. # and auth. # from file 356.22 into file 356.2
  1. ; HCSRIEN - file 356.22 ien
  1. ; IBTRN - file 356 ien
  1. ; DFN - file 2 ien
  1. ; EVNTDT - event date from 356.22/.07
  1. ;
  1. N CERT,FDA,FLD,HCSRIENS,IENS,IIEN,IMIEN,IRIEN,IRIENS,NUM
  1. I +$G(HCSRIEN)>0,+$G(IBTRN)>0 D
  1. .S HCSRIENS=HCSRIEN_","
  1. .S CERT=$$GET1^DIQ(356.22,HCSRIENS,103.01)
  1. .S NUM=$$GET1^DIQ(356.22,HCSRIENS,103.02,"I")
  1. .S IMIEN=$$GET1^DIQ(356.22,HCSRIENS,.03) ;Insurance Multiple IEN
  1. .S IENS=IMIEN_","_DFN_"," ;
  1. .S IIEN=$$GET1^DIQ(2.312,IENS,.01,"I") ; Insurance Company IEN
  1. .S FLD=2.01 ; default to ref. #, goes into 356.2/2.01
  1. .I "^A1^A2^A6^"[(U_CERT_U) S FLD=2.02 ; it's an auth. #, goes into 356.2/2.02
  1. .;
  1. .;If there are no entries in 356.2 and it's outpatient, add an entry to 356.2
  1. .I '$D(^IBT(356.2,"C",IBTRN)),$P($G(^IBT(356.22,RESIEN,0)),U,4)'="I" D ADD(EVNTDT,IBTRN,DFN,NUM,FLD,IIEN) Q
  1. .;
  1. .; find appropriate entries in file 356.2
  1. .S IRIEN=0 F S IRIEN=$O(^IBT(356.2,"C",IBTRN,IRIEN)) Q:'IRIEN D
  1. ..S IRIENS=IRIEN_","
  1. ..Q:IIEN'=$$GET1^DIQ(356.2,IRIENS,.08,"I") ; don't set if it's not the correct insurance company
  1. ..S:$P($G(^IBT(356.2,IRIEN,2)),U,$S(FLD=2.02:2,1:1))="" FDA(356.2,IRIENS,FLD)=NUM
  1. ..D FILE^DIE(,"FDA") K FDA
  1. ..Q
  1. .Q
  1. Q
  1. ;
  1. ; add an entry to 365.2
  1. ; for outpatient if there isn't one already
  1. ADD(EVNTDT,IBTRN,DFN,NUM,FLD,IIEN) ; -- add initial entry
  1. ; EVNTDT - EVNTDT (in internal fileman format)
  1. ; IBTRN - file 356 ien
  1. ; DFN - file 2 ien
  1. ; NUM - authorization or referral number
  1. ; FLD - field to file it it.
  1. ; IIEN - Insurance Company IEN
  1. ;
  1. N FDA,HIP,IBDD,IBNXRV,IBTOC,ORDER,STOP
  1. I $G(NUM)]"",$G(FLD)]"",+$G(IIEN) D
  1. .;
  1. .D ALL^IBCNS1(DFN,"IBDD",1,EVNTDT,1) ; return active insurances in COB order
  1. .Q:'$G(IBDD(0)) ; no active insurance on that date
  1. .;
  1. .; get first insurance company that matches
  1. .S ORDER=0 F S ORDER=$O(IBDD("S",ORDER)) Q:'ORDER D Q:HIP
  1. ..S HIP=0 F S HIP=$O(IBDD("S",ORDER,HIP)) Q:'HIP Q:+$G(IBDD(HIP,0))=IIEN
  1. .Q:'$G(HIP) ; stop if none match
  1. .;
  1. .S FDA(356.2,"+1,",.01)=EVNTDT
  1. .;
  1. .;Pointer to claims tracking
  1. .S FDA(356.2,"+1,",.02)=IBTRN
  1. .S FDA(356.2,"+1,",.19)=1
  1. .;
  1. .;Type of Contact
  1. .S IBTOC=$$FIND1^DIC(356.11,,"C","OUTPATIENT TREATMENT")
  1. .S FDA(356.2,"+1,",.04)=IBTOC
  1. .;
  1. .;Patient
  1. .S FDA(356.2,"+1,",.05)=DFN
  1. .;
  1. .; Health Insurance Policy
  1. .S FDA(356.2,"+1,",1.05)=HIP
  1. .;
  1. .;File referal or authorization
  1. .S FDA(356.2,"+1,",FLD)=NUM
  1. .;
  1. .; Next Review
  1. .S IBNXRV=DT
  1. .I EVNTDT>$$FMADD^XLFDT(DT,7) S IBNXRV=$$FMADD^XLFDT(EVNTDT,-7)
  1. .S FDA(356.2,"+1,",.24)=IBNXRV
  1. .;
  1. .;Last Edit Date/By
  1. .D NOW^%DTC
  1. .S FDA(356.2,"+1,",1.01)=%
  1. .S FDA(356.2,"+1,",1.02)=DUZ
  1. .;
  1. .D UPDATE^DIE(,"FDA") K FDA
  1. Q