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

FBUCMBS.m

Go to the documentation of this file.
  1. FBUCMBS ;LEX/WRC - MILLENNIUM ACT EMERGENCY CARE SUMMARY REPORT ;07/07/03
  1. ;;3.5;FEE BASIS;**62,90**;JAN 30, 1995
  1. ;
  1. SDT S %DT="EA",%DT("A")="Start Date: " D ^%DT
  1. S FBSDT=Y I FBSDT<0 D KIL Q
  1. I FBSDT>DT W !,"Start date cannot be in the future." G SDT
  1. ;
  1. EDT S %DT="EA",%DT("A")="End Date: " D ^%DT
  1. S FBEDT=Y I FBEDT<0 D KIL Q
  1. I FBEDT<FBSDT W !,"End date cannot be prior to the Start date." G EDT
  1. ;
  1. ZIS S %IS="Q" D ^%ZIS
  1. K %H,%T I POP=1 D KIL Q
  1. I '$D(IO("Q")) U IO D STRT Q
  1. S ZTRTN="STRT^FBUCMBS",ZTIO=ION,ZTSAVE("FBEDT")="",ZTSAVE("FBSDT")=""
  1. D ^%ZTLOAD
  1. W:'$D(ZTQUEUED) !,"Request Queued!",!,"Task Number: "_$G(ZTSK),!
  1. D KIL Q
  1. ;
  1. STRT ;
  1. S (FBTNCL,FBTDCL,FBTCLMTS,FBTNCLPD,FBTDCLPD,FBTNCLR,FBTDCLR,FBTNCLPN,FBTDCLPN,FBTREAS,FBNCLMS,FBDAYS,FBTDSUPD)=0
  1. S Y=FBSDT D DD^%DT S FBPSDT=Y
  1. S FBDA="",FBSDT=FBSDT-1
  1. F S FBSDT=$O(^FB583("B",FBSDT)) Q:FBSDT>FBEDT!(FBSDT="") D
  1. . F S FBDA=$O(^FB583("B",FBSDT,FBDA)) Q:FBDA="" D
  1. .. I $P($G(^FB583(FBDA,0)),"^",28)'=1 Q
  1. .. S FBUCL0=$G(^FB583(FBDA,0))
  1. .. S FBTNCL=FBTNCL+1
  1. .. S FBAMTCL=$P(FBUCL0,"^",9)
  1. .. S FBTDCL=FBTDCL+FBAMTCL
  1. .. S FBCLMT=$P(FBUCL0,"^",23)
  1. .. I FBCLMT'="",($D(^TMP($J,"FBUCMBS","CLMT",FBCLMT))=0) S ^TMP($J,"FBUCMBS","CLMT",FBCLMT)="",FBTCLMTS=FBTCLMTS+1
  1. .. S FBDISPO=$P(FBUCL0,"^",11)
  1. .. I FBDISPO="" S FBTNCLPN=FBTNCLPN+1,FBTDCLPN=FBTDCLPN+$P(FBUCL0,"^",9) Q
  1. .. I $D(^FB(162.91,FBDISPO,0))=0 S FBTNCLPN=FBTNCLPN+1,FBTDCLPN=FBTDCLPN+$P(FBUCL0,"^",9) Q
  1. .. S FBDIS0=$P($G(^FB(162.91,FBDISPO,0)),"^",1)
  1. .. I $E($P(FBDIS0,"^",1),1,8)="APPROVED" D Q
  1. ... S FBPD1=$$AMTPD(FBDA)
  1. ... S FBTNCLPD=FBTNCLPD+1,FBTDCLPD=FBTDCLPD+FBPD1,FBTDSUPD=FBTDSUPD+FBAMTCL D AVGTM
  1. .. S FBTNCLR=FBTNCLR+1,FBTDCLR=FBTDCLR+$P(FBUCL0,"^",9)
  1. .. D REAS,ADD,STATUS,AVGTM
  1. D PRT S FBDENIAL="" D DENIAL I $D(FBQ) D KIL Q
  1. D PAVG I $D(FBQ) D KIL Q
  1. D KIL
  1. Q
  1. ;
  1. REAS N X S FBREAS=""
  1. S X=$O(^FB583(FBDA,"D",0))
  1. I X S X=+$G(^FB583(FBDA,"D",X,0))
  1. I X S FBREAS=$P($G(^FB(162.94,X,0)),"^")
  1. S FBREAS=$S(FBREAS="":"OTHER",1:FBREAS)
  1. Q
  1. ADD ;
  1. 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
  1. S ^TMP($J,"FBUCMBS","REAS",FBREAS)=1
  1. Q
  1. ;
  1. STATUS I $P(FBUCL0,"^",24)="" Q
  1. S FBSIEN=$P(FBUCL0,"^",24)
  1. I $D(^FB(162.92,FBSIEN,0))=0 Q
  1. I $P(^FB(162.92,FBSIEN,0),"^",1)["PENDING" S FBTNCLPN=FBTNCLPN+1,FBTDCLPN=FBTDCLPN+$P(FBUCL0,"^",9)
  1. Q
  1. ;
  1. AVGTM ;
  1. I $P(FBUCL0,"^",1)="" Q
  1. I $P(FBUCL0,"^",12)="" Q
  1. S FBNCLMS=FBNCLMS+1,X1=$P(FBUCL0,"^",12),X2=$P(FBUCL0,"^",1) D ^%DTC S FBDAYS=FBDAYS+X
  1. Q
  1. ;
  1. PRT ;
  1. S Y=DT D DD^%DT S FBPRDT=Y
  1. S Y=FBEDT D DD^%DT S FBPEDT=Y
  1. W @IOF,!,?25,"MILLENNIUM ACT EMERGENCY CARE"
  1. S FBTDSU=FBTDSUPD-FBTDCLPD
  1. W !,?32,"SUMMARY REPORT"
  1. W !,?23,FBPSDT," THROUGH ",FBPEDT
  1. W !,?29,"RUN DATE: ",FBPRDT,!!
  1. W !,"Total Number Claims Received: " S X=FBTNCL,X2=0,X3=20 D COMMA^%DTC W ?50,X
  1. W !,"Total Dollars Claims Received: " S X=FBTDCL,X2="2$",X3=20 D COMMA^%DTC W ?50,X
  1. W !!,"Total Claimants: " S X=FBTCLMTS,X2=0,X3=20 D COMMA^%DTC W ?50,X
  1. W !!,"Total Claims Paid: " S X=FBTNCLPD,X2=0,X3=20 D COMMA^%DTC W ?50,X
  1. W !,"Total Dollars Claims Paid: " S X=FBTDCLPD,X2="2$",X3=20 D COMMA^%DTC W ?50,X
  1. W !!,"Total Dollars Suspended: " S X=FBTDSU,X2="2$",X3=20 D COMMA^%DTC W ?50,X
  1. W !!,"Total Number Claims Rejected: " S X=FBTNCLR,X2=0,X3=20 D COMMA^%DTC W ?50,X
  1. W !,"Total Dollars Claims Rejected: " S X=FBTDCLR,X2="2$",X3=20 D COMMA^%DTC W ?50,X,!
  1. W !,?32,"REASONS REJECTED",!
  1. Q
  1. ;
  1. DENIAL F S FBDENIAL=$O(^TMP($J,"FBUCMBS","REAS",FBDENIAL)) Q:FBDENIAL=""!($D(FBQ)) D
  1. . W !,?5,FBDENIAL,":" S X=$P(^TMP($J,"FBUCMBS","REAS",FBDENIAL),"^",1),X2=0,X3=20 D COMMA^%DTC W ?50,X
  1. . I $Y>(IOSL-2) D PAUSE Q:$D(FBQ)
  1. . S FBTREAS=FBTREAS+$P(^TMP($J,"FBUCMBS","REAS",FBDENIAL),"^",1)
  1. Q
  1. ;
  1. PAVG W !,?59,"----------" I $Y>(IOSL-2) D PAUSE S FBPSW=1 Q:$D(FBQ)
  1. 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)
  1. 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)
  1. 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)
  1. I FBNCLMS=0 W !!,"Average Processing Time: ",$J(0,3,2)," Days" D:$Y>(IOSL-14) PAUSE Q
  1. 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)
  1. I '$D(FBPSW) D PAUSE
  1. Q
  1. ;
  1. KIL ;
  1. K FBTNCL,FBTDCL,FBTCLMTS,FBTNCLPD,FBTDCLPD,FBTNCLR,FBTDCLR,FBTNCLPN,FBTDCLPN,FBTREAS,FBNCLMS,FBDAYS,FBPSDT,FBSDT,FBPEDT,FBEDT,FBDA,FBAMTCL,FBDISPO,FBREAS,FBSIEN
  1. 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
  1. K ^TMP($J)
  1. D ^%ZISC
  1. Q
  1. ;
  1. AMTPD(FBDA) ;Determine the amount paid an unauthorized claim
  1. ;Input: FBDA -- IEN of record in the unauthorized claim file 162.7
  1. ;Output: Amount paid, or 0 if the claim cannot be identified
  1. ;
  1. N FBTAMT,FBX,FBUCPAY,FBFILE,FBIENS,FBAMT
  1. ;
  1. ; - initialize total amount paid
  1. S FBTAMT=0
  1. ;
  1. ; - check for valid input
  1. I '$G(^FB583(FBDA,0)) G AMTPDQ
  1. ;
  1. ; - get list of payments for the claim
  1. S FBX=$$PAYST^FBUCUTL(FBDA,"FBUCPAY")
  1. ;
  1. ; - loop thru payments to get total amount approved
  1. S FBTAMT=0
  1. F FBFILE=162.03,162.11,162.5 D
  1. . S FBIENS="" F S FBIENS=$O(FBUCPAY(FBDA,FBFILE,FBIENS)) Q:FBIENS="" D
  1. .. 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)
  1. .. 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)
  1. .. I FBFILE=162.5 Q:$P($G(^FBAAI(+FBIENS,"FBREJ")),"^",1)'="" S FBAMT=$$GET1^DIQ(FBFILE,FBIENS,8)
  1. .. S FBTAMT=FBTAMT+FBAMT
  1. ;
  1. AMTPDQ Q FBTAMT
  1. ;
  1. PAUSE ; - Page break
  1. I $E(IOST,1,2)'="C-" Q
  1. S DIR(0)="E" D ^DIR I $D(DIRUT) S FBQ=1 Q
  1. W @IOF
  1. Q