FBUCDE ;BOIFO/SGJ-UNAUTHORIZED EDI CLAIMS THAT WERE NOT APPROVED ;12/18/03
;;3.5;FEE BASIS;**69**;JAN 30, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
N FBX
; ask date range
S DIR(0)="D^::EX",DIR("A")=" Beginning Date"
; default from date is first day of current month
S DIR("B")=$$FMTE^XLFDT($E(DT,1,5)_"01")
D ^DIR K DIR Q:$D(DIRUT)
S FBBEG=Y
S DIR(0)="DA^"_FBBEG_"::EX",DIR("A")=" Ending Date: "
; default to date is last day of specified month
D NOW^%DTC S DIR("B")=$$FMTE^XLFDT(X)
D ^DIR K DIR Q:$D(DIRUT)
S FBEND=Y
;
; ask device
S %ZIS="QM" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. S ZTRTN="QEN^FBUCDE",ZTDESC="UNAUTHORIZED EDI CLAIMS REPORT"
. F FBX="FBBEG","FBEND" S ZTSAVE(FBX)=""
. D ^%ZTLOAD,HOME^%ZIS K ZTSK
;
QEN ; queued entry
U IO
;
GATHER ; collect and sort data by date
N FBSET,FBFPPSC,FBC,FBPG,FBHDT,FBDA,FBDTR
S (FBQUIT,FBPG)=0
D NOW^%DTC S FBDTR=$$DATX^FBAAUTL(X)
K FBDL S FBDL="",$P(FBDL,"=",IOM)=""
; build page header text for selection criteria
S FBHDT(1)="From Date: "_$$DATX^FBAAUTL(FBBEG)_" To Date: "_$$DATX^FBAAUTL(FBEND)
;
D HD
S FBBEG=FBBEG-.0000001
S FBEND=FBEND+.999999
K ^TMP("FBDE")
;
; Initialize Counter
S FBC=0
;
S FBSET=" Reason for Disapproval: "
;
S (FBFPPSC,FBDA)=""
F S FBFPPSC=$O(^FB583("AFC",FBFPPSC)) Q:FBFPPSC="" F S FBDA=$O(^FB583("AFC",FBFPPSC,FBDA)) Q:FBDA="" D ONE
D PRINT
;
I FBC=0 W !!,"no entries found.",!
;
I FBQUIT W !!,"REPORT STOPPED AT USER REQUEST",!
;
I 'FBQUIT,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
D ^%ZISC
G EXIT
Q
;
HD ; page header
N FBI
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,FBQUIT=1 Q
I $E(IOST,1,2)="C-",FBPG S DIR(0)="E" D ^DIR K DIR I 'Y S FBQUIT=1 Q
I $E(IOST,1,2)="C-"!FBPG W @IOF
S FBPG=FBPG+1
W !,"UNAUTHORIZED EDI CLAIMS THAT WERE NOT APPROVED",?67,FBDTR
S FBI=0 F S FBI=$O(FBHDT(FBI)) Q:'FBI W !,FBHDT(FBI)
W ?68,"Page: ",FBPG
W !!,"Date of Disposition",?23,"Disposition",?42,"FPPS Claim ID",?62,"Fee Program"
W !?2,"Veteran",?38,"Vendor"
W !?2,"Treatment From",?31,"Treatment To",?58,"Amt Claimed"
W !,FBDL
Q
;
ONE N FBZ,FBDT
S FBZ=$G(^FB583(FBDA,0))
S FBDT=$P(FBZ,U,12)
; skip if date of disposition not within specified period
Q:FBDT=""!(FBDT>FBEND)!(FBDT<FBBEG)
; skip if disposition is not equal to disapproved,
; cancelled/withdrawn or abandoned.
Q:"^1^4^"[(U_$P(FBZ,U,11)_U)
; store the ien in list (sorted by date of disposition)
S ^TMP("FBDE",$J,FBDT,FBDA,FBFPPSC)=""
Q
PRINT ; print claims
N I,FBZ,FBAC
S FBDT="" F S FBDT=$O(^TMP("FBDE",$J,FBDT)) Q:FBDT="" D Q:FBQUIT
. S FBDA="" F S FBDA=$O(^TMP("FBDE",$J,FBDT,FBDA)) Q:FBDA="" D Q:FBQUIT
. . S FBC=FBC+1,I=""
. . S FBZ=$G(^FB583(FBDA,0))
. . S FBAC=$P(FBZ,U,9)+.0001,FBAC=$P(FBAC,".",1)_"."_$E($P(FBAC,".",2),1,2)
. . I $Y+9>IOSL D HD Q:FBQUIT
. . W !!,$$DATX^FBAAUTL($E(FBDT,1,7)),?21,$E($P($$PTR^FBUCUTL("^FB(162.91,",$P(FBZ,U,11)),U),1,30),?44,$O(^TMP("FBDE",$J,FBDT,FBDA,0)),?62,$$PROG^FBUCUTL($P(FBZ,U,2))
. . W !?2,$E($$VET^FBUCUTL($P(FBZ,U,4)),1,30),?35,$E($$VEN^FBUCUTL($P(FBZ,U,3)),1,30)
. . W !?2,$$DATX^FBAAUTL($E($P(FBZ,U,5),1,7)),?32,$$DATX^FBAAUTL($E($P(FBZ,U,6),1,7)),?58,$J(FBAC,6)
. . F S I=$O(^FB583(FBDA,"D","B",I)) Q:I="" W !,FBSET_$P(^FB(162.94,I,0),U)
Q
EXIT ; kill variables, tmp global and quit
S:$D(ZTQUEUED) ZTREQ="@"
K %,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,POP,X,Y
K ^TMP("FBDE"),FBBEG,FBEND,FBQUIT,FBDL
Q
;FBUCDE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUCDE 3546 printed Apr 09, 2024@21:05:11 Page 2
FBUCDE ;BOIFO/SGJ-UNAUTHORIZED EDI CLAIMS THAT WERE NOT APPROVED ;12/18/03
+1 ;;3.5;FEE BASIS;**69**;JAN 30, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 NEW FBX
+5 ; ask date range
+6 SET DIR(0)="D^::EX"
SET DIR("A")=" Beginning Date"
+7 ; default from date is first day of current month
+8 SET DIR("B")=$$FMTE^XLFDT($EXTRACT(DT,1,5)_"01")
+9 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+10 SET FBBEG=Y
+11 SET DIR(0)="DA^"_FBBEG_"::EX"
SET DIR("A")=" Ending Date: "
+12 ; default to date is last day of specified month
+13 DO NOW^%DTC
SET DIR("B")=$$FMTE^XLFDT(X)
+14 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+15 SET FBEND=Y
+16 ;
+17 ; ask device
+18 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO EXIT
+19 IF $DATA(IO("Q"))
Begin DoDot:1
+20 SET ZTRTN="QEN^FBUCDE"
SET ZTDESC="UNAUTHORIZED EDI CLAIMS REPORT"
+21 FOR FBX="FBBEG","FBEND"
SET ZTSAVE(FBX)=""
+22 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
GOTO EXIT
+23 ;
QEN ; queued entry
+1 USE IO
+2 ;
GATHER ; collect and sort data by date
+1 NEW FBSET,FBFPPSC,FBC,FBPG,FBHDT,FBDA,FBDTR
+2 SET (FBQUIT,FBPG)=0
+3 DO NOW^%DTC
SET FBDTR=$$DATX^FBAAUTL(X)
+4 KILL FBDL
SET FBDL=""
SET $PIECE(FBDL,"=",IOM)=""
+5 ; build page header text for selection criteria
+6 SET FBHDT(1)="From Date: "_$$DATX^FBAAUTL(FBBEG)_" To Date: "_$$DATX^FBAAUTL(FBEND)
+7 ;
+8 DO HD
+9 SET FBBEG=FBBEG-.0000001
+10 SET FBEND=FBEND+.999999
+11 KILL ^TMP("FBDE")
+12 ;
+13 ; Initialize Counter
+14 SET FBC=0
+15 ;
+16 SET FBSET=" Reason for Disapproval: "
+17 ;
+18 SET (FBFPPSC,FBDA)=""
+19 FOR
SET FBFPPSC=$ORDER(^FB583("AFC",FBFPPSC))
if FBFPPSC=""
QUIT
FOR
SET FBDA=$ORDER(^FB583("AFC",FBFPPSC,FBDA))
if FBDA=""
QUIT
DO ONE
+20 DO PRINT
+21 ;
+22 IF FBC=0
WRITE !!,"no entries found.",!
+23 ;
+24 IF FBQUIT
WRITE !!,"REPORT STOPPED AT USER REQUEST",!
+25 ;
+26 IF 'FBQUIT
IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
+27 DO ^%ZISC
+28 GOTO EXIT
+29 QUIT
+30 ;
HD ; page header
+1 NEW FBI
+2 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
SET FBQUIT=1
QUIT
+3 IF $EXTRACT(IOST,1,2)="C-"
IF FBPG
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET FBQUIT=1
QUIT
+4 IF $EXTRACT(IOST,1,2)="C-"!FBPG
WRITE @IOF
+5 SET FBPG=FBPG+1
+6 WRITE !,"UNAUTHORIZED EDI CLAIMS THAT WERE NOT APPROVED",?67,FBDTR
+7 SET FBI=0
FOR
SET FBI=$ORDER(FBHDT(FBI))
if 'FBI
QUIT
WRITE !,FBHDT(FBI)
+8 WRITE ?68,"Page: ",FBPG
+9 WRITE !!,"Date of Disposition",?23,"Disposition",?42,"FPPS Claim ID",?62,"Fee Program"
+10 WRITE !?2,"Veteran",?38,"Vendor"
+11 WRITE !?2,"Treatment From",?31,"Treatment To",?58,"Amt Claimed"
+12 WRITE !,FBDL
+13 QUIT
+14 ;
ONE NEW FBZ,FBDT
+1 SET FBZ=$GET(^FB583(FBDA,0))
+2 SET FBDT=$PIECE(FBZ,U,12)
+3 ; skip if date of disposition not within specified period
+4 if FBDT=""!(FBDT>FBEND)!(FBDT<FBBEG)
QUIT
+5 ; skip if disposition is not equal to disapproved,
+6 ; cancelled/withdrawn or abandoned.
+7 if "^1^4^"[(U_$PIECE(FBZ,U,11)_U)
QUIT
+8 ; store the ien in list (sorted by date of disposition)
+9 SET ^TMP("FBDE",$JOB,FBDT,FBDA,FBFPPSC)=""
+10 QUIT
PRINT ; print claims
+1 NEW I,FBZ,FBAC
+2 SET FBDT=""
FOR
SET FBDT=$ORDER(^TMP("FBDE",$JOB,FBDT))
if FBDT=""
QUIT
Begin DoDot:1
+3 SET FBDA=""
FOR
SET FBDA=$ORDER(^TMP("FBDE",$JOB,FBDT,FBDA))
if FBDA=""
QUIT
Begin DoDot:2
+4 SET FBC=FBC+1
SET I=""
+5 SET FBZ=$GET(^FB583(FBDA,0))
+6 SET FBAC=$PIECE(FBZ,U,9)+.0001
SET FBAC=$PIECE(FBAC,".",1)_"."_$EXTRACT($PIECE(FBAC,".",2),1,2)
+7 IF $Y+9>IOSL
DO HD
if FBQUIT
QUIT
+8 WRITE !!,$$DATX^FBAAUTL($EXTRACT(FBDT,1,7)),?21,$EXTRACT($PIECE($$PTR^FBUCUTL("^FB(162.91,",$PIECE(FBZ,U,11)),U),1,30),?44,$ORDER(^TMP("FBDE",$JOB,FBDT,FBDA,0)),?62,$$PROG^FBUCUTL($PIECE(FBZ,U,2))
+9 WRITE !?2,$EXTRACT($$VET^FBUCUTL($PIECE(FBZ,U,4)),1,30),?35,$EXTRACT($$VEN^FBUCUTL($PIECE(FBZ,U,3)),1,30)
+10 WRITE !?2,$$DATX^FBAAUTL($EXTRACT($PIECE(FBZ,U,5),1,7)),?32,$$DATX^FBAAUTL($EXTRACT($PIECE(FBZ,U,6),1,7)),?58,$JUSTIFY(FBAC,6)
+11 FOR
SET I=$ORDER(^FB583(FBDA,"D","B",I))
if I=""
QUIT
WRITE !,FBSET_$PIECE(^FB(162.94,I,0),U)
End DoDot:2
if FBQUIT
QUIT
End DoDot:1
if FBQUIT
QUIT
+12 QUIT
EXIT ; kill variables, tmp global and quit
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL %,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,POP,X,Y
+3 KILL ^TMP("FBDE"),FBBEG,FBEND,FBQUIT,FBDL
+4 QUIT
+5 ;FBUCDE
