FBFPCI ;WOIFO/SAB-FPPS AUDIT REPORT ;8/6/2003
;;3.5;FEE BASIS;**61**;JAN 30, 1995
;
ASKCI ; ask FPPS CLAIM ID
K DA
S DIR(0)="162.7,32"
D ^DIR K DIR I $D(DIRUT) S FBQUIT=1 G EXIT
S FBFPPSC=Y
;
; ask device
S %ZIS="QM" D ^%ZIS I POP S FBQUIT=1 G EXIT
I $D(IO("Q")) D S FBQUIT=0 G EXIT
. S ZTRTN="QEN^FBFPCI",ZTDESC="FPPS Claim Inquiry"
. F FBX="FBFPPSC" S ZTSAVE(FBX)=""
. D ^%ZTLOAD,HOME^%ZIS K ZTSK
;
QEN ; queued entry
U IO
;
GATHER ; collect and sort data
S FBQUIT=0
K ^TMP($J)
;
; check inpatient invoices
F FBDA=0 F S FBDA=$O(^FBAAI("AFC",FBFPPSC,FBDA)) Q:'FBDA D
. S FBY0=$G(^FBAAI(FBDA,0))
. S FBAAIN=$P(FBY0,U)
. S FBPROG=$P(FBY0,U,12)
. I FBAAIN]"" S ^TMP($J,162.5,FBAAIN)=FBPROG
;
; check outpatient/ancillary invoices
S FBDA3=0
F S FBDA3=$O(^FBAAC("AFC",FBFPPSC,FBDA3)) Q:'FBDA3 D
.S FBDA2=0
.F S FBDA2=$O(^FBAAC("AFC",FBFPPSC,FBDA3,FBDA2)) Q:'FBDA2 D
..S FBDA1=0
..F S FBDA1=$O(^FBAAC("AFC",FBFPPSC,FBDA3,FBDA2,FBDA1)) Q:'FBDA1 D
...S FBDA=0
...F S FBDA=$O(^FBAAC("AFC",FBFPPSC,FBDA3,FBDA2,FBDA1,FBDA)) Q:'FBDA D
....S FBY0=$G(^FBAAC(FBDA3,1,FBDA2,1,FBDA1,1,FBDA,0))
....S FBAAIN=$P(FBY0,U,16)
....I FBAAIN]"" S ^TMP($J,162.03,FBAAIN,FBDA3,FBDA2,FBDA1,FBDA)=""
;
; check pharmacy invoices
S FBDA=0 F S FBDA=$O(^FBAA(162.1,"AFC",FBFPPSC,FBDA)) Q:'FBDA D
. S FBY0=$G(^FBAA(162.1,FBDA,0))
. S FBAAIN=$P(FBY0,U)
. I FBAAIN]"" S ^TMP($J,162.1,FBAAIN)=""
;
; check unauthorized claims
S FBDA=0 F S FBDA=$O(^FB583("AFC",FBFPPSC,FBDA)) Q:'FBDA D
. S FBY0=$G(^FB583(FBDA,0))
. S FBPN=$$GET1^DIQ(162.7,FBDA_",",2)
. S FBVN=$$GET1^DIQ(162.7,FBDA_",",1)
. S FBDT=$$GET1^DIQ(162.7,FBDA_",",.01)
. S ^TMP($J,162.7,FBDT,FBDA)=FBPN_U_FBVN
;
PRINT ; report data
S FBPG=0 D NOW^%DTC S Y=% D DD^%DT S FBDTR=Y
K FBDL S FBDL="",$P(FBDL,"-",IOM)=""
;
D HD
;
; show invoices
F FBFILE=162.5,162.03,162.1 D
. S FBAAIN="" F S FBAAIN=$O(^TMP($J,FBFILE,FBAAIN)) Q:FBAAIN="" D
. . I $Y+7>IOSL D HD Q:FBQUIT
. . I FBFILE=162.5 D
. . . S FBPROG=$P($G(^TMP($J,FBFILE,FBAAIN)),U)
. . . W !,"Inpatient ("
. . . W $S(FBPROG=6:"CH",FBPROG=7:"CNH",1:"")
. . . W ") Invoice: ",FBAAIN
. . I FBFILE=162.03 W !,"Outpatient/Ancillary Invoice: ",FBAAIN
. . I FBFILE=162.1 W !,"Pharmacy Invoice: ",FBAAIN
;
; show unauthorized claims
S FBDT="" F S FBDT=$O(^TMP($J,162.7,FBDT)) Q:FBDT="" D
. S FBDA=0 F S FBDA=$O(^TMP($J,162.7,FBDT,FBDA)) Q:'FBDA D
. . I $Y+7>IOSL D HD Q:FBQUIT
. . S FBX=$G(^TMP($J,162.7,FBDT,FBDA))
. . W !,"Unauthorized Claim: ",$P(FBX,U)," ",$P(FBX,U,2)," ",FBDT
;
I '$D(^TMP($J)) W !,"No VistA invoices found with specified FPPS CLAIM ID."
;
I FBQUIT W !!,"REPORT STOPPED AT USER REQUEST"
;
I 'FBQUIT,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR I 'Y S FBQUIT=1
D ^%ZISC
;
EXIT ;
I $D(ZTQUEUED) S ZTREQ="@"
K ^TMP($J)
K FBAAIN,FBDA,FBDA1,FBDA2,FBDA3,FBDL,FBDT,FBDTR,FBFILE
K FBPN,FBFPPSC,FBPG,FBPROG,FBVN,FBX,FBY0
K %,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,J,POP,X,Y
I 'FBQUIT,$E(IOST,1,2)="C-" W ! G ASKCI
K FBQUIT
Q
HD ; page header
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 !,"FPPS Claim Inquiry for ID: ",FBFPPSC,?49,FBDTR,?72,"page ",FBPG
W !,FBDL
Q
;
;FBFPCI
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBFPCI 3406 printed Nov 22, 2024@17:08:39 Page 2
FBFPCI ;WOIFO/SAB-FPPS AUDIT REPORT ;8/6/2003
+1 ;;3.5;FEE BASIS;**61**;JAN 30, 1995
+2 ;
ASKCI ; ask FPPS CLAIM ID
+1 KILL DA
+2 SET DIR(0)="162.7,32"
+3 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET FBQUIT=1
GOTO EXIT
+4 SET FBFPPSC=Y
+5 ;
+6 ; ask device
+7 SET %ZIS="QM"
DO ^%ZIS
IF POP
SET FBQUIT=1
GOTO EXIT
+8 IF $DATA(IO("Q"))
Begin DoDot:1
+9 SET ZTRTN="QEN^FBFPCI"
SET ZTDESC="FPPS Claim Inquiry"
+10 FOR FBX="FBFPPSC"
SET ZTSAVE(FBX)=""
+11 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
SET FBQUIT=0
GOTO EXIT
+12 ;
QEN ; queued entry
+1 USE IO
+2 ;
GATHER ; collect and sort data
+1 SET FBQUIT=0
+2 KILL ^TMP($JOB)
+3 ;
+4 ; check inpatient invoices
+5 FOR FBDA=0
FOR
SET FBDA=$ORDER(^FBAAI("AFC",FBFPPSC,FBDA))
if 'FBDA
QUIT
Begin DoDot:1
+6 SET FBY0=$GET(^FBAAI(FBDA,0))
+7 SET FBAAIN=$PIECE(FBY0,U)
+8 SET FBPROG=$PIECE(FBY0,U,12)
+9 IF FBAAIN]""
SET ^TMP($JOB,162.5,FBAAIN)=FBPROG
End DoDot:1
+10 ;
+11 ; check outpatient/ancillary invoices
+12 SET FBDA3=0
+13 FOR
SET FBDA3=$ORDER(^FBAAC("AFC",FBFPPSC,FBDA3))
if 'FBDA3
QUIT
Begin DoDot:1
+14 SET FBDA2=0
+15 FOR
SET FBDA2=$ORDER(^FBAAC("AFC",FBFPPSC,FBDA3,FBDA2))
if 'FBDA2
QUIT
Begin DoDot:2
+16 SET FBDA1=0
+17 FOR
SET FBDA1=$ORDER(^FBAAC("AFC",FBFPPSC,FBDA3,FBDA2,FBDA1))
if 'FBDA1
QUIT
Begin DoDot:3
+18 SET FBDA=0
+19 FOR
SET FBDA=$ORDER(^FBAAC("AFC",FBFPPSC,FBDA3,FBDA2,FBDA1,FBDA))
if 'FBDA
QUIT
Begin DoDot:4
+20 SET FBY0=$GET(^FBAAC(FBDA3,1,FBDA2,1,FBDA1,1,FBDA,0))
+21 SET FBAAIN=$PIECE(FBY0,U,16)
+22 IF FBAAIN]""
SET ^TMP($JOB,162.03,FBAAIN,FBDA3,FBDA2,FBDA1,FBDA)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 ;
+24 ; check pharmacy invoices
+25 SET FBDA=0
FOR
SET FBDA=$ORDER(^FBAA(162.1,"AFC",FBFPPSC,FBDA))
if 'FBDA
QUIT
Begin DoDot:1
+26 SET FBY0=$GET(^FBAA(162.1,FBDA,0))
+27 SET FBAAIN=$PIECE(FBY0,U)
+28 IF FBAAIN]""
SET ^TMP($JOB,162.1,FBAAIN)=""
End DoDot:1
+29 ;
+30 ; check unauthorized claims
+31 SET FBDA=0
FOR
SET FBDA=$ORDER(^FB583("AFC",FBFPPSC,FBDA))
if 'FBDA
QUIT
Begin DoDot:1
+32 SET FBY0=$GET(^FB583(FBDA,0))
+33 SET FBPN=$$GET1^DIQ(162.7,FBDA_",",2)
+34 SET FBVN=$$GET1^DIQ(162.7,FBDA_",",1)
+35 SET FBDT=$$GET1^DIQ(162.7,FBDA_",",.01)
+36 SET ^TMP($JOB,162.7,FBDT,FBDA)=FBPN_U_FBVN
End DoDot:1
+37 ;
PRINT ; report data
+1 SET FBPG=0
DO NOW^%DTC
SET Y=%
DO DD^%DT
SET FBDTR=Y
+2 KILL FBDL
SET FBDL=""
SET $PIECE(FBDL,"-",IOM)=""
+3 ;
+4 DO HD
+5 ;
+6 ; show invoices
+7 FOR FBFILE=162.5,162.03,162.1
Begin DoDot:1
+8 SET FBAAIN=""
FOR
SET FBAAIN=$ORDER(^TMP($JOB,FBFILE,FBAAIN))
if FBAAIN=""
QUIT
Begin DoDot:2
+9 IF $Y+7>IOSL
DO HD
if FBQUIT
QUIT
+10 IF FBFILE=162.5
Begin DoDot:3
+11 SET FBPROG=$PIECE($GET(^TMP($JOB,FBFILE,FBAAIN)),U)
+12 WRITE !,"Inpatient ("
+13 WRITE $SELECT(FBPROG=6:"CH",FBPROG=7:"CNH",1:"")
+14 WRITE ") Invoice: ",FBAAIN
End DoDot:3
+15 IF FBFILE=162.03
WRITE !,"Outpatient/Ancillary Invoice: ",FBAAIN
+16 IF FBFILE=162.1
WRITE !,"Pharmacy Invoice: ",FBAAIN
End DoDot:2
End DoDot:1
+17 ;
+18 ; show unauthorized claims
+19 SET FBDT=""
FOR
SET FBDT=$ORDER(^TMP($JOB,162.7,FBDT))
if FBDT=""
QUIT
Begin DoDot:1
+20 SET FBDA=0
FOR
SET FBDA=$ORDER(^TMP($JOB,162.7,FBDT,FBDA))
if 'FBDA
QUIT
Begin DoDot:2
+21 IF $Y+7>IOSL
DO HD
if FBQUIT
QUIT
+22 SET FBX=$GET(^TMP($JOB,162.7,FBDT,FBDA))
+23 WRITE !,"Unauthorized Claim: ",$PIECE(FBX,U)," ",$PIECE(FBX,U,2)," ",FBDT
End DoDot:2
End DoDot:1
+24 ;
+25 IF '$DATA(^TMP($JOB))
WRITE !,"No VistA invoices found with specified FPPS CLAIM ID."
+26 ;
+27 IF FBQUIT
WRITE !!,"REPORT STOPPED AT USER REQUEST"
+28 ;
+29 IF 'FBQUIT
IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET FBQUIT=1
+30 DO ^%ZISC
+31 ;
EXIT ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL ^TMP($JOB)
+3 KILL FBAAIN,FBDA,FBDA1,FBDA2,FBDA3,FBDL,FBDT,FBDTR,FBFILE
+4 KILL FBPN,FBFPPSC,FBPG,FBPROG,FBVN,FBX,FBY0
+5 KILL %,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,J,POP,X,Y
+6 IF 'FBQUIT
IF $EXTRACT(IOST,1,2)="C-"
WRITE !
GOTO ASKCI
+7 KILL FBQUIT
+8 QUIT
HD ; page header
+1 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
SET FBQUIT=1
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"
IF FBPG
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET FBQUIT=1
QUIT
+3 IF $EXTRACT(IOST,1,2)="C-"!FBPG
WRITE @IOF
+4 SET FBPG=FBPG+1
+5 WRITE !,"FPPS Claim Inquiry for ID: ",FBFPPSC,?49,FBDTR,?72,"page ",FBPG
+6 WRITE !,FBDL
+7 QUIT
+8 ;
+9 ;FBFPCI
