| [613] | 1 | FBAAPCS ;WCIOFO/SAB-REPORT COST/SAVINGS FROM RBRVS FEE SCHEDULE ;6/28/1999
|
|---|
| 2 | ;;3.5;FEE BASIS;**4,77**;JAN 30, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ; ask date range
|
|---|
| 5 | D DATE^FBAAUTL Q:FBPOP
|
|---|
| 6 | ;
|
|---|
| 7 | W !,"Note: code descriptors will be versioned for the Ending DATE"
|
|---|
| 8 | N ICPTVDT S ICPTVDT=$G(ENDDATE)
|
|---|
| 9 | ;
|
|---|
| 10 | ; ask CPT codes to include
|
|---|
| 11 | K FBRCPT
|
|---|
| 12 | S DIR(0)="Y",DIR("A")="Include all CPT codes",DIR("B")="YES"
|
|---|
| 13 | D ^DIR K DIR G:$D(DIRUT) EXIT
|
|---|
| 14 | S FBRCPT=$S(Y:"A",1:"")
|
|---|
| 15 | ; if not all CPT codes then ask selection method
|
|---|
| 16 | I FBRCPT="" D
|
|---|
| 17 | . S DIR(0)="S^1:RANGE OF CODES;2:INDIVIDUAL CODES"
|
|---|
| 18 | . S DIR("A")="Choose a method to specify CPT Codes"
|
|---|
| 19 | . S DIR("?",1)="You must choose one of the two methods that can be used"
|
|---|
| 20 | . S DIR("?",2)="to specify the CPT codes to be included on the report."
|
|---|
| 21 | . S DIR("?",3)="If the Range method is chosen, you will asked for one or more"
|
|---|
| 22 | . S DIR("?",4)="ranges of CPT codes. (e.g. from 11000 to 11999)"
|
|---|
| 23 | . S DIR("?",5)="If the Individual method is chosen, you will be asked to select"
|
|---|
| 24 | . S DIR("?",6)="one or more specific CPT codes."
|
|---|
| 25 | . S DIR("?")="Enter a code from the list."
|
|---|
| 26 | . D ^DIR K DIR Q:$D(DIRUT)
|
|---|
| 27 | . S FBRCPT=$S(Y=1:"R",1:"I")
|
|---|
| 28 | I FBRCPT="" G EXIT
|
|---|
| 29 | ; if individual selected then ask specific codes
|
|---|
| 30 | I FBRCPT="I" D I $D(DTOUT)!$D(DUOUT)!'$O(FBRCPT(0)) G EXIT
|
|---|
| 31 | . W !,"Note: code descriptors will be versioned for the Ending DATE"
|
|---|
| 32 | . F D Q:Y'>0!$D(DIRUT)
|
|---|
| 33 | . . S DIR(0)="PO^81:EM"
|
|---|
| 34 | . . D ^DIR K DIR Q:$D(DIRUT)
|
|---|
| 35 | . . I Y>0 S FBRCPT($P(Y,U))=$P(Y,U,2)
|
|---|
| 36 | ; if range selected then ask ranges
|
|---|
| 37 | I FBRCPT="R" D I $D(DTOUT)!$D(DUOUT)!'$O(FBRCPT(0)) G EXIT
|
|---|
| 38 | . N FBI,FBX
|
|---|
| 39 | . S FBI=0 F D Q:Y=""!$D(DIRUT)
|
|---|
| 40 | . . S DIR(0)="FO^5:5",DIR("A")="Start of CPT Range #"_(FBI+1)
|
|---|
| 41 | . . D ^DIR K DIR Q:$D(DIRUT)
|
|---|
| 42 | . . S FBX=Y
|
|---|
| 43 | . . S DIR(0)="F^5:5",DIR("A")="End of CPT Range #"_(FBI+1)
|
|---|
| 44 | . . D ^DIR K DIR Q:$D(DIRUT)
|
|---|
| 45 | . . S $P(FBX,U,2)=Y
|
|---|
| 46 | . . I $P(FBX,U)]$P(FBX,U,2) W $C(7),!,"Start can't be after the End" Q
|
|---|
| 47 | . . S FBI=FBI+1,FBRCPT(FBI)=FBX
|
|---|
| 48 | ;
|
|---|
| 49 | ; ask device
|
|---|
| 50 | W !!,"Note: Additional data printed if device supports 130+ characters"
|
|---|
| 51 | S VAR="BEGDATE^ENDDATE^FBRCPT*",PGM="START^FBAAPCS"
|
|---|
| 52 | D ZIS^FBAAUTL G EXIT:FBPOP
|
|---|
| 53 | ;
|
|---|
| 54 | START ; queued entry
|
|---|
| 55 | ; input
|
|---|
| 56 | ; BEGDATE - begin date (fileman)
|
|---|
| 57 | ; ENDDATE - end date (fileman)
|
|---|
| 58 | ; FBRCPT - CPT codes to report ('A' All, 'I' Individual, 'R' Ranges)
|
|---|
| 59 | ; FBRCPT( - array of specifc codes or ranges when not All CPT codes
|
|---|
| 60 | ; format when FBRCPT="I"
|
|---|
| 61 | ; FBRCPT(cpt code internal value)=cpt code external value
|
|---|
| 62 | ; format when FBRCPT="R"
|
|---|
| 63 | ; FBRCPT(sequential range #)=start value^end value
|
|---|
| 64 | U IO
|
|---|
| 65 | ;
|
|---|
| 66 | GATHER ; collect and sort data
|
|---|
| 67 | K ^TMP($J)
|
|---|
| 68 | ; loop thru payments by date finalized
|
|---|
| 69 | S FBDT=BEGDATE-1
|
|---|
| 70 | F S FBDT=$O(^FBAAC("AK",FBDT)) Q:FBDT'>0!(FBDT>ENDDATE) D
|
|---|
| 71 | . ; loop thru veterans
|
|---|
| 72 | . S FBDFN=0
|
|---|
| 73 | . F S FBDFN=$O(^FBAAC("AK",FBDT,FBDFN)) Q:FBDFN'>0 D
|
|---|
| 74 | . . ; loop thru vendors
|
|---|
| 75 | . . S FBV=0
|
|---|
| 76 | . . F S FBV=$O(^FBAAC("AK",FBDT,FBDFN,FBV)) Q:FBV'>0 D
|
|---|
| 77 | . . . ; loop thru initial treatment dates
|
|---|
| 78 | . . . S FBK=0
|
|---|
| 79 | . . . F S FBK=$O(^FBAAC("AK",FBDT,FBDFN,FBV,FBK)) Q:FBK'>0 D
|
|---|
| 80 | . . . . ; loop thru service provided (cpt)
|
|---|
| 81 | . . . . S FBL=0
|
|---|
| 82 | . . . . F S FBL=$O(^FBAAC("AK",FBDT,FBDFN,FBV,FBK,FBL)) Q:FBL'>0 D
|
|---|
| 83 | . . . . . S FBY0=$G(^FBAAC(FBDFN,1,FBV,1,FBK,1,FBL,0))
|
|---|
| 84 | . . . . . S FBCPT=$$CPT^FBAAUTL4($P(FBY0,U))
|
|---|
| 85 | . . . . . ; quit if CPT code not included in report
|
|---|
| 86 | . . . . . I FBRCPT="I",'$D(FBRCPT($P(FBY0,U))) Q
|
|---|
| 87 | . . . . . I FBRCPT="R" S FBFND=0 D Q:'FBFND
|
|---|
| 88 | . . . . . . 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
|
|---|
| 89 | . . . . . ; passed CPT checks
|
|---|
| 90 | . . . . . S FBY2=$G(^FBAAC(FBDFN,1,FBV,1,FBK,1,FBL,2))
|
|---|
| 91 | . . . . . S FBMODL=$$MODL^FBAAUTL4("^FBAAC("_FBDFN_",1,"_FBV_",1,"_FBK_",1,"_FBL_",""M"")","E")
|
|---|
| 92 | . . . . . S FBCPTM=" "_FBCPT_$S(FBMODL]"":"-"_FBMODL,1:"")
|
|---|
| 93 | . . . . . ; retrieve counts and totals for the CPT-MODIFIERS combination
|
|---|
| 94 | . . . . . S FBX=$G(^TMP($J,FBCPTM))
|
|---|
| 95 | . . . . . ; update counts and totals for this payment
|
|---|
| 96 | . . . . . S $P(FBX,U)=$P(FBX,U)+1 ; total count
|
|---|
| 97 | . . . . . S $P(FBX,U,2)=$P(FBX,U,2)+$P(FBY0,U,3) ; total paid
|
|---|
| 98 | . . . . . ; if paid at the RBRVS amount
|
|---|
| 99 | . . . . . I +$P(FBY0,U,3)=+$P(FBY2,U,12),$P(FBY2,U,13)="R" D
|
|---|
| 100 | . . . . . . S $P(FBX,U,3)=$P(FBX,U,3)+1 ; RBRVS count
|
|---|
| 101 | . . . . . . S $P(FBX,U,4)=$P(FBX,U,4)+$P(FBY0,U,3) ; RBRVS payments
|
|---|
| 102 | . . . . . . ; calc 75th percentile
|
|---|
| 103 | . . . . . . S FBDOS=$P($G(^FBAAC(FBDFN,1,FBV,1,FBK,0)),U)
|
|---|
| 104 | . . . . . . S FBAMT=$$PRCTL^FBAAFSF($P(FBY0,U),FBMODL,FBDOS)
|
|---|
| 105 | . . . . . . I FBAMT>0 D
|
|---|
| 106 | . . . . . . . S $P(FBX,U,5)=$P(FBX,U,5)+1 ; covered by 75th count
|
|---|
| 107 | . . . . . . . S $P(FBX,U,6)=$P(FBX,U,6)+FBAMT ; 75th estimated payment
|
|---|
| 108 | . . . . . . E D
|
|---|
| 109 | . . . . . . . S $P(FBX,U,7)=$P(FBX,U,7)+1 ; not covered by 75th count
|
|---|
| 110 | . . . . . . . S $P(FBX,U,8)=$P(FBX,U,8)+$P(FBY0,U,2) ; claimed amount
|
|---|
| 111 | . . . . . ; save counts and totals for the CPT-MODIFIERS combination
|
|---|
| 112 | . . . . . S ^TMP($J,FBCPTM)=FBX
|
|---|
| 113 | ;
|
|---|
| 114 | PRINT ; report data
|
|---|
| 115 | S (FBQUIT,FBPG)=0 D NOW^%DTC S Y=% D DD^%DT S FBDTR=Y
|
|---|
| 116 | S FBO=$S(IOM>129:43,1:0) ; column offset if room to display more detail
|
|---|
| 117 | ;
|
|---|
| 118 | ; build page header text in FBHT( based on selection criteria
|
|---|
| 119 | K FBHT
|
|---|
| 120 | S FBHT(1)=" for Payments with Finalized Dates from "
|
|---|
| 121 | S FBHT(1)=FBHT(1)_$$FMTE^XLFDT(BEGDATE)_" to "_$$FMTE^XLFDT(ENDDATE)
|
|---|
| 122 | I FBRCPT="A" S FBHT(2)=" and all CPT Codes"
|
|---|
| 123 | E D
|
|---|
| 124 | . S FBL=2,FBHT(FBL)=" and CPT Codes: "
|
|---|
| 125 | . S (FBC,FBI)=0 F S FBI=$O(FBRCPT(FBI)) Q:'FBI D
|
|---|
| 126 | . . I $L(FBHT(FBL))+$S(FBRCPT="I":2,1:10)+$L(FBRCPT(FBI))>75 D
|
|---|
| 127 | . . . I FBC S FBHT(FBL)=FBHT(FBL)_","
|
|---|
| 128 | . . . S FBL=FBL+1,FBC=0,FBHT(FBL)=" "
|
|---|
| 129 | . . S FBHT(FBL)=FBHT(FBL)_$S(FBC:", ",1:"")
|
|---|
| 130 | . . I FBRCPT="I" S FBHT(FBL)=FBHT(FBL)_FBRCPT(FBI)
|
|---|
| 131 | . . I FBRCPT="R" S FBHT(FBL)=FBHT(FBL)_"from "_$P(FBRCPT(FBI),U)_" to "_$P(FBRCPT(FBI),U,2)
|
|---|
| 132 | . . S FBC=FBC+1 ; count of codes or ranges on current line (FBL)
|
|---|
| 133 | ;
|
|---|
| 134 | D HD
|
|---|
| 135 | I '$D(^TMP($J)) W !!," No payments found that match criteria. ",!
|
|---|
| 136 | ;
|
|---|
| 137 | S FBT="" ; initialize report totals
|
|---|
| 138 | ; loop thru CPT-MODIFIER(S)
|
|---|
| 139 | S FBCPTM="" F S FBCPTM=$O(^TMP($J,FBCPTM)) Q:FBCPTM="" D Q:FBQUIT
|
|---|
| 140 | . S FBX=$G(^TMP($J,FBCPTM))
|
|---|
| 141 | . I $Y+6>IOSL D HD Q:FBQUIT
|
|---|
| 142 | . ;
|
|---|
| 143 | . ; compute estimated savings
|
|---|
| 144 | . S FBSAV=$P(FBX,U,6)+$P(FBX,U,8)-$P(FBX,U,4)
|
|---|
| 145 | . ;
|
|---|
| 146 | . ; print detail line
|
|---|
| 147 | . W !,$E($P(FBCPTM,",",1,4),2,99) W:$P(FBCPTM,",",5)]"" "," W ?18,"|"
|
|---|
| 148 | . W ?20,$J($P(FBX,U,1),5),?26,$J($FN($P(FBX,U,2),",",2),13),?40,"|"
|
|---|
| 149 | . W ?42,$J($P(FBX,U,3),5),?48,$J($FN($P(FBX,U,4),",",2),13),?62,"|"
|
|---|
| 150 | . ; if room display additional detail
|
|---|
| 151 | . I FBO D
|
|---|
| 152 | . . W ?64,$J($P(FBX,U,5),5),?70,$J($FN($P(FBX,U,6),",",2),13)
|
|---|
| 153 | . . W ?85,$J($P(FBX,U,7),5),?91,$J($FN($P(FBX,U,8),",",2),13)
|
|---|
| 154 | . . W ?105,"|"
|
|---|
| 155 | . W ?63+FBO,$J($FN(FBSAV,",P",2),15),?78+FBO,"|"
|
|---|
| 156 | . ; if more than 4 modifiers then display them on subsequent lines
|
|---|
| 157 | . F FBI=1:1 Q:$P(FBCPTM,",",(FBI*4)+1)="" D
|
|---|
| 158 | . . W !,?5,"-",$P(FBCPTM,",",(FBI*4)+1,(FBI*4)+4) ; next set of mods
|
|---|
| 159 | . . W:$P(FBCPTM,",",(FBI*4)+5)]"" "," ; additional line will be needed
|
|---|
| 160 | . . W ?18,"|",?40,"|",?62,"|" W:FBO ?105,"|" W ?78+FBO,"|"
|
|---|
| 161 | . ;
|
|---|
| 162 | . ; add to report totals
|
|---|
| 163 | . F FBI=1:1:8 S $P(FBT,U,FBI)=$P(FBT,U,FBI)+$P(FBX,U,FBI)
|
|---|
| 164 | . S $P(FBT,U,9)=$P(FBT,U,9)+FBSAV
|
|---|
| 165 | ;
|
|---|
| 166 | I FBQUIT W !!,"REPORT STOPPED AT USER REQUEST"
|
|---|
| 167 | E D ; report totals
|
|---|
| 168 | . D DL
|
|---|
| 169 | . W !,"REPORT TOTALS ",?18,"|"
|
|---|
| 170 | . W ?20,$J($P(FBT,U,1),5),?26,$J($FN($P(FBT,U,2),",",2),13),?40,"|"
|
|---|
| 171 | . W ?42,$J($P(FBT,U,3),5),?48,$J($FN($P(FBT,U,4),",",2),13),?62,"|"
|
|---|
| 172 | . I FBO D
|
|---|
| 173 | . . W ?64,$J($P(FBT,U,5),5),?70,$J($FN($P(FBT,U,6),",",2),13)
|
|---|
| 174 | . . W ?85,$J($P(FBT,U,7),5),?91,$J($FN($P(FBT,U,8),",",2),13)
|
|---|
| 175 | . . W ?105,"|"
|
|---|
| 176 | . W ?63+FBO,$J($FN($P(FBT,U,9),",P",2),15),?78+FBO,"|"
|
|---|
| 177 | I 'FBQUIT,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
|
|---|
| 178 | D ^%ZISC
|
|---|
| 179 | ;
|
|---|
| 180 | EXIT ;
|
|---|
| 181 | I $D(ZTQUEUED) S ZTREQ="@"
|
|---|
| 182 | K ^TMP($J)
|
|---|
| 183 | K BEGDATE,ENDDATE,FBRCPT
|
|---|
| 184 | K FBAMT,FBC,FBCPT,FBCPTM,FBDFN,FBDT,FBDTR,FBFND,FBHT,FBI,FBK
|
|---|
| 185 | K FBL,FBMODL,FBO,FBPG,FBPOP,FBQUIT,FBRCPT,FBSAV,FBT,FBV,FBX,FBY0,FBY2
|
|---|
| 186 | K DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
|---|
| 187 | Q
|
|---|
| 188 | ;
|
|---|
| 189 | HD ; page header
|
|---|
| 190 | I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,FBQUIT=1 Q
|
|---|
| 191 | I $E(IOST,1,2)="C-",FBPG S DIR(0)="E" D ^DIR K DIR I 'Y S FBQUIT=1 Q
|
|---|
| 192 | I $E(IOST,1,2)="C-"!FBPG W @IOF
|
|---|
| 193 | S FBPG=FBPG+1
|
|---|
| 194 | W !,"COST/SAVINGS FROM RBRVS FEE SCHEDULE",?49,FBDTR,?72,"page ",FBPG
|
|---|
| 195 | S FBI=0 F S FBI=$O(FBHT(FBI)) Q:'FBI W !,FBHT(FBI)
|
|---|
| 196 | ;
|
|---|
| 197 | W !!,"CPT CODE-",?18,"|",?20,"Total Occurrences ",?40,"|"
|
|---|
| 198 | W ?42,"Payments at RBRVS",?62,"|"
|
|---|
| 199 | W:FBO ?64,"Estimated Payments if RBRVS was not used",?105,"|"
|
|---|
| 200 | W ?64+FBO,"Est. Savings",?78+FBO,"|"
|
|---|
| 201 | ;
|
|---|
| 202 | I FBO D
|
|---|
| 203 | . W !,?18,"|",?40,"|",?62,"|"
|
|---|
| 204 | . W ?64,"75th Percentile",?85,"Usual & Customary*"
|
|---|
| 205 | . W ?105,"|",?78+FBO,"|"
|
|---|
| 206 | ;
|
|---|
| 207 | W !," Modifier(s)",?18,"|",?20,"count $ amount",?40,"|"
|
|---|
| 208 | W ?42,"count $ amount",?62,"|"
|
|---|
| 209 | W:FBO ?64,"count $ amount",?85,"count $ amount",?105,"|"
|
|---|
| 210 | W ?64+FBO,"from RBRVS",?78+FBO,"|"
|
|---|
| 211 | ;
|
|---|
| 212 | DL ; write dashed line
|
|---|
| 213 | W !,"------------------",?18,"|",?20,"----- -------------",?40,"|"
|
|---|
| 214 | W ?42,"----- -------------",?62,"|"
|
|---|
| 215 | W:FBO ?64,"----- -------------",?85,"----- -------------",?105,"|"
|
|---|
| 216 | W ?64+FBO,"-------------",?78+FBO,"|"
|
|---|
| 217 | Q
|
|---|
| 218 | ;
|
|---|
| 219 | ;FBAAPCS
|
|---|
