source: FOIAVistA/tag/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPE215.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 9.5 KB
Line 
1RCDPE215 ;ALB/TMK- SF215 EDI Lockbox Summary Report ;1 Jun 99
2 ;;4.5;Accounts Receivable;**114,173,220**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7SUMM215 ; summary 215
8 D FULL^VALM1
9 S VALMBCK="R"
10 ;
11 N %,%ZIS,POP,RCDEPTDA,RCTYPE,DIC,X,Y,ZTSAVE,ZTDESC,ZTSK,ZTRTN
12 ;
13 S DIC(0)="AEMQ",DIC="^RCY(344.1,",DIC("A")="Select DEPOSIT: "
14 D ^DIC K DIC
15 I Y'>0 Q
16 S RCDEPTDA=+Y
17 S RCTYPE=$$GETTYPE^RCDPR215
18 I RCTYPE="" Q
19 ;
20 ; device
21 W ! S %ZIS="Q" D ^%ZIS Q:POP
22 I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK D ^%ZISC Q
23 . S ZTDESC="Print Summary 215 Report",ZTRTN="DQ^RCDPE215"
24 . S ZTSAVE("RCDEPTDA")="",ZTSAVE("RCTYPE")="",ZTSAVE("ZTREQ")="@"
25 W !!,"<*> please wait <*>"
26 D DQ
27 Q
28 ;
29DQ ; queued report entrypoint
30 ; RCDEPTDA = ien of the deposit to summarize
31 ; RCTYPE="D"etail or "A"ccrual
32 N %I,AMOUNT,BILL,BILLDA,COMMENTS,COUNT,DA,DATA,DEPOSIT,FMSDOCNO,FUND,NOW,PAGE,PIECE,PRINTOTL,RCSTFLAG,RCYLINE,RECEIPT,SCREEN,TOTAL,TOTLAMT,UNAPPLY,X,Y,RCDETAIL,PCT,RECEIPDA,TOT,EDITOT,DETAIL,Z,EFTFUND
33 ;
34 ; calculate report
35 K ^TMP($J,"RCFMSCR"),^TMP($J,"RCFMSCR_SUM"),^TMP($J,"RCDPR215"),^TMP($J,"RCDET")
36 S EFTFUND=$S(DT<$$ADDPTEDT^PRCAACC():"5287.4/8NZZ",1:"528704/8NZZ")
37 S DEPOSIT=$P($G(^RCY(344.1,RCDEPTDA,0)),U)
38 S RECEIPDA=0 F S RECEIPDA=$O(^RCY(344,"AD",RCDEPTDA,RECEIPDA)) Q:'RECEIPDA D
39 . D FMSLINES^RCXFMSC1(RECEIPDA)
40 . ; sort by Receipt #
41 . S ^TMP($J,"RCFMSCR_SUM",RECEIPDA)=""
42 . M ^TMP($J,"RCFMSCR_SUM",RECEIPDA)=^TMP($J,"RCFMSCR")
43 . K ^TMP($J,"RCFMSCR")
44 . I $$EDILB^RCDPEU(RECEIPDA)=1 D ; EFT dep receipt
45 .. S TOT=0
46 .. S Z=0 F S Z=$O(^RCY(344,RECEIPDA,1,Z)) Q:'Z S TOT=TOT+$P($G(^(Z,0)),U,4)
47 .. S (^TMP($J,"RCFMSCR_SUM",RECEIPDA,EFTFUND),^TMP($J,"RCTOT","EDILBOX"))=TOT
48 ;
49 ; summary rep for a deposit
50 S PAGE=0,RCYLINE="",$P(RCYLINE,"-",81)=""
51 D NOW^%DTC S Y=% D DD^%DT S NOW=Y
52 S SCREEN=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S SCREEN=1
53 U IO
54 K ^TMP($J,"RCTOT")
55 S RCDETAIL=1,PCT=0,EDITOT=0
56 S RECEIPDA=0 F S RECEIPDA=$O(^TMP($J,"RCFMSCR_SUM",RECEIPDA)) Q:'RECEIPDA D
57 . S DATA=$G(^RCY(344,RECEIPDA,0))
58 . S RECEIPT=$P(DATA,"^")
59 . S FMSDOCNO=$P($G(^RCY(344.1,+$P(DATA,"^",6),2)),"^")
60 . D SET("<NP>",RECEIPT_"@"_FMSDOCNO_"@"_RECEIPDA,.PCT)
61 . ;
62 . S TOTAL="" ; stores printotal^inttotal^admintotal^marshtotal^cctotal
63 . ;
64 . S FUND="" F S FUND=$O(^TMP($J,"RCFMSCR_SUM",RECEIPDA,FUND)) Q:'FUND D
65 .. D SET("!!?5","Appropriation: "_FUND,.PCT)
66 .. I RCTYPE="D" D SET("!","",.PCT)
67 .. ;
68 .. S PRINTOTL=0
69 .. S COUNT=0
70 .. I FUND=EFTFUND S PRINTOTL=PRINTOTL+$G(^TMP($J,"RCFMSCR_SUM",RECEIPDA,FUND)),EDITOT=EDITOT+$G(^TMP($J,"RCFMSCR_SUM",RECEIPDA,FUND))
71 .. S BILLDA=0 F S BILLDA=$O(^TMP($J,"RCFMSCR_SUM",RECEIPDA,FUND,BILLDA)) Q:'BILLDA D
72 ... S COUNT=COUNT+1
73 ... S BILL=$P($G(^PRCA(430,BILLDA,0)),"^")
74 ... S DATA=^TMP($J,"RCFMSCR_SUM",RECEIPDA,FUND,BILLDA)
75 ... S PRINTOTL=PRINTOTL+$P(DATA,"^")
76 ... F PIECE=1:1:5 S $P(TOTAL,"^",PIECE)=$P(TOTAL,"^",PIECE)+$P(DATA,"^",PIECE),$P(^TMP($J,"RCTOT","TOTAL"),"^",PIECE)=$P($G(^TMP($J,"RCTOT","TOTAL")),"^",PIECE)+$P(DATA,"^",PIECE)
77 ... ; if accrued report,no detail
78 ... I RCTYPE="A" Q
79 ... ;
80 ... D SET("!?5",COUNT_")",.PCT),SET("?10",BILL,.PCT),SET("?30",$J($P(DATA,"^"),10,2),.PCT),SET("?45","DEBTOR: "_$E($$DEBTOR^RCDPR215(BILLDA),1,25),.PCT)
81 ... D SET("!?15","INT:"_$J($P(DATA,"^",2),10,2)_" ADMIN:"_$J($P(DATA,"^",3),10,2)_" MARS: "_$J($P(DATA,"^",4),10,2)_" CC: "_$J($P(DATA,"^",5),10,2),.PCT,1)
82 .. ;
83 .. I RCTYPE="D" D SET("!?30","----------",.PCT),SET("!?5","TOTAL for "_FUND,.PCT)
84 .. D SET("?30",$J(PRINTOTL,10,2),.PCT)
85 .. I FUND="0160a1" D SET("?45","0160a1 sub-totals Champva receipts",.PCT),SET("!?45","not sent to FMS on the CR document.",.PCT)
86 .. S ^TMP($J,"RCTOT","PRINTOTL",FUND)=$G(^TMP($J,"RCTOT","PRINTOTL",FUND))+PRINTOTL
87 .. I FUND=EFTFUND S $P(^TMP($J,"RCTOT","TOTAL"),U)=$P($G(^TMP($J,"RCTOT","TOTAL")),U)+PRINTOTL
88 . ;
89 . ; show int, admin, etc receipt totals
90 . D SET("!","",.PCT)
91 . D SET("!?5","INTEREST : (APP: 1435)",.PCT),SET("?30",$J($P(TOTAL,"^",2),10,2),.PCT)
92 . D SET("!?5","ADMIN : (APP: 3220)",.PCT),SET("?30",$J($P(TOTAL,"^",3),10,2),.PCT)
93 . D SET("!?5","MARSHALL : (APP: 0869)",.PCT),SET("?30",$J($P(TOTAL,"^",4),10,2),.PCT)
94 . D SET("!?5","COURTCOST: (APP: 0869)",.PCT),SET("?30",$J($P(TOTAL,"^",5),10,2),.PCT)
95 . D SET("!?30","----------",.PCT)
96 . D SET("!?30",$J($P(TOTAL,"^",2)+$P(TOTAL,"^",3)+$P(TOTAL,"^",4)+$P(TOTAL,"^",5),10,2),.PCT)
97 . ;
98 . I $G(^TMP($J,"RCFMSCR_SUM",RECEIPDA,EFTFUND)) S $P(TOTAL,U)=$P(TOTAL,U)+^TMP($J,"RCFMSCR_SUM",RECEIPDA,EFTFUND)
99 . D SUSP(RECEIPDA,RCTYPE,.TOTAL,.PCT)
100 . ;
101 . S TOTLAMT=0 F PIECE=1:1:5 S TOTLAMT=TOTLAMT+$P(TOTAL,"^",PIECE)
102 . D SET("!!","TOTALS: ",.PCT)
103 . D SET("!?5","TOTAL AMT POSTED FOR RECEIPT:",.PCT),SET("?30",$J(TOTLAMT,10,2),.PCT,1)
104 ;
105 D H
106 W !!,"**** GRAND TOTALS FOR DEPOSIT: "_$P($G(^RCY(344.1,+RCDEPTDA,0)),U)
107 S TOT=0
108 S FUND="" F S FUND=$O(^TMP($J,"RCTOT","PRINTOTL",FUND)) Q:FUND="" D
109 . W !!?5,"Appropriation: ",FUND,": ",?35,$J($G(^TMP($J,"RCTOT","PRINTOTL",FUND)),10,2)
110 . S TOT=TOT+$G(^TMP($J,"RCTOT","PRINTOTL",FUND))
111 W !,?35,"=============",!,"Total Appropriation: ",?35,$J(+TOT,10,2)
112 I FUND="0160a1" W ?47,"0160a1 sub-totals Champva receipts",!?47,"not sent to FMS on the CR doc."
113 ;
114 S TOTAL=$G(^TMP($J,"RCTOT","TOTAL"))
115 W !
116 W !?5,"INTEREST : (APP: 1435)",?35,$J($P(TOTAL,"^",2),10,2)
117 W !?5,"ADMIN : (APP: 3220)",?35,$J($P(TOTAL,"^",3),10,2)
118 W !?5,"MARSHALL : (APP: 0869)",?35,$J($P(TOTAL,"^",4),10,2)
119 W !?5,"COURTCOST: (APP: 0869)",?35,$J($P(TOTAL,"^",5),10,2)
120 W !?35,"----------"
121 W !?35,$J($P(TOTAL,"^",2)+$P(TOTAL,"^",3)+$P(TOTAL,"^",4)+$P(TOTAL,"^",5),10,2)
122 I $G(^TMP($J,"RCTOT","SUSPENSE")) W !!?5,"Total Appropriation: 3875",?35,$J(^TMP($J,"RCTOT","SUSPENSE"),10,2)
123 ;
124 S TOTLAMT=0 F PIECE=1:1:5 S TOTLAMT=TOTLAMT+$P(TOTAL,"^",PIECE)
125 I $G(^TMP($J,"RCTOT","EDILBOX")) S TOTLAMT=TOTLAMT+^TMP($J,"RCTOT","EDILBOX")
126 W !!,"TOTALS: "
127 W !?5,"TOT AMT POSTED FOR DEPOSIT: ",?35,$J(+TOTLAMT,10,2)
128 I SCREEN D PAUSE G:$G(RCSTFLAG) Q
129 N Q,W,T,NS
130 S W=""
131 S PCT=0 F S PCT=$O(^TMP($J,"RCDET",PCT)) Q:'PCT D G:$G(RCSTFLAG) Q
132 . S Q=$P($G(^TMP($J,"RCDET",PCT)),U),T=$P($G(^(PCT)),U,2),NS=$P($G(^(PCT)),U,3)
133 . I Q="<NP>" D Q
134 .. I W'="" W @W S W="" D:SCREEN PAUSE Q:$G(RCSTFLAG)
135 .. S RECEIPT=$P(T,"@"),FMSDOCNO=$P(T,"@",2),RECEIPDA=$P(T,"@",3)
136 .. D H,H1(0)
137 . I $E(Q)="!" W:W'="" @W S W=""
138 . S W=W_$S(W="":"",1:",")_Q_$S(Q'="":",",1:"")_""""_T_""""
139 . I 'NS,$Y>(IOSL-6) D:SCREEN PAUSE I '$G(RCSTFLAG) D H,H1(1)
140 I W'="" W @W S W=""
141 I SCREEN W !,"Press RETURN to continue: " R X:DTIME
142 ;
143Q D ^%ZISC
144 K ^TMP($J,"RCFMSCR"),^TMP($J,"RCDPR215"),^TMP($J,"RCTOT"),^TMP($J,"RCFMSCR_SUM"),^TMP($J,"RCDET")
145 Q
146 ;
147 ;
148SUSP(RECEIPDA,RCTYPE,TOTAL,PCT) ; unapplied amts for suspense
149 ; RCTYPE = see explanation at DQ above
150 ; Returns PCT,TOTAL if passed by reference
151 ;
152 N DA,AMOUNT,UNAPPLY,COUNT,PRINTOTL,COMMENTS
153 K ^TMP($J,"RCDPR215")
154 S DA=0 F S DA=$O(^RCY(344,RECEIPDA,1,DA)) Q:'DA D
155 . S AMOUNT=$P($G(^RCY(344,RECEIPDA,1,DA,0)),"^",4) I 'AMOUNT Q
156 . S UNAPPLY=$P($G(^RCY(344,RECEIPDA,1,DA,2)),"^",5) I UNAPPLY="" Q
157 . ; if amount has not been processed, show it in suspense
158 . I '$P(^RCY(344,RECEIPDA,1,DA,0),"^",5) S ^TMP($J,"RCDPR215",DA)=UNAPPLY_"^"_AMOUNT_"^"_$P($G(^RCY(344,RECEIPDA,1,DA,1)),"^",2)
159 ;
160 I $O(^TMP($J,"RCDPR215",0)) D
161 . D SET("!!?5","Appropriation: 3875",.PCT)
162 . I RCTYPE="D" D SET("!","",.PCT)
163 . ;
164 . S COUNT=0,PRINTOTL=0
165 . S DA=0 F S DA=$O(^TMP($J,"RCDPR215",DA)) Q:'DA!($G(RCSTFLAG)) D
166 . . ;
167 . . S UNAPPLY=$P(^TMP($J,"RCDPR215",DA),"^"),AMOUNT=$P(^(DA),"^",2),COMMENTS=$P(^(DA),"^",3)
168 . . S PRINTOTL=PRINTOTL+AMOUNT
169 . . S $P(TOTAL,"^")=$P(TOTAL,"^")+AMOUNT
170 . . ; no detail if accrued report
171 . . I RCTYPE="A" Q
172 . . ;
173 . . S COUNT=COUNT+1
174 . . D SET("!?5",COUNT_")",.PCT),SET("?10",UNAPPLY,.PCT),SET("?30",$J(AMOUNT,10,2),.PCT),SET("?45","COMMENTS: "_$E(COMMENTS,1,25),.PCT)
175 . . I $TR($E(COMMENTS,26,80)," ")'="" D SET("!?25",$E(COMMENTS,26,80),.PCT)
176 . ;
177 . S $P(^TMP($J,"RCTOT","TOTAL"),U)=($P($G(^TMP($J,"RCTOT","TOTAL")),U)+PRINTOTL)
178 . I RCTYPE="D" D SET("!?30","----------",.PCT),SET("!?5","TOTAL for 3875",.PCT)
179 . D SET("?30",$J(PRINTOTL,10,2),.PCT)
180 . S ^TMP($J,"RCTOT","SUSPENSE")=$G(^TMP($J,"RCTOT","SUSPENSE"))+PRINTOTL
181 Q
182 ;
183 ;
184GETTYPE() ; ask type of report to print
185 N DIR,X,Y
186 S DIR(0)="S^A:ACCRUED;D:DETAILED",DIR("A")="ACCRUED OR DETAILED REPORT",DIR("B")="ACCRUED",DIR("?")="A DETAILED Report will list out accrued bills separately"
187 S DIR("?",1)="An ACCRUED Report will list just the accrued total under each appropriation"
188 D ^DIR
189 I Y'="A",Y'="D" Q ""
190 Q Y
191 ;
192 ;
193H ; Deposit hdr
194 N Z
195 S PAGE=PAGE+1 I PAGE'=1!(SCREEN) W @IOF
196 W $C(13),"Page ",PAGE,?(80-$L(NOW)),NOW
197 W !,$E($TR(RCYLINE,"-","*"),1,26)," 215 DEPOSIT SUMMARY REPORT ",$E($TR(RCYLINE,"-","*"),1,26)
198 W !!,"DEPOSIT #: ",DEPOSIT
199 W !,RCYLINE
200 Q
201 ;
202H1(CONT) ; Receipt Hdr
203 ; CONT = 1 if continuation from previous page
204 ;
205 N Z
206 W !!,"RECEIPT #: "_RECEIPT_$S($G(CONT):" (continued)",1:"")
207 I FMSDOCNO'="" W ?51,"FMS Document #: ",FMSDOCNO
208 S Z="",$P(Z,"-",$L(RECEIPT)+1)=""
209 W !,?11,Z
210 S Z=""
211 I $P($G(^RCY(344,RECEIPDA,0)),U,18) S Z=$E(" REFERENCE ERA #: "_$P($G(^RCY(344.4,+$P($G(^RCY(344,RECEIPDA,0)),U,18),0)),U)_" ("_$P($G(^RCY(344.4,+$P($G(^RCY(344,RECEIPDA,0)),U,18),0)),U,2)_")"_$J("",51),1,51)
212 I Z'="" W !,Z
213 W !
214 Q
215 ;
216 ;
217PAUSE ;
218 D PAUSE^RCDPR215
219 Q
220 ;
221SET(CTRL,TXT,PCT,NOSP) ; Sets print array for detail
222 ;PCT = count of lines
223 ;CTRL = Control characters
224 ;TXT = text to print
225 ;NOSP = 1 if line should always print with the previous line
226 S PCT=PCT+1,^TMP($J,"RCDET",PCT)=CTRL_U_TXT_U_+$G(NOSP)
227 Q
228 ;
Note: See TracBrowser for help on using the repository browser.