| 1 | FBCHCR ;AISC/CMR-CIVIL HOSPITAL COST REPORT ;7/23/01
|
|---|
| 2 | ;;3.5;FEE BASIS;**32**;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;FBTP SET IN OPTION ENTRANCE ACTION (6=CH/7=CNH)
|
|---|
| 5 | ;FBREF SET IN OPTION ENTRANCE ACTION (FBREF="FB7078" OR "FB583")
|
|---|
| 6 | D DATE^FBAAUTL G END:FBPOP
|
|---|
| 7 | ; if UC ask if report for just mill-bill (1725) or just non-mill bill
|
|---|
| 8 | S FB1725R=""
|
|---|
| 9 | I FBTP=6,FBREF="FB583" S FB1725R=$$ASKMB^FBUCUTL9 I FB1725R="" G END
|
|---|
| 10 | S DIR(0)="S^D:DETAILED REPORT;S:SUMMARY ONLY",DIR("A")="Choose Report Type",DIR("B")="S" D ^DIR K DIR G END:$D(DIRUT) S FBRT=Y W !
|
|---|
| 11 | S VAR="BEGDATE^ENDDATE^FBTP^FBREF^FBRT^FB1725R",VAL=BEGDATE_"^"_ENDDATE_"^"_FBTP_"^"_FBREF_"^"_FBRT,PGM="START^FBCHCR",IOP="Q" D ZIS^FBAAUTL G END:FBPOP
|
|---|
| 12 | START K ^TMP($J,"FBCHCR") S (FBIEN,FBCTR,FBTAMT,FBTLOS,FBAAOUT)=0,BEGDT=BEGDATE-1,Q="-",$P(Q,"-",30)="-",QQ="=",$P(QQ,"=",80)="="
|
|---|
| 13 | F FBDT=BEGDT:0 S FBDT=$O(^FBAAI("AD",FBDT)) Q:FBDT'>0!(FBDT>ENDDATE) F S FBIEN=$O(^FBAAI("AD",FBDT,FBIEN)) Q:FBIEN'>0 S FBTYPE=$P($G(^FBAAI(FBIEN,0)),"^",12) I FBTYPE]"",(FBTP=FBTYPE) D
|
|---|
| 14 | .S FBINV=^FBAAI(FBIEN,0),FBPTC=$P(FBINV,"^",19) S:FBPTC="" FBPTC="99" S @FBREF=$S($P(FBINV,"^",5)[FBREF:+$P(FBINV,"^",5),1:"") Q:@FBREF<1
|
|---|
| 15 | .;if UC and user requested just Mill Bill or just non-Mill Bill then
|
|---|
| 16 | .;check claim and skip when appropriate
|
|---|
| 17 | .I FBTP=6,FBREF="FB583","^M^N^"[(U_FB1725R_U),$P(FBINV,"^",5)[FBREF S FB1725=+$P($G(^FB583(+$P(FBINV,U,5),0)),U,28) Q:$S(FB1725R="M"&'FB1725:1,FB1725R="N"&FB1725:1,1:0)
|
|---|
| 18 | .S DFN=$P(FBINV,"^",4) Q:'$G(DFN) S FBNAME=$$NAME^FBCHREQ2(DFN),FBAMT=$P(FBINV,"^",9),FBDRG=$P(FBINV,"^",24),X1=$P(FBINV,"^",7),X2=$P(FBINV,"^",6) D ^%DTC S FBLOS=$S(X>0:X,1:1)
|
|---|
| 19 | .I FBLOS>0 S FBSUM=$G(^TMP($J,"FBCHCR","SUM",FBPTC,FBLOS)),$P(FBSUM,"^")=($P(FBSUM,"^")+1),$P(FBSUM,"^",2)=($P(FBSUM,"^",2)+FBAMT) D
|
|---|
| 20 | ..S ^TMP($J,"FBCHCR","SUM",FBPTC,FBLOS)=FBSUM
|
|---|
| 21 | .S ^TMP($J,"FBCHCR",FBPTC,FBNAME,@FBREF,"INV",FBIEN)=DFN_"^"_FBAMT_"^"_FBDRG_"^"_FBLOS
|
|---|
| 22 | D ANCIL^FBCHCR1
|
|---|
| 23 | U IO W:$E(IOST,1,2)["C-" @IOF I '$D(^TMP($J,"FBCHCR")) S FBEND=1 D HED W !!,"No payments found within specified timeframe!" G END
|
|---|
| 24 | DETAIL S (FBIEN,FBPTC,FBREF1,DFN,FBAMT,FBLOS,FBANC,L,M,N)=0,(FBNAME,FBDRG,FBCHK)=""
|
|---|
| 25 | I FBRT="D" D HED
|
|---|
| 26 | F S FBPTC=$O(^TMP($J,"FBCHCR",FBPTC)) Q:FBPTC=""!(FBAAOUT) F S FBNAME=$O(^TMP($J,"FBCHCR",FBPTC,FBNAME)) Q:FBNAME=""!(FBAAOUT) F S FBREF1=$O(^TMP($J,"FBCHCR",FBPTC,FBNAME,FBREF1)) Q:FBREF1'>0!(FBAAOUT) D
|
|---|
| 27 | .I $D(^TMP($J,"FBCHCR",FBPTC,FBNAME,FBREF1,"INV")) D
|
|---|
| 28 | ..F S FBIEN=$O(^TMP($J,"FBCHCR",FBPTC,FBNAME,FBREF1,"INV",FBIEN)) Q:FBIEN=""!(FBAAOUT) S FBCTR=FBCTR+1 D
|
|---|
| 29 | ...S FBINV=^TMP($J,"FBCHCR",FBPTC,FBNAME,FBREF1,"INV",FBIEN),DFN=+FBINV,FBAMT=$P(FBINV,"^",2),FBDRG=$P(FBINV,"^",3),FBLOS=$P(FBINV,"^",4),FBTAMT=FBTAMT+FBAMT,FBTLOS=FBTLOS+FBLOS D PRINT:FBRT="D"
|
|---|
| 30 | .I $D(^TMP($J,"FBCHCR",FBPTC,FBNAME,FBREF1,"ANC")) F S L=$O(^TMP($J,"FBCHCR",FBPTC,FBNAME,FBREF1,"ANC",L)) Q:'L!(FBAAOUT) D
|
|---|
| 31 | ..F S M=$O(^TMP($J,"FBCHCR",FBPTC,FBNAME,FBREF1,"ANC",L,M)) Q:'M!(FBAAOUT) F S N=$O(^TMP($J,"FBCHCR",FBPTC,FBNAME,FBREF1,"ANC",L,M,N)) Q:'N!(FBAAOUT) D
|
|---|
| 32 | ...S FBANC=1,FBINV=^TMP($J,"FBCHCR",FBPTC,FBNAME,FBREF1,"ANC",L,M,N),DFN=+FBINV,FBAMT=$P(FBINV,"^",2),FBDRG="",FBLOS="" D PRINT:FBRT="D" S FBANC=0
|
|---|
| 33 | G END:FBAAOUT I FBRT="D" W !!!,?22,"** Indicates an Ancillary Payment"
|
|---|
| 34 | D SUMMARY^FBCHCR1
|
|---|
| 35 | END K FBNAME,FBPTC,FBIEN,DFN,FBAMT,FBDRG,FBCHK,FBLOS,FB7078,FBANC,Q,QQ,FBCTR,FBTAMT,FBTLOS,FBDT,BEGDATE,ENDDATE,BEGDT,FBTP,FBTYPE,FBINV,FBAAOUT,I,J,K,L,M,N,FBJ,FBREF,FBREF1,FB583,FB7078,FBEND,FBSUM,FBSUM1,FBSUM2,FBRT,FB1725,FB1725R
|
|---|
| 36 | K ^TMP($J,"FBCHCR") D CLOSE^FBAAUTL
|
|---|
| 37 | Q
|
|---|
| 38 | PRINT I $Y+5>IOSL W !!!?22,"** Indicates an Ancillary Payment"
|
|---|
| 39 | D PGCHK Q:FBAAOUT
|
|---|
| 40 | I FBPTC'=FBCHK D HED1 S FBCHK=FBPTC
|
|---|
| 41 | W !,$E(FBNAME,1,23),?24,$$SSN^FBAAUTL(DFN),?40,$S(FBREF="FB7078":$P(^FB7078(FBREF1,0),"^"),1:$$DATX^FBAAUTL($P(^FB583(FBREF1,0),"^"))),?53,$S($G(FBAMT):$J($FN(FBAMT,",",2),10),1:""),?63,$S(FBANC:"**",1:""),?71,FBDRG,?75,$J(FBLOS,5)
|
|---|
| 42 | Q
|
|---|
| 43 | HED I FBREF="FB583" W !?22,$S(FB1725R="M":"MILL BILL (1725) ",FB1725R="N":" NON-MILL BILL ",1:" "),"UNAUTHORIZED CLAIMS"
|
|---|
| 44 | W !,@$S(FBTP=6:"?25",1:"?22"),"COST REPORT FOR ",$S(FBTP=6:"CIVIL HOSPITAL",1:"CONTRACT NURSING HOME"),!?28,$$DATX^FBAAUTL(BEGDATE)," THROUGH ",$$DATX^FBAAUTL(ENDDATE),!,@$S(FBTP=6:"?25",1:"?22"),Q I FBTP=7 F J=1:1:7 W "-"
|
|---|
| 45 | I $G(FBEND) D HED2 Q
|
|---|
| 46 | W !!!,"PATIENT NAME",?25,"PATIENT ID"
|
|---|
| 47 | I FBREF="FB583" W ?40,"DT CLAIM REC"
|
|---|
| 48 | I FBREF="FB7078" W ?40,"ASSOC 7078"
|
|---|
| 49 | W ?55,"AMT PAID",?66,"FINAL DRG",?77,"LOS",!,QQ
|
|---|
| 50 | Q
|
|---|
| 51 | HED1 W !!?5,"TREATING SPECIALTY: " F I=1:1:8 S J=$T(TEXT+I) I $P(J,";",3)=FBPTC W $P(J,";",4) Q
|
|---|
| 52 | Q
|
|---|
| 53 | HED2 W !!,?35,"SUMMARY",!!?22,"LOS",?40,"# CASES",?60,"AVE. AMT. PAID",!,QQ
|
|---|
| 54 | Q
|
|---|
| 55 | PGCHK I $Y+5>IOSL,($E(IOST,1,2)["C-") S DIR(0)="E" D ^DIR K DIR I 'Y S FBAAOUT=1 Q
|
|---|
| 56 | I $Y+5>IOSL W @IOF D HED
|
|---|
| 57 | Q
|
|---|
| 58 | TEXT ;
|
|---|
| 59 | ;;00;SURGICAL
|
|---|
| 60 | ;;10;MEDICAL
|
|---|
| 61 | ;;60;HOME NURSING SERVICE
|
|---|
| 62 | ;;85;PSYCHIATRIC-CONTRACT
|
|---|
| 63 | ;;86;PSYCHIATRIC
|
|---|
| 64 | ;;95;NEUROLOGICAL-CONTRACT
|
|---|
| 65 | ;;96;NEUROLOGICAL
|
|---|
| 66 | ;;99;UNKNOWN
|
|---|
