FBPCR3.m

FBPCR3 ;AISC/GRR,TET-PHARMACY POTENTIAL COST RECOVERY, SORT/PRINT ;6/30/2006

 ;;3.5;FEE BASIS;**48,69,98,163,166**;JAN 30, 1995;Build 21

 ;Per VA Directive 6402, this routine should not be modified.

 ;

EN ;entry point

 S (FBCATC,FBINS,FBPSF)=0

SORT ;sort by date certified for payment, patient, invoice number ien, rx ien

 S I=FBBDATE-.1 F  S I=$O(^FBAA(162.1,"AA",I)) Q:'I!(I>FBEDATE)  S J=0 F  S J=$O(^FBAA(162.1,"AA",I,J)) Q:'J  D

 .S DFN=J D VET^FBPCR

 .S K=0 F  S K=$O(^FBAA(162.1,"AA",I,J,K)) Q:K'>0  S L=0 F  S L=$O(^FBAA(162.1,"AA",I,J,K,L)) Q:L'>0  D  S (FBCATC,FBINS,FBPSF)=0

 ..D SET Q:'FBPSV&('$D(FBPSV(FBPSF)))  I FBCATC!FBINS D SETTMP

KILL ;kill variables set in sort

 K A1,A2,DFN,FBAAA,FBAC,FBAP,FBBATCH,FBCATC,FBDA1,FBDRUG,FBFD,FBFD1,FBIN,FBINS,FBINVN,FBLOC,FBPAT,FBPD,FBPSF,FBPV,FBQTY,FBREIM,FBRX,FBSC,FBSTR,FBSUSP,FBVEN,FBVI,I,J,K,L,N,V,Y

 K FBVNAME,FBVID,FBVCHAIN,FBPNAME,FBPID,FBDOB

 K FBADJLA,FBADJLR,TAMT,FBRRMKL

 K FBAUTH,FBIEN,FBX ;FB*3.5*163

 D KILL^FBPCR2

 Q

SET ;set variables

 N FBIEN,FBX ;FB*3.5*163

 S Y(0)=$G(^FBAA(162.1,+K,"RX",+L,0)) I Y(0)']""!($P(Y(0),U,9)=1) Q

 I $G(^FBAA(162.1,+K,"RX",+L,"FBREJ"))]"" Q

 S Y(2)=$G(^FBAA(162.1,+K,0))

 S Y(1)=$G(^FBAA(162.1,+K,"RX",+L,2))

 S FBX=$$ADJLRA^FBRXFA(+L_","_+K_",")

 S FBADJLR=$P(FBX,U) ;adjustment code

 S FBADJLA=$P(FBX,U,2) ;adjustment amount

 S TAMT=$FN($P(Y(0),"^",7),"",2) ;suspend amount

 S FBRRMKL=$$RRL^FBRXFR(+L_","_+K_",") ;remitt remarks

 S FBPSF=+$P(Y(1),U,5),FBFD=$P(Y(0),U,3),FBAAA=$P(Y(0),U,5)

 Q:'FBPSV&('$D(FBPSV(FBPSF)))  S FBCATC=$$CATC^FBPCR(DFN,FBFD)

 ;,FBINS=$S($O(^FBAAA("AIC",FBAAA,+$O(^FBAAA("AIC",FBAAA,-FBFD)),0))="Y":1,1:0)

 S FBINS=$S($$INSCK(FBFD,FBAAA,FBPI)=1:$$INSURED^FBPCR4(DFN,FBFD),1:0)

 Q:'FBCATC&'FBINS

 S FBINVN=$P(Y(2),U) D VEN

 S FBRX=$P(Y(0),U,1),FBDRUG=$P(Y(0),U,2),FBAC=$P(Y(0),U,4),FBAP=$P(Y(0),U,16),FBSUSP=$P(Y(0),U,8),FBPD=$P(Y(0),U,19),FBBATCH=$P(Y(0),U,17),FBBATCH=$P($G(^FBAA(161.7,+FBBATCH,0)),U)

 I FBSUSP]"" S FBSUSP=$P($G(^FBAA(161.27,+FBSUSP,0)),U)

 S FBREIM=$S($P(Y(0),U,20)="R":"*",1:""),FBSTR=$P(Y(0),U,12),FBQTY=$P(Y(0),U,13),A1=$J(FBAC,6,2),A2=$J(FBAP,6,2),FBPV=""

 S FBPD=$$DATX^FBAAUTL(FBPD),FBFD=$$DATX^FBAAUTL(FBFD)

 S FBPV=$S($P(Y(1),U,3)="V":"#",1:""),FBFD1=$S(FBPV="":" ",1:FBPV)_$S(FBREIM="":" ",1:FBREIM)_FBFD,FBRX="Rx: "_FBRX

 S FBVEN=FBVNAME_";"_FBVID,FBPAT=FBPNAME_";"_DFN

 S FBAUTH=$P(Y(1),U,7) ;Get linked auth FB*3.5*163

 I FBAUTH D FBAUTH^FBPCR2(FBAUTH,DFN)  ;FB*3.5*163

 Q

