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

IBTOSUM1.m

Go to the documentation of this file. 
  1. IBTOSUM1	;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ; 29-OCT-93
  1. 	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. 	;
  1. REV	; -- count reviews
  1. 	D CHK^IBTOSUM2 I $G(ZTSTOP) Q
  1. 	; -- count review for same period
  1. 	S IBDT=IBBDT-.000000001
  1. 	F  S IBDT=$O(^IBT(356.2,"B",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.24))  S IBTRC=0 F  S IBTRC=$O(^IBT(356.2,"B",IBDT,IBTRC)) Q:'IBTRC  D RCNT
  1. 	;
  1. RCNT	; -- process each review
  1. 	N IBDAY,IBETYP,IBAC,IBNOD,IBTALL,IBPEND
  1. 	S IBTRCD=$G(^IBT(356.2,+IBTRC,0))
  1. 	S IBETYP=$G(^IBE(356.11,+$P(IBTRCD,"^",4),0))
  1. 	I $P(IBETYP,"^",2)>65 Q  ;is a patient, other or an ins. verification call
  1. 	;
  1. 	I $P(IBETYP,"^",2)=60 D  Q  ; count initial appeals and quit
  1. 	.S IBCNT(81)=IBCNT(81)+1
  1. 	;
  1. 	I $P(IBETYP,"^",2)=65 D  Q  ; count subsequent appeals and quit
  1. 	.S IBCNT(82)=IBCNT(82)+1
  1. 	;
  1. 	I $P(IBTRCD,"^",19)'=10 Q  ;must be completed to included in report
  1. 	;
  1. 	S IBSPEC=$$SPEC(IBTRC)
  1. 	S IBBBS=$$BBS(+IBSPEC)
  1. 	S IBRATE=$$RATE(IBBBS,+IBTRCD)
  1. 	;
  1. 	S IBPCNT(IBTRN,+$P(^IBT(356.2,+IBTRC,1),"^",5))=""
  1. 	S IBCNT(5)=$G(IBCNT(5))+1 ;count of total reviews done
  1. 	S IBCNT(5,+IBSPEC)=$G(IBCNT(5,+IBSPEC))+1
  1. 	S IBAC=+$$ACTION(IBTRC),IBDAY=0
  1. 	;
  1. 	I IBAC=10 D
  1. 	.S IBTALL=+$P($G(^IBT(356.2,IBTRC,1)),"^",8) ;approved all days
  1. 	.S IBCDT=$$CDT^IBTODD1(IBTRN)
  1. 	.S IBMAX=$S($D(IBDCNT(IBTRN))#2:IBDCNT(IBTRN),1:$$DAY^IBTUTL3(+IBCDT,$S($P(IBCDT,"^",2):$P(IBCDT,"^",2),1:IBEDT))) ; max days approved for a visit
  1. 	.I '$D(IBDCNT(IBTRN))#2 S IBDCNT(IBTRN)=IBMAX
  1. 	.I 'IBTALL S IBDAY=$$DAY^IBTUTL3(+$P(IBTRCD,"^",12),+$P(IBTRCD,"^",13),IBTRN)
  1. 	.I IBTALL S IBDAY=$$DAY^IBTUTL3(+IBCDT,$S($P(IBCDT,"^",2):$P(IBCDT,"^",2),1:DT),IBTRN)
  1. 	.I IBDAY>IBMAX S IBDAY=IBMAX
  1. 	.S IBDCNT(IBTRN)=IBDCNT(IBTRN)-IBDAY ;count can't excede total days
  1. 	;
  1. 	I IBAC=20 D
  1. 	.S IBTALL=+$P($G(^IBT(356.2,IBTRC,1)),"^",7) ;denied all days
  1. 	.S IBCDT=$$CDT^IBTODD1(IBTRN)
  1. 	.S IBMAX=$S($D(IBDCNT(IBTRN))#2:IBDCNT(IBTRN),1:$$DAY^IBTUTL3(+IBCDT,$S($P(IBCDT,"^",2):$P(IBCDT,"^",2),1:IBEDT))) ; max days approved for a visit
  1. 	.I '$D(IBDCNT(IBTRN))#2 S IBDCNT(IBTRN)=IBMAX
  1. 	.I 'IBTALL S IBDAY=$$DAY^IBTUTL3(+$P(IBTRCD,"^",15),+$P(IBTRCD,"^",16),IBTRN)
  1. 	.I IBTALL S IBDAY=$$DAY^IBTUTL3(+IBCDT,$S($P(IBCDT,"^",2):$P(IBCDT,"^",2),1:DT),IBTRN)
  1. 	.I IBDAY>IBMAX S IBDAY=$S(IBMAX<0:0,1:IBMAX)
  1. 	.S IBDCNT(IBTRN)=IBDCNT(IBTRN)-IBDAY ;count can't excede total days
  1. 	;
  1. 	S IBCNT(IBAC)=$G(IBCNT(IBAC))+IBDAY,IBCNT(IBAC,+IBSPEC)=$G(IBCNT(IBAC,+IBSPEC))+IBDAY
  1. 	S IBCNT(IBAC+1)=$G(IBCNT(IBAC+1))+(IBDAY*IBRATE)
  1. 	S IBCNT(IBAC+1,+IBSPEC)=$G(IBCNT(IBAC+1,+IBSPEC))+(IBDAY*IBRATE)
  1. 	I IBAC=30 S IBPEN=0 F  S IBPEN=$O(^IBT(356.2,+IBTRC,13,IBPEN)) Q:'IBPEN  S IBPEND=$G(^(IBPEN,0)) D
  1. 	.S IBNOD=IBPEND+30
  1. 	.S $P(IBCNT(IBNOD),"^",1)=$P(IBCNT(IBNOD),"^",1)+1
  1. 	.S $P(IBCNT(IBNOD),"^",2)=$P(IBCNT(IBNOD),"^",2)+$P(IBPEND,"^",2)
  1. 	.S $P(IBCNT(IBNOD,+IBSPEC),"^",1)=+$G(IBCNT(IBNOD,+IBSPEC))+1
  1. 	.S $P(IBCNT(IBNOD,+IBSPEC),"^",2)=$P($G(IBCNT(IBNOD,+IBSPEC)),"^",2)+$P(IBPEND,"^",2)
  1. 	.Q
  1. 	Q
  1. 	;
  1. ACTION(IBTRC)	; -- compute action code for a review
  1. 	Q $P($G(^IBE(356.7,+$P($G(^IBT(356.2,+$G(IBTRC),0)),"^",11),0)),"^",3)
  1. 	;
  1. SPEC(IBTRC)	; -- compute treating specialty on review date
  1. 	N VAERR,VAIN,VAINDT,X,Y,I,J,DFN,IBTRN,IBCDT
  1. 	S VAINDT=+$G(^IBT(356.2,+IBTRC,0))+.2359,DFN=$P(^(0),"^",5)
  1. 	S IBTRN=$P($G(^IBT(356.2,+IBTRC,0)),"^",2),IBCDT=$$CDT^IBTODD1(IBTRN)
  1. 	I VAINDT,+IBCDT,VAINDT<(+IBCDT) S VAINDT=IBCDT+.2359
  1. 	I VAINDT,+$P(IBCDT,"^",2),VAINDT>$P(IBCDT,"^",2) S VAINDT=$P(IBCDT,"^",2)\1
  1. 	D:DFN INP^VADPT
  1. 	Q $G(VAIN(3))
  1. 	;
  1. BBS(IBSPEC)	; -- compute billing bedsection from specialty
  1. 	N X
  1. 	S X=$P($G(^DIC(42.4,+$P($G(^DIC(45.7,+$G(IBSPEC),0)),"^",2),0)),"^",5)
  1. 	I X'="" S X=$O(^DGCR(399.1,"B",X,0))
  1. 	Q X
  1. 	;
  1. RATE(IBBBS,IBDT)	; -- compute daily bed section rate for date
  1. 	N DGREV,DGBR,IBIDT,DGBRN,DGFND,IBCHK,X,IBAMT
  1. 	S IBAMT=0 I '$G(IBBBS)!('$G(IBDT)) G RATEQ
  1. 	D SETREV
  1. RATEQ	Q IBAMT
  1. 	;
  1. SETREV	; -- find current active revenue codes for bedsection
  1. 	S (IBAMT,DGREV,DGBR)=0,IBIDT=-(IBDT+.01) K DGFND
  1. 	F  S IBIDT=$O(^DGCR(399.5,"AIVDT",IBBBS,IBIDT)) Q:'IBIDT!($D(DGFND))  D
  1. 	. F  S DGREV=$O(^DGCR(399.5,"AIVDT",IBBBS,IBIDT,DGREV)) Q:'DGREV  D
  1. 	.. F  S DGBR=$O(^DGCR(399.5,"AIVDT",IBBBS,IBIDT,DGREV,DGBR)) Q:'DGBR  D CHKREV I IBCHK S IBAMT=IBAMT+X
  1. 	Q
  1. CHKREV	; -- check if billing rate (dgbr) is active and starndard.
  1. 	S IBCHK=0,X=0
  1. 	S DGBRN=^DGCR(399.5,DGBR,0) I '$P(DGBRN,"^",5) Q  ;quit if inactive
  1. 	I +$P(DGBRN,"^",7) Q  ;quit if non-standard rate
  1. 	;
  1. 	; -- use cat c rate as total for tortuously liable rates
  1. 	I $P(DGBRN,U,6)["c" S:'$D(DGFND) DGFND="" S IBCHK=1
  1. 	;
  1. 	S X=$P(^DGCR(399.5,DGBR,0),"^",4)
  1. 	Q