source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRJRCO2.m@ 1608

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

initial load of WorldVistAEHR
File size: 5.1 KB
RevLine 
[613]1RCRJRCO2 ;WISC/RFJ-start of the ar2 data collector ;3/7/00 12:17 PM
2 ;;4.5;Accounts Receivable;**96,152,156,174,191**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7DQ ; start queued task from taskmanager here
8 D START(PRCASITE,DATEBEG,DATEEND)
9 Q
10 ;
11 ;
12START(PRCASITE,DATEBEG,DATEEND) ; start ar2 collector
13 N %,BATCNAME,STRTTIME,TOTAL,X,Y
14 ;
15 ; set start time
16 D NOW^%DTC S STRTTIME=%
17 ;
18 D STATEMNT,PAYDEP,IRS
19 ;
20 ; ---------- send to ndb ----------
21 K ^TMP($J,"RCRJRCORMM")
22 ; build the first two control lines in mail message
23 S Y=DATEBEG D DD^%DT
24 S BATCNAME="AR2-"_$E(Y,1,3)_$E(DATEBEG,6,7)_$TR($P(Y,",",2)," ")
25 S Y=DATEEND D DD^%DT
26 S BATCNAME=BATCNAME_"-"_$E(Y,1,3)_$E(DATEEND,6,7)_$TR($P(Y,",",2)," ")
27 S ^TMP($J,"RCRJRCORMM",1)="T$ "_PRCASITE_"$"_BATCNAME_"$$$$$*"
28 ; get end time (in %)
29 D NOW^%DTC
30 S ^TMP($J,"RCRJRCORMM",2)="S$ "_STRTTIME_"^"_%_"$0$5"
31 S ^TMP($J,"RCRJRCORMM",3)="D$ :1/1/"_TOTAL(1)_":2/2/"_TOTAL(2)_":3/3/"_TOTAL(3)_":4/4/"_TOTAL(4)_":5/5/"_TOTAL(5)
32 ;
33 S XMY("S.PRQN DATA COLLECTION MONITOR@FO-ALBANY.MED.VA.GOV")=""
34 S %=$$SENDMSG^RCRJRCOR("AR2 "_$E(DATEEND,4,5)_"/"_$E(DATEEND,2,3)_" NDB DATA FOR SITE "_PRCASITE,.XMY)
35 K ^TMP($J,"RCRJRCORMM")
36 Q
37 ;
38 ;
39STATEMNT ; count statements
40 N ADMIN,COUNT,DA,DATA,DATE,DATESTRT,DATESTOP,DEBTOR,INTEREST,PRINBAL
41 S DATESTRT=9999999-DATEEND,DATESTOP=9999999.999999-DATEBEG
42 ;
43 S (COUNT,PRINBAL,INTEREST,ADMIN)=0
44 S DEBTOR=0 F S DEBTOR=$O(^RC(341,"AD",DEBTOR)) Q:'DEBTOR D
45 . S DATE=DATESTRT F S DATE=$O(^RC(341,"AD",DEBTOR,2,DATE)) Q:'DATE!(DATE>DATESTOP) D
46 . . S DA=0 F S DA=$O(^RC(341,"AD",DEBTOR,2,DATE,DA)) Q:'DA D
47 . . . S DATA=$G(^RC(341,DA,1))
48 . . . S COUNT=COUNT+1,PRINBAL=PRINBAL+$P(DATA,"^"),INTEREST=INTEREST+$P(DATA,"^",2),ADMIN=ADMIN+$P(DATA,"^",3)
49 ;
50 ; 1 is data collector index for statements
51 S TOTAL(1)=COUNT_"^"_PRINBAL_"^"_INTEREST_"^"_ADMIN
52 Q
53 ;
54 ;
55PAYDEP ; process payments and deposits
56 N COUNT,DA,DATA0,DATECONF,DEPAMT,DEPCNT,DEPTICDA,TDATA0,TDATA1,TOTALAMT,TOTALDEP,TRANDA,TYPE
57 S (COUNT,TOTALAMT,DEPCNT,TOTALDEP)=0
58 S DA=0 F S DA=$O(^RCY(344,DA)) Q:'DA S DATA0=$G(^(DA,0)) I $P(DATA0,"^",8) D
59 . S TYPE=$P($G(^RC(341.1,+$P(DATA0,"^",4),0)),"^")
60 . I TYPE'["PAYMENT" Q
61 . ;
62 . ; count payment transactions and amount
63 . S DEPAMT=0
64 . S TRANDA=0 F S TRANDA=$O(^RCY(344,DA,1,TRANDA)) Q:'TRANDA D
65 . . S TDATA0=$G(^RCY(344,DA,1,TRANDA,0)),TDATA1=$G(^(1))
66 . . I $P(TDATA1,"^",2)'="" Q
67 . . S DEPAMT=DEPAMT+$P(TDATA0,"^",4)
68 . . I $P(TDATA0,"^",6)<DATEBEG!($P(TDATA0,"^",6)>DATEEND) Q
69 . . I $P(TDATA0,"^",4) S COUNT=COUNT+1,TOTALAMT=TOTALAMT+$P(TDATA0,"^",4)
70 . ;
71 . ; count total deposits and amount
72 . I 'DEPAMT Q
73 . S DEPTICDA=$P(DATA0,"^",6) I 'DEPTICDA Q
74 . S DATECONF=$P($P($G(^RCY(344.1,DEPTICDA,0)),U,11),".")
75 . I DATECONF<DATEBEG!(DATECONF>DATEEND) Q
76 . S TOTALDEP=TOTALDEP+DEPAMT
77 . I '$D(DEPCNT(DATECONF)) S DEPCNT(DATECONF)="",DEPCNT=DEPCNT+1
78 ;
79 ; 2 is data collector index for deposits
80 ; 3 is data collector index for payment transactions
81 S TOTAL(2)=DEPCNT_"^"_TOTALDEP
82 S TOTAL(3)=COUNT_"^"_TOTALAMT
83 Q
84 ;
85 ;
86IRS ; count of irs letters and amounts
87 ; count of 1st party accounts and bills under $25 with total amt.
88 N AMOUNT,BILLDA,COUNT,COUNTED,DATA6,DEBTOR
89 N L25BCNT,L25ACNT,L25AMT,L25FLG,DEBAMT,DEBCNT,DATA7,P181DT
90 N BAMT,DATA0,I
91 S P181DT=$$FMADD^XLFDT(DATEEND,-181)
92 S (AMOUNT,COUNT,L25BCNT,L25ACNT,L25AMT)=0
93 S DEBTOR=0 F S DEBTOR=$O(^PRCA(430,"C",DEBTOR)) Q:'DEBTOR D
94 . S (COUNTED,DEBAMT,DEBCNT,L25FLG)=0
95 . S BILLDA=0 F S BILLDA=$O(^PRCA(430,"C",DEBTOR,BILLDA)) Q:'BILLDA D
96 . . S DATA6=$G(^PRCA(430,BILLDA,6))
97 . . ; if the first party account is still less than $25, get the
98 . . ; next active bill and add those dollars
99 . . D:'L25FLG
100 . . . ; not a 1st party account
101 . . . I $P($G(^RCD(340,DEBTOR,0)),U)'[";DPT(" S L25FLG=1 Q
102 . . . ; bill not activated for more than 180 days
103 . . . Q:$P(DATA6,U,21)>P181DT
104 . . . S DATA0=$G(^PRCA(430,BILLDA,0))
105 . . . ; bill not active or in suspended status
106 . . . ; not necessary to check for open status because of age of
107 . . . ; bill (should not be open for more than 30 days)
108 . . . I $P(DATA0,"^",8)'=16,$P(DATA0,"^",8)'=40 Q
109 . . . S DATA7=$G(^PRCA(430,BILLDA,7))
110 . . . S BAMT=0 F I=1:1:5 S BAMT=BAMT+$P(DATA7,U,I)
111 . . . ; no outstanding balance on the bill
112 . . . Q:'BAMT
113 . . . S DEBAMT=DEBAMT+BAMT
114 . . . ; accounts is greater than $25, do not count it
115 . . . I DEBAMT'<25 S L25FLG=1 Q
116 . . . S DEBCNT=DEBCNT+1
117 . . . Q
118 . . I $P(DATA6,"^",14)<DATEBEG!($P(DATA6,"^",14)>DATEEND) Q
119 . . I 'COUNTED S COUNT=COUNT+1,COUNTED=1
120 . . S AMOUNT=AMOUNT+$P(DATA6,"^",19)
121 . . Q
122 . ;increment account less than 25 totals
123 . I 'L25FLG,DEBAMT S L25ACNT=L25ACNT+1,L25AMT=L25AMT+DEBAMT,L25BCNT=L25BCNT+DEBCNT
124 . Q
125 ;
126 ; 4 is data collector index for irs letters and amounts
127 S TOTAL(4)=COUNT_"^"_AMOUNT
128 ;
129 ; 5 is data collector index for accounts less than $25, total
130 ; amount of accounts under $25, # of bills covered by those accounts
131 S TOTAL(5)=L25ACNT_"^"_L25AMT_"^"_L25BCNT
132 Q
Note: See TracBrowser for help on using the repository browser.