SETTMP ;sort data by primary service facility, patient, fee program, vendor, date

 Q:$$FILTER^FBPCR4()=0

 S ^TMP($J,"FB",FBPSF,FBPAT,FBPI,FBVEN,I,K_L)=FBFD1_U_FBRX_U_FBDRUG_U_FBSTR_U_FBQTY_U_A1_U_A2_U_FBSUSP_U_FBINVN_U_FBBATCH_U_FBPD_U_FBDOB_U_FBVCHAIN_U_FBPI_U_FBCATC_U_FBINS

 S ^TMP($J,"FB",FBPSF,FBPAT,FBPI,FBVEN,I,K_L,"FBADJ")=FBADJLR_U_FBADJLA_U_FBRRMKL_U_TAMT

 S ^TMP($J,"FB",FBPSF,FBPAT,FBPI,FBVEN,I,K_L,"FBAUTH")=$G(FBADX1)_U_$G(FBADX2)_U_$G(FBADX3)_U_$G(FBAICD)_U_$G(FBAREF)_U_$G(FBARNPI)_U_$G(FBAVND)_U_$G(FBAVNPI)_U_$G(FBAVTAX) ; FB*3.5*163

 S ^TMP($J,"FB",FBPSF,FBPAT,FBPI,FBVEN)=FBVCHAIN,^TMP($J,"FB",FBPSF,FBPAT)=FBDOB

 ;S FBIN(5)=$P(Y(1),U,6) I FBIN(5)]"",$D(^TMP($J,"FB",FBPSF,FBPAT,FBPI,FBVEN,I,L)) D ANC^FBPCR67

 Q

VEN ;set variables for vendor

 S V=$G(^FBAAV(+$P(Y(2),U,4),0)),FBVNAME=$E($P(V,U),1,23),FBVID=$P(V,U,2),FBVCHAIN=$P(V,U,10)

 Q

PRINT ;write output

 I FBPG>1&(($Y+10)>IOSL) D HDR Q:FBOUT

 E  D HDR1 Q:FBOUT

 S FBVI="" F  S FBVI=$O(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI)) Q:FBVI']""!(FBOUT)  D SH Q:FBOUT  D  Q:FBOUT

 .S FBDT=0 F  S FBDT=$O(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT)) Q:'FBDT  S L=0 F  S L=$O(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,L)) Q:'L  D  Q:FBOUT

 ..I ($Y+6)>IOSL D PAGE Q:FBOUT

 ..S FBDATA=^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,L),FBCATC=$P(FBDATA,U,15),FBINS=$P(FBDATA,U,16)

 ..S FBADJ=^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,L,"FBADJ")

 ..W !,$P(FBDATA,U),?64,$P(FBDATA,U,11),!

 ..W ?2,$P(FBDATA,U,2),?15,$P(FBDATA,U,3),?45,$P(FBDATA,U,4),?63,$P(FBDATA,U,5)

 ..W !?4,$P(FBDATA,U,6),?12,$P(FBDATA,U,7)

 ..W ?20 I $P(FBADJ,U,1)]"" W $P(FBADJ,U,1),?30,$J($P(FBADJ,U,2),14)

 ..;If no adjustment code then print suspend cpde amd amount

 ..I $P(FBADJ,U,1)="" W $P(FBDATA,U,8),?30,$J($P(FBADJ,U,4),14)

 ..W ?47,$P(FBDATA,U,9),?58,$P(FBDATA,U,10),?66,$P(FBADJ,U,3)

 ..I FBCATC!FBINS W !?5,">>> Cost recover from "_$S(FBCATC:"means testing",FBINS:"insurance",1:"") W:FBCATC&FBINS " and insurance" W "."

 ..W ! D PRTAUTH^FBPCR2(L)  ; FB*3.5*163

 ..W !

