IBJDF72 ;ALB/MR - REPAYMENT PLAN REPORT (PRINT) ;16-AUG-00
;;2.0;INTEGRATED BILLING;**123,159**;21-MAR-94
;
EN ; - Print the Repayment Plan Report
;
S IBQ=0 D NOW^%DTC S IBRUN=$$DAT2^IBOUTL(%)
;
I '$G(IBXTRACT),'$D(^TMP("IBJDF7",$J)) D G ENQ
. I '$G(IBEXCEL) D @($S(IBRPT="D":"HDRD",1:"HDRS"))
. W !!,"There are no Repayment Plan for the parameters selected."
;
; - Summary report was selected
I IBRPT="S" G SUM
;
I '$G(IBEXCEL) S IBPAG=0 D HDRD G:IBQ ENQ
;
; - Print the header line for the Excel spreadsheet
I $G(IBEXCEL) D PHDL
;
S (IBKEY,IBDFN,IBILL)=""
F S IBKEY=$O(^TMP("IBJDF7",$J,IBKEY)) Q:IBKEY="" D Q:IBQ
. F S IBDFN=$O(^TMP("IBJDF7",$J,IBKEY,IBDFN)) Q:IBDFN="" D Q:IBQ
. . S IBPAT=$G(^TMP("IBJDF7",$J,IBKEY,IBDFN)),IBFLG=1
. . S IBCNT=0,IBTOT=""
. . ;
. . ; - Page Break
. . I '$G(IBEXCEL),$Y>(IOSL-7) D PAUSE Q:IBQ D HDRD Q:IBQ
. . ;
. . ; - Debtor Name (* - if in default) and SSN
. . I '$G(IBEXCEL) D WPAT
. . ;
. . F S IBILL=$O(^TMP("IBJDF7",$J,IBKEY,IBDFN,IBILL)) Q:IBILL="" D Q:IBQ
. . . S IBRP=$G(^TMP("IBJDF7",$J,IBKEY,IBDFN,IBILL))
. . . ;
. . . ; - Print the data to an Excel data format
. . . I $G(IBEXCEL) D EXCEL Q
. . . ;
. . . ; - Page Break
. . . I $Y>(IOSL-6) D PAUSE Q:IBQ D HDRD,WPAT Q:IBQ
. . . ;
. . . ; - Bill, Start Date, Balance, Mo.Pymt and Due Day
. . . W ?51,IBILL
. . . I $P(IBRP,"^")="" D Q
. . . . W ?64,"->REPAYMENT PLAN INCOMPLETE. PLEASE CHECK!",!
. . . W ?64,$$DAT1^IBOUTL($P(IBRP,"^"))
. . . W ?74,$J($FN($P(IBRP,"^",9),",",2),10)
. . . W ?86,$J($FN($P(IBRP,"^",3),",",2),10)
. . . W ?98,$J($P(IBRP,"^",4),2)
. . . ;
. . . ; - Last Payment (Date and Amount)
. . . I $P(IBRP,"^",5)'="" D
. . . . W ?102,$$DAT1^IBOUTL($P(IBRP,"^",5))
. . . . W ?112,$J($FN($P(IBRP,"^",6),",",2),10)
. . . ;
. . . ; - Number of Payments - Due and Defaulted
. . . W ?124,$J($P(IBRP,"^",7),3),?128,$J($P(IBRP,"^",8),3),!
. . . ;
. . . ; - Date of Death (if any)
. . . I IBFLG,$P(IBPAT,"^",3) D
. . . . W $$DAT1^IBOUTL($P(IBPAT,"^",3)) S IBFLG=0
. . . ;
. . . ; - Will be used to print TOTAL line by Debtor
. . . S IBCNT=IBCNT+1
. . . F I=6,9 S $P(IBTOT,"^",I)=$P(IBTOT,"^",I)+$P(IBRP,"^",I)
. . ;
. . ; - Quits if the entry was printed to Excel file
. . I $G(IBEXCEL) Q
. . ;
. . ; - Prints Total by Debtor
. . I 'IBQ,IBTPT,IBCNT>1 D PTOT
;
DETQ G ENQ:IBQ!$G(IBEXCEL) D PAUSE G ENQ:IBQ
;
SUM ; - Print Summary Report
;
; Sets IB with totals (Current + Defaulted)
F I=9,11,12 S IB(I)=IB(I-8)+IB(I-4)
;
; Formats the amount fields to a $ format (9,999,999.99)
F I=3,7,11 S IB(I)=$FN(IB(I),"",2)
;
; - Extract summary data
I $G(IBXTRACT) D E^IBJDE(38,0) G ENQ
;
D HDRS
I $Y>(IOSL-12) D PAUSE G ENQ:IBQ D HDRS G ENQ:IBQ
I IBPLN'="D" D PSUM("C") W !!
I $Y>(IOSL-11) D PAUSE G ENQ:IBQ D HDRS G ENQ:IBQ
I IBPLN'="C" D PSUM("D") W !!
I $Y>(IOSL-11) D PAUSE G ENQ:IBQ D HDRS G ENQ:IBQ
D PSUM("T") D PAUSE
;
ENQ K IBCNT,IBFLG,IBDFN,IBILL,IBKEY,IBPAT,IBPAG,IBQ,IBRUN,IBRP,IBTOT,%
Q
;
WPAT ; - Write the Debtor name & SSN
W !,$P(IBPAT,"^"),$S($P(IBPAT,"^",4):" *",1:"")
W ?38,$P(IBPAT,"^",2)
Q
;
EXCEL ; - Prints the data to an Excel file format
;
W !,$P(IBPAT,"^",1)_"^"_$TR($P(IBPAT,"^",2),"-")_"^"
W $S($P(IBRP,"^",8):"D",1:"C")_"^"
W $S($P(IBPAT,"^",3):$$DT($P(IBPAT,"^",3)),1:"")_"^"
W IBILL_"^"_$$DT($P(IBRP,"^"))_"^"_$P(IBRP,"^",3)_"^"
W $E($P(IBRP,"^",4)+100,2,3)_"^"_$$DT($P(IBRP,"^",5))_"^"
W $P(IBRP,"^",6)_"^"_$P(IBRP,"^",2)_"^"_$P(IBRP,"^",7)_"^"
W $P(IBRP,"^",8)
Q
;
HDRD ; - Prints the Detailed Report Header
I $E(IOST,1,2)="C-"!$G(IBPAG) W @IOF,*13
S IBPAG=$G(IBPAG)+1 W "Repayment Plan Report"
W ?60,"Run Date: ",IBRUN,?123,"Page: ",$J(IBPAG,3)
S X="" S:IBPLN'="D" X="CURRENT " S:IBPLN="B" X=X_"AND "
S:IBPLN'="C" X=X_"DEFAULTED " S X=X_"REPAYMENT PLAN / "
S:IBMCR="N" X=X_"NON-" S X=X_"MCCR RECEIVABLES ONLY / "
S X=X_"BY DEBTOR "_$S(IBSN="N":"NAME",1:"LAST 4 DIGITS OF SSN")
S X=X_" ("_$S($G(IBSNA)="ALL":"ALL",1:"From "_$S(IBSNF="":"FIRST",1:IBSNF)_" to "_$S(IBSNL="zzzzz":"LAST",1:IBSNL))_") / "
S X=X_"'*' AFTER THE NAME = DEBTOR HAS DEFAULTED ON A REPAYMENT PLAN"
F I=1:1 W !,$E(X,1,132) S X=$E(X,133,999) I X="" Q
;
W !!,"Debtor Name",?64,"Start",?86,"Monthly",?97,"Due"
W ?104,"Last Payment",?124,"#Paymts"
W !,"Date of Death",?38,"SSN",?51,"Bill",?64,"Date",?74,"Balance"
W ?86,"Payment",?97,"Day",?102,"Date",?112,"Amount",?124,"Due",?128,"Def"
W !,$$DASH(IOM,0) S IBQ=$$STOP^IBOUTL("Repayment Plan Report")
Q
;
HDRS ; - Prints the Summary Report Header
;
N X
I $E(IOST,1,2)="C-"!$G(IBPAG) W @IOF,*13
S IBPAG=$G(IBPAG)+1 W ?71,"Page: ",$J(IBPAG,3)
W !?26,"SUMMARY REPAYMENT PLAN REPORT"
S X="MCCR RECEIVABLES" S:IBMCR="N" X="NON-"_X
S X=X_" / "_$S($G(IBSNA)="ALL":IBSNA_" ",1:"")_"DEBTORS"
I IBSNA'="ALL" S X=X_" From "_$S(IBSNF="":"FIRST",1:IBSNF)_" to "_$S(IBSNL="zzzzz":"LAST",1:IBSNL)
S X="("_X_")"
W !?(80-$L(X)/2+1),X,!!?(80-$L(IBRUN)/2+1),IBRUN
S X="",$P(X,"=",$L(IBRUN)+1)="" W !?(80-$L(IBRUN)/2+1),X
W !
Q
;
PHDL ; - Print the header line for the Excel spreadsheet
N X
S X="Debtor^SSN^Plan Type^Death Dt^Bill #^Start Dt^Mo.Pymt Amt^"
S X=X_"Due Day^Lst Pymt Dt^Lst Pymt Amt^Curr.Bal.^Pymts Due^Pymts Def."
W !,X
Q
;
PTOT ; - Prints the TOTAL line for the Debtor
;
N I,X
S $P(X,"-",11)=""
W ?74,X,?112,X
W !?74,$J($FN($P(IBTOT,"^",9),"",2),10)
W ?112,$J($FN($P(IBTOT,"^",6),"",2),10),!
Q
;
PSUM(X) ; Prints the Summary Information
; Input: X=Type of information: C-Current, D-Defaulted or T-Total
;
N IBIX
W !?15,$S(X="C":"CURRENT",X="D":"DEFAULTED",1:"TOTAL")
W " REPAYMENT PLANS" W:X="T" " (CURRENT + DEFAULTED)"
;
S IBIX=$S(X="D":1,X="C":5,1:9)
;
W !?15,"Number of Bills:",?47,$J(+IB(IBIX),10)
W:X'="T" $$PER(IB(IBIX),+IB(9))
W !?15,"Number of Debtors" W:X="T" " (unique)" W ":",?47,$J(IB(IBIX+1),10)
W:X'="T" $$PER(IB(IBIX+1),IB(10))
W !?15,"Outstanding balance of Bills:",?47,$J(IB(IBIX+2),10)
W:X'="T" $$PER(IB(IBIX+2),IB(11))
W !?15,"Number of payments due:",?47,$J(IB(IBIX+3),10)
W:X'="T" $$PER(IB(IBIX+3),IB(12))
Q
;
PER(X,T) ; Calculates the percentage
; Input: T=Total Amount, X=Amount
; Output: Percentage of X from T - Format: (99.99%)
;
I 'T Q ""
Q $J(" ("_($TR(X,",","")/$TR(T,",","")*10000+.5\1/100)_"%)",10)
;
DASH(X,Y) ; - Return a dashed line.
; Input: X=Number of Columns (80 or 132), Y=Char to be printed
;
Q $TR($J("",X)," ",$S(Y:"-",1:"="))
;
PAUSE ; - Page break.
;
I $E(IOST,1,2)'="C-" Q
N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
F IBX=$Y:1:(IOSL-3) W !
S DIR(0)="E" D ^DIR S:$D(DIRUT)!($D(DUOUT)) IBQ=1
Q
;
DT(X) ; - Return date.
; Input: X=Date in Fileman format
; Output: Z=Date in MMDDYY format
;
Q $E(X,4,7)_$E(X,2,3)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJDF72 6914 printed Apr 09, 2024@21:04:17 Page 2
IBJDF72 ;ALB/MR - REPAYMENT PLAN REPORT (PRINT) ;16-AUG-00
+1 ;;2.0;INTEGRATED BILLING;**123,159**;21-MAR-94
+2 ;
EN ; - Print the Repayment Plan Report
+1 ;
+2 SET IBQ=0
DO NOW^%DTC
SET IBRUN=$$DAT2^IBOUTL(%)
+3 ;
+4 IF '$GET(IBXTRACT)
IF '$DATA(^TMP("IBJDF7",$JOB))
Begin DoDot:1
+5 IF '$GET(IBEXCEL)
DO @($SELECT(IBRPT="D":"HDRD",1:"HDRS"))
+6 WRITE !!,"There are no Repayment Plan for the parameters selected."
End DoDot:1
GOTO ENQ
+7 ;
+8 ; - Summary report was selected
+9 IF IBRPT="S"
GOTO SUM
+10 ;
+11 IF '$GET(IBEXCEL)
SET IBPAG=0
DO HDRD
if IBQ
GOTO ENQ
+12 ;
+13 ; - Print the header line for the Excel spreadsheet
+14 IF $GET(IBEXCEL)
DO PHDL
+15 ;
+16 SET (IBKEY,IBDFN,IBILL)=""
+17 FOR
SET IBKEY=$ORDER(^TMP("IBJDF7",$JOB,IBKEY))
if IBKEY=""
QUIT
Begin DoDot:1
+18 FOR
SET IBDFN=$ORDER(^TMP("IBJDF7",$JOB,IBKEY,IBDFN))
if IBDFN=""
QUIT
Begin DoDot:2
+19 SET IBPAT=$GET(^TMP("IBJDF7",$JOB,IBKEY,IBDFN))
SET IBFLG=1
+20 SET IBCNT=0
SET IBTOT=""
+21 ;
+22 ; - Page Break
+23 IF '$GET(IBEXCEL)
IF $Y>(IOSL-7)
DO PAUSE
if IBQ
QUIT
DO HDRD
if IBQ
QUIT
+24 ;
+25 ; - Debtor Name (* - if in default) and SSN
+26 IF '$GET(IBEXCEL)
DO WPAT
+27 ;
+28 FOR
SET IBILL=$ORDER(^TMP("IBJDF7",$JOB,IBKEY,IBDFN,IBILL))
if IBILL=""
QUIT
Begin DoDot:3
+29 SET IBRP=$GET(^TMP("IBJDF7",$JOB,IBKEY,IBDFN,IBILL))
+30 ;
+31 ; - Print the data to an Excel data format
+32 IF $GET(IBEXCEL)
DO EXCEL
QUIT
+33 ;
+34 ; - Page Break
+35 IF $Y>(IOSL-6)
DO PAUSE
if IBQ
QUIT
DO HDRD
DO WPAT
if IBQ
QUIT
+36 ;
+37 ; - Bill, Start Date, Balance, Mo.Pymt and Due Day
+38 WRITE ?51,IBILL
+39 IF $PIECE(IBRP,"^")=""
Begin DoDot:4
+40 WRITE ?64,"->REPAYMENT PLAN INCOMPLETE. PLEASE CHECK!",!
End DoDot:4
QUIT
+41 WRITE ?64,$$DAT1^IBOUTL($PIECE(IBRP,"^"))
+42 WRITE ?74,$JUSTIFY($FNUMBER($PIECE(IBRP,"^",9),",",2),10)
+43 WRITE ?86,$JUSTIFY($FNUMBER($PIECE(IBRP,"^",3),",",2),10)
+44 WRITE ?98,$JUSTIFY($PIECE(IBRP,"^",4),2)
+45 ;
+46 ; - Last Payment (Date and Amount)
+47 IF $PIECE(IBRP,"^",5)'=""
Begin DoDot:4
+48 WRITE ?102,$$DAT1^IBOUTL($PIECE(IBRP,"^",5))
+49 WRITE ?112,$JUSTIFY($FNUMBER($PIECE(IBRP,"^",6),",",2),10)
End DoDot:4
+50 ;
+51 ; - Number of Payments - Due and Defaulted
+52 WRITE ?124,$JUSTIFY($PIECE(IBRP,"^",7),3),?128,$JUSTIFY($PIECE(IBRP,"^",8),3),!
+53 ;
+54 ; - Date of Death (if any)
+55 IF IBFLG
IF $PIECE(IBPAT,"^",3)
Begin DoDot:4
+56 WRITE $$DAT1^IBOUTL($PIECE(IBPAT,"^",3))
SET IBFLG=0
End DoDot:4
+57 ;
+58 ; - Will be used to print TOTAL line by Debtor
+59 SET IBCNT=IBCNT+1
+60 FOR I=6,9
SET $PIECE(IBTOT,"^",I)=$PIECE(IBTOT,"^",I)+$PIECE(IBRP,"^",I)
End DoDot:3
if IBQ
QUIT
+61 ;
+62 ; - Quits if the entry was printed to Excel file
+63 IF $GET(IBEXCEL)
QUIT
+64 ;
+65 ; - Prints Total by Debtor
+66 IF 'IBQ
IF IBTPT
IF IBCNT>1
DO PTOT
End DoDot:2
if IBQ
QUIT
End DoDot:1
if IBQ
QUIT
+67 ;
DETQ if IBQ!$GET(IBEXCEL)
GOTO ENQ
DO PAUSE
if IBQ
GOTO ENQ
+1 ;
SUM ; - Print Summary Report
+1 ;
+2 ; Sets IB with totals (Current + Defaulted)
+3 FOR I=9,11,12
SET IB(I)=IB(I-8)+IB(I-4)
+4 ;
+5 ; Formats the amount fields to a $ format (9,999,999.99)
+6 FOR I=3,7,11
SET IB(I)=$FNUMBER(IB(I),"",2)
+7 ;
+8 ; - Extract summary data
+9 IF $GET(IBXTRACT)
DO E^IBJDE(38,0)
GOTO ENQ
+10 ;
+11 DO HDRS
+12 IF $Y>(IOSL-12)
DO PAUSE
if IBQ
GOTO ENQ
DO HDRS
if IBQ
GOTO ENQ
+13 IF IBPLN'="D"
DO PSUM("C")
WRITE !!
+14 IF $Y>(IOSL-11)
DO PAUSE
if IBQ
GOTO ENQ
DO HDRS
if IBQ
GOTO ENQ
+15 IF IBPLN'="C"
DO PSUM("D")
WRITE !!
+16 IF $Y>(IOSL-11)
DO PAUSE
if IBQ
GOTO ENQ
DO HDRS
if IBQ
GOTO ENQ
+17 DO PSUM("T")
DO PAUSE
+18 ;
ENQ KILL IBCNT,IBFLG,IBDFN,IBILL,IBKEY,IBPAT,IBPAG,IBQ,IBRUN,IBRP,IBTOT,%
+1 QUIT
+2 ;
WPAT ; - Write the Debtor name & SSN
+1 WRITE !,$PIECE(IBPAT,"^"),$SELECT($PIECE(IBPAT,"^",4):" *",1:"")
+2 WRITE ?38,$PIECE(IBPAT,"^",2)
+3 QUIT
+4 ;
EXCEL ; - Prints the data to an Excel file format
+1 ;
+2 WRITE !,$PIECE(IBPAT,"^",1)_"^"_$TRANSLATE($PIECE(IBPAT,"^",2),"-")_"^"
+3 WRITE $SELECT($PIECE(IBRP,"^",8):"D",1:"C")_"^"
+4 WRITE $SELECT($PIECE(IBPAT,"^",3):$$DT($PIECE(IBPAT,"^",3)),1:"")_"^"
+5 WRITE IBILL_"^"_$$DT($PIECE(IBRP,"^"))_"^"_$PIECE(IBRP,"^",3)_"^"
+6 WRITE $EXTRACT($PIECE(IBRP,"^",4)+100,2,3)_"^"_$$DT($PIECE(IBRP,"^",5))_"^"
+7 WRITE $PIECE(IBRP,"^",6)_"^"_$PIECE(IBRP,"^",2)_"^"_$PIECE(IBRP,"^",7)_"^"
+8 WRITE $PIECE(IBRP,"^",8)
+9 QUIT
+10 ;
HDRD ; - Prints the Detailed Report Header
+1 IF $EXTRACT(IOST,1,2)="C-"!$GET(IBPAG)
WRITE @IOF,*13
+2 SET IBPAG=$GET(IBPAG)+1
WRITE "Repayment Plan Report"
+3 WRITE ?60,"Run Date: ",IBRUN,?123,"Page: ",$JUSTIFY(IBPAG,3)
+4 SET X=""
if IBPLN'="D"
SET X="CURRENT "
if IBPLN="B"
SET X=X_"AND "
+5 if IBPLN'="C"
SET X=X_"DEFAULTED "
SET X=X_"REPAYMENT PLAN / "
+6 if IBMCR="N"
SET X=X_"NON-"
SET X=X_"MCCR RECEIVABLES ONLY / "
+7 SET X=X_"BY DEBTOR "_$SELECT(IBSN="N":"NAME",1:"LAST 4 DIGITS OF SSN")
+8 SET X=X_" ("_$SELECT($GET(IBSNA)="ALL":"ALL",1:"From "_$SELECT(IBSNF="":"FIRST",1:IBSNF)_" to "_$SELECT(IBSNL="zzzzz":"LAST",1:IBSNL))_") / "
+9 SET X=X_"'*' AFTER THE NAME = DEBTOR HAS DEFAULTED ON A REPAYMENT PLAN"
+10 FOR I=1:1
WRITE !,$EXTRACT(X,1,132)
SET X=$EXTRACT(X,133,999)
IF X=""
QUIT
+11 ;
+12 WRITE !!,"Debtor Name",?64,"Start",?86,"Monthly",?97,"Due"
+13 WRITE ?104,"Last Payment",?124,"#Paymts"
+14 WRITE !,"Date of Death",?38,"SSN",?51,"Bill",?64,"Date",?74,"Balance"
+15 WRITE ?86,"Payment",?97,"Day",?102,"Date",?112,"Amount",?124,"Due",?128,"Def"
+16 WRITE !,$$DASH(IOM,0)
SET IBQ=$$STOP^IBOUTL("Repayment Plan Report")
+17 QUIT
+18 ;
HDRS ; - Prints the Summary Report Header
+1 ;
+2 NEW X
+3 IF $EXTRACT(IOST,1,2)="C-"!$GET(IBPAG)
WRITE @IOF,*13
+4 SET IBPAG=$GET(IBPAG)+1
WRITE ?71,"Page: ",$JUSTIFY(IBPAG,3)
+5 WRITE !?26,"SUMMARY REPAYMENT PLAN REPORT"
+6 SET X="MCCR RECEIVABLES"
if IBMCR="N"
SET X="NON-"_X
+7 SET X=X_" / "_$SELECT($GET(IBSNA)="ALL":IBSNA_" ",1:"")_"DEBTORS"
+8 IF IBSNA'="ALL"
SET X=X_" From "_$SELECT(IBSNF="":"FIRST",1:IBSNF)_" to "_$SELECT(IBSNL="zzzzz":"LAST",1:IBSNL)
+9 SET X="("_X_")"
+10 WRITE !?(80-$LENGTH(X)/2+1),X,!!?(80-$LENGTH(IBRUN)/2+1),IBRUN
+11 SET X=""
SET $PIECE(X,"=",$LENGTH(IBRUN)+1)=""
WRITE !?(80-$LENGTH(IBRUN)/2+1),X
+12 WRITE !
+13 QUIT
+14 ;
PHDL ; - Print the header line for the Excel spreadsheet
+1 NEW X
+2 SET X="Debtor^SSN^Plan Type^Death Dt^Bill #^Start Dt^Mo.Pymt Amt^"
+3 SET X=X_"Due Day^Lst Pymt Dt^Lst Pymt Amt^Curr.Bal.^Pymts Due^Pymts Def."
+4 WRITE !,X
+5 QUIT
+6 ;
PTOT ; - Prints the TOTAL line for the Debtor
+1 ;
+2 NEW I,X
+3 SET $PIECE(X,"-",11)=""
+4 WRITE ?74,X,?112,X
+5 WRITE !?74,$JUSTIFY($FNUMBER($PIECE(IBTOT,"^",9),"",2),10)
+6 WRITE ?112,$JUSTIFY($FNUMBER($PIECE(IBTOT,"^",6),"",2),10),!
+7 QUIT
+8 ;
PSUM(X) ; Prints the Summary Information
+1 ; Input: X=Type of information: C-Current, D-Defaulted or T-Total
+2 ;
+3 NEW IBIX
+4 WRITE !?15,$SELECT(X="C":"CURRENT",X="D":"DEFAULTED",1:"TOTAL")
+5 WRITE " REPAYMENT PLANS"
if X="T"
WRITE " (CURRENT + DEFAULTED)"
+6 ;
+7 SET IBIX=$SELECT(X="D":1,X="C":5,1:9)
+8 ;
+9 WRITE !?15,"Number of Bills:",?47,$JUSTIFY(+IB(IBIX),10)
+10 if X'="T"
WRITE $$PER(IB(IBIX),+IB(9))
+11 WRITE !?15,"Number of Debtors"
if X="T"
WRITE " (unique)"
WRITE ":",?47,$JUSTIFY(IB(IBIX+1),10)
+12 if X'="T"
WRITE $$PER(IB(IBIX+1),IB(10))
+13 WRITE !?15,"Outstanding balance of Bills:",?47,$JUSTIFY(IB(IBIX+2),10)
+14 if X'="T"
WRITE $$PER(IB(IBIX+2),IB(11))
+15 WRITE !?15,"Number of payments due:",?47,$JUSTIFY(IB(IBIX+3),10)
+16 if X'="T"
WRITE $$PER(IB(IBIX+3),IB(12))
+17 QUIT
+18 ;
PER(X,T) ; Calculates the percentage
+1 ; Input: T=Total Amount, X=Amount
+2 ; Output: Percentage of X from T - Format: (99.99%)
+3 ;
+4 IF 'T
QUIT ""
+5 QUIT $JUSTIFY(" ("_($TRANSLATE(X,",","")/$TRANSLATE(T,",","")*10000+.5\1/100)_"%)",10)
+6 ;
DASH(X,Y) ; - Return a dashed line.
+1 ; Input: X=Number of Columns (80 or 132), Y=Char to be printed
+2 ;
+3 QUIT $TRANSLATE($JUSTIFY("",X)," ",$SELECT(Y:"-",1:"="))
+4 ;
PAUSE ; - Page break.
+1 ;
+2 IF $EXTRACT(IOST,1,2)'="C-"
QUIT
+3 NEW IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
+4 FOR IBX=$Y:1:(IOSL-3)
WRITE !
+5 SET DIR(0)="E"
DO ^DIR
if $DATA(DIRUT)!($DATA(DUOUT))
SET IBQ=1
+6 QUIT
+7 ;
DT(X) ; - Return date.
+1 ; Input: X=Date in Fileman format
+2 ; Output: Z=Date in MMDDYY format
+3 ;
+4 QUIT $EXTRACT(X,4,7)_$EXTRACT(X,2,3)
