IBOTR4 ;ALB/CPM - INSURANCE PAYMENT TREND REPORT - OUTPUT (CON'T.) ; 31-DEC-91
;;2.0;INTEGRATED BILLING;**42,100,118,128,752**;21-MAR-94;Build 20
;;Per VA Directive 6402, this routine should not be modified.
;
;MAP TO DGCROTR4
;
ADDFLD ; - Build descriptive title for BILL/CLAIMS field.
S IBAFT=IBAFN_": "
I IBAFD D Q
.S IBAFT=IBAFT_$S(IBAFF=0&(IBAFL=9999999):"ALL DATES",IBAFF=0:"ALL DATES THROUGH "_$$DATE^IBOTR3(IBAFL),IBAFL=9999999:"ALL DATES ON AND AFTER "_$$DATE^IBOTR3(IBAFL),1:$$DATE^IBOTR3(IBAFF)_" THROUGH "_$$DATE^IBOTR3(IBAFL))
I $D(IBAFZ) S IBAFT=IBAFT_$S(IBAFZ="ALL":"ALL VALUES",1:"NULL VALUES ONLY") Q
I IBAFF="@" S IBAFT=IBAFT_$S(IBAFL]"":"ALL VALUES THROUGH "_IBAFL_", INCLUDING NULLS",1:"ALL VALUES, INCLUDING NULLS") Q
S IBAFT=IBAFT_$S(IBAFF']"":"ALL VALUES THROUGH "_IBAFL,IBAFL']"":"ALL VALUES FOLLOWING "_IBAFF,1:"ALL VALUES BETWEEN "_IBAFF_" AND "_IBAFL)
Q
;
SUBTOT ; - Calculate and write sub-totals for each insurance company.
I $Y>(IOSL-7) S IBCALC=7 D PAUSE^IBOTR3 Q:IBQUIT D HDR^IBOTR3,INSADD^IBOTR3
I IBPRNT="M" W !?79,"----------- ---------- ----------- ----------- ------"
W !,"TOTAL NUMBER OF BILLS",$S(IBPRNT="M":" (AVG # DAYS)",1:""),": "
W +IBTI,$S(IBPRNT="M":" ("_$J($S(+IBTI:IBDS/+IBTI,1:0),0,1)_")",1:"")
W ?79,$J($P(IBTI,U,2),11,2),?91,$J($P(IBTI,U,3),10,2),$S(IBSORT="P":"*",1:"")
W ?102,$J($P(IBTI,U,2)-$P(IBTI,U,3),11,2),$S(IBSORT="O":"*",1:"")
W ?114,$J($P(IBTI,U,4),11,2),?126,$J($S('$P(IBTI,U,2):0,1:$P(IBTI,U,3)/$P(IBTI,U,2)*100),6,2)
Q
;
GTOT ; - Calculate and write grand totals for report.
I $Y>(IOSL-15) S IBCALC=15 D PAUSE^IBOTR3 Q:IBQUIT D HDR^IBOTR3
I IBPRNT'="G" W !
W !?40,"GRAND TOTAL NUMBER OF BILLS:",?80,$J(+IBTT,11)
W !?40,"GRAND TOTAL AMOUNT BILLED:",?80,$J($P(IBTT,U,2),11,2)
W !?40,"GRAND TOTAL AMOUNT BILLED-UNDER 65:",?80,$J($P(IBTT,U,3),11,2)
W !?40,"GRAND TOTAL AMOUNT BILLED-65 & OVER:",?80,$J($P(IBTT,U,4),11,2)
W !?40,"GRAND TOTAL AMOUNT COLLECTED:",?80,$J($P(IBTT,U,5),11,2)
W !?40,"GRAND TOTAL AMOUNT COLLECTED-UNDER 65:",?80,$J($P(IBTT,U,6),11,2)
W !?40,"GRAND TOTAL AMOUNT COLLECTED-65 & OVER:",?80,$J($P(IBTT,U,7),11,2)
W !?40,"GRAND TOTAL AMOUNT UNPAID:",?80,$J($P(IBTT,U,2)-$P(IBTT,U,5),11,2)
W !?40,"GRAND TOTAL AMOUNT PENDING:",?80,$J($P(IBTT,U,8),11,2)
W !?40,"PERCENTAGE COLLECTED:",?80,$J($S('$P(IBTT,U,2):0,1:$P(IBTT,U,5)/$P(IBTT,U,2)*100),11,2)
I $G(IBCANC) D
.W !?40,"GRAND TOTAL NUMBER OF CANCELLED BILLS:",?80,$J($P(IBTT,U,9),11)
.W !?40,"GRAND TOTAL AMOUNT OF CANCELLED BILLS:",?80,$J($P(IBTT,U,10),11,2)
;IB*752/DTG - remove the extra pause
;S IBCALC=3 D PAUSE^IBOTR3
S IBCALC=3
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBOTR4 2660 printed Nov 22, 2024@17:36:17 Page 2
IBOTR4 ;ALB/CPM - INSURANCE PAYMENT TREND REPORT - OUTPUT (CON'T.) ; 31-DEC-91
+1 ;;2.0;INTEGRATED BILLING;**42,100,118,128,752**;21-MAR-94;Build 20
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;MAP TO DGCROTR4
+5 ;
ADDFLD ; - Build descriptive title for BILL/CLAIMS field.
+1 SET IBAFT=IBAFN_": "
+2 IF IBAFD
Begin DoDot:1
+3 SET IBAFT=IBAFT_$SELECT(IBAFF=0&(IBAFL=9999999):"ALL DATES",IBAFF=0:"ALL DATES THROUGH "_$$DATE^IBOTR3(IBAFL),IBAFL=9999999:"ALL DATES ON AND AFTER "_$$DATE^IBOTR3(IBAFL),1:$$DATE^IBOTR3(IBAFF)_" THROUGH "_$$DATE^IBOTR3(IBAFL))
End DoDot:1
QUIT
+4 IF $DATA(IBAFZ)
SET IBAFT=IBAFT_$SELECT(IBAFZ="ALL":"ALL VALUES",1:"NULL VALUES ONLY")
QUIT
+5 IF IBAFF="@"
SET IBAFT=IBAFT_$SELECT(IBAFL]"":"ALL VALUES THROUGH "_IBAFL_", INCLUDING NULLS",1:"ALL VALUES, INCLUDING NULLS")
QUIT
+6 SET IBAFT=IBAFT_$SELECT(IBAFF']"":"ALL VALUES THROUGH "_IBAFL,IBAFL']"":"ALL VALUES FOLLOWING "_IBAFF,1:"ALL VALUES BETWEEN "_IBAFF_" AND "_IBAFL)
+7 QUIT
+8 ;
SUBTOT ; - Calculate and write sub-totals for each insurance company.
+1 IF $Y>(IOSL-7)
SET IBCALC=7
DO PAUSE^IBOTR3
if IBQUIT
QUIT
DO HDR^IBOTR3
DO INSADD^IBOTR3
+2 IF IBPRNT="M"
WRITE !?79,"----------- ---------- ----------- ----------- ------"
+3 WRITE !,"TOTAL NUMBER OF BILLS",$SELECT(IBPRNT="M":" (AVG # DAYS)",1:""),": "
+4 WRITE +IBTI,$SELECT(IBPRNT="M":" ("_$JUSTIFY($SELECT(+IBTI:IBDS/+IBTI,1:0),0,1)_")",1:"")
+5 WRITE ?79,$JUSTIFY($PIECE(IBTI,U,2),11,2),?91,$JUSTIFY($PIECE(IBTI,U,3),10,2),$SELECT(IBSORT="P":"*",1:"")
+6 WRITE ?102,$JUSTIFY($PIECE(IBTI,U,2)-$PIECE(IBTI,U,3),11,2),$SELECT(IBSORT="O":"*",1:"")
+7 WRITE ?114,$JUSTIFY($PIECE(IBTI,U,4),11,2),?126,$JUSTIFY($SELECT('$PIECE(IBTI,U,2):0,1:$PIECE(IBTI,U,3)/$PIECE(IBTI,U,2)*100),6,2)
+8 QUIT
+9 ;
GTOT ; - Calculate and write grand totals for report.
+1 IF $Y>(IOSL-15)
SET IBCALC=15
DO PAUSE^IBOTR3
if IBQUIT
QUIT
DO HDR^IBOTR3
+2 IF IBPRNT'="G"
WRITE !
+3 WRITE !?40,"GRAND TOTAL NUMBER OF BILLS:",?80,$JUSTIFY(+IBTT,11)
+4 WRITE !?40,"GRAND TOTAL AMOUNT BILLED:",?80,$JUSTIFY($PIECE(IBTT,U,2),11,2)
+5 WRITE !?40,"GRAND TOTAL AMOUNT BILLED-UNDER 65:",?80,$JUSTIFY($PIECE(IBTT,U,3),11,2)
+6 WRITE !?40,"GRAND TOTAL AMOUNT BILLED-65 & OVER:",?80,$JUSTIFY($PIECE(IBTT,U,4),11,2)
+7 WRITE !?40,"GRAND TOTAL AMOUNT COLLECTED:",?80,$JUSTIFY($PIECE(IBTT,U,5),11,2)
+8 WRITE !?40,"GRAND TOTAL AMOUNT COLLECTED-UNDER 65:",?80,$JUSTIFY($PIECE(IBTT,U,6),11,2)
+9 WRITE !?40,"GRAND TOTAL AMOUNT COLLECTED-65 & OVER:",?80,$JUSTIFY($PIECE(IBTT,U,7),11,2)
+10 WRITE !?40,"GRAND TOTAL AMOUNT UNPAID:",?80,$JUSTIFY($PIECE(IBTT,U,2)-$PIECE(IBTT,U,5),11,2)
+11 WRITE !?40,"GRAND TOTAL AMOUNT PENDING:",?80,$JUSTIFY($PIECE(IBTT,U,8),11,2)
+12 WRITE !?40,"PERCENTAGE COLLECTED:",?80,$JUSTIFY($SELECT('$PIECE(IBTT,U,2):0,1:$PIECE(IBTT,U,5)/$PIECE(IBTT,U,2)*100),11,2)
+13 IF $GET(IBCANC)
Begin DoDot:1
+14 WRITE !?40,"GRAND TOTAL NUMBER OF CANCELLED BILLS:",?80,$JUSTIFY($PIECE(IBTT,U,9),11)
+15 WRITE !?40,"GRAND TOTAL AMOUNT OF CANCELLED BILLS:",?80,$JUSTIFY($PIECE(IBTT,U,10),11,2)
End DoDot:1
+16 ;IB*752/DTG - remove the extra pause
+17 ;S IBCALC=3 D PAUSE^IBOTR3
+18 SET IBCALC=3
+19 QUIT