EXIT ;kill and quit

 Q

HDR ;main header

 D HDR^FBPCR Q:FBOUT

HDR1 W !!?(IOM-(13+$L(FBXPROG))/2),"NVC PROGRAM: ",FBXPROG ;FB*3.5*163 Changed from FEE to NVC

 W !?4,"Fill Date",?64,"Date Certified"

 W !,?15,"Drug Name",?44,"Strength",?60,"Quantity"

 W !?2,"Claimed",?12,"Paid",?20,"Adj Code",?33,"Adj Amounts",?47,"Invoice #",?58,"Batch #",?66,"Remit Remarks",!,FBDASH

 Q

SH ;subheader - vendor, prints when name changes

 I ($Y+4)>IOSL D HDR Q:FBOUT

 W !!,"Vendor: ",$P(FBVI,";"),?41,"Vendor ID: ",$P($P(FBVI,";",2),"/",1),?65,"Chain #: ",$P($G(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI)),U)

 W !?20,"Fee Basis Billing Provider NPI: ",$P(FBVI,"/",2)

 Q

CR ;read for display

 S DIR(0)="E" W ! D ^DIR K DIR S:$D(DUOUT)!($D(DTOUT)) FBOUT=1

 Q

PAGE ;new page

 D HDR Q:FBOUT  D SH

 Q

 ;FB*3.5*163 - modified to process yes or no Potential Cost Recovery value.

INSCK(FBDT,FBDA1,FBPI) ;possible cost recovery fcn call

 ;Passed variables:  fbdt=fill date or treatment from date

 ;                   fbda1=ien if fee patient file, patient ien

 ;                   fbpi=fee program

 ;Output variables:  fbins=1 if possible recovery, 0 if no

 N FBDA,FBFLAG,FBINS

 S FBINS=0,FBFLAG=0,FBDT=FBDT+.1,FBDT=+$O(^FBAAA("AIC",FBDA1,-FBDT))

 I FBDT S FBINS=$O(^FBAAA("AIC",FBDA1,FBDT,"N")) I FBINS="Y"!(FBINS="N") D

 .S FBDA=0 F  S FBDA=$O(^FBAAA("AIC",FBDA1,FBDT,FBINS,FBDA)) Q:'FBDA  D  ; Get both inpatient and outpatient pcr - FB*3.5*166

 ..I $P($G(^FBAAA(FBDA1,1,FBDA,0)),U,3)=FBPI S FBFLAG=1

 I 'FBFLAG S FBINS=0

 Q $S(FBINS="Y":1,FBINS="N":1,1:0)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBPCR3   6054     printed  Mar 13, 2025@21:04:30                                                                                                                                                                                                      Page 2

FBPCR3    ;AISC/GRR,TET-PHARMACY POTENTIAL COST RECOVERY, SORT/PRINT ;6/30/2006

 +1       ;;3.5;FEE BASIS;**48,69,98,163,166**;JAN 30, 1995;Build 21

 +2       ;Per VA Directive 6402, this routine should not be modified.

 +3       ;

EN        ;entry point

 +1        SET (FBCATC,FBINS,FBPSF)=0

SORT      ;sort by date certified for payment, patient, invoice number ien, rx ien

 +1        SET I=FBBDATE-.1

           FOR 

               SET I=$ORDER(^FBAA(162.1,"AA",I))

               if 'I!(I>FBEDATE)

                   QUIT 

               SET J=0

               FOR 

                   SET J=$ORDER(^FBAA(162.1,"AA",I,J))

                   if 'J

                       QUIT 

                   Begin DoDot:1

 +2                    SET DFN=J

                       DO VET^FBPCR

 +3                    SET K=0

                       FOR 

                           SET K=$ORDER(^FBAA(162.1,"AA",I,J,K))

                           if K'>0

                               QUIT 

                           SET L=0

                           FOR 

                               SET L=$ORDER(^FBAA(162.1,"AA",I,J,K,L))

                               if L'>0

                                   QUIT 

                               Begin DoDot:2

 +4                                DO SET

                                   if 'FBPSV&('$DATA(FBPSV(FBPSF)))

                                       QUIT 

                                   IF FBCATC!FBINS

                                       DO SETTMP

                               End DoDot:2

                               SET (FBCATC,FBINS,FBPSF)=0

                   End DoDot:1

