IBTUBV ;ALB/AAS - UNBILLED AMOUNTS - VIEW UNBILLED DATA ;29-SEP-94
;;2.0;INTEGRATED BILLING;**19,123,155**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
% ; - View unbilled amounts for the month.
I '$D(IOF) D HOME^%ZIS
W !!,"View unbilled amounts",!
S %ZIS="QM" D ^%ZIS G:POP END
I $D(IO("Q")) D G END
.S ZTRTN="DQ^IBTUBV",ZTSAVE("IB*")=""
.S ZTDESC="IB - Unbilled View Unbilled Amounts"
.D ^%ZTLOAD K IO("Q"),ZTSK D HOME^%ZIS
;
U IO D DQ
;
END W ! I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
Q
;
DQ ; - Entry point when queued.
N IBAVGI,IBAVGP,IBFL,IBHDT,IBPAG,IBQUIT,IBTMON,DA,ND,ND3,TAB,X,Y
S IBHDT=$$HTE^XLFDT($H,1),(IBPAG,IBQUIT)=0
D HDR S IBTMON="",TAB=40
F S IBTMON=$O(^IBE(356.19,"AIVDT",IBTMON)) Q:'IBTMON D Q:IBQUIT
.S DA=-IBTMON,IBFL=1
.I '$D(^IBE(356.19,DA,1)) D OLDV(DA) Q ; No '1' node-print old report.
.S ND=$P($G(^IBE(356.19,DA,1)),U,1,6)
.;
.; - Get average instutional amount.
.S X1=$S('$P(ND,U,3):0,1:+ND/$P(ND,U,3))
.S X2=$S('$P(ND,U):0,1:+$P(ND,U,2)/+ND),IBAVGI=$J(X1*X2,0,2)
.;
.; - Get average professional amount.
.S X1=$S('$P(ND,U,6):0,1:+$P(ND,U,4)/$P(ND,U,6))
.S X2=$S('$P(ND,U,4):0,1:+$P(ND,U,5)/$P(ND,U,4)),IBAVGP=$J(X1*X2,0,2)
.;
.S ND=$G(^IBE(356.19,DA,2))
.S ND3=$G(^IBE(356.19,DA,3))
.I $Y>(IOSL-7) D HDR Q:IBQUIT
.W !?22,"Inpatient Care: ",$$MYR(DA)
.W !?9,"Number of Unbilled Inpatient Cases: ",$J($P(ND,U,2)+ND,11)
.W !?10,"Number of Unbilled MRA Admissions: ",$J($P(ND3,U,2)+ND3,11)
.W !?4,"Average Inpt. Institutional Bill Amount: ",$J(IBAVGI,11,2)
.W !?5,"Average Inpt. Professional Bill Amount: ",$J(IBAVGP,11,2)
.W !?14,"Total Unbilled Inpatient Care: ",$J($P(ND,U,7),11,2)
.W !?10,"Total MRA Unbilled Inpatient Care: ",$J($P(ND3,U,7),11,2),!
.;
.I $Y>(IOSL-7) D HDR Q:IBQUIT
.W !?21,"Outpatient Care: ",$$MYR(DA)
.W !?8,"Number of Unbilled Outpatient Cases: ",$J($P(ND,U,3),11)
.W !?15,"Number of Unbilled CPT Codes: ",$J($P(ND,U,4)+$P(ND,U,5),11)
.W !?11,"Number of MRA Unbilled CPT Codes: ",$J($P(ND3,U,4)+$P(ND3,U,5),11)
.W !?13,"Total Unbilled Outpatient Care: ",$J($P(ND,U,8),11,2)
.W !?9,"Total MRA Unbilled Outpatient Care: ",$J($P(ND3,U,8),11,2),!
.;
.I $Y>(IOSL-7) D HDR Q:IBQUIT
.W !?23,"Prescriptions: ",$$MYR(DA)
.W !?11,"Number of Unbilled Prescriptions: ",$J($P(ND,U,6),11)
.W !?7,"Number of MRA Unbilled Prescriptions: ",$J($P(ND3,U,6),11)
.W !?15,"Total Unbilled Prescriptions: ",$J($P(ND,U,9),11,2)
.W !?11,"Total MRA Unbilled Prescriptions: ",$J($P(ND3,U,9),11,2),!
;
I '$G(IBFL) W !!,"No Unbilled Amount information found."
Q
;
OLDV(X) ; - Print old version of report if no '1' node of file #356.19 entry.
S ND=$G(^IBE(356.19,X,0)) G:'$P(ND,U,16) OLDVQ
I $Y>(IOSL-7) D HDR
W !!?11,"Inpatient Care: ",$$MYR(X)
W !?3,"Number of Unbilled Inpt. Cases: ",$J($P(ND,U,12),11)
W !?8,"Average Inpt. Bill Amount: ",$J($P(ND,U,13),11,2)
W !?9,"Total Inpatient Unbilled: ",$J($P(ND,U,12)*$P(ND,U,13),11,2)
;
I $Y>(IOSL-7) D HDR
W !!?11,"Outpatient Care: ",$$MYR(X)
W !?3,"Number of Unbilled Opt. Cases: ",$J($P(ND,U,14),11)
W !?9,"Average Opt. Bill Amount: ",$J($P(ND,U,15),11,2)
W !?8,"Total Outpatient Unbilled: ",$J($P(ND,U,14)*$P(ND,U,15),11,2)
;
OLDVQ Q
;
HDR ; - Output header.
I $E(IOST,1,2)="C-",IBPAG D PAUSE^VALM1 I $D(DIRUT) S IBQUIT=1 G HDRQ
I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
S IBPAG=IBPAG+1
W !,"Unbilled Amounts Report",?(IOM-33),"Page ",IBPAG," ",IBHDT
W !,$TR($J(" ",IOM)," ","-")
I $D(ZTQUEUED),$$S^%ZTLOAD D
.S (IBQUIT,ZTSTOP)=1 W !!,"...task stopped at user request"
;
HDRQ Q
;
MYR(X) ; - Format month/year (MM/YY).
Q $S('$G(X):"",1:$E(X,4,5)_"/"_$E(X,2,3))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTUBV 3741 printed Dec 13, 2024@02:29:12 Page 2
IBTUBV ;ALB/AAS - UNBILLED AMOUNTS - VIEW UNBILLED DATA ;29-SEP-94
+1 ;;2.0;INTEGRATED BILLING;**19,123,155**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
% ; - View unbilled amounts for the month.
+1 IF '$DATA(IOF)
DO HOME^%ZIS
+2 WRITE !!,"View unbilled amounts",!
+3 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO END
+4 IF $DATA(IO("Q"))
Begin DoDot:1
+5 SET ZTRTN="DQ^IBTUBV"
SET ZTSAVE("IB*")=""
+6 SET ZTDESC="IB - Unbilled View Unbilled Amounts"
+7 DO ^%ZTLOAD
KILL IO("Q"),ZTSK
DO HOME^%ZIS
End DoDot:1
GOTO END
+8 ;
+9 USE IO
DO DQ
+10 ;
END WRITE !
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+1 DO ^%ZISC
+2 QUIT
+3 ;
DQ ; - Entry point when queued.
+1 NEW IBAVGI,IBAVGP,IBFL,IBHDT,IBPAG,IBQUIT,IBTMON,DA,ND,ND3,TAB,X,Y
+2 SET IBHDT=$$HTE^XLFDT($HOROLOG,1)
SET (IBPAG,IBQUIT)=0
+3 DO HDR
SET IBTMON=""
SET TAB=40
+4 FOR
SET IBTMON=$ORDER(^IBE(356.19,"AIVDT",IBTMON))
if 'IBTMON
QUIT
Begin DoDot:1
+5 SET DA=-IBTMON
SET IBFL=1
+6 ; No '1' node-print old report.
IF '$DATA(^IBE(356.19,DA,1))
DO OLDV(DA)
QUIT
+7 SET ND=$PIECE($GET(^IBE(356.19,DA,1)),U,1,6)
+8 ;
+9 ; - Get average instutional amount.
+10 SET X1=$SELECT('$PIECE(ND,U,3):0,1:+ND/$PIECE(ND,U,3))
+11 SET X2=$SELECT('$PIECE(ND,U):0,1:+$PIECE(ND,U,2)/+ND)
SET IBAVGI=$JUSTIFY(X1*X2,0,2)
+12 ;
+13 ; - Get average professional amount.
+14 SET X1=$SELECT('$PIECE(ND,U,6):0,1:+$PIECE(ND,U,4)/$PIECE(ND,U,6))
+15 SET X2=$SELECT('$PIECE(ND,U,4):0,1:+$PIECE(ND,U,5)/$PIECE(ND,U,4))
SET IBAVGP=$JUSTIFY(X1*X2,0,2)
+16 ;
+17 SET ND=$GET(^IBE(356.19,DA,2))
+18 SET ND3=$GET(^IBE(356.19,DA,3))
+19 IF $Y>(IOSL-7)
DO HDR
if IBQUIT
QUIT
+20 WRITE !?22,"Inpatient Care: ",$$MYR(DA)
+21 WRITE !?9,"Number of Unbilled Inpatient Cases: ",$JUSTIFY($PIECE(ND,U,2)+ND,11)
+22 WRITE !?10,"Number of Unbilled MRA Admissions: ",$JUSTIFY($PIECE(ND3,U,2)+ND3,11)
+23 WRITE !?4,"Average Inpt. Institutional Bill Amount: ",$JUSTIFY(IBAVGI,11,2)
+24 WRITE !?5,"Average Inpt. Professional Bill Amount: ",$JUSTIFY(IBAVGP,11,2)
+25 WRITE !?14,"Total Unbilled Inpatient Care: ",$JUSTIFY($PIECE(ND,U,7),11,2)
+26 WRITE !?10,"Total MRA Unbilled Inpatient Care: ",$JUSTIFY($PIECE(ND3,U,7),11,2),!
+27 ;
+28 IF $Y>(IOSL-7)
DO HDR
if IBQUIT
QUIT
+29 WRITE !?21,"Outpatient Care: ",$$MYR(DA)
+30 WRITE !?8,"Number of Unbilled Outpatient Cases: ",$JUSTIFY($PIECE(ND,U,3),11)
+31 WRITE !?15,"Number of Unbilled CPT Codes: ",$JUSTIFY($PIECE(ND,U,4)+$PIECE(ND,U,5),11)
+32 WRITE !?11,"Number of MRA Unbilled CPT Codes: ",$JUSTIFY($PIECE(ND3,U,4)+$PIECE(ND3,U,5),11)
+33 WRITE !?13,"Total Unbilled Outpatient Care: ",$JUSTIFY($PIECE(ND,U,8),11,2)
+34 WRITE !?9,"Total MRA Unbilled Outpatient Care: ",$JUSTIFY($PIECE(ND3,U,8),11,2),!
+35 ;
+36 IF $Y>(IOSL-7)
DO HDR
if IBQUIT
QUIT
+37 WRITE !?23,"Prescriptions: ",$$MYR(DA)
+38 WRITE !?11,"Number of Unbilled Prescriptions: ",$JUSTIFY($PIECE(ND,U,6),11)
+39 WRITE !?7,"Number of MRA Unbilled Prescriptions: ",$JUSTIFY($PIECE(ND3,U,6),11)
+40 WRITE !?15,"Total Unbilled Prescriptions: ",$JUSTIFY($PIECE(ND,U,9),11,2)
+41 WRITE !?11,"Total MRA Unbilled Prescriptions: ",$JUSTIFY($PIECE(ND3,U,9),11,2),!
End DoDot:1
if IBQUIT
QUIT
+42 ;
+43 IF '$GET(IBFL)
WRITE !!,"No Unbilled Amount information found."
+44 QUIT
+45 ;
OLDV(X) ; - Print old version of report if no '1' node of file #356.19 entry.
+1 SET ND=$GET(^IBE(356.19,X,0))
if '$PIECE(ND,U,16)
GOTO OLDVQ
+2 IF $Y>(IOSL-7)
DO HDR
+3 WRITE !!?11,"Inpatient Care: ",$$MYR(X)
+4 WRITE !?3,"Number of Unbilled Inpt. Cases: ",$JUSTIFY($PIECE(ND,U,12),11)
+5 WRITE !?8,"Average Inpt. Bill Amount: ",$JUSTIFY($PIECE(ND,U,13),11,2)
+6 WRITE !?9,"Total Inpatient Unbilled: ",$JUSTIFY($PIECE(ND,U,12)*$PIECE(ND,U,13),11,2)
+7 ;
+8 IF $Y>(IOSL-7)
DO HDR
+9 WRITE !!?11,"Outpatient Care: ",$$MYR(X)
+10 WRITE !?3,"Number of Unbilled Opt. Cases: ",$JUSTIFY($PIECE(ND,U,14),11)
+11 WRITE !?9,"Average Opt. Bill Amount: ",$JUSTIFY($PIECE(ND,U,15),11,2)
+12 WRITE !?8,"Total Outpatient Unbilled: ",$JUSTIFY($PIECE(ND,U,14)*$PIECE(ND,U,15),11,2)
+13 ;
OLDVQ QUIT
+1 ;
HDR ; - Output header.
+1 IF $EXTRACT(IOST,1,2)="C-"
IF IBPAG
DO PAUSE^VALM1
IF $DATA(DIRUT)
SET IBQUIT=1
GOTO HDRQ
+2 IF $EXTRACT(IOST,1,2)="C-"!(IBPAG)
WRITE @IOF
+3 SET IBPAG=IBPAG+1
+4 WRITE !,"Unbilled Amounts Report",?(IOM-33),"Page ",IBPAG," ",IBHDT
+5 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-")
+6 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
Begin DoDot:1
+7 SET (IBQUIT,ZTSTOP)=1
WRITE !!,"...task stopped at user request"
End DoDot:1
+8 ;
HDRQ QUIT
+1 ;
MYR(X) ; - Format month/year (MM/YY).
+1 QUIT $SELECT('$GET(X):"",1:$EXTRACT(X,4,5)_"/"_$EXTRACT(X,2,3))