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

IBTOUR2.m

Go to the documentation of this file. 
  1. IBTOUR2 ;ALB/AAS - CLAIMS TRACKING UR/ACTIVITY REPORT ; 27-OCT-93
  1.  ;;Version 2.0 ; INTEGRATED BILLING ;**45**; 21-MAR-94
  1.  ;
  1. % ;
  1.  ; -- insurance: ^tmp($j,"ibtour", $s(pt. name/specialty/review date) ,pt. name,sort3,ibtrc)=^ibt(ibtrc,0)
  1.  ;               ^tmp($j,"ibtour0,ibtrn)=ibtrn (case list)
  1.  ;               ^tmp($j,"ibtour1",specialty)=days approved ^ days denied ^ $approved ^ $denied
  1.  ;
  1.  ; -- hospital: ^tmp($j,"ibtour3",$s...
  1.  ;              ^tmp($j,"ibtour2",specialty)= adm. met ^ adm not met ^ days met ^ days not met
  1.  ;              ^tmp($j,"ibtour4",ibtrn)=ibtrn (case list)
  1.  ;
  1.  ;
  1. IREV ; -- count and sort reviews
  1.  N IBDT,J
  1.  S IBDT=IBBDT-.00001
  1.  F  S IBDT=$O(^IBT(356.2,"B",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.9))!(IBQUIT)  D
  1.  .S IBTRC=0 F  S IBTRC=$O(^IBT(356.2,"B",IBDT,IBTRC)) Q:'IBTRC!(IBQUIT)  D
  1.  ..S IBTRCD=$G(^IBT(356.2,+IBTRC,0)) Q:IBTRCD=""
  1.  ..S IBTRN=$P(IBTRCD,"^",2)
  1.  ..Q:$P(IBTRCD,"^",19)<10
  1.  ..D SET
  1.  Q
  1.  ;
  1. SET ; -- set utility array
  1.  Q:'$G(IBTRN)
  1.  N DFN,SORT1,SORT2,SORT3,IBSPEC,IBBBS,RATE,IBAC,IBDAY,IBDA,IBDD,IBCDT
  1.  S DFN=+$P(IBTRCD,"^",5) Q:'DFN
  1.  ;
  1.  S IBSPEC=$$SPEC^IBTOSUM1(IBTRC)
  1.  S IBBBS=$$BBS^IBTOSUM1(+IBSPEC)
  1.  S RATE=$$RATE^IBTOSUM1(IBBBS,+IBTRCD)
  1.  S IBAC=$$ACTION^IBTOSUM1(IBTRC)
  1.  S IBSPEC=$P(IBSPEC,"^",2) S:IBSPEC="" IBSPEC="Unknown"
  1.  ;
  1.  I $P(^IBT(356,+$P(IBTRCD,"^",2),0),"^",4) S IBSPEC="OUTPATIENT VISIT",RATE=178
  1.  ;
  1.  I $P(^IBT(356,+$P(IBTRCD,"^",2),0),"^",8) S IBSPEC="PRESCRIPTION",RATE=20
  1.  I $P(^IBT(356,+$P(IBTRCD,"^",2),0),"^",9) S IBSPEC="PROSTHETICS",RATE=0
  1.  ;
  1.  S SORT3=$P($G(^DPT(DFN,0)),"^")
  1.  I IBHOW="P" S (SORT1,SORT2)=SORT3
  1.  I IBHOW="S" S SORT1=IBSPEC,SORT2=SORT3
  1.  I IBHOW="R" S SORT1=$P($G(^VA(200,+$P($G(^IBT(356.2,+IBTRC,1)),"^",4),0)),"^"),SORT2=$P($G(^IBE(356.11,+$P(IBTRCD,"^",4),0)),"^")
  1.  S:SORT1="" SORT1="Unknown"
  1.  S:SORT2="" SORT2="Unknown"
  1.  S:SORT3="" SORT2="Unknown"
  1.  S ^TMP($J,"IBTOUR",SORT1,SORT2,SORT3,IBTRC)=IBTRCD
  1.  ;
  1.  S IBDAY=""
  1.  ;I $P(^IBT(356,IBTRN,0),"^",5),$P(^IBT(356.2,+IBTRC,1),"^",7) S IBCDT=$$CDT^IBTODD1(IBTRN),IBDAY=$$DAY^IBTUTL3(+IBCDT,$S(+$P(IBCDT,"^",2):$P(IBCDT,"^",2),1:DT),IBTRN)
  1.  ; -- replace the above line with the following line to add in admissions
  1.  ;    approved for the entire stay to report
  1.  I $P(^IBT(356,IBTRN,0),"^",5),($P(^IBT(356.2,+IBTRC,1),"^",7)!($P(^(1),"^",8))) S IBCDT=$$CDT^IBTODD1(IBTRN),IBDAY=$$DAY^IBTUTL3(+IBCDT,$S(+$P(IBCDT,"^",2):$P(IBCDT,"^",2),1:DT),IBTRN)
  1.  ;
  1.  I IBAC=10,'IBDAY S IBDAY=$$DAY^IBTUTL3(+$P(IBTRCD,"^",12),+$P(IBTRCD,"^",13),IBTRN)
  1.  I IBAC=20,'IBDAY S IBDAY=$$DAY^IBTUTL3(+$P(IBTRCD,"^",15),+$P(IBTRCD,"^",16),IBTRN)
  1.  I 'IBDAY,$P(^IBT(356,IBTRN,0),"^",4) S IBDAY=1 ;opt encounter =1 day
  1.  S IBDA=$S(IBAC=10:IBDAY,1:0)
  1.  S IBDD=$S(IBAC=20:IBDAY,1:0)
  1.  S ^TMP($J,"IBTOUR0",+IBTRN)=IBTRN
  1.  ;
  1.  I $P(^IBT(356,+IBTRN,0),"^",5),IBSPEC'="Unknown" D
  1.  .I '$D(^TMP($J,"IBTOUR1",IBSPEC)) S ^TMP($J,"IBTOUR1",IBSPEC)="0^0^0^0^"
  1.  .S X=$G(^TMP($J,"IBTOUR1",IBSPEC))
  1.  .S ^TMP($J,"IBTOUR1",IBSPEC)=($P(X,"^")+IBDA)_"^"_($P(X,"^",2)+IBDD)_"^"_($P(X,"^",3)+(IBDA*RATE))_"^"_($P(X,"^",4)+(IBDD*RATE))
  1.  Q
  1.  ;
  1. HREV ; -- count and sort reviews
  1.  N IBDT,J
  1.  S IBDT=IBBDT-.00001
  1.  F  S IBDT=$O(^IBT(356.1,"B",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.9))!(IBQUIT)  D
  1.  .S IBTRV=0 F  S IBTRV=$O(^IBT(356.1,"B",IBDT,IBTRV)) Q:'IBTRV!(IBQUIT)  D
  1.  ..S IBTRVD=$G(^IBT(356.1,+IBTRV,0)) Q:IBTRVD=""
  1.  ..S IBTRN=$P(IBTRVD,"^",2)
  1.  ..I $P(IBTRVD,"^",21)=10 D HSET
  1.  Q
  1.  ;
  1. HSET ; -- set up review cases
  1.  S ^TMP($J,"IBTOUR4",IBTRN)=IBTRN
  1.  Q
  1.  ;
  1. HSET1 ; -- build by specialy report for hosp. reviews.
  1.  I $G(IBSPEC)="" D
  1.  .N VAIN,DFN
  1.  .S DFN=$P(^IBT(356,IBTRN,0),"^",2)
  1.  .S VAINDT=$P(^IBT(356,IBTRN,0),"^",6)\1+.2359 D INP^VADPT S IBSPEC=$P(VAIN(3),"^",2)
  1.  .I $G(IBSPEC)="" S IBSPEC="Unknown"
  1.  I '$D(^TMP($J,"IBTOUR2",IBSPEC)) S ^TMP($J,"IBTOUR2",IBSPEC)="0^0^0^0^"
  1.  S X=$G(^TMP($J,"IBTOUR2",IBSPEC))
  1.  S ^TMP($J,"IBTOUR2",IBSPEC)=($P(X,"^")+IBP1)_"^"_($P(X,"^",2)+IBP2)_"^"_($P(X,"^",3)+IBP3)_"^"_($P(X,"^",4)+IBP4)
  1.  Q
  1.  ;
  1. HSET2 ; -- set utility array
  1.  N DFN,SORT1,SORT2,SORT3
  1.  S DFN=+$P(IBTRND,"^",2) Q:'DFN
  1.  ;
  1.  S SORT3=$P($G(^DPT(DFN,0)),"^")
  1.  I IBHOW="P" S (SORT1,SORT2)=SORT3
  1.  I IBHOW="S" S SORT1=IBSPEC,SORT2=SORT3
  1.  I IBHOW="R" S SORT1=$P($G(^VA(200,+$P($G(^IBT(356,+IBTRN,1)),"^",5),0)),"^"),SORT2=$P($G(^IBE(356.11,+$P(IBTRVD,"^",22),0)),"^")
  1.  S:SORT1="" SORT1="Unknown"
  1.  S:SORT2="" SORT2="Unknown"
  1.  S:SORT3="" SORT2="Unknown"
  1.  ;
  1.  S ^TMP($J,"IBTOUR3",SORT1,SORT2,SORT3,IBTRN)=IBADM_"^"_IBDAYS_"^"_IBDAYN
  1.  Q