KILL      ;kill variables set in sort

 +1        KILL A1,A2,DFN,FBAAA,FBAC,FBAP,FBBATCH,FBCATC,FBDA1,FBDRUG,FBFD,FBFD1,FBIN,FBINS,FBINVN,FBLOC,FBPAT,FBPD,FBPSF,FBPV,FBQTY,FBREIM,FBRX,FBSC,FBSTR,FBSUSP,FBVEN,FBVI,I,J,K,L,N,V,Y

 +2        KILL FBVNAME,FBVID,FBVCHAIN,FBPNAME,FBPID,FBDOB

 +3        KILL FBADJLA,FBADJLR,TAMT,FBRRMKL

 +4       ;FB*3.5*163

           KILL FBAUTH,FBIEN,FBX

 +5        DO KILL^FBPCR2

 +6        QUIT 

SET       ;set variables

 +1       ;FB*3.5*163

           NEW FBIEN,FBX

 +2        SET Y(0)=$GET(^FBAA(162.1,+K,"RX",+L,0))

           IF Y(0)']""!($PIECE(Y(0),U,9)=1)

               QUIT 

 +3        IF $GET(^FBAA(162.1,+K,"RX",+L,"FBREJ"))]""

               QUIT 

 +4        SET Y(2)=$GET(^FBAA(162.1,+K,0))

 +5        SET Y(1)=$GET(^FBAA(162.1,+K,"RX",+L,2))

 +6        SET FBX=$$ADJLRA^FBRXFA(+L_","_+K_",")

 +7       ;adjustment code

           SET FBADJLR=$PIECE(FBX,U)

 +8       ;adjustment amount

           SET FBADJLA=$PIECE(FBX,U,2)

 +9       ;suspend amount

           SET TAMT=$FNUMBER($PIECE(Y(0),"^",7),"",2)

 +10      ;remitt remarks

           SET FBRRMKL=$$RRL^FBRXFR(+L_","_+K_",")

 +11       SET FBPSF=+$PIECE(Y(1),U,5)

           SET FBFD=$PIECE(Y(0),U,3)

           SET FBAAA=$PIECE(Y(0),U,5)

 +12       if 'FBPSV&('$DATA(FBPSV(FBPSF)))

               QUIT 

           SET FBCATC=$$CATC^FBPCR(DFN,FBFD)

 +13      ;,FBINS=$S($O(^FBAAA("AIC",FBAAA,+$O(^FBAAA("AIC",FBAAA,-FBFD)),0))="Y":1,1:0)

 +14       SET FBINS=$SELECT($$INSCK(FBFD,FBAAA,FBPI)=1:$$INSURED^FBPCR4(DFN,FBFD),1:0)

 +15       if 'FBCATC&'FBINS

               QUIT 

 +16       SET FBINVN=$PIECE(Y(2),U)

           DO VEN

 +17       SET FBRX=$PIECE(Y(0),U,1)

           SET FBDRUG=$PIECE(Y(0),U,2)

           SET FBAC=$PIECE(Y(0),U,4)

           SET FBAP=$PIECE(Y(0),U,16)

           SET FBSUSP=$PIECE(Y(0),U,8)

           SET FBPD=$PIECE(Y(0),U,19)

           SET FBBATCH=$PIECE(Y(0),U,17)

           SET FBBATCH=$PIECE($GET(^FBAA(161.7,+FBBATCH,0)),U)

 +18       IF FBSUSP]""

               SET FBSUSP=$PIECE($GET(^FBAA(161.27,+FBSUSP,0)),U)

 +19       SET FBREIM=$SELECT($PIECE(Y(0),U,20)="R":"*",1:"")

           SET FBSTR=$PIECE(Y(0),U,12)

           SET FBQTY=$PIECE(Y(0),U,13)

           SET A1=$JUSTIFY(FBAC,6,2)

           SET A2=$JUSTIFY(FBAP,6,2)

           SET FBPV=""

 +20       SET FBPD=$$DATX^FBAAUTL(FBPD)

           SET FBFD=$$DATX^FBAAUTL(FBFD)

 +21       SET FBPV=$SELECT($PIECE(Y(1),U,3)="V":"#",1:"")

           SET FBFD1=$SELECT(FBPV="":" ",1:FBPV)_$SELECT(FBREIM="":" ",1:FBREIM)_FBFD

           SET FBRX="Rx: "_FBRX

 +22       SET FBVEN=FBVNAME_";"_FBVID

           SET FBPAT=FBPNAME_";"_DFN

 +23      ;Get linked auth FB*3.5*163

           SET FBAUTH=$PIECE(Y(1),U,7)

 +24      ;FB*3.5*163

           IF FBAUTH

               DO FBAUTH^FBPCR2(FBAUTH,DFN)

 +25       QUIT 

