67 lines
4.8 KiB
Mathematica
67 lines
4.8 KiB
Mathematica
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
|