close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJDF81.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

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

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

initial load of WorldVistAEHR
File size: 4.7 KB
RevLine 
1IBJDF81 ;ALB/RRG - AR PRODUCTIVITY REPORT (COMPILE) ;29-AUG-00
2 ;;2.0;INTEGRATED BILLING;**123,159,192**;21-MAR-94
3 ;
4ST ; - Tasked entry point.
5 K IB,^TMP("IBJDF8",$J),^TMP("IBJDF8SUM",$J) S IBQ=0
6 ;
7 ; - Initialize the array IB
8 F I=1:1:13 S IB(I)=0
9 ;
10 ; - Loops through all the AR Transactions by DATE ENTERED X-ref
11 S IBTRDA="",IBTDATE=IBTDATE+.9
12 S IBTRTP=0 ; - Don't include INCREASE ADJUSTMENTS transactions
13 F S IBTRTP=$O(^PRCA(433,"AT",IBTRTP)) Q:'IBTRTP D Q:IBQ
14 . S IBDTEN=IBFDATE-.1
15 . F S IBDTEN=$O(^PRCA(433,"AT",IBTRTP,IBDTEN)) Q:'IBDTEN!(IBDTEN>IBTDATE) D Q:IBQ
16 . . F S IBTRDA=$O(^PRCA(433,"AT",IBTRTP,IBDTEN,IBTRDA)) Q:'IBTRDA D Q:IBQ
17 . . . S IBTR0=$G(^PRCA(433,IBTRDA,0))
18 . . . S IBARDA=$P(IBTR0,"^",2) Q:IBARDA=""
19 . . . S IBTR1=$G(^PRCA(433,IBTRDA,1))
20 . . . S IBTR5=$G(^PRCA(433,IBTRDA,5))
21 . . . S IBTR8=$G(^PRCA(433,IBTRDA,8))
22 . . . I IBARDA#100=0 S IBQ=$$STOP^IBOUTL("AR Productivity Report") Q:IBQ
23 . . . S IBAR0=$G(^PRCA(430,IBARDA,0))
24 . . . I 'IBAR0!($P(IBAR0,"^",8)=8) Q ; No AR bill/bill terminated.
25 . . . S IBAR7=$G(^PRCA(430,IBARDA,7))
26 . . . S IBAR9=$G(^PRCA(430,IBARDA,9))
27 . . . D TRDA
28 ;
29 I IBSEL'="",IBSEL'[",2," G PRT ; AUDIT Transaction type not selected
30 ;
31 ; - Get AUDIT Transactions
32 S IBARDA="",IBACTDT=IBFDATE-.1
33 ;F S IBACTDT=$O(^PRCA(430,"ACTDT",IBACTDT)) Q:'IBACTDT D Q:IBQ
34 F S IBACTDT=$O(^PRCA(430,"ACTDT",IBACTDT)) Q:'IBACTDT!(IBACTDT>IBTDATE) D Q:IBQ
35 . F S IBARDA=$O(^PRCA(430,"ACTDT",IBACTDT,IBARDA)) Q:'IBARDA D Q:IBQ
36 . . S IBAR0=$G(^PRCA(430,IBARDA,0)) Q:'IBAR0
37 . . S IBAR7=$G(^PRCA(430,IBARDA,7))
38 . . S IBAR9=$G(^PRCA(430,IBARDA,9))
39 . . D AUDIT
40 ;
41PRT I 'IBQ D EN^IBJDF82 ; Print the report.
42 ;
43ENQ K ^TMP("IBJDF8",$J),^TMP("IBJDF8SUM",$J)
44 I $D(ZTQUEUED) S ZTREQ="@" G ENQ1
45 ;
46 D ^%ZISC
47ENQ1 K IBARDA,IBTRDA,IBAR0,IBAR7,IBAR9,IBTR0,IBTR1,IBTR5,IBTR8,IBTRTP,IBACTDT
48 K IBBAL,IBDTEN,IBCLNU,IBCLNM,IBDATA,IBCONT,IBCOM,IBFUDT,IBTRAMT,IBQ
49 K TRXCAT,TRXCATN,TRXTYPN,IB,I
50 Q
51 ;
52AUDIT ; - Determine if bill has been audited and add to Audit Transaction
53 ; Total, then:
54 ; - Sets temporary detail global (for detail printing)
55 ; - Sets temporary summary global (for summary printing)
56 ;
57 S IBCLNU=$P(IBAR9,"^",1) I IBCLNU="" Q ; Approved By (Clerk) not found
58 ;
59 I '$D(^IBE(351.73,IBCLNU,0)) Q ; Clerk not set up
60 I IBCLERK="S",'$D(IBCLERK(IBCLNU)) Q ; Clerk not selected
61 S IBCLNM=$P($G(^VA(200,IBCLNU,0)),"^",1)
62 ;
63 S IBBAL=0 F I=1:1:5 S IBBAL=IBBAL+$P(IBAR7,"^",I) ; Current Bill Balance
64 ;
65 S IB(2)=($P(IB(2),"^",1)+1)_"^"_($P(IB(2),"^",2)+$P(IBAR0,"^",3))_"^AUDIT"
66 S TRXCAT=2
67 ;
68 ; - Update TMP global with Summary information by Clerk
69 S IBDATA=$G(^TMP("IBJDF8SUM",$J,IBCLNM,2))
70 S $P(IBDATA,"^",1)=$P(IBDATA,"^",1)+1
71 S $P(IBDATA,"^",2)=$P(IBDATA,"^",2)+$P(IBAR0,"^",3)
72 S $P(IBDATA,"^",3)="AUDIT"
73 S ^TMP("IBJDF8SUM",$J,IBCLNM,2)=IBDATA
74 ;
75 I IBRPT="S" Q ; Don't set ^TMP for detail if only Summary was selected
76 ;
77 ; - Update TMP global with Detailed information
78 S ^TMP("IBJDF8",$J,IBCLNM,IBARDA,0)=$P(IBAR0,"^")_"^"_IBACTDT_"^"_$$DEBTOR(IBARDA)_"^AUDIT^"_$P(IBAR0,"^",3)_"^"_IBBAL
79 ;
80 Q
81 ;
82TRDA ; - Checks if Transactions is eligible for the Report, then:
83 ; - Sets temporary global (for detail printing)
84 ; - Sets temporary Summary global (for summary printing)
85 ;
86 S IBCLNU=$P(IBTR0,"^",9) I IBCLNU="" Q ; No CLERK found on the AR Trans.
87 ;
88 I '$D(^IBE(351.73,IBCLNU,0)) Q ; Clerk not set up
89 I IBCLERK="S",'$D(IBCLERK(IBCLNU)) Q ; Clerk not selected to print
90 ;
91 S IBTRAMT=$P(IBTR1,"^",5) ; TRX Amount
92 ;
93 I IBRPT'="S",IBTT'="ALL" Q:IBTT'[("|"_IBTRTP_"|") ; TRX type not selected
94 ;
95 I '$$VALID^RCRJRCOT(IBTRDA) Q ; Invalid TRX
96 ;
97 S IBCONT=$P(IBTR8,"^",8) ; Contractual / Non-Contractual Transaction
98 ;
99 S IBBAL=0 F I=1:1:5 S IBBAL=IBBAL+$P(IBAR7,"^",I) ; Current Bill Balance
100 ;
101 ; - Set IB array with summary information
102 I $T(@IBTRTP^IBJDF811)'="" D @(IBTRTP_"^IBJDF811")
103 ;
104 S IBCLNM=$P($G(^VA(200,$P(IBTR0,"^",9),0)),"^",1) ; Clerk Name
105 ;
106 ; - Set TMP global with Summary information
107 S IBDATA=$G(^TMP("IBJDF8SUM",$J,IBCLNM,TRXCAT))
108 S $P(IBDATA,"^",1)=$P(IBDATA,"^",1)+1
109 S $P(IBDATA,"^",2)=$P(IBDATA,"^",2)+IBTRAMT
110 S $P(IBDATA,"^",3)=TRXCATN
111 S ^TMP("IBJDF8SUM",$J,IBCLNM,TRXCAT)=IBDATA
112 ;
113 I IBRPT="S" Q ; Don't set ^TMP for detail if only Summary was selected
114 ;
115 S IBCOM=$P(IBTR5,"^",2) ; Brief Comments
116 S IBFUDT=$P(IBTR5,"^",3) ; Follow-Up Date
117 ;
118 ; - Set TMP global with Detailed information
119 S ^TMP("IBJDF8",$J,IBCLNM,IBARDA,IBTRDA)=$P(IBAR0,"^")_"^"_IBDTEN_"^"_$$DEBTOR(IBARDA)_"^"_TRXTYPN_"^"_IBTRAMT_"^"_IBBAL_"^"_IBFUDT_"^"_IBCOM
120 ;
121 Q
122 ;
123DEBTOR(ARDA) ; - Retrieve debtor name
124 N Y,DIC,DA,DR,DIQ,DEB
125 S DIC="^PRCA(430,",DA=ARDA,DR=9,DIQ="DEB" D EN^DIQ1
126 S Y=$G(DEB(430,DA,9))
127 Q Y
Note: See TracBrowser for help on using the repository browser.