SETTMP    ;sort data by primary service facility, patient, fee program, vendor, date

 +1        if $$FILTER^FBPCR4()=0

               QUIT 

 +2        SET ^TMP($JOB,"FB",FBPSF,FBPAT,FBPI,FBVEN,I,K_L)=FBFD1_U_FBRX_U_FBDRUG_U_FBSTR_U_FBQTY_U_A1_U_A2_U_FBSUSP_U_FBINVN_U_FBBATCH_U_FBPD_U_FBDOB_U_FBVCHAIN_U_FBPI_U_FBCATC_U_FBINS

 +3        SET ^TMP($JOB,"FB",FBPSF,FBPAT,FBPI,FBVEN,I,K_L,"FBADJ")=FBADJLR_U_FBADJLA_U_FBRRMKL_U_TAMT

 +4       ; FB*3.5*163

           SET ^TMP($JOB,"FB",FBPSF,FBPAT,FBPI,FBVEN,I,K_L,"FBAUTH")=$GET(FBADX1)_U_$GET(FBADX2)_U_$GET(FBADX3)_U_$GET(FBAICD)_U_$GET(FBAREF)_U_$GET(FBARNPI)_U_$GET(FBAVND)_U_$GET(FBAVNPI)_U_$GET(FBAVTAX)

 +5        SET ^TMP($JOB,"FB",FBPSF,FBPAT,FBPI,FBVEN)=FBVCHAIN

           SET ^TMP($JOB,"FB",FBPSF,FBPAT)=FBDOB

 +6       ;S FBIN(5)=$P(Y(1),U,6) I FBIN(5)]"",$D(^TMP($J,"FB",FBPSF,FBPAT,FBPI,FBVEN,I,L)) D ANC^FBPCR67

 +7        QUIT 

VEN       ;set variables for vendor

 +1        SET V=$GET(^FBAAV(+$PIECE(Y(2),U,4),0))

           SET FBVNAME=$EXTRACT($PIECE(V,U),1,23)

           SET FBVID=$PIECE(V,U,2)

           SET FBVCHAIN=$PIECE(V,U,10)

 +2        QUIT 

PRINT     ;write output

 +1        IF FBPG>1&(($Y+10)>IOSL)

               DO HDR

               if FBOUT

                   QUIT 

 +2       IF '$TEST

               DO HDR1

               if FBOUT

                   QUIT 

 +3        SET FBVI=""

           FOR 

               SET FBVI=$ORDER(^TMP($JOB,"FB",FBPSF,FBPT,FBPI,FBVI))

               if FBVI']""!(FBOUT)

                   QUIT 

               DO SH

               if FBOUT

                   QUIT 

               Begin DoDot:1

 +4                SET FBDT=0

                   FOR 

                       SET FBDT=$ORDER(^TMP($JOB,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT))

                       if 'FBDT

                           QUIT 

                       SET L=0

                       FOR 

                           SET L=$ORDER(^TMP($JOB,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,L))

                           if 'L

                               QUIT 

                           Begin DoDot:2

 +5                            IF ($Y+6)>IOSL

                                   DO PAGE

                                   if FBOUT

                                       QUIT 

 +6                            SET FBDATA=^TMP($JOB,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,L)

                               SET FBCATC=$PIECE(FBDATA,U,15)

                               SET FBINS=$PIECE(FBDATA,U,16)

 +7                            SET FBADJ=^TMP($JOB,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,L,"FBADJ")

 +8                            WRITE !,$PIECE(FBDATA,U),?64,$PIECE(FBDATA,U,11),!

 +9                            WRITE ?2,$PIECE(FBDATA,U,2),?15,$PIECE(FBDATA,U,3),?45,$PIECE(FBDATA,U,4),?63,$PIECE(FBDATA,U,5)

 +10                           WRITE !?4,$PIECE(FBDATA,U,6),?12,$PIECE(FBDATA,U,7)

 +11                           WRITE ?20

                               IF $PIECE(FBADJ,U,1)]""

                                   WRITE $PIECE(FBADJ,U,1),?30,$JUSTIFY($PIECE(FBADJ,U,2),14)

 +12      ;If no adjustment code then print suspend cpde amd amount

 +13                           IF $PIECE(FBADJ,U,1)=""

                                   WRITE $PIECE(FBDATA,U,8),?30,$JUSTIFY($PIECE(FBADJ,U,4),14)

 +14                           WRITE ?47,$PIECE(FBDATA,U,9),?58,$PIECE(FBDATA,U,10),?66,$PIECE(FBADJ,U,3)

 +15                           IF FBCATC!FBINS

                                   WRITE !?5,">>> Cost recover from "_$SELECT(FBCATC:"means testing",FBINS:"insurance",1:"")

                                   if FBCATC&FBINS

                                       WRITE " and insurance"

                                   WRITE "."

 +16      ; FB*3.5*163

                               WRITE !

                               DO PRTAUTH^FBPCR2(L)

 +17                           WRITE !

                           End DoDot:2

                           if FBOUT

                               QUIT 

               End DoDot:1

               if FBOUT

                   QUIT 

