- 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 Feb 18, 2025@23:55:41 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))