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