source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTOUR2.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.3 KB
RevLine 
[613]1IBTOUR2 ;ALB/AAS - CLAIMS TRACKING UR/ACTIVITY REPORT ; 27-OCT-93
2 ;;Version 2.0 ; INTEGRATED BILLING ;**45**; 21-MAR-94
3 ;
4% ;
5 ; -- insurance: ^tmp($j,"ibtour", $s(pt. name/specialty/review date) ,pt. name,sort3,ibtrc)=^ibt(ibtrc,0)
6 ; ^tmp($j,"ibtour0,ibtrn)=ibtrn (case list)
7 ; ^tmp($j,"ibtour1",specialty)=days approved ^ days denied ^ $approved ^ $denied
8 ;
9 ; -- hospital: ^tmp($j,"ibtour3",$s...
10 ; ^tmp($j,"ibtour2",specialty)= adm. met ^ adm not met ^ days met ^ days not met
11 ; ^tmp($j,"ibtour4",ibtrn)=ibtrn (case list)
12 ;
13 ;
14IREV ; -- count and sort reviews
15 N IBDT,J
16 S IBDT=IBBDT-.00001
17 F S IBDT=$O(^IBT(356.2,"B",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.9))!(IBQUIT) D
18 .S IBTRC=0 F S IBTRC=$O(^IBT(356.2,"B",IBDT,IBTRC)) Q:'IBTRC!(IBQUIT) D
19 ..S IBTRCD=$G(^IBT(356.2,+IBTRC,0)) Q:IBTRCD=""
20 ..S IBTRN=$P(IBTRCD,"^",2)
21 ..Q:$P(IBTRCD,"^",19)<10
22 ..D SET
23 Q
24 ;
25SET ; -- set utility array
26 Q:'$G(IBTRN)
27 N DFN,SORT1,SORT2,SORT3,IBSPEC,IBBBS,RATE,IBAC,IBDAY,IBDA,IBDD,IBCDT
28 S DFN=+$P(IBTRCD,"^",5) Q:'DFN
29 ;
30 S IBSPEC=$$SPEC^IBTOSUM1(IBTRC)
31 S IBBBS=$$BBS^IBTOSUM1(+IBSPEC)
32 S RATE=$$RATE^IBTOSUM1(IBBBS,+IBTRCD)
33 S IBAC=$$ACTION^IBTOSUM1(IBTRC)
34 S IBSPEC=$P(IBSPEC,"^",2) S:IBSPEC="" IBSPEC="Unknown"
35 ;
36 I $P(^IBT(356,+$P(IBTRCD,"^",2),0),"^",4) S IBSPEC="OUTPATIENT VISIT",RATE=178
37 ;
38 I $P(^IBT(356,+$P(IBTRCD,"^",2),0),"^",8) S IBSPEC="PRESCRIPTION",RATE=20
39 I $P(^IBT(356,+$P(IBTRCD,"^",2),0),"^",9) S IBSPEC="PROSTHETICS",RATE=0
40 ;
41 S SORT3=$P($G(^DPT(DFN,0)),"^")
42 I IBHOW="P" S (SORT1,SORT2)=SORT3
43 I IBHOW="S" S SORT1=IBSPEC,SORT2=SORT3
44 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)),"^")
45 S:SORT1="" SORT1="Unknown"
46 S:SORT2="" SORT2="Unknown"
47 S:SORT3="" SORT2="Unknown"
48 S ^TMP($J,"IBTOUR",SORT1,SORT2,SORT3,IBTRC)=IBTRCD
49 ;
50 S IBDAY=""
51 ;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)
52 ; -- replace the above line with the following line to add in admissions
53 ; approved for the entire stay to report
54 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)
55 ;
56 I IBAC=10,'IBDAY S IBDAY=$$DAY^IBTUTL3(+$P(IBTRCD,"^",12),+$P(IBTRCD,"^",13),IBTRN)
57 I IBAC=20,'IBDAY S IBDAY=$$DAY^IBTUTL3(+$P(IBTRCD,"^",15),+$P(IBTRCD,"^",16),IBTRN)
58 I 'IBDAY,$P(^IBT(356,IBTRN,0),"^",4) S IBDAY=1 ;opt encounter =1 day
59 S IBDA=$S(IBAC=10:IBDAY,1:0)
60 S IBDD=$S(IBAC=20:IBDAY,1:0)
61 S ^TMP($J,"IBTOUR0",+IBTRN)=IBTRN
62 ;
63 I $P(^IBT(356,+IBTRN,0),"^",5),IBSPEC'="Unknown" D
64 .I '$D(^TMP($J,"IBTOUR1",IBSPEC)) S ^TMP($J,"IBTOUR1",IBSPEC)="0^0^0^0^"
65 .S X=$G(^TMP($J,"IBTOUR1",IBSPEC))
66 .S ^TMP($J,"IBTOUR1",IBSPEC)=($P(X,"^")+IBDA)_"^"_($P(X,"^",2)+IBDD)_"^"_($P(X,"^",3)+(IBDA*RATE))_"^"_($P(X,"^",4)+(IBDD*RATE))
67 Q
68 ;
69HREV ; -- count and sort reviews
70 N IBDT,J
71 S IBDT=IBBDT-.00001
72 F S IBDT=$O(^IBT(356.1,"B",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.9))!(IBQUIT) D
73 .S IBTRV=0 F S IBTRV=$O(^IBT(356.1,"B",IBDT,IBTRV)) Q:'IBTRV!(IBQUIT) D
74 ..S IBTRVD=$G(^IBT(356.1,+IBTRV,0)) Q:IBTRVD=""
75 ..S IBTRN=$P(IBTRVD,"^",2)
76 ..I $P(IBTRVD,"^",21)=10 D HSET
77 Q
78 ;
79HSET ; -- set up review cases
80 S ^TMP($J,"IBTOUR4",IBTRN)=IBTRN
81 Q
82 ;
83HSET1 ; -- build by specialy report for hosp. reviews.
84 I $G(IBSPEC)="" D
85 .N VAIN,DFN
86 .S DFN=$P(^IBT(356,IBTRN,0),"^",2)
87 .S VAINDT=$P(^IBT(356,IBTRN,0),"^",6)\1+.2359 D INP^VADPT S IBSPEC=$P(VAIN(3),"^",2)
88 .I $G(IBSPEC)="" S IBSPEC="Unknown"
89 I '$D(^TMP($J,"IBTOUR2",IBSPEC)) S ^TMP($J,"IBTOUR2",IBSPEC)="0^0^0^0^"
90 S X=$G(^TMP($J,"IBTOUR2",IBSPEC))
91 S ^TMP($J,"IBTOUR2",IBSPEC)=($P(X,"^")+IBP1)_"^"_($P(X,"^",2)+IBP2)_"^"_($P(X,"^",3)+IBP3)_"^"_($P(X,"^",4)+IBP4)
92 Q
93 ;
94HSET2 ; -- set utility array
95 N DFN,SORT1,SORT2,SORT3
96 S DFN=+$P(IBTRND,"^",2) Q:'DFN
97 ;
98 S SORT3=$P($G(^DPT(DFN,0)),"^")
99 I IBHOW="P" S (SORT1,SORT2)=SORT3
100 I IBHOW="S" S SORT1=IBSPEC,SORT2=SORT3
101 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)),"^")
102 S:SORT1="" SORT1="Unknown"
103 S:SORT2="" SORT2="Unknown"
104 S:SORT3="" SORT2="Unknown"
105 ;
106 S ^TMP($J,"IBTOUR3",SORT1,SORT2,SORT3,IBTRN)=IBADM_"^"_IBDAYS_"^"_IBDAYN
107 Q
Note: See TracBrowser for help on using the repository browser.