source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBUCMBS.m@ 1766

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

initial load of WorldVistAEHR

File size: 5.8 KB
Line 
1FBUCMBS ;LEX/WRC - MILLENNIUM ACT EMERGENCY CARE SUMMARY REPORT ;07/07/03
2 ;;3.5;FEE BASIS;**62,90**;JAN 30, 1995
3 ;
4SDT S %DT="EA",%DT("A")="Start Date: " D ^%DT
5 S FBSDT=Y I FBSDT<0 D KIL Q
6 I FBSDT>DT W !,"Start date cannot be in the future." G SDT
7 ;
8EDT S %DT="EA",%DT("A")="End Date: " D ^%DT
9 S FBEDT=Y I FBEDT<0 D KIL Q
10 I FBEDT<FBSDT W !,"End date cannot be prior to the Start date." G EDT
11 ;
12ZIS S %IS="Q" D ^%ZIS
13 K %H,%T I POP=1 D KIL Q
14 I '$D(IO("Q")) U IO D STRT Q
15 S ZTRTN="STRT^FBUCMBS",ZTIO=ION,ZTSAVE("FBEDT")="",ZTSAVE("FBSDT")=""
16 D ^%ZTLOAD
17 W:'$D(ZTQUEUED) !,"Request Queued!",!,"Task Number: "_$G(ZTSK),!
18 D KIL Q
19 ;
20STRT ;
21 S (FBTNCL,FBTDCL,FBTCLMTS,FBTNCLPD,FBTDCLPD,FBTNCLR,FBTDCLR,FBTNCLPN,FBTDCLPN,FBTREAS,FBNCLMS,FBDAYS,FBTDSUPD)=0
22 S Y=FBSDT D DD^%DT S FBPSDT=Y
23 S FBDA="",FBSDT=FBSDT-1
24 F S FBSDT=$O(^FB583("B",FBSDT)) Q:FBSDT>FBEDT!(FBSDT="") D
25 . F S FBDA=$O(^FB583("B",FBSDT,FBDA)) Q:FBDA="" D
26 .. I $P($G(^FB583(FBDA,0)),"^",28)'=1 Q
27 .. S FBUCL0=$G(^FB583(FBDA,0))
28 .. S FBTNCL=FBTNCL+1
29 .. S FBAMTCL=$P(FBUCL0,"^",9)
30 .. S FBTDCL=FBTDCL+FBAMTCL
31 .. S FBCLMT=$P(FBUCL0,"^",23)
32 .. I FBCLMT'="",($D(^TMP($J,"FBUCMBS","CLMT",FBCLMT))=0) S ^TMP($J,"FBUCMBS","CLMT",FBCLMT)="",FBTCLMTS=FBTCLMTS+1
33 .. S FBDISPO=$P(FBUCL0,"^",11)
34 .. I FBDISPO="" S FBTNCLPN=FBTNCLPN+1,FBTDCLPN=FBTDCLPN+$P(FBUCL0,"^",9) Q
35 .. I $D(^FB(162.91,FBDISPO,0))=0 S FBTNCLPN=FBTNCLPN+1,FBTDCLPN=FBTDCLPN+$P(FBUCL0,"^",9) Q
36 .. S FBDIS0=$P($G(^FB(162.91,FBDISPO,0)),"^",1)
37 .. I $E($P(FBDIS0,"^",1),1,8)="APPROVED" D Q
38 ... S FBPD1=$$AMTPD(FBDA)
39 ... S FBTNCLPD=FBTNCLPD+1,FBTDCLPD=FBTDCLPD+FBPD1,FBTDSUPD=FBTDSUPD+FBAMTCL D AVGTM
40 .. S FBTNCLR=FBTNCLR+1,FBTDCLR=FBTDCLR+$P(FBUCL0,"^",9)
41 .. D REAS,ADD,STATUS,AVGTM
42 D PRT S FBDENIAL="" D DENIAL I $D(FBQ) D KIL Q
43 D PAVG I $D(FBQ) D KIL Q
44 D KIL
45 Q
46 ;
47REAS N X S FBREAS=""
48 S X=$O(^FB583(FBDA,"D",0))
49 I X S X=+$G(^FB583(FBDA,"D",X,0))
50 I X S FBREAS=$P($G(^FB(162.94,X,0)),"^")
51 S FBREAS=$S(FBREAS="":"OTHER",1:FBREAS)
52 Q
53ADD ;
54 I $D(^TMP($J,"FBUCMBS","REAS",FBREAS))=1 S $P(^TMP($J,"FBUCMBS","REAS",FBREAS),"^",1)=$P(^TMP($J,"FBUCMBS","REAS",FBREAS),"^",1)+1 Q
55 S ^TMP($J,"FBUCMBS","REAS",FBREAS)=1
56 Q
57 ;
58STATUS I $P(FBUCL0,"^",24)="" Q
59 S FBSIEN=$P(FBUCL0,"^",24)
60 I $D(^FB(162.92,FBSIEN,0))=0 Q
61 I $P(^FB(162.92,FBSIEN,0),"^",1)["PENDING" S FBTNCLPN=FBTNCLPN+1,FBTDCLPN=FBTDCLPN+$P(FBUCL0,"^",9)
62 Q
63 ;
64AVGTM ;
65 I $P(FBUCL0,"^",1)="" Q
66 I $P(FBUCL0,"^",12)="" Q
67 S FBNCLMS=FBNCLMS+1,X1=$P(FBUCL0,"^",12),X2=$P(FBUCL0,"^",1) D ^%DTC S FBDAYS=FBDAYS+X
68 Q
69 ;
70PRT ;
71 S Y=DT D DD^%DT S FBPRDT=Y
72 S Y=FBEDT D DD^%DT S FBPEDT=Y
73 W @IOF,!,?25,"MILLENNIUM ACT EMERGENCY CARE"
74 S FBTDSU=FBTDSUPD-FBTDCLPD
75 W !,?32,"SUMMARY REPORT"
76 W !,?23,FBPSDT," THROUGH ",FBPEDT
77 W !,?29,"RUN DATE: ",FBPRDT,!!
78 W !,"Total Number Claims Received: " S X=FBTNCL,X2=0,X3=20 D COMMA^%DTC W ?50,X
79 W !,"Total Dollars Claims Received: " S X=FBTDCL,X2="2$",X3=20 D COMMA^%DTC W ?50,X
80 W !!,"Total Claimants: " S X=FBTCLMTS,X2=0,X3=20 D COMMA^%DTC W ?50,X
81 W !!,"Total Claims Paid: " S X=FBTNCLPD,X2=0,X3=20 D COMMA^%DTC W ?50,X
82 W !,"Total Dollars Claims Paid: " S X=FBTDCLPD,X2="2$",X3=20 D COMMA^%DTC W ?50,X
83 W !!,"Total Dollars Suspended: " S X=FBTDSU,X2="2$",X3=20 D COMMA^%DTC W ?50,X
84 W !!,"Total Number Claims Rejected: " S X=FBTNCLR,X2=0,X3=20 D COMMA^%DTC W ?50,X
85 W !,"Total Dollars Claims Rejected: " S X=FBTDCLR,X2="2$",X3=20 D COMMA^%DTC W ?50,X,!
86 W !,?32,"REASONS REJECTED",!
87 Q
88 ;
89DENIAL F S FBDENIAL=$O(^TMP($J,"FBUCMBS","REAS",FBDENIAL)) Q:FBDENIAL=""!($D(FBQ)) D
90 . W !,?5,FBDENIAL,":" S X=$P(^TMP($J,"FBUCMBS","REAS",FBDENIAL),"^",1),X2=0,X3=20 D COMMA^%DTC W ?50,X
91 . I $Y>(IOSL-2) D PAUSE Q:$D(FBQ)
92 . S FBTREAS=FBTREAS+$P(^TMP($J,"FBUCMBS","REAS",FBDENIAL),"^",1)
93 Q
94 ;
95PAVG W !,?59,"----------" I $Y>(IOSL-2) D PAUSE S FBPSW=1 Q:$D(FBQ)
96 S X=FBTREAS,X2=0,X3=20 D COMMA^%DTC W !,?50,X I $Y>(IOSL-2) D PAUSE S FBPSW=1 Q:$D(FBQ)
97 W !!,"Total Number Claims Pending: " S X=FBTNCLPN,X2=0,X3=20 D COMMA^%DTC W ?50,X I $Y>(IOSL-2) D PAUSE S FBPSW=1 Q:$D(FBQ)
98 W !,"Total Dollars Claims Pending: " S X=FBTDCLPN,X2="2$",X3=20 D COMMA^%DTC W ?50,X I $Y>(IOSL-2) D PAUSE S FBPSW=1 Q:$D(FBQ)
99 I FBNCLMS=0 W !!,"Average Processing Time: ",$J(0,3,2)," Days" D:$Y>(IOSL-14) PAUSE Q
100 S FBAVGD=FBDAYS/FBNCLMS W !!,"Average Processing Time: ",$J(FBAVGD,3,2)," Days" I $Y>(IOSL-2) D PAUSE S FBPSW=1 Q:$D(FBQ)
101 I '$D(FBPSW) D PAUSE
102 Q
103 ;
104KIL ;
105 K FBTNCL,FBTDCL,FBTCLMTS,FBTNCLPD,FBTDCLPD,FBTNCLR,FBTDCLR,FBTNCLPN,FBTDCLPN,FBTREAS,FBNCLMS,FBDAYS,FBPSDT,FBSDT,FBPEDT,FBEDT,FBDA,FBAMTCL,FBDISPO,FBREAS,FBSIEN
106 K %DT,%IS,POP,ZTIO,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK,FBAVGD,FBCLMT,FBCLMTS,FBDENIAL,FBPRDT,FBRDT,X,X1,X2,X3,Y,FBPSW,FBQ,DIR,DIRUT,DUOUT,FBPD1,FBTDSUPD,FBUCL0,FBDIS0,FBTDSU
107 K ^TMP($J)
108 D ^%ZISC
109 Q
110 ;
111AMTPD(FBDA) ;Determine the amount paid an unauthorized claim
112 ;Input: FBDA -- IEN of record in the unauthorized claim file 162.7
113 ;Output: Amount paid, or 0 if the claim cannot be identified
114 ;
115 N FBTAMT,FBX,FBUCPAY,FBFILE,FBIENS,FBAMT
116 ;
117 ; - initialize total amount paid
118 S FBTAMT=0
119 ;
120 ; - check for valid input
121 I '$G(^FB583(FBDA,0)) G AMTPDQ
122 ;
123 ; - get list of payments for the claim
124 S FBX=$$PAYST^FBUCUTL(FBDA,"FBUCPAY")
125 ;
126 ; - loop thru payments to get total amount approved
127 S FBTAMT=0
128 F FBFILE=162.03,162.11,162.5 D
129 . S FBIENS="" F S FBIENS=$O(FBUCPAY(FBDA,FBFILE,FBIENS)) Q:FBIENS="" D
130 .. I FBFILE=162.03 Q:$P($G(^FBAAC($P(FBIENS,",",4),1,$P(FBIENS,",",3),1,$P(FBIENS,",",2),1,$P(FBIENS,",",1),"FBREJ")),"^",1)'="" S FBAMT=$$GET1^DIQ(FBFILE,FBIENS,2)
131 .. I FBFILE=162.11 Q:$P($G(^FBAA(162.1,$P(FBIENS,",",2),"RX",$P(FBIENS,",",1),"FBREJ")),"^",1)'="" S FBAMT=$$GET1^DIQ(FBFILE,FBIENS,16.5)
132 .. I FBFILE=162.5 Q:$P($G(^FBAAI(+FBIENS,"FBREJ")),"^",1)'="" S FBAMT=$$GET1^DIQ(FBFILE,FBIENS,8)
133 .. S FBTAMT=FBTAMT+FBAMT
134 ;
135AMTPDQ Q FBTAMT
136 ;
137PAUSE ; - Page break
138 I $E(IOST,1,2)'="C-" Q
139 S DIR(0)="E" D ^DIR I $D(DIRUT) S FBQ=1 Q
140 W @IOF
141 Q
Note: See TracBrowser for help on using the repository browser.