FBCHCR ;AISC/CMR-CIVIL HOSPITAL COST REPORT ;7/23/01
 ;;3.5;FEE BASIS;**32**;JAN 30, 1995
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 ;FBTP SET IN OPTION ENTRANCE ACTION (6=CH/7=CNH)
 ;FBREF SET IN OPTION ENTRANCE ACTION (FBREF="FB7078" OR "FB583")
 D DATE^FBAAUTL G END:FBPOP
 ; if UC ask if report for just mill-bill (1725) or just non-mill bill
 S FB1725R=""
 I FBTP=6,FBREF="FB583" S FB1725R=$$ASKMB^FBUCUTL9 I FB1725R="" G END
 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 !
 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
START K ^TMP($J,"FBCHCR") S (FBIEN,FBCTR,FBTAMT,FBTLOS,FBAAOUT)=0,BEGDT=BEGDATE-1,Q="-",$P(Q,"-",30)="-",QQ="=",$P(QQ,"=",80)="="
 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
 .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
 .;if UC and user requested just Mill Bill or just non-Mill Bill then
 .;check claim and skip when appropriate
 .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)
 .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)
 .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
 ..S ^TMP($J,"FBCHCR","SUM",FBPTC,FBLOS)=FBSUM
 .S ^TMP($J,"FBCHCR",FBPTC,FBNAME,@FBREF,"INV",FBIEN)=DFN_"^"_FBAMT_"^"_FBDRG_"^"_FBLOS
 D ANCIL^FBCHCR1
 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
DETAIL S (FBIEN,FBPTC,FBREF1,DFN,FBAMT,FBLOS,FBANC,L,M,N)=0,(FBNAME,FBDRG,FBCHK)=""
 I FBRT="D" D HED
 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
 .I $D(^TMP($J,"FBCHCR",FBPTC,FBNAME,FBREF1,"INV")) D
 ..F  S FBIEN=$O(^TMP($J,"FBCHCR",FBPTC,FBNAME,FBREF1,"INV",FBIEN)) Q:FBIEN=""!(FBAAOUT)  S FBCTR=FBCTR+1 D
 ...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"
 .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
 ..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
 ...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
 G END:FBAAOUT I FBRT="D" W !!!,?22,"** Indicates an Ancillary Payment"
 D SUMMARY^FBCHCR1
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
 K ^TMP($J,"FBCHCR") D CLOSE^FBAAUTL
 Q
PRINT I $Y+5>IOSL W !!!?22,"** Indicates an Ancillary Payment"
 D PGCHK Q:FBAAOUT
 I FBPTC'=FBCHK D HED1 S FBCHK=FBPTC
 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)
 Q
HED I FBREF="FB583" W !?22,$S(FB1725R="M":"MILL BILL (1725) ",FB1725R="N":"  NON-MILL BILL ",1:"        "),"UNAUTHORIZED CLAIMS"
 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 "-"
 I $G(FBEND) D HED2 Q
 W !!!,"PATIENT NAME",?25,"PATIENT ID"
 I FBREF="FB583" W ?40,"DT CLAIM REC"
 I FBREF="FB7078" W ?40,"ASSOC 7078"
 W ?55,"AMT PAID",?66,"FINAL DRG",?77,"LOS",!,QQ
 Q
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
 Q
HED2 W !!,?35,"SUMMARY",!!?22,"LOS",?40,"# CASES",?60,"AVE. AMT. PAID",!,QQ
 Q
PGCHK I $Y+5>IOSL,($E(IOST,1,2)["C-") S DIR(0)="E" D ^DIR K DIR I 'Y S FBAAOUT=1 Q
 I $Y+5>IOSL W @IOF D HED
 Q
TEXT ;
 ;;00;SURGICAL
 ;;10;MEDICAL
 ;;60;HOME NURSING SERVICE
 ;;85;PSYCHIATRIC-CONTRACT
 ;;86;PSYCHIATRIC
 ;;95;NEUROLOGICAL-CONTRACT
 ;;96;NEUROLOGICAL
 ;;99;UNKNOWN