source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJDF82.m@ 1582

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

initial load of FOIAVistA 6/30/08 version
File size: 4.7 KB
Line 
1IBJDF82 ;ALB/RRG - AR PRODUCTIVITY REPORT (PRINT) ;29-AUG-00
2 ;;2.0;INTEGRATED BILLING;**123,159**;21-MAR-94
3 ;
4EN ; - Print the AR Productivity Report
5 ;
6 S IBQ=0 D NOW^%DTC S IBRUN=$$DAT2^IBOUTL(%)
7 ;
8 I '$D(^TMP("IBJDF8SUM",$J)) D G ENQ
9 . D @($S(IBRPT="D":"HDRD",1:"HDRS"))
10 . W !!,"There is no AR Productivity information for the parameters selected."
11 . D PAUSE
12 ;
13 ; - Summary report was selected
14 I IBRPT="S" G SUM
15 ;
16 S IBPAG=0 D HDRD G:IBQ ENQ
17 ;
18 S (IBCLNAM,IBBLNUM,IBTRXNUM)="",CLIDENT=0
19 F S IBCLNAM=$O(^TMP("IBJDF8",$J,IBCLNAM)) Q:IBCLNAM="" D Q:IBQ
20 . I IBPNI="I" S CLIDENT=CLIDENT+1
21 . I $Y>(IOSL-6) D PAUSE Q:IBQ D HDRD Q:IBQ
22 . D WCLK
23 . F S IBBLNUM=$O(^TMP("IBJDF8",$J,IBCLNAM,IBBLNUM)) Q:IBBLNUM="" D Q:IBQ
24 . . F S IBTRXNUM=$O(^TMP("IBJDF8",$J,IBCLNAM,IBBLNUM,IBTRXNUM)) Q:IBTRXNUM="" D Q:IBQ
25 . . . S IBTRXDAT=$G(^TMP("IBJDF8",$J,IBCLNAM,IBBLNUM,IBTRXNUM)),IBFLG=1
26 . . . ;
27 . . . ; - Page Break
28 . . . I $Y>(IOSL-6) D PAUSE Q:IBQ D HDRD,WCLK Q:IBQ
29 . . . ;
30 . . . ; - Bill, Trx Date, Debtor, Trx Type, Trx Amount
31 . . . W !,$P(IBTRXDAT,"^",1),?13,$$DAT1^IBOUTL($P(IBTRXDAT,"^",2))
32 . . . W ?23,$E($P(IBTRXDAT,"^",3),1,28)
33 . . . W ?53,$E($P(IBTRXDAT,"^",4),1,20)
34 . . . W ?75,$J($FN($P(IBTRXDAT,"^",5),",",2),11)
35 . . . ;
36 . . . ; - Current Balance, Follow-up date, Trx Number
37 . . . W ?90,$J($FN($P(IBTRXDAT,"^",6),",",2),11)
38 . . . W ?104,$$DAT1^IBOUTL($P(IBTRXDAT,"^",7))
39 . . . W ?115,$S(IBTRXNUM:IBTRXNUM,1:"N/A")
40 . . . ;
41 . . . ; - Most recent brief comment
42 . . . I $P(IBTRXDAT,"^",8)'="" D
43 . . . . W !,?13,"COMMENT: ",?22,$E($P(IBTRXDAT,"^",8),1,90)
44 . W !
45 ;
46 G ENQ:IBQ D PAUSE G ENQ:IBQ
47 ;
48SUM ; - Print Summary Report
49 ;
50 D HDRS G ENQ:IBQ
51 ;
52 S (IBCNT1,IBTOT1,CLIDENT)=0
53 I IBSPT=1 D
54 . S CLNAM="" F S CLNAM=$O(^TMP("IBJDF8SUM",$J,CLNAM)) Q:CLNAM="" D Q:IBQ
55 . . I IBPNI="I" S CLIDENT=CLIDENT+1
56 . . I $Y>(IOSL-7) D PAUSE Q:IBQ D HDRS Q:IBQ
57 . . W !,$S(IBPNI="I":"CLERK # "_CLIDENT,1:CLNAM)
58 . . S (IBCNT,IBTOT)=0,TRXCAT=""
59 . . F S TRXCAT=$O(^TMP("IBJDF8SUM",$J,CLNAM,TRXCAT)) Q:TRXCAT="" D Q:IBQ
60 . . . I $Y>(IOSL-6) D PAUSE Q:IBQ D HDRS Q:IBQ W !,$S(IBPNI="I":"CLERK # "_CLIDENT,1:CLNAM)
61 . . . S SUMDAT=^TMP("IBJDF8SUM",$J,CLNAM,TRXCAT)
62 . . . W ?25,$P(SUMDAT,"^",3),?50,$J($P(SUMDAT,"^",1),12)
63 . . . W ?65,$J($FN($P(SUMDAT,"^",2),",",2),15),!
64 . . . S IBQ=$$STOP^IBOUTL("AR Productivity Report")
65 . . . S IBCNT=IBCNT+SUMDAT,IBTOT=IBTOT+$P(SUMDAT,"^",2)
66 . . ;
67 . . D WTOT
68 . I IBCNT1>1 D WTOT1
69 ;
70 G ENQ:IBQ
71 ;
72 I IBSPT=0 D
73 . S (IBCNT,IBTOT)=0,TRXCAT=""
74 . F S TRXCAT=$O(IB(TRXCAT)) Q:TRXCAT="" D
75 . . S SUMDAT=IB(TRXCAT) I $P(SUMDAT,"^",1)=0 Q
76 . . W !,?25,$P(SUMDAT,"^",3),?50,$J($P(SUMDAT,"^",1),12)
77 . . W ?65,$J($FN($P(SUMDAT,"^",2),",",2),15)
78 . . S IBCNT=IBCNT+SUMDAT,IBTOT=IBTOT+$P(SUMDAT,"^",2)
79 . W ! D WTOT
80 ;
81 D PAUSE
82 ;
83ENQ K IBCNT,IBCNT1,IBFLG,IBDFN,IBILL,IBKEY,IBPAT,IBPAG,IBQ,IBRUN,IBRP
84 K IBTOT,IBTOT1,%,SUMDAT,CLIDENT,TRXCAT,IBCLNAM,IBTRXNUM,IBTRXDAT
85 K CLNAM,IBBLNUM
86 Q
87 ;
88WCLK ; - Print Clerk Name or Identifier
89 W !,$S(IBPNI="I":"CLERK # "_CLIDENT,1:IBCLNAM)
90 Q
91 ;
92WTOT ; Write the Totals by Clerk
93 ;
94 S IBCNT1=IBCNT1+IBCNT,IBTOT1=IBTOT1+IBTOT
95 I IBCNT'>1 S (IBCNT,IBTOT)=0 Q
96 W ?53,"---------",?67,"-------------"
97 W !?50,$J(IBCNT,12),?65,$J($FN(IBTOT,",",2),15),!
98 S (IBCNT,IBTOT)=0
99 Q
100 ;
101WTOT1 ; Write the Grand Totals
102 ;
103 W !?53,"---------",?67,"-------------"
104 W !?25,"GRAND TOTALS",?50,$J(IBCNT1,12),?65,$J($FN(IBTOT1,",",2),15),!
105 Q
106 ;
107HDRD ; - Prints the Detailed Report Header
108 ;
109 W @IOF,*13 S IBPAG=$G(IBPAG)+1
110 W !,"AR Productivity Report",?60,"Run Date: ",IBRUN
111 W ?123,"Page: ",$J(IBPAG,3)
112 W !,"From: ",?7,IBF,?20,"to",?23,IBT
113 W ?60,"Detail By ",?70,$S(IBPNI="N":"Clerk Name",1:"Clerk Identifier")
114 ;
115 W !!,?13,"Trx.",?53,"Transaction",?75,"Transaction",?90,"Current"
116 W ?104,"Follow-Up",?115,"Transaction"
117 W !,"Bill Number",?13,"Date",?23,"Debtor",?53,"Type",?75,"Amount"
118 W ?90,"Balance",?104,"Date",?115,"Number"
119 W !,$$DASH(132,0) S IBQ=$$STOP^IBOUTL("AR Productivity Report")
120 Q
121 ;
122HDRS ; - Prints the Summary Report Header
123 ;
124 N X
125 W @IOF,$C(13) W !?26,"SUMMARY AR PRODUCTIVITY REPORT"
126 S X=" From "_IBF_" to "_IBT
127 W !?(80-$L(X)/2+1),X,!!?(80-$L(IBRUN)/2+1),IBRUN
128 S X="",$P(X,"=",$L(IBRUN))="" W !?(80-$L(IBRUN)/2+1),X
129 W !!,$S(IBSPT=1:"Clerk",1:""),?25,"Transaction Category"
130 W ?50,"Total Number",?64,"Total Dollar Amt"
131 W !,$$DASH(80,0) S IBQ=$$STOP^IBOUTL("AR Productivity Report")
132 Q
133 ;
134DASH(X,Y) ; - Return a dashed line.
135 ; Input: X=Number of Columns (80 or 132), Y=Char to be printed
136 ;
137 Q $TR($J("",X)," ",$S(Y:"-",1:"="))
138 ;
139PAUSE ; - Page break.
140 ;
141 I $E(IOST,1,2)'="C-" Q
142 N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
143 F IBX=$Y:1:(IOSL-3) W !
144 S DIR(0)="E" D ^DIR S:$D(DIRUT)!($D(DUOUT)) IBQ=1
145 Q
146 ;
147DT(X) ; - Return date.
148 ; Input: X=Date in Fileman format
149 ; Output: Z=Date in MMDDYY format
150 ;
151 Q $E(X,4,7)_$E(X,2,3)
Note: See TracBrowser for help on using the repository browser.