| 1 | FBAACR ;AISC/CMR-OPT MED Cost Report ;6/1/1999
|
|---|
| 2 | ;;3.5;FEE BASIS;**4,77**;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | D DATE^FBAAUTL Q:FBPOP
|
|---|
| 5 | S VAR="BEGDATE^ENDDATE",VAL=BEGDATE_"^"_ENDDATE,PGM="START^FBAACR" D ZIS^FBAAUTL G END:FBPOP
|
|---|
| 6 | START K ^TMP($J,"FBAACR") S (FBAAOUT,DFN,FBA,FBB,FBC)=0,BEGDT=BEGDATE-1,Q="-",$P(Q,"-",25)="-",QQ="=",$P(QQ,"=",80)="=" U IO W:$E(IOST,1,2)["C-" @IOF D HED
|
|---|
| 7 | F FBDT=BEGDT:0 S FBDT=$O(^FBAAC("AK",FBDT)) Q:FBDT'>0!(FBDT>ENDDATE) F S DFN=$O(^FBAAC("AK",FBDT,DFN)) Q:DFN'>0 F S FBA=$O(^FBAAC("AK",FBDT,DFN,FBA)) Q:FBA'>0 D
|
|---|
| 8 | .F S FBB=$O(^FBAAC("AK",FBDT,DFN,FBA,FBB)) Q:FBB'>0 F S FBC=$O(^FBAAC("AK",FBDT,DFN,FBA,FBB,FBC)) Q:FBC'>0 S FBPMT=^FBAAC(DFN,1,FBA,1,FBB,1,FBC,0),FBSRVDT=+$G(^FBAAC(DFN,1,FBA,1,FBB,0)) I $P(FBPMT,"^",13)="" D
|
|---|
| 9 | ..S FBPTC=$P(FBPMT,"^",17),FBAMT=$P(FBPMT,"^",3),FBNAME=$$NAME^FBCHREQ2(DFN),FBCPT=$P(FBPMT,"^"),^TMP($J,"FBAACR",FBNAME)=DFN,^TMP($J,"FBAACR",FBNAME,FBA,FBB,FBC)=FBPTC_"^"_FBAMT_"^"_FBCPT_"^"_FBSRVDT
|
|---|
| 10 | S (FBNAME,FBNM)="",(FBA,FBB,FBC,DFN,FBPTC,FBAMT,FBPAMT,FBTAMT,FBCPT,FBCTR,FBTPT)=0
|
|---|
| 11 | F S FBNAME=$O(^TMP($J,"FBAACR",FBNAME)) Q:FBNAME=""!(FBAAOUT) S DFN=+^TMP($J,"FBAACR",FBNAME) S FBTPT=FBTPT+1,FBPCTR=0 D D PSUM
|
|---|
| 12 | .F S FBA=$O(^TMP($J,"FBAACR",FBNAME,FBA)) Q:FBA'>0!(FBAAOUT) F S FBB=$O(^TMP($J,"FBAACR",FBNAME,FBA,FBB)) Q:FBB'>0!(FBAAOUT) F S FBC=$O(^TMP($J,"FBAACR",FBNAME,FBA,FBB,FBC)) Q:FBC'>0!(FBAAOUT) S FBCTR=FBCTR+1,FBPCTR=FBPCTR+1 D
|
|---|
| 13 | ..S FBPMT=^TMP($J,"FBAACR",FBNAME,FBA,FBB,FBC),FBPTC=$P(FBPMT,"^"),FBAMT=$P(FBPMT,"^",2),FBCPT=$$CPT^FBAAUTL4(+$P(FBPMT,"^",3),1,+$P(FBPMT,"^",4)),FBPAMT=FBPAMT+FBAMT,FBTAMT=FBTAMT+FBAMT D PRINT
|
|---|
| 14 | G END:FBAAOUT
|
|---|
| 15 | W !!,QQ,!!,"TOTAL PAYMENTS: ",?25,$J(FBCTR,7),?40,"TOTAL PATIENTS: ",?65,$J(FBTPT,7),!,"AVE. PAID FOR A PAYMENT:",?25 W:FBCTR>0 $J($FN(FBTAMT/FBCTR,",",2),10) W ?40,"AVE. PAID FOR A PATIENT:",?65 W:FBTPT>0 $J($FN(FBTAMT/FBTPT,",",2),10)
|
|---|
| 16 | END K FBSRVDT,FBPMT,FBNAME,DFN,FBAAOUT,FBA,FBB,FBC,FBAMT,FBPTC,FBPAMT,FBTAMT,FBCTR,FBDT,FBCPT,FBNM,FBPCTR,FBPTC1,FBTPT,BEGDT,BEGDATE,ENDDATE,J,Q,QQ,^TMP($J,"FBAACR") D CLOSE^FBAAUTL
|
|---|
| 17 | Q
|
|---|
| 18 | PRINT D CHK Q:FBAAOUT S FBPTC1=""
|
|---|
| 19 | S:FBPTC="" FBPTC="99" F I=1:1:8 S J=$T(TEXT+I) I $P(J,";;",2)=FBPTC S FBPTC1=$P(J,";;",3) Q
|
|---|
| 20 | I FBNAME=FBNM W !?30,$E(FBPTC1,1,16),?48,$E(FBCPT,1,20),?70,$J($FN(FBAMT,",",2),10)
|
|---|
| 21 | I FBNAME'=FBNM W !!,$E(FBNAME,1,20),?22,$$SSN^FBAAUTL(DFN,1),?30,$E(FBPTC1,1,16),?48,$E(FBCPT,1,20),?70,$J($FN(FBAMT,",",2),10) S FBNM=FBNAME
|
|---|
| 22 | Q
|
|---|
| 23 | HED W !?25,"OUTPATIENT COST REPORT",!?24,$$DATX^FBAAUTL(BEGDATE)," THROUGH ",$$DATX^FBAAUTL(ENDDATE),!,?24,Q,!!!,?21,"PATIENT",?31,"TREATING",!,"PATIENT NAME",?21," ID",?31,"SPECIALTY",?52,"CPT CODE",?69,"AMOUNT PAID",!,QQ
|
|---|
| 24 | Q
|
|---|
| 25 | CHK I $Y+5>IOSL,$E(IOST,1,2)["C-" S DIR(0)="E" D ^DIR K DIR I 'Y S FBAAOUT=1 Q
|
|---|
| 26 | I $Y+5>IOSL W @IOF D HED
|
|---|
| 27 | Q
|
|---|
| 28 | PSUM W !?70,"----------",!?70,$J($FN(FBPAMT,",",2),10)
|
|---|
| 29 | S FBPAMT=0
|
|---|
| 30 | Q
|
|---|
| 31 | TEXT ;
|
|---|
| 32 | ;;00;;SURGICAL
|
|---|
| 33 | ;;10;;MEDICAL
|
|---|
| 34 | ;;60;;HOME NURSING SERVICE
|
|---|
| 35 | ;;85;;PSYCHIATRIC-CONTRACT
|
|---|
| 36 | ;;86;;PSYCHIATRIC
|
|---|
| 37 | ;;95;;NEUROLOGICAL-CONTRACT
|
|---|
| 38 | ;;96;;NEUROLOGICAL
|
|---|
| 39 | ;;99;;UNKNOWN
|
|---|
