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  Sep 23, 2025@20:05:33                                                                                                                                                                                                      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))