source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJDF72.m@ 1604

Last change on this file since 1604 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 6.6 KB
Line 
1IBJDF72 ;ALB/MR - REPAYMENT PLAN REPORT (PRINT) ;16-AUG-00
2 ;;2.0;INTEGRATED BILLING;**123,159**;21-MAR-94
3 ;
4EN ; - Print the Repayment Plan Report
5 ;
6 S IBQ=0 D NOW^%DTC S IBRUN=$$DAT2^IBOUTL(%)
7 ;
8 I '$G(IBXTRACT),'$D(^TMP("IBJDF7",$J)) D G ENQ
9 . I '$G(IBEXCEL) D @($S(IBRPT="D":"HDRD",1:"HDRS"))
10 . W !!,"There are no Repayment Plan for the parameters selected."
11 ;
12 ; - Summary report was selected
13 I IBRPT="S" G SUM
14 ;
15 I '$G(IBEXCEL) S IBPAG=0 D HDRD G:IBQ ENQ
16 ;
17 ; - Print the header line for the Excel spreadsheet
18 I $G(IBEXCEL) D PHDL
19 ;
20 S (IBKEY,IBDFN,IBILL)=""
21 F S IBKEY=$O(^TMP("IBJDF7",$J,IBKEY)) Q:IBKEY="" D Q:IBQ
22 . F S IBDFN=$O(^TMP("IBJDF7",$J,IBKEY,IBDFN)) Q:IBDFN="" D Q:IBQ
23 . . S IBPAT=$G(^TMP("IBJDF7",$J,IBKEY,IBDFN)),IBFLG=1
24 . . S IBCNT=0,IBTOT=""
25 . . ;
26 . . ; - Page Break
27 . . I '$G(IBEXCEL),$Y>(IOSL-7) D PAUSE Q:IBQ D HDRD Q:IBQ
28 . . ;
29 . . ; - Debtor Name (* - if in default) and SSN
30 . . I '$G(IBEXCEL) D WPAT
31 . . ;
32 . . F S IBILL=$O(^TMP("IBJDF7",$J,IBKEY,IBDFN,IBILL)) Q:IBILL="" D Q:IBQ
33 . . . S IBRP=$G(^TMP("IBJDF7",$J,IBKEY,IBDFN,IBILL))
34 . . . ;
35 . . . ; - Print the data to an Excel data format
36 . . . I $G(IBEXCEL) D EXCEL Q
37 . . . ;
38 . . . ; - Page Break
39 . . . I $Y>(IOSL-6) D PAUSE Q:IBQ D HDRD,WPAT Q:IBQ
40 . . . ;
41 . . . ; - Bill, Start Date, Balance, Mo.Pymt and Due Day
42 . . . W ?51,IBILL
43 . . . I $P(IBRP,"^")="" D Q
44 . . . . W ?64,"->REPAYMENT PLAN INCOMPLETE. PLEASE CHECK!",!
45 . . . W ?64,$$DAT1^IBOUTL($P(IBRP,"^"))
46 . . . W ?74,$J($FN($P(IBRP,"^",9),",",2),10)
47 . . . W ?86,$J($FN($P(IBRP,"^",3),",",2),10)
48 . . . W ?98,$J($P(IBRP,"^",4),2)
49 . . . ;
50 . . . ; - Last Payment (Date and Amount)
51 . . . I $P(IBRP,"^",5)'="" D
52 . . . . W ?102,$$DAT1^IBOUTL($P(IBRP,"^",5))
53 . . . . W ?112,$J($FN($P(IBRP,"^",6),",",2),10)
54 . . . ;
55 . . . ; - Number of Payments - Due and Defaulted
56 . . . W ?124,$J($P(IBRP,"^",7),3),?128,$J($P(IBRP,"^",8),3),!
57 . . . ;
58 . . . ; - Date of Death (if any)
59 . . . I IBFLG,$P(IBPAT,"^",3) D
60 . . . . W $$DAT1^IBOUTL($P(IBPAT,"^",3)) S IBFLG=0
61 . . . ;
62 . . . ; - Will be used to print TOTAL line by Debtor
63 . . . S IBCNT=IBCNT+1
64 . . . F I=6,9 S $P(IBTOT,"^",I)=$P(IBTOT,"^",I)+$P(IBRP,"^",I)
65 . . ;
66 . . ; - Quits if the entry was printed to Excel file
67 . . I $G(IBEXCEL) Q
68 . . ;
69 . . ; - Prints Total by Debtor
70 . . I 'IBQ,IBTPT,IBCNT>1 D PTOT
71 ;
72DETQ G ENQ:IBQ!$G(IBEXCEL) D PAUSE G ENQ:IBQ
73 ;
74SUM ; - Print Summary Report
75 ;
76 ; Sets IB with totals (Current + Defaulted)
77 F I=9,11,12 S IB(I)=IB(I-8)+IB(I-4)
78 ;
79 ; Formats the amount fields to a $ format (9,999,999.99)
80 F I=3,7,11 S IB(I)=$FN(IB(I),"",2)
81 ;
82 ; - Extract summary data
83 I $G(IBXTRACT) D E^IBJDE(38,0) G ENQ
84 ;
85 D HDRS
86 I $Y>(IOSL-12) D PAUSE G ENQ:IBQ D HDRS G ENQ:IBQ
87 I IBPLN'="D" D PSUM("C") W !!
88 I $Y>(IOSL-11) D PAUSE G ENQ:IBQ D HDRS G ENQ:IBQ
89 I IBPLN'="C" D PSUM("D") W !!
90 I $Y>(IOSL-11) D PAUSE G ENQ:IBQ D HDRS G ENQ:IBQ
91 D PSUM("T") D PAUSE
92 ;
93ENQ K IBCNT,IBFLG,IBDFN,IBILL,IBKEY,IBPAT,IBPAG,IBQ,IBRUN,IBRP,IBTOT,%
94 Q
95 ;
96WPAT ; - Write the Debtor name & SSN
97 W !,$P(IBPAT,"^"),$S($P(IBPAT,"^",4):" *",1:"")
98 W ?38,$P(IBPAT,"^",2)
99 Q
100 ;
101EXCEL ; - Prints the data to an Excel file format
102 ;
103 W !,$P(IBPAT,"^",1)_"^"_$TR($P(IBPAT,"^",2),"-")_"^"
104 W $S($P(IBRP,"^",8):"D",1:"C")_"^"
105 W $S($P(IBPAT,"^",3):$$DT($P(IBPAT,"^",3)),1:"")_"^"
106 W IBILL_"^"_$$DT($P(IBRP,"^"))_"^"_$P(IBRP,"^",3)_"^"
107 W $E($P(IBRP,"^",4)+100,2,3)_"^"_$$DT($P(IBRP,"^",5))_"^"
108 W $P(IBRP,"^",6)_"^"_$P(IBRP,"^",2)_"^"_$P(IBRP,"^",7)_"^"
109 W $P(IBRP,"^",8)
110 Q
111 ;
112HDRD ; - Prints the Detailed Report Header
113 I $E(IOST,1,2)="C-"!$G(IBPAG) W @IOF,*13
114 S IBPAG=$G(IBPAG)+1 W "Repayment Plan Report"
115 W ?60,"Run Date: ",IBRUN,?123,"Page: ",$J(IBPAG,3)
116 S X="" S:IBPLN'="D" X="CURRENT " S:IBPLN="B" X=X_"AND "
117 S:IBPLN'="C" X=X_"DEFAULTED " S X=X_"REPAYMENT PLAN / "
118 S:IBMCR="N" X=X_"NON-" S X=X_"MCCR RECEIVABLES ONLY / "
119 S X=X_"BY DEBTOR "_$S(IBSN="N":"NAME",1:"LAST 4 DIGITS OF SSN")
120 S X=X_" ("_$S($G(IBSNA)="ALL":"ALL",1:"From "_$S(IBSNF="":"FIRST",1:IBSNF)_" to "_$S(IBSNL="zzzzz":"LAST",1:IBSNL))_") / "
121 S X=X_"'*' AFTER THE NAME = DEBTOR HAS DEFAULTED ON A REPAYMENT PLAN"
122 F I=1:1 W !,$E(X,1,132) S X=$E(X,133,999) I X="" Q
123 ;
124 W !!,"Debtor Name",?64,"Start",?86,"Monthly",?97,"Due"
125 W ?104,"Last Payment",?124,"#Paymts"
126 W !,"Date of Death",?38,"SSN",?51,"Bill",?64,"Date",?74,"Balance"
127 W ?86,"Payment",?97,"Day",?102,"Date",?112,"Amount",?124,"Due",?128,"Def"
128 W !,$$DASH(IOM,0) S IBQ=$$STOP^IBOUTL("Repayment Plan Report")
129 Q
130 ;
131HDRS ; - Prints the Summary Report Header
132 ;
133 N X
134 I $E(IOST,1,2)="C-"!$G(IBPAG) W @IOF,*13
135 S IBPAG=$G(IBPAG)+1 W ?71,"Page: ",$J(IBPAG,3)
136 W !?26,"SUMMARY REPAYMENT PLAN REPORT"
137 S X="MCCR RECEIVABLES" S:IBMCR="N" X="NON-"_X
138 S X=X_" / "_$S($G(IBSNA)="ALL":IBSNA_" ",1:"")_"DEBTORS"
139 I IBSNA'="ALL" S X=X_" From "_$S(IBSNF="":"FIRST",1:IBSNF)_" to "_$S(IBSNL="zzzzz":"LAST",1:IBSNL)
140 S X="("_X_")"
141 W !?(80-$L(X)/2+1),X,!!?(80-$L(IBRUN)/2+1),IBRUN
142 S X="",$P(X,"=",$L(IBRUN)+1)="" W !?(80-$L(IBRUN)/2+1),X
143 W !
144 Q
145 ;
146PHDL ; - Print the header line for the Excel spreadsheet
147 N X
148 S X="Debtor^SSN^Plan Type^Death Dt^Bill #^Start Dt^Mo.Pymt Amt^"
149 S X=X_"Due Day^Lst Pymt Dt^Lst Pymt Amt^Curr.Bal.^Pymts Due^Pymts Def."
150 W !,X
151 Q
152 ;
153PTOT ; - Prints the TOTAL line for the Debtor
154 ;
155 N I,X
156 S $P(X,"-",11)=""
157 W ?74,X,?112,X
158 W !?74,$J($FN($P(IBTOT,"^",9),"",2),10)
159 W ?112,$J($FN($P(IBTOT,"^",6),"",2),10),!
160 Q
161 ;
162PSUM(X) ; Prints the Summary Information
163 ; Input: X=Type of information: C-Current, D-Defaulted or T-Total
164 ;
165 N IBIX
166 W !?15,$S(X="C":"CURRENT",X="D":"DEFAULTED",1:"TOTAL")
167 W " REPAYMENT PLANS" W:X="T" " (CURRENT + DEFAULTED)"
168 ;
169 S IBIX=$S(X="D":1,X="C":5,1:9)
170 ;
171 W !?15,"Number of Bills:",?47,$J(+IB(IBIX),10)
172 W:X'="T" $$PER(IB(IBIX),+IB(9))
173 W !?15,"Number of Debtors" W:X="T" " (unique)" W ":",?47,$J(IB(IBIX+1),10)
174 W:X'="T" $$PER(IB(IBIX+1),IB(10))
175 W !?15,"Outstanding balance of Bills:",?47,$J(IB(IBIX+2),10)
176 W:X'="T" $$PER(IB(IBIX+2),IB(11))
177 W !?15,"Number of payments due:",?47,$J(IB(IBIX+3),10)
178 W:X'="T" $$PER(IB(IBIX+3),IB(12))
179 Q
180 ;
181PER(X,T) ; Calculates the percentage
182 ; Input: T=Total Amount, X=Amount
183 ; Output: Percentage of X from T - Format: (99.99%)
184 ;
185 I 'T Q ""
186 Q $J(" ("_($TR(X,",","")/$TR(T,",","")*10000+.5\1/100)_"%)",10)
187 ;
188DASH(X,Y) ; - Return a dashed line.
189 ; Input: X=Number of Columns (80 or 132), Y=Char to be printed
190 ;
191 Q $TR($J("",X)," ",$S(Y:"-",1:"="))
192 ;
193PAUSE ; - Page break.
194 ;
195 I $E(IOST,1,2)'="C-" Q
196 N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
197 F IBX=$Y:1:(IOSL-3) W !
198 S DIR(0)="E" D ^DIR S:$D(DIRUT)!($D(DUOUT)) IBQ=1
199 Q
200 ;
201DT(X) ; - Return date.
202 ; Input: X=Date in Fileman format
203 ; Output: Z=Date in MMDDYY format
204 ;
205 Q $E(X,4,7)_$E(X,2,3)
Note: See TracBrowser for help on using the repository browser.