IBTOUR2 ;ALB/AAS - CLAIMS TRACKING UR/ACTIVITY REPORT ; 27-OCT-93
;;Version 2.0 ; INTEGRATED BILLING ;**45**; 21-MAR-94
;
% ;
; -- insurance: ^tmp($j,"ibtour", $s(pt. name/specialty/review date) ,pt. name,sort3,ibtrc)=^ibt(ibtrc,0)
; ^tmp($j,"ibtour0,ibtrn)=ibtrn (case list)
; ^tmp($j,"ibtour1",specialty)=days approved ^ days denied ^ $approved ^ $denied
;
; -- hospital: ^tmp($j,"ibtour3",$s...
; ^tmp($j,"ibtour2",specialty)= adm. met ^ adm not met ^ days met ^ days not met
; ^tmp($j,"ibtour4",ibtrn)=ibtrn (case list)
;
;
IREV ; -- count and sort reviews
N IBDT,J
S IBDT=IBBDT-.00001
F S IBDT=$O(^IBT(356.2,"B",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.9))!(IBQUIT) D
.S IBTRC=0 F S IBTRC=$O(^IBT(356.2,"B",IBDT,IBTRC)) Q:'IBTRC!(IBQUIT) D
..S IBTRCD=$G(^IBT(356.2,+IBTRC,0)) Q:IBTRCD=""
..S IBTRN=$P(IBTRCD,"^",2)
..Q:$P(IBTRCD,"^",19)<10
..D SET
Q
;
SET ; -- set utility array
Q:'$G(IBTRN)
N DFN,SORT1,SORT2,SORT3,IBSPEC,IBBBS,RATE,IBAC,IBDAY,IBDA,IBDD,IBCDT
S DFN=+$P(IBTRCD,"^",5) Q:'DFN
;
S IBSPEC=$$SPEC^IBTOSUM1(IBTRC)
S IBBBS=$$BBS^IBTOSUM1(+IBSPEC)
S RATE=$$RATE^IBTOSUM1(IBBBS,+IBTRCD)
S IBAC=$$ACTION^IBTOSUM1(IBTRC)
S IBSPEC=$P(IBSPEC,"^",2) S:IBSPEC="" IBSPEC="Unknown"
;
I $P(^IBT(356,+$P(IBTRCD,"^",2),0),"^",4) S IBSPEC="OUTPATIENT VISIT",RATE=178
;
I $P(^IBT(356,+$P(IBTRCD,"^",2),0),"^",8) S IBSPEC="PRESCRIPTION",RATE=20
I $P(^IBT(356,+$P(IBTRCD,"^",2),0),"^",9) S IBSPEC="PROSTHETICS",RATE=0
;
S SORT3=$P($G(^DPT(DFN,0)),"^")
I IBHOW="P" S (SORT1,SORT2)=SORT3
I IBHOW="S" S SORT1=IBSPEC,SORT2=SORT3
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)),"^")
S:SORT1="" SORT1="Unknown"
S:SORT2="" SORT2="Unknown"
S:SORT3="" SORT2="Unknown"
S ^TMP($J,"IBTOUR",SORT1,SORT2,SORT3,IBTRC)=IBTRCD
;
S IBDAY=""
;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)
; -- replace the above line with the following line to add in admissions
; approved for the entire stay to report
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)
;
I IBAC=10,'IBDAY S IBDAY=$$DAY^IBTUTL3(+$P(IBTRCD,"^",12),+$P(IBTRCD,"^",13),IBTRN)
I IBAC=20,'IBDAY S IBDAY=$$DAY^IBTUTL3(+$P(IBTRCD,"^",15),+$P(IBTRCD,"^",16),IBTRN)
I 'IBDAY,$P(^IBT(356,IBTRN,0),"^",4) S IBDAY=1 ;opt encounter =1 day
S IBDA=$S(IBAC=10:IBDAY,1:0)
S IBDD=$S(IBAC=20:IBDAY,1:0)
S ^TMP($J,"IBTOUR0",+IBTRN)=IBTRN
;
I $P(^IBT(356,+IBTRN,0),"^",5),IBSPEC'="Unknown" D
.I '$D(^TMP($J,"IBTOUR1",IBSPEC)) S ^TMP($J,"IBTOUR1",IBSPEC)="0^0^0^0^"
.S X=$G(^TMP($J,"IBTOUR1",IBSPEC))
.S ^TMP($J,"IBTOUR1",IBSPEC)=($P(X,"^")+IBDA)_"^"_($P(X,"^",2)+IBDD)_"^"_($P(X,"^",3)+(IBDA*RATE))_"^"_($P(X,"^",4)+(IBDD*RATE))
Q
;
HREV ; -- count and sort reviews
N IBDT,J
S IBDT=IBBDT-.00001
F S IBDT=$O(^IBT(356.1,"B",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.9))!(IBQUIT) D
.S IBTRV=0 F S IBTRV=$O(^IBT(356.1,"B",IBDT,IBTRV)) Q:'IBTRV!(IBQUIT) D
..S IBTRVD=$G(^IBT(356.1,+IBTRV,0)) Q:IBTRVD=""
..S IBTRN=$P(IBTRVD,"^",2)
..I $P(IBTRVD,"^",21)=10 D HSET
Q
;
HSET ; -- set up review cases
S ^TMP($J,"IBTOUR4",IBTRN)=IBTRN
Q
;
HSET1 ; -- build by specialy report for hosp. reviews.
I $G(IBSPEC)="" D
.N VAIN,DFN
.S DFN=$P(^IBT(356,IBTRN,0),"^",2)
.S VAINDT=$P(^IBT(356,IBTRN,0),"^",6)\1+.2359 D INP^VADPT S IBSPEC=$P(VAIN(3),"^",2)
.I $G(IBSPEC)="" S IBSPEC="Unknown"
I '$D(^TMP($J,"IBTOUR2",IBSPEC)) S ^TMP($J,"IBTOUR2",IBSPEC)="0^0^0^0^"
S X=$G(^TMP($J,"IBTOUR2",IBSPEC))
S ^TMP($J,"IBTOUR2",IBSPEC)=($P(X,"^")+IBP1)_"^"_($P(X,"^",2)+IBP2)_"^"_($P(X,"^",3)+IBP3)_"^"_($P(X,"^",4)+IBP4)
Q
;
HSET2 ; -- set utility array
N DFN,SORT1,SORT2,SORT3
S DFN=+$P(IBTRND,"^",2) Q:'DFN
;
S SORT3=$P($G(^DPT(DFN,0)),"^")
I IBHOW="P" S (SORT1,SORT2)=SORT3
I IBHOW="S" S SORT1=IBSPEC,SORT2=SORT3
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)),"^")
S:SORT1="" SORT1="Unknown"
S:SORT2="" SORT2="Unknown"
S:SORT3="" SORT2="Unknown"
;
S ^TMP($J,"IBTOUR3",SORT1,SORT2,SORT3,IBTRN)=IBADM_"^"_IBDAYS_"^"_IBDAYN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTOUR2 4475 printed Jun 11, 2024@22:15:18 Page 2
IBTOUR2 ;ALB/AAS - CLAIMS TRACKING UR/ACTIVITY REPORT ; 27-OCT-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;**45**; 21-MAR-94
+2 ;
% ;
+1 ; -- insurance: ^tmp($j,"ibtour", $s(pt. name/specialty/review date) ,pt. name,sort3,ibtrc)=^ibt(ibtrc,0)
+2 ; ^tmp($j,"ibtour0,ibtrn)=ibtrn (case list)
+3 ; ^tmp($j,"ibtour1",specialty)=days approved ^ days denied ^ $approved ^ $denied
+4 ;
+5 ; -- hospital: ^tmp($j,"ibtour3",$s...
+6 ; ^tmp($j,"ibtour2",specialty)= adm. met ^ adm not met ^ days met ^ days not met
+7 ; ^tmp($j,"ibtour4",ibtrn)=ibtrn (case list)
+8 ;
+9 ;
IREV ; -- count and sort reviews
+1 NEW IBDT,J
+2 SET IBDT=IBBDT-.00001
+3 FOR
SET IBDT=$ORDER(^IBT(356.2,"B",IBDT))
if 'IBDT!(IBDT>(IBEDT+.9))!(IBQUIT)
QUIT
Begin DoDot:1
+4 SET IBTRC=0
FOR
SET IBTRC=$ORDER(^IBT(356.2,"B",IBDT,IBTRC))
if 'IBTRC!(IBQUIT)
QUIT
Begin DoDot:2
+5 SET IBTRCD=$GET(^IBT(356.2,+IBTRC,0))
if IBTRCD=""
QUIT
+6 SET IBTRN=$PIECE(IBTRCD,"^",2)
+7 if $PIECE(IBTRCD,"^",19)<10
QUIT
+8 DO SET
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
SET ; -- set utility array
+1 if '$GET(IBTRN)
QUIT
+2 NEW DFN,SORT1,SORT2,SORT3,IBSPEC,IBBBS,RATE,IBAC,IBDAY,IBDA,IBDD,IBCDT
+3 SET DFN=+$PIECE(IBTRCD,"^",5)
if 'DFN
QUIT
+4 ;
+5 SET IBSPEC=$$SPEC^IBTOSUM1(IBTRC)
+6 SET IBBBS=$$BBS^IBTOSUM1(+IBSPEC)
+7 SET RATE=$$RATE^IBTOSUM1(IBBBS,+IBTRCD)
+8 SET IBAC=$$ACTION^IBTOSUM1(IBTRC)
+9 SET IBSPEC=$PIECE(IBSPEC,"^",2)
if IBSPEC=""
SET IBSPEC="Unknown"
+10 ;
+11 IF $PIECE(^IBT(356,+$PIECE(IBTRCD,"^",2),0),"^",4)
SET IBSPEC="OUTPATIENT VISIT"
SET RATE=178
+12 ;
+13 IF $PIECE(^IBT(356,+$PIECE(IBTRCD,"^",2),0),"^",8)
SET IBSPEC="PRESCRIPTION"
SET RATE=20
+14 IF $PIECE(^IBT(356,+$PIECE(IBTRCD,"^",2),0),"^",9)
SET IBSPEC="PROSTHETICS"
SET RATE=0
+15 ;
+16 SET SORT3=$PIECE($GET(^DPT(DFN,0)),"^")
+17 IF IBHOW="P"
SET (SORT1,SORT2)=SORT3
+18 IF IBHOW="S"
SET SORT1=IBSPEC
SET SORT2=SORT3
+19 IF IBHOW="R"
SET SORT1=$PIECE($GET(^VA(200,+$PIECE($GET(^IBT(356.2,+IBTRC,1)),"^",4),0)),"^")
SET SORT2=$PIECE($GET(^IBE(356.11,+$PIECE(IBTRCD,"^",4),0)),"^")
+20 if SORT1=""
SET SORT1="Unknown"
+21 if SORT2=""
SET SORT2="Unknown"
+22 if SORT3=""
SET SORT2="Unknown"
+23 SET ^TMP($JOB,"IBTOUR",SORT1,SORT2,SORT3,IBTRC)=IBTRCD
+24 ;
+25 SET IBDAY=""
+26 ;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)
+27 ; -- replace the above line with the following line to add in admissions
+28 ; approved for the entire stay to report
+29 IF $PIECE(^IBT(356,IBTRN,0),"^",5)
IF ($PIECE(^IBT(356.2,+IBTRC,1),"^",7)!($PIECE(^(1),"^",8)))
SET IBCDT=$$CDT^IBTODD1(IBTRN)
SET IBDAY=$$DAY^IBTUTL3(+IBCDT,$SELECT(+$PIECE(IBCDT,"^",2):$PIECE(IBCDT,"^",2),1:DT),IBTRN)
+30 ;
+31 IF IBAC=10
IF 'IBDAY
SET IBDAY=$$DAY^IBTUTL3(+$PIECE(IBTRCD,"^",12),+$PIECE(IBTRCD,"^",13),IBTRN)
+32 IF IBAC=20
IF 'IBDAY
SET IBDAY=$$DAY^IBTUTL3(+$PIECE(IBTRCD,"^",15),+$PIECE(IBTRCD,"^",16),IBTRN)
+33 ;opt encounter =1 day
IF 'IBDAY
IF $PIECE(^IBT(356,IBTRN,0),"^",4)
SET IBDAY=1
+34 SET IBDA=$SELECT(IBAC=10:IBDAY,1:0)
+35 SET IBDD=$SELECT(IBAC=20:IBDAY,1:0)
+36 SET ^TMP($JOB,"IBTOUR0",+IBTRN)=IBTRN
+37 ;
+38 IF $PIECE(^IBT(356,+IBTRN,0),"^",5)
IF IBSPEC'="Unknown"
Begin DoDot:1
+39 IF '$DATA(^TMP($JOB,"IBTOUR1",IBSPEC))
SET ^TMP($JOB,"IBTOUR1",IBSPEC)="0^0^0^0^"
+40 SET X=$GET(^TMP($JOB,"IBTOUR1",IBSPEC))
+41 SET ^TMP($JOB,"IBTOUR1",IBSPEC)=($PIECE(X,"^")+IBDA)_"^"_($PIECE(X,"^",2)+IBDD)_"^"_($PIECE(X,"^",3)+(IBDA*RATE))_"^"_($PIECE(X,"^",4)+(IBDD*RATE))
End DoDot:1
+42 QUIT
+43 ;
HREV ; -- count and sort reviews
+1 NEW IBDT,J
+2 SET IBDT=IBBDT-.00001
+3 FOR
SET IBDT=$ORDER(^IBT(356.1,"B",IBDT))
if 'IBDT!(IBDT>(IBEDT+.9))!(IBQUIT)
QUIT
Begin DoDot:1
+4 SET IBTRV=0
FOR
SET IBTRV=$ORDER(^IBT(356.1,"B",IBDT,IBTRV))
if 'IBTRV!(IBQUIT)
QUIT
Begin DoDot:2
+5 SET IBTRVD=$GET(^IBT(356.1,+IBTRV,0))
if IBTRVD=""
QUIT
+6 SET IBTRN=$PIECE(IBTRVD,"^",2)
+7 IF $PIECE(IBTRVD,"^",21)=10
DO HSET
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
HSET ; -- set up review cases
+1 SET ^TMP($JOB,"IBTOUR4",IBTRN)=IBTRN
+2 QUIT
+3 ;
HSET1 ; -- build by specialy report for hosp. reviews.
+1 IF $GET(IBSPEC)=""
Begin DoDot:1
+2 NEW VAIN,DFN
+3 SET DFN=$PIECE(^IBT(356,IBTRN,0),"^",2)
+4 SET VAINDT=$PIECE(^IBT(356,IBTRN,0),"^",6)\1+.2359
DO INP^VADPT
SET IBSPEC=$PIECE(VAIN(3),"^",2)
+5 IF $GET(IBSPEC)=""
SET IBSPEC="Unknown"
End DoDot:1
+6 IF '$DATA(^TMP($JOB,"IBTOUR2",IBSPEC))
SET ^TMP($JOB,"IBTOUR2",IBSPEC)="0^0^0^0^"
+7 SET X=$GET(^TMP($JOB,"IBTOUR2",IBSPEC))
+8 SET ^TMP($JOB,"IBTOUR2",IBSPEC)=($PIECE(X,"^")+IBP1)_"^"_($PIECE(X,"^",2)+IBP2)_"^"_($PIECE(X,"^",3)+IBP3)_"^"_($PIECE(X,"^",4)+IBP4)
+9 QUIT
+10 ;
HSET2 ; -- set utility array
+1 NEW DFN,SORT1,SORT2,SORT3
+2 SET DFN=+$PIECE(IBTRND,"^",2)
if 'DFN
QUIT
+3 ;
+4 SET SORT3=$PIECE($GET(^DPT(DFN,0)),"^")
+5 IF IBHOW="P"
SET (SORT1,SORT2)=SORT3
+6 IF IBHOW="S"
SET SORT1=IBSPEC
SET SORT2=SORT3
+7 IF IBHOW="R"
SET SORT1=$PIECE($GET(^VA(200,+$PIECE($GET(^IBT(356,+IBTRN,1)),"^",5),0)),"^")
SET SORT2=$PIECE($GET(^IBE(356.11,+$PIECE(IBTRVD,"^",22),0)),"^")
+8 if SORT1=""
SET SORT1="Unknown"
+9 if SORT2=""
SET SORT2="Unknown"
+10 if SORT3=""
SET SORT2="Unknown"
+11 ;
+12 SET ^TMP($JOB,"IBTOUR3",SORT1,SORT2,SORT3,IBTRN)=IBADM_"^"_IBDAYS_"^"_IBDAYN
+13 QUIT
