| 1 | FBCHCR1 ;AISC/CMR-CH & CNH COST REPORT CONT. ;7/4/01
|
|---|
| 2 | ;;3.5;FEE BASIS;**32**;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ANCIL S J="",(K,L,M,N)=0,FBDT=BEGDATE
|
|---|
| 5 | F S J=$O(^FBAAC("AM",J)) Q:J="" I J[FBREF F S K=$O(^FBAAC("AM",J,K)) Q:K'>0 F S L=$O(^FBAAC("AM",J,K,L)) Q:L'>0 F S M=$O(^FBAAC("AM",J,K,L,M)) Q:M'>0 F S N=$O(^FBAAC("AM",J,K,L,M,N)) Q:N'>0 D
|
|---|
| 6 | .S FBINV=$G(^FBAAC(K,1,L,1,M,1,N,0))
|
|---|
| 7 | .I $P(FBINV,"^",9)=FBTP,$P(FBINV,"^",6)>(FBDT-1),$P(FBINV,"^",6)<(ENDDATE+1) D
|
|---|
| 8 | ..;if UC and user requested just Mill Bill or just non-Mill Bill then
|
|---|
| 9 | ..;check claim and skip when appropriate
|
|---|
| 10 | ..I FBTP=6,FBREF="FB583","^M^N^"[(U_FB1725R_U),$P(FBINV,"^",13)[FBREF S FB1725=+$P($G(^FB583(+$P(FBINV,U,13),0)),U,28) Q:$S(FB1725R="M"&'FB1725:1,FB1725R="N"&FB1725:1,1:0)
|
|---|
| 11 | ..S FBPTC=$P(FBINV,"^",17) S:FBPTC="" FBPTC="99" S DFN=K,FBNAME=$$NAME^FBCHREQ2(DFN),FBAMT=$P(FBINV,"^",3),FBREF1=$P(J,";")
|
|---|
| 12 | ..S FBSUM=$G(^TMP($J,"FBCHCR","SUM","ANC")),$P(FBSUM,"^")=($P(FBSUM,"^")+1),$P(FBSUM,"^",2)=($P(FBSUM,"^",2)+FBAMT) S ^TMP($J,"FBCHCR","SUM","ANC")=FBSUM
|
|---|
| 13 | ..S ^TMP($J,"FBCHCR",FBPTC,FBNAME,FBREF1,"ANC",L,M,N)=DFN_"^"_FBAMT_"^^"
|
|---|
| 14 | Q
|
|---|
| 15 | SUMMARY I FBRT="D",($E(IOST,1,2)["C-") S DIR(0)="E" D ^DIR K DIR Q:'Y
|
|---|
| 16 | W @IOF S FBEND=1 D HED^FBCHCR
|
|---|
| 17 | S (FBPTC,FBLOS)=0,FBCHK=""
|
|---|
| 18 | F S FBPTC=$O(^TMP($J,"FBCHCR","SUM",FBPTC)) Q:FBPTC=""!(FBAAOUT) F S FBLOS=$O(^TMP($J,"FBCHCR","SUM",FBPTC,FBLOS)) Q:FBLOS=""!(FBAAOUT) S FBSUM=^(FBLOS),FBSUM1=+FBSUM,FBSUM2=$P(FBSUM,"^",2) D
|
|---|
| 19 | .D PGCHK^FBCHCR Q:$G(FBAAOUT)
|
|---|
| 20 | .I FBPTC'=FBCHK D HED1^FBCHCR S FBCHK=FBPTC
|
|---|
| 21 | .W !?20,$J(FBLOS,5),?40,$J(FBSUM1,5),?60,$J((FBSUM2/FBSUM1),10,2)
|
|---|
| 22 | W !!,QQ,!!?4,"TOTAL CASES: ",FBCTR,?24,"AVERAGE AMOUNT PAID: ",$S($G(FBTAMT):$FN((FBTAMT/FBCTR),",",2),1:""),?56,"AVERAGE LOS: ",$S($G(FBTLOS):$FN((FBTLOS/FBCTR),",",2),1:"")
|
|---|
| 23 | I $D(^TMP($J,"FBCHCR","SUM","ANC")) S FBSUM=^("ANC"),FBSUM1=+FBSUM,FBSUM2=$P(FBSUM,"^",2) W !!?4,"TOTAL ANCILLARY PAYMENTS: ",$J(FBSUM1,5),?40,"AVERAGE AMOUNT PAID: ",$J((FBSUM2/FBSUM1),10,2)
|
|---|
| 24 | Q
|
|---|
