FBAAPCS ;WCIOFO/SAB-REPORT COST/SAVINGS FROM RBRVS FEE SCHEDULE ;6/28/1999
;;3.5;FEE BASIS;**4,77**;JAN 30, 1995
;
; ask date range
D DATE^FBAAUTL Q:FBPOP
;
W !,"Note: code descriptors will be versioned for the Ending DATE"
N ICPTVDT S ICPTVDT=$G(ENDDATE)
;
; ask CPT codes to include
K FBRCPT
S DIR(0)="Y",DIR("A")="Include all CPT codes",DIR("B")="YES"
D ^DIR K DIR G:$D(DIRUT) EXIT
S FBRCPT=$S(Y:"A",1:"")
; if not all CPT codes then ask selection method
I FBRCPT="" D
. S DIR(0)="S^1:RANGE OF CODES;2:INDIVIDUAL CODES"
. S DIR("A")="Choose a method to specify CPT Codes"
. S DIR("?",1)="You must choose one of the two methods that can be used"
. S DIR("?",2)="to specify the CPT codes to be included on the report."
. S DIR("?",3)="If the Range method is chosen, you will asked for one or more"
. S DIR("?",4)="ranges of CPT codes. (e.g. from 11000 to 11999)"
. S DIR("?",5)="If the Individual method is chosen, you will be asked to select"
. S DIR("?",6)="one or more specific CPT codes."
. S DIR("?")="Enter a code from the list."
. D ^DIR K DIR Q:$D(DIRUT)
. S FBRCPT=$S(Y=1:"R",1:"I")
I FBRCPT="" G EXIT
; if individual selected then ask specific codes
I FBRCPT="I" D I $D(DTOUT)!$D(DUOUT)!'$O(FBRCPT(0)) G EXIT
. W !,"Note: code descriptors will be versioned for the Ending DATE"
. F D Q:Y'>0!$D(DIRUT)
. . S DIR(0)="PO^81:EM"
. . D ^DIR K DIR Q:$D(DIRUT)
. . I Y>0 S FBRCPT($P(Y,U))=$P(Y,U,2)
; if range selected then ask ranges
I FBRCPT="R" D I $D(DTOUT)!$D(DUOUT)!'$O(FBRCPT(0)) G EXIT
. N FBI,FBX
. S FBI=0 F D Q:Y=""!$D(DIRUT)
. . S DIR(0)="FO^5:5",DIR("A")="Start of CPT Range #"_(FBI+1)
. . D ^DIR K DIR Q:$D(DIRUT)
. . S FBX=Y
. . S DIR(0)="F^5:5",DIR("A")="End of CPT Range #"_(FBI+1)
. . D ^DIR K DIR Q:$D(DIRUT)
. . S $P(FBX,U,2)=Y
. . I $P(FBX,U)]$P(FBX,U,2) W $C(7),!,"Start can't be after the End" Q
. . S FBI=FBI+1,FBRCPT(FBI)=FBX
;
; ask device
W !!,"Note: Additional data printed if device supports 130+ characters"
S VAR="BEGDATE^ENDDATE^FBRCPT*",PGM="START^FBAAPCS"
D ZIS^FBAAUTL G EXIT:FBPOP
;
START ; queued entry
; input
; BEGDATE - begin date (fileman)
; ENDDATE - end date (fileman)
; FBRCPT - CPT codes to report ('A' All, 'I' Individual, 'R' Ranges)
; FBRCPT( - array of specifc codes or ranges when not All CPT codes
; format when FBRCPT="I"
; FBRCPT(cpt code internal value)=cpt code external value
; format when FBRCPT="R"
; FBRCPT(sequential range #)=start value^end value
U IO
;
GATHER ; collect and sort data
K ^TMP($J)
; loop thru payments by date finalized
S FBDT=BEGDATE-1
F S FBDT=$O(^FBAAC("AK",FBDT)) Q:FBDT'>0!(FBDT>ENDDATE) D
. ; loop thru veterans
. S FBDFN=0
. F S FBDFN=$O(^FBAAC("AK",FBDT,FBDFN)) Q:FBDFN'>0 D
. . ; loop thru vendors
. . S FBV=0
. . F S FBV=$O(^FBAAC("AK",FBDT,FBDFN,FBV)) Q:FBV'>0 D
. . . ; loop thru initial treatment dates
. . . S FBK=0
. . . F S FBK=$O(^FBAAC("AK",FBDT,FBDFN,FBV,FBK)) Q:FBK'>0 D
. . . . ; loop thru service provided (cpt)
. . . . S FBL=0
. . . . F S FBL=$O(^FBAAC("AK",FBDT,FBDFN,FBV,FBK,FBL)) Q:FBL'>0 D
. . . . . S FBY0=$G(^FBAAC(FBDFN,1,FBV,1,FBK,1,FBL,0))
. . . . . S FBCPT=$$CPT^FBAAUTL4($P(FBY0,U))
. . . . . ; quit if CPT code not included in report
. . . . . I FBRCPT="I",'$D(FBRCPT($P(FBY0,U))) Q
. . . . . I FBRCPT="R" S FBFND=0 D Q:'FBFND
. . . . . . S FBI=0 F S FBI=$O(FBRCPT(FBI)) Q:'FBI I $P(FBRCPT(FBI),U)']FBCPT,FBCPT']$P(FBRCPT(FBI),U,2) S FBFND=1 Q
. . . . . ; passed CPT checks
. . . . . S FBY2=$G(^FBAAC(FBDFN,1,FBV,1,FBK,1,FBL,2))
. . . . . S FBMODL=$$MODL^FBAAUTL4("^FBAAC("_FBDFN_",1,"_FBV_",1,"_FBK_",1,"_FBL_",""M"")","E")
. . . . . S FBCPTM=" "_FBCPT_$S(FBMODL]"":"-"_FBMODL,1:"")
. . . . . ; retrieve counts and totals for the CPT-MODIFIERS combination
. . . . . S FBX=$G(^TMP($J,FBCPTM))
. . . . . ; update counts and totals for this payment
. . . . . S $P(FBX,U)=$P(FBX,U)+1 ; total count
. . . . . S $P(FBX,U,2)=$P(FBX,U,2)+$P(FBY0,U,3) ; total paid
. . . . . ; if paid at the RBRVS amount
. . . . . I +$P(FBY0,U,3)=+$P(FBY2,U,12),$P(FBY2,U,13)="R" D
. . . . . . S $P(FBX,U,3)=$P(FBX,U,3)+1 ; RBRVS count
. . . . . . S $P(FBX,U,4)=$P(FBX,U,4)+$P(FBY0,U,3) ; RBRVS payments
. . . . . . ; calc 75th percentile
. . . . . . S FBDOS=$P($G(^FBAAC(FBDFN,1,FBV,1,FBK,0)),U)
. . . . . . S FBAMT=$$PRCTL^FBAAFSF($P(FBY0,U),FBMODL,FBDOS)
. . . . . . I FBAMT>0 D
. . . . . . . S $P(FBX,U,5)=$P(FBX,U,5)+1 ; covered by 75th count
. . . . . . . S $P(FBX,U,6)=$P(FBX,U,6)+FBAMT ; 75th estimated payment
. . . . . . E D
. . . . . . . S $P(FBX,U,7)=$P(FBX,U,7)+1 ; not covered by 75th count
. . . . . . . S $P(FBX,U,8)=$P(FBX,U,8)+$P(FBY0,U,2) ; claimed amount
. . . . . ; save counts and totals for the CPT-MODIFIERS combination
. . . . . S ^TMP($J,FBCPTM)=FBX
;
PRINT ; report data
S (FBQUIT,FBPG)=0 D NOW^%DTC S Y=% D DD^%DT S FBDTR=Y
S FBO=$S(IOM>129:43,1:0) ; column offset if room to display more detail
;
; build page header text in FBHT( based on selection criteria
K FBHT
S FBHT(1)=" for Payments with Finalized Dates from "
S FBHT(1)=FBHT(1)_$$FMTE^XLFDT(BEGDATE)_" to "_$$FMTE^XLFDT(ENDDATE)
I FBRCPT="A" S FBHT(2)=" and all CPT Codes"
E D
. S FBL=2,FBHT(FBL)=" and CPT Codes: "
. S (FBC,FBI)=0 F S FBI=$O(FBRCPT(FBI)) Q:'FBI D
. . I $L(FBHT(FBL))+$S(FBRCPT="I":2,1:10)+$L(FBRCPT(FBI))>75 D
. . . I FBC S FBHT(FBL)=FBHT(FBL)_","
. . . S FBL=FBL+1,FBC=0,FBHT(FBL)=" "
. . S FBHT(FBL)=FBHT(FBL)_$S(FBC:", ",1:"")
. . I FBRCPT="I" S FBHT(FBL)=FBHT(FBL)_FBRCPT(FBI)
. . I FBRCPT="R" S FBHT(FBL)=FBHT(FBL)_"from "_$P(FBRCPT(FBI),U)_" to "_$P(FBRCPT(FBI),U,2)
. . S FBC=FBC+1 ; count of codes or ranges on current line (FBL)
;
D HD
I '$D(^TMP($J)) W !!," No payments found that match criteria. ",!
;
S FBT="" ; initialize report totals
; loop thru CPT-MODIFIER(S)
S FBCPTM="" F S FBCPTM=$O(^TMP($J,FBCPTM)) Q:FBCPTM="" D Q:FBQUIT
. S FBX=$G(^TMP($J,FBCPTM))
. I $Y+6>IOSL D HD Q:FBQUIT
. ;
. ; compute estimated savings
. S FBSAV=$P(FBX,U,6)+$P(FBX,U,8)-$P(FBX,U,4)
. ;
. ; print detail line
. W !,$E($P(FBCPTM,",",1,4),2,99) W:$P(FBCPTM,",",5)]"" "," W ?18,"|"
. W ?20,$J($P(FBX,U,1),5),?26,$J($FN($P(FBX,U,2),",",2),13),?40,"|"
. W ?42,$J($P(FBX,U,3),5),?48,$J($FN($P(FBX,U,4),",",2),13),?62,"|"
. ; if room display additional detail
. I FBO D
. . W ?64,$J($P(FBX,U,5),5),?70,$J($FN($P(FBX,U,6),",",2),13)
. . W ?85,$J($P(FBX,U,7),5),?91,$J($FN($P(FBX,U,8),",",2),13)
. . W ?105,"|"
. W ?63+FBO,$J($FN(FBSAV,",P",2),15),?78+FBO,"|"
. ; if more than 4 modifiers then display them on subsequent lines
. F FBI=1:1 Q:$P(FBCPTM,",",(FBI*4)+1)="" D
. . W !,?5,"-",$P(FBCPTM,",",(FBI*4)+1,(FBI*4)+4) ; next set of mods
. . W:$P(FBCPTM,",",(FBI*4)+5)]"" "," ; additional line will be needed
. . W ?18,"|",?40,"|",?62,"|" W:FBO ?105,"|" W ?78+FBO,"|"
. ;
. ; add to report totals
. F FBI=1:1:8 S $P(FBT,U,FBI)=$P(FBT,U,FBI)+$P(FBX,U,FBI)
. S $P(FBT,U,9)=$P(FBT,U,9)+FBSAV
;
I FBQUIT W !!,"REPORT STOPPED AT USER REQUEST"
E D ; report totals
. D DL
. W !,"REPORT TOTALS ",?18,"|"
. W ?20,$J($P(FBT,U,1),5),?26,$J($FN($P(FBT,U,2),",",2),13),?40,"|"
. W ?42,$J($P(FBT,U,3),5),?48,$J($FN($P(FBT,U,4),",",2),13),?62,"|"
. I FBO D
. . W ?64,$J($P(FBT,U,5),5),?70,$J($FN($P(FBT,U,6),",",2),13)
. . W ?85,$J($P(FBT,U,7),5),?91,$J($FN($P(FBT,U,8),",",2),13)
. . W ?105,"|"
. W ?63+FBO,$J($FN($P(FBT,U,9),",P",2),15),?78+FBO,"|"
I 'FBQUIT,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
D ^%ZISC
;
EXIT ;
I $D(ZTQUEUED) S ZTREQ="@"
K ^TMP($J)
K BEGDATE,ENDDATE,FBRCPT
K FBAMT,FBC,FBCPT,FBCPTM,FBDFN,FBDT,FBDTR,FBFND,FBHT,FBI,FBK
K FBL,FBMODL,FBO,FBPG,FBPOP,FBQUIT,FBRCPT,FBSAV,FBT,FBV,FBX,FBY0,FBY2
K DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
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 !,"COST/SAVINGS FROM RBRVS FEE SCHEDULE",?49,FBDTR,?72,"page ",FBPG
S FBI=0 F S FBI=$O(FBHT(FBI)) Q:'FBI W !,FBHT(FBI)
;
W !!,"CPT CODE-",?18,"|",?20,"Total Occurrences ",?40,"|"
W ?42,"Payments at RBRVS",?62,"|"
W:FBO ?64,"Estimated Payments if RBRVS was not used",?105,"|"
W ?64+FBO,"Est. Savings",?78+FBO,"|"
;
I FBO D
. W !,?18,"|",?40,"|",?62,"|"
. W ?64,"75th Percentile",?85,"Usual & Customary*"
. W ?105,"|",?78+FBO,"|"
;
W !," Modifier(s)",?18,"|",?20,"count $ amount",?40,"|"
W ?42,"count $ amount",?62,"|"
W:FBO ?64,"count $ amount",?85,"count $ amount",?105,"|"
W ?64+FBO,"from RBRVS",?78+FBO,"|"
;
DL ; write dashed line
W !,"------------------",?18,"|",?20,"----- -------------",?40,"|"
W ?42,"----- -------------",?62,"|"
W:FBO ?64,"----- -------------",?85,"----- -------------",?105,"|"
W ?64+FBO,"-------------",?78+FBO,"|"
Q
;
;FBAAPCS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAPCS 9090 printed Sep 23, 2025@19:32:02 Page 2
FBAAPCS ;WCIOFO/SAB-REPORT COST/SAVINGS FROM RBRVS FEE SCHEDULE ;6/28/1999
+1 ;;3.5;FEE BASIS;**4,77**;JAN 30, 1995
+2 ;
+3 ; ask date range
+4 DO DATE^FBAAUTL
if FBPOP
QUIT
+5 ;
+6 WRITE !,"Note: code descriptors will be versioned for the Ending DATE"
+7 NEW ICPTVDT
SET ICPTVDT=$GET(ENDDATE)
+8 ;
+9 ; ask CPT codes to include
+10 KILL FBRCPT
+11 SET DIR(0)="Y"
SET DIR("A")="Include all CPT codes"
SET DIR("B")="YES"
+12 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+13 SET FBRCPT=$SELECT(Y:"A",1:"")
+14 ; if not all CPT codes then ask selection method
+15 IF FBRCPT=""
Begin DoDot:1
+16 SET DIR(0)="S^1:RANGE OF CODES;2:INDIVIDUAL CODES"
+17 SET DIR("A")="Choose a method to specify CPT Codes"
+18 SET DIR("?",1)="You must choose one of the two methods that can be used"
+19 SET DIR("?",2)="to specify the CPT codes to be included on the report."
+20 SET DIR("?",3)="If the Range method is chosen, you will asked for one or more"
+21 SET DIR("?",4)="ranges of CPT codes. (e.g. from 11000 to 11999)"
+22 SET DIR("?",5)="If the Individual method is chosen, you will be asked to select"
+23 SET DIR("?",6)="one or more specific CPT codes."
+24 SET DIR("?")="Enter a code from the list."
+25 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+26 SET FBRCPT=$SELECT(Y=1:"R",1:"I")
End DoDot:1
+27 IF FBRCPT=""
GOTO EXIT
+28 ; if individual selected then ask specific codes
+29 IF FBRCPT="I"
Begin DoDot:1
+30 WRITE !,"Note: code descriptors will be versioned for the Ending DATE"
+31 FOR
Begin DoDot:2
+32 SET DIR(0)="PO^81:EM"
+33 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+34 IF Y>0
SET FBRCPT($PIECE(Y,U))=$PIECE(Y,U,2)
End DoDot:2
if Y'>0!$DATA(DIRUT)
QUIT
End DoDot:1
IF $DATA(DTOUT)!$DATA(DUOUT)!'$ORDER(FBRCPT(0))
GOTO EXIT
+35 ; if range selected then ask ranges
+36 IF FBRCPT="R"
Begin DoDot:1
+37 NEW FBI,FBX
+38 SET FBI=0
FOR
Begin DoDot:2
+39 SET DIR(0)="FO^5:5"
SET DIR("A")="Start of CPT Range #"_(FBI+1)
+40 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+41 SET FBX=Y
+42 SET DIR(0)="F^5:5"
SET DIR("A")="End of CPT Range #"_(FBI+1)
+43 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+44 SET $PIECE(FBX,U,2)=Y
+45 IF $PIECE(FBX,U)]$PIECE(FBX,U,2)
WRITE $CHAR(7),!,"Start can't be after the End"
QUIT
+46 SET FBI=FBI+1
SET FBRCPT(FBI)=FBX
End DoDot:2
if Y=""!$DATA(DIRUT)
QUIT
End DoDot:1
IF $DATA(DTOUT)!$DATA(DUOUT)!'$ORDER(FBRCPT(0))
GOTO EXIT
+47 ;
+48 ; ask device
+49 WRITE !!,"Note: Additional data printed if device supports 130+ characters"
+50 SET VAR="BEGDATE^ENDDATE^FBRCPT*"
SET PGM="START^FBAAPCS"
+51 DO ZIS^FBAAUTL
if FBPOP
GOTO EXIT
+52 ;
START ; queued entry
+1 ; input
+2 ; BEGDATE - begin date (fileman)
+3 ; ENDDATE - end date (fileman)
+4 ; FBRCPT - CPT codes to report ('A' All, 'I' Individual, 'R' Ranges)
+5 ; FBRCPT( - array of specifc codes or ranges when not All CPT codes
+6 ; format when FBRCPT="I"
+7 ; FBRCPT(cpt code internal value)=cpt code external value
+8 ; format when FBRCPT="R"
+9 ; FBRCPT(sequential range #)=start value^end value
+10 USE IO
+11 ;
GATHER ; collect and sort data
+1 KILL ^TMP($JOB)
+2 ; loop thru payments by date finalized
+3 SET FBDT=BEGDATE-1
+4 FOR
SET FBDT=$ORDER(^FBAAC("AK",FBDT))
if FBDT'>0!(FBDT>ENDDATE)
QUIT
Begin DoDot:1
+5 ; loop thru veterans
+6 SET FBDFN=0
+7 FOR
SET FBDFN=$ORDER(^FBAAC("AK",FBDT,FBDFN))
if FBDFN'>0
QUIT
Begin DoDot:2
+8 ; loop thru vendors
+9 SET FBV=0
+10 FOR
SET FBV=$ORDER(^FBAAC("AK",FBDT,FBDFN,FBV))
if FBV'>0
QUIT
Begin DoDot:3
+11 ; loop thru initial treatment dates
+12 SET FBK=0
+13 FOR
SET FBK=$ORDER(^FBAAC("AK",FBDT,FBDFN,FBV,FBK))
if FBK'>0
QUIT
Begin DoDot:4
+14 ; loop thru service provided (cpt)
+15 SET FBL=0
+16 FOR
SET FBL=$ORDER(^FBAAC("AK",FBDT,FBDFN,FBV,FBK,FBL))
if FBL'>0
QUIT
Begin DoDot:5
+17 SET FBY0=$GET(^FBAAC(FBDFN,1,FBV,1,FBK,1,FBL,0))
+18 SET FBCPT=$$CPT^FBAAUTL4($PIECE(FBY0,U))
+19 ; quit if CPT code not included in report
+20 IF FBRCPT="I"
IF '$DATA(FBRCPT($PIECE(FBY0,U)))
QUIT
+21 IF FBRCPT="R"
SET FBFND=0
Begin DoDot:6
+22 SET FBI=0
FOR
SET FBI=$ORDER(FBRCPT(FBI))
if 'FBI
QUIT
IF $PIECE(FBRCPT(FBI),U)']FBCPT
IF FBCPT']$PIECE(FBRCPT(FBI),U,2)
SET FBFND=1
QUIT
End DoDot:6
if 'FBFND
QUIT
+23 ; passed CPT checks
+24 SET FBY2=$GET(^FBAAC(FBDFN,1,FBV,1,FBK,1,FBL,2))
+25 SET FBMODL=$$MODL^FBAAUTL4("^FBAAC("_FBDFN_",1,"_FBV_",1,"_FBK_",1,"_FBL_",""M"")","E")
+26 SET FBCPTM=" "_FBCPT_$SELECT(FBMODL]"":"-"_FBMODL,1:"")
+27 ; retrieve counts and totals for the CPT-MODIFIERS combination
+28 SET FBX=$GET(^TMP($JOB,FBCPTM))
+29 ; update counts and totals for this payment
+30 ; total count
SET $PIECE(FBX,U)=$PIECE(FBX,U)+1
+31 ; total paid
SET $PIECE(FBX,U,2)=$PIECE(FBX,U,2)+$PIECE(FBY0,U,3)
+32 ; if paid at the RBRVS amount
+33 IF +$PIECE(FBY0,U,3)=+$PIECE(FBY2,U,12)
IF $PIECE(FBY2,U,13)="R"
Begin DoDot:6
+34 ; RBRVS count
SET $PIECE(FBX,U,3)=$PIECE(FBX,U,3)+1
+35 ; RBRVS payments
SET $PIECE(FBX,U,4)=$PIECE(FBX,U,4)+$PIECE(FBY0,U,3)
+36 ; calc 75th percentile
+37 SET FBDOS=$PIECE($GET(^FBAAC(FBDFN,1,FBV,1,FBK,0)),U)
+38 SET FBAMT=$$PRCTL^FBAAFSF($PIECE(FBY0,U),FBMODL,FBDOS)
+39 IF FBAMT>0
Begin DoDot:7
+40 ; covered by 75th count
SET $PIECE(FBX,U,5)=$PIECE(FBX,U,5)+1
+41 ; 75th estimated payment
SET $PIECE(FBX,U,6)=$PIECE(FBX,U,6)+FBAMT
End DoDot:7
+42 IF '$TEST
Begin DoDot:7
+43 ; not covered by 75th count
SET $PIECE(FBX,U,7)=$PIECE(FBX,U,7)+1
+44 ; claimed amount
SET $PIECE(FBX,U,8)=$PIECE(FBX,U,8)+$PIECE(FBY0,U,2)
End DoDot:7
End DoDot:6
+45 ; save counts and totals for the CPT-MODIFIERS combination
+46 SET ^TMP($JOB,FBCPTM)=FBX
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+47 ;
PRINT ; report data
+1 SET (FBQUIT,FBPG)=0
DO NOW^%DTC
SET Y=%
DO DD^%DT
SET FBDTR=Y
+2 ; column offset if room to display more detail
SET FBO=$SELECT(IOM>129:43,1:0)
+3 ;
+4 ; build page header text in FBHT( based on selection criteria
+5 KILL FBHT
+6 SET FBHT(1)=" for Payments with Finalized Dates from "
+7 SET FBHT(1)=FBHT(1)_$$FMTE^XLFDT(BEGDATE)_" to "_$$FMTE^XLFDT(ENDDATE)
+8 IF FBRCPT="A"
SET FBHT(2)=" and all CPT Codes"
+9 IF '$TEST
Begin DoDot:1
+10 SET FBL=2
SET FBHT(FBL)=" and CPT Codes: "
+11 SET (FBC,FBI)=0
FOR
SET FBI=$ORDER(FBRCPT(FBI))
if 'FBI
QUIT
Begin DoDot:2
+12 IF $LENGTH(FBHT(FBL))+$SELECT(FBRCPT="I":2,1:10)+$LENGTH(FBRCPT(FBI))>75
Begin DoDot:3
+13 IF FBC
SET FBHT(FBL)=FBHT(FBL)_","
+14 SET FBL=FBL+1
SET FBC=0
SET FBHT(FBL)=" "
End DoDot:3
+15 SET FBHT(FBL)=FBHT(FBL)_$SELECT(FBC:", ",1:"")
+16 IF FBRCPT="I"
SET FBHT(FBL)=FBHT(FBL)_FBRCPT(FBI)
+17 IF FBRCPT="R"
SET FBHT(FBL)=FBHT(FBL)_"from "_$PIECE(FBRCPT(FBI),U)_" to "_$PIECE(FBRCPT(FBI),U,2)
+18 ; count of codes or ranges on current line (FBL)
SET FBC=FBC+1
End DoDot:2
End DoDot:1
+19 ;
+20 DO HD
+21 IF '$DATA(^TMP($JOB))
WRITE !!," No payments found that match criteria. ",!
+22 ;
+23 ; initialize report totals
SET FBT=""
+24 ; loop thru CPT-MODIFIER(S)
+25 SET FBCPTM=""
FOR
SET FBCPTM=$ORDER(^TMP($JOB,FBCPTM))
if FBCPTM=""
QUIT
Begin DoDot:1
+26 SET FBX=$GET(^TMP($JOB,FBCPTM))
+27 IF $Y+6>IOSL
DO HD
if FBQUIT
QUIT
+28 ;
+29 ; compute estimated savings
+30 SET FBSAV=$PIECE(FBX,U,6)+$PIECE(FBX,U,8)-$PIECE(FBX,U,4)
+31 ;
+32 ; print detail line
+33 WRITE !,$EXTRACT($PIECE(FBCPTM,",",1,4),2,99)
if $PIECE(FBCPTM,",",5)]""
WRITE ","
WRITE ?18,"|"
+34 WRITE ?20,$JUSTIFY($PIECE(FBX,U,1),5),?26,$JUSTIFY($FNUMBER($PIECE(FBX,U,2),",",2),13),?40,"|"
+35 WRITE ?42,$JUSTIFY($PIECE(FBX,U,3),5),?48,$JUSTIFY($FNUMBER($PIECE(FBX,U,4),",",2),13),?62,"|"
+36 ; if room display additional detail
+37 IF FBO
Begin DoDot:2
+38 WRITE ?64,$JUSTIFY($PIECE(FBX,U,5),5),?70,$JUSTIFY($FNUMBER($PIECE(FBX,U,6),",",2),13)
+39 WRITE ?85,$JUSTIFY($PIECE(FBX,U,7),5),?91,$JUSTIFY($FNUMBER($PIECE(FBX,U,8),",",2),13)
+40 WRITE ?105,"|"
End DoDot:2
+41 WRITE ?63+FBO,$JUSTIFY($FNUMBER(FBSAV,",P",2),15),?78+FBO,"|"
+42 ; if more than 4 modifiers then display them on subsequent lines
+43 FOR FBI=1:1
if $PIECE(FBCPTM,",",(FBI*4)+1)=""
QUIT
Begin DoDot:2
+44 ; next set of mods
WRITE !,?5,"-",$PIECE(FBCPTM,",",(FBI*4)+1,(FBI*4)+4)
+45 ; additional line will be needed
if $PIECE(FBCPTM,",",(FBI*4)+5)]""
WRITE ","
+46 WRITE ?18,"|",?40,"|",?62,"|"
if FBO
WRITE ?105,"|"
WRITE ?78+FBO,"|"
End DoDot:2
+47 ;
+48 ; add to report totals
+49 FOR FBI=1:1:8
SET $PIECE(FBT,U,FBI)=$PIECE(FBT,U,FBI)+$PIECE(FBX,U,FBI)
+50 SET $PIECE(FBT,U,9)=$PIECE(FBT,U,9)+FBSAV
End DoDot:1
if FBQUIT
QUIT
+51 ;
+52 IF FBQUIT
WRITE !!,"REPORT STOPPED AT USER REQUEST"
+53 ; report totals
IF '$TEST
Begin DoDot:1
+54 DO DL
+55 WRITE !,"REPORT TOTALS ",?18,"|"
+56 WRITE ?20,$JUSTIFY($PIECE(FBT,U,1),5),?26,$JUSTIFY($FNUMBER($PIECE(FBT,U,2),",",2),13),?40,"|"
+57 WRITE ?42,$JUSTIFY($PIECE(FBT,U,3),5),?48,$JUSTIFY($FNUMBER($PIECE(FBT,U,4),",",2),13),?62,"|"
+58 IF FBO
Begin DoDot:2
+59 WRITE ?64,$JUSTIFY($PIECE(FBT,U,5),5),?70,$JUSTIFY($FNUMBER($PIECE(FBT,U,6),",",2),13)
+60 WRITE ?85,$JUSTIFY($PIECE(FBT,U,7),5),?91,$JUSTIFY($FNUMBER($PIECE(FBT,U,8),",",2),13)
+61 WRITE ?105,"|"
End DoDot:2
+62 WRITE ?63+FBO,$JUSTIFY($FNUMBER($PIECE(FBT,U,9),",P",2),15),?78+FBO,"|"
End DoDot:1
+63 IF 'FBQUIT
IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
+64 DO ^%ZISC
+65 ;
EXIT ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL ^TMP($JOB)
+3 KILL BEGDATE,ENDDATE,FBRCPT
+4 KILL FBAMT,FBC,FBCPT,FBCPTM,FBDFN,FBDT,FBDTR,FBFND,FBHT,FBI,FBK
+5 KILL FBL,FBMODL,FBO,FBPG,FBPOP,FBQUIT,FBRCPT,FBSAV,FBT,FBV,FBX,FBY0,FBY2
+6 KILL DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+7 QUIT
+8 ;
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 !,"COST/SAVINGS FROM RBRVS FEE SCHEDULE",?49,FBDTR,?72,"page ",FBPG
+6 SET FBI=0
FOR
SET FBI=$ORDER(FBHT(FBI))
if 'FBI
QUIT
WRITE !,FBHT(FBI)
+7 ;
+8 WRITE !!,"CPT CODE-",?18,"|",?20,"Total Occurrences ",?40,"|"
+9 WRITE ?42,"Payments at RBRVS",?62,"|"
+10 if FBO
WRITE ?64,"Estimated Payments if RBRVS was not used",?105,"|"
+11 WRITE ?64+FBO,"Est. Savings",?78+FBO,"|"
+12 ;
+13 IF FBO
Begin DoDot:1
+14 WRITE !,?18,"|",?40,"|",?62,"|"
+15 WRITE ?64,"75th Percentile",?85,"Usual & Customary*"
+16 WRITE ?105,"|",?78+FBO,"|"
End DoDot:1
+17 ;
+18 WRITE !," Modifier(s)",?18,"|",?20,"count $ amount",?40,"|"
+19 WRITE ?42,"count $ amount",?62,"|"
+20 if FBO
WRITE ?64,"count $ amount",?85,"count $ amount",?105,"|"
+21 WRITE ?64+FBO,"from RBRVS",?78+FBO,"|"
+22 ;
DL ; write dashed line
+1 WRITE !,"------------------",?18,"|",?20,"----- -------------",?40,"|"
+2 WRITE ?42,"----- -------------",?62,"|"
+3 if FBO
WRITE ?64,"----- -------------",?85,"----- -------------",?105,"|"
+4 WRITE ?64+FBO,"-------------",?78+FBO,"|"
+5 QUIT
+6 ;
+7 ;FBAAPCS