EXIT      ;kill and quit

 +1        QUIT 

HDR       ;main header

 +1        DO HDR^FBPCR

           if FBOUT

               QUIT 

HDR1      ;FB*3.5*163 Changed from FEE to NVC

           WRITE !!?(IOM-(13+$LENGTH(FBXPROG))/2),"NVC PROGRAM: ",FBXPROG

 +1        WRITE !?4,"Fill Date",?64,"Date Certified"

 +2        WRITE !,?15,"Drug Name",?44,"Strength",?60,"Quantity"

 +3        WRITE !?2,"Claimed",?12,"Paid",?20,"Adj Code",?33,"Adj Amounts",?47,"Invoice #",?58,"Batch #",?66,"Remit Remarks",!,FBDASH

 +4        QUIT 

SH        ;subheader - vendor, prints when name changes

 +1        IF ($Y+4)>IOSL

               DO HDR

               if FBOUT

                   QUIT 

 +2        WRITE !!,"Vendor: ",$PIECE(FBVI,";"),?41,"Vendor ID: ",$PIECE($PIECE(FBVI,";",2),"/",1),?65,"Chain #: ",$PIECE($GET(^TMP($JOB,"FB",FBPSF,FBPT,FBPI,FBVI)),U)

 +3        WRITE !?20,"Fee Basis Billing Provider NPI: ",$PIECE(FBVI,"/",2)

 +4        QUIT 

CR        ;read for display

 +1        SET DIR(0)="E"

           WRITE !

           DO ^DIR

           KILL DIR

           if $DATA(DUOUT)!($DATA(DTOUT))

               SET FBOUT=1

 +2        QUIT 

PAGE      ;new page

 +1        DO HDR

           if FBOUT

               QUIT 

           DO SH

 +2        QUIT 

 +3       ;FB*3.5*163 - modified to process yes or no Potential Cost Recovery value.

INSCK(FBDT,FBDA1,FBPI) ;possible cost recovery fcn call

 +1       ;Passed variables:  fbdt=fill date or treatment from date

 +2       ;                   fbda1=ien if fee patient file, patient ien

 +3       ;                   fbpi=fee program

 +4       ;Output variables:  fbins=1 if possible recovery, 0 if no

 +5        NEW FBDA,FBFLAG,FBINS

 +6        SET FBINS=0

           SET FBFLAG=0

           SET FBDT=FBDT+.1

           SET FBDT=+$ORDER(^FBAAA("AIC",FBDA1,-FBDT))

 +7        IF FBDT

               SET FBINS=$ORDER(^FBAAA("AIC",FBDA1,FBDT,"N"))

               IF FBINS="Y"!(FBINS="N")

                   Begin DoDot:1

 +8       ; Get both inpatient and outpatient pcr - FB*3.5*166

                       SET FBDA=0

                       FOR 

                           SET FBDA=$ORDER(^FBAAA("AIC",FBDA1,FBDT,FBINS,FBDA))

                           if 'FBDA

                               QUIT 

                           Begin DoDot:2

 +9                            IF $PIECE($GET(^FBAAA(FBDA1,1,FBDA,0)),U,3)=FBPI

                                   SET FBFLAG=1

                           End DoDot:2

                   End DoDot:1

 +10       IF 'FBFLAG

               SET FBINS=0

 +11       QUIT $SELECT(FBINS="Y":1,FBINS="N":1,1:0)