source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPR215.m@ 789

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

initial load of WorldVistAEHR
File size: 5.9 KB
Line 
1RCDPR215 ;WISC/RFJ-receipt processing sf215 report ;1 Jun 99
2 ;;4.5;Accounts Receivable;**114,173,211,220**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7DQ ; queued report starts here, input RECEIPDA
8 ; RCTYPE="D"etail or "A"ccrual
9 N %I,AMOUNT,BILL,BILLDA,COMMENTS,COUNT,DA,DATA,DEPOSIT,DETAIL,FMSDOCNO,FUND,NOW,PAGE,PIECE,PRINTOTL,RCSTFLAG,RCYLINE,RECEIPT,SCREEN,TOTAL,TOTLAMT,UNAPPLY,X,Y,TOT,%,REPRODT,EFTFUND
10 ;
11 ; calculate report
12 ; input receipda (ien of receipt)
13 K ^TMP($J,"RCFMSCR"),^TMP($J,"RCDPR215")
14 S EFTFUND=$S(DT<$$ADDPTEDT^PRCAACC():"5287.4/8NZZ",1:"528704/8NZZ")
15 S REPRODT=$P($P($G(^RCY(344,RECEIPDA,0)),"^",8),".")
16 D FMSLINES^RCXFMSC1(RECEIPDA)
17 I $$EDILB^RCDPEU(RECEIPDA)=1 D ; EFT deposit receipt
18 . S TOT=0
19 . S Z=0 F S Z=$O(^RCY(344,RECEIPDA,1,Z)) Q:'Z S TOT=TOT+$P($G(^(Z,0)),U,4)
20 . S ^TMP($J,"RCFMSCR",EFTFUND)=TOT
21 ;
22 ; print report
23 S DATA=$G(^RCY(344,RECEIPDA,0))
24 S RECEIPT=$P(DATA,"^")
25 S DEPOSIT=$P($G(^RCY(344.1,+$P(DATA,"^",6),0)),"^")
26 S FMSDOCNO=$P($G(^RCY(344.1,+$P(DATA,"^",6),2)),"^")
27 ;
28 D NOW^%DTC S Y=% D DD^%DT S NOW=Y
29 S PAGE=0,RCYLINE="",$P(RCYLINE,"-",81)=""
30 S SCREEN=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S SCREEN=1
31 U IO D H
32 ;
33 S TOTAL="" ; stores printotal^inttotal^admintotal^marshtotal^cctotal
34 S FUND="" F S FUND=$O(^TMP($J,"RCFMSCR",FUND)) Q:'FUND!($G(RCSTFLAG)) D
35 . I $Y>(IOSL-6) D:SCREEN PAUSE Q:$G(RCSTFLAG) D H
36 . W !!?5,"Appropriation: ",FUND
37 . I RCTYPE="D" W !
38 . ;
39 . S PRINTOTL=0
40 . S COUNT=0
41 . I FUND=EFTFUND S PRINTOTL=PRINTOTL+$G(^TMP($J,"RCFMSCR",FUND))
42 . S BILLDA=0 F S BILLDA=$O(^TMP($J,"RCFMSCR",FUND,BILLDA)) Q:'BILLDA!($G(RCSTFLAG)) D
43 . . I $Y>(IOSL-5) D:SCREEN PAUSE Q:$G(RCSTFLAG) D H
44 . . S COUNT=COUNT+1
45 . . S BILL=$P($G(^PRCA(430,BILLDA,0)),"^")
46 . . S DATA=^TMP($J,"RCFMSCR",FUND,BILLDA)
47 . . S PRINTOTL=PRINTOTL+$P(DATA,"^")
48 . . F PIECE=1:1:5 S $P(TOTAL,"^",PIECE)=$P(TOTAL,"^",PIECE)+$P(DATA,"^",PIECE)
49 . . ; if accrued report, do not show detail
50 . . I RCTYPE="A" Q
51 . . ;
52 . . W !?5,COUNT,")",?10,BILL,?30,$J($P(DATA,"^"),10,2),?45,"DEBTOR: ",$E($$DEBTOR(BILLDA),1,25)
53 . . W !?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)
54 . ;
55 . I $G(RCSTFLAG) Q
56 . I RCTYPE="D" W !?30,"----------",!?5,"TOTAL for ",FUND
57 . W ?30,$J(PRINTOTL,10,2)
58 . I FUND="0160a1" W ?45,"0160a1 sub-totals Champva receipts",!?45,"not sent to FMS on the CR document."
59 ;
60 I $G(RCSTFLAG) D Q Q
61 I $Y>(IOSL-6) D:SCREEN PAUSE I '$G(RCSTFLAG) D H
62 I $G(RCSTFLAG) D Q Q
63 ;
64 ; show int, admin, etc totals
65 W !
66 W !?5,"INTEREST : (APP: 1435)",?30,$J($P(TOTAL,"^",2),10,2)
67 W !?5,"ADMIN : (APP: 3220)",?30,$J($P(TOTAL,"^",3),10,2)
68 W !?5,"MARSHALL : (APP: 0869)",?30,$J($P(TOTAL,"^",4),10,2)
69 W !?5,"COURTCOST: (APP: 0869)",?30,$J($P(TOTAL,"^",5),10,2)
70 W !?30,"----------"
71 W !?30,$J($P(TOTAL,"^",2)+$P(TOTAL,"^",3)+$P(TOTAL,"^",4)+$P(TOTAL,"^",5),10,2)
72 ;
73 I $Y>(IOSL-8) D:SCREEN PAUSE I '$G(RCSTFLAG) D H
74 I $G(RCSTFLAG) D Q Q
75 ;
76 I $G(^TMP($J,"RCFMSCR",EFTFUND)) S $P(TOTAL,U)=$P(TOTAL,U)+^TMP($J,"RCFMSCR",EFTFUND)
77 ; compile unapplied amounts that went to suspense
78 S DA=0 F S DA=$O(^RCY(344,RECEIPDA,1,DA)) Q:'DA D
79 . S AMOUNT=$P($G(^RCY(344,RECEIPDA,1,DA,0)),"^",4) I 'AMOUNT Q
80 . S UNAPPLY=$P($G(^RCY(344,RECEIPDA,1,DA,2)),"^",5) I UNAPPLY="" Q
81 . ; if amount has not been processed, show it in suspense
82 . 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)
83 ;
84 ; print unapplied amounts that went to suspense
85 I $O(^TMP($J,"RCDPR215",0)) D
86 . W !!?5,"Appropriation: 3875"
87 . I RCTYPE="D" W !
88 . ;
89 . S COUNT=0,PRINTOTL=0
90 . S DA=0 F S DA=$O(^TMP($J,"RCDPR215",DA)) Q:'DA!($G(RCSTFLAG)) D
91 . . I $Y>(IOSL-6) D:SCREEN PAUSE Q:$G(RCSTFLAG) D H
92 . . ;
93 . . S UNAPPLY=$P(^TMP($J,"RCDPR215",DA),"^"),AMOUNT=$P(^(DA),"^",2),COMMENTS=$P(^(DA),"^",3)
94 . . S PRINTOTL=PRINTOTL+AMOUNT
95 . . S $P(TOTAL,"^")=$P(TOTAL,"^")+AMOUNT
96 . . ; if accrued report, do not show detail
97 . . I RCTYPE="A" Q
98 . . ;
99 . . S COUNT=COUNT+1
100 . . W !?5,COUNT,")",?10,UNAPPLY,?30,$J(AMOUNT,10,2),?45,"COMMENTS: ",$E(COMMENTS,1,25)
101 . . I $TR($E(COMMENTS,26,80)," ")'="" W !?25,$E(COMMENTS,26,80)
102 . ;
103 . I $G(RCSTFLAG) Q
104 . I RCTYPE="D" W !?30,"----------",!?5,"TOTAL for 3875"
105 . W ?30,$J(PRINTOTL,10,2)
106 I $G(RCSTFLAG) D Q Q
107 ;
108 S TOTLAMT=0 F PIECE=1:1:5 S TOTLAMT=TOTLAMT+$P(TOTAL,"^",PIECE)
109 W !!,"TOTALS: "
110 W !?5,"TOTAL AMOUNT POSTED:",?30,$J(TOTLAMT,10,2)
111 ;
112 I SCREEN W !,"Press RETURN to continue: " R X:DTIME
113Q D ^%ZISC
114 K ^TMP($J,"RCFMSCR"),^TMP($J,"RCDPR215")
115 Q
116 ;
117 ;
118GETTYPE() ; ask the type of report to print
119 N DIR,X,Y
120 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"
121 S DIR("?",1)="An ACCRUED Report will list just the accrued total under each appropriation"
122 D ^DIR
123 I Y'="A",Y'="D" Q ""
124 Q Y
125 ;
126 ;
127DEBTOR(DA) ; returns the debtor name for ien of bill (da) in file 430
128 N D0,DEBTOR,DIC,DIQ,DR
129 S DIC="^PRCA(430,",DR=9,DIQ(0)="E",DIQ="DEBTOR"
130 D EN^DIQ1
131 Q $G(DEBTOR(430,DA,9,"E"))
132 ;
133 ;
134H ; header
135 N Z
136 S PAGE=PAGE+1 I PAGE'=1!(SCREEN) W @IOF
137 W $C(13),"Page ",PAGE,?(80-$L(NOW)),NOW
138 W !,$E($TR(RCYLINE,"-","*"),1,34)," 215 REPORT ",$E($TR(RCYLINE,"-","*"),1,34)
139 W !!,"RECEIPT #: ",RECEIPT,?25,"for DEPOSIT #: ",DEPOSIT
140 I FMSDOCNO'="" W ?51,"FMS Document #: ",FMSDOCNO
141 S Z=""
142 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)
143 I Z'="" W !,Z
144 W !,RCYLINE
145 Q
146 ;
147 ;
148PAUSE ; pause at end of page
149 N X U IO(0) W !,"Press RETURN to continue, '^' to exit:" R X:DTIME S:'$T X="^" S:X["^" RCSTFLAG=1 U IO
150 Q
Note: See TracBrowser for help on using the repository browser.