133 lines
5.1 KiB
Mathematica
133 lines
5.1 KiB
Mathematica
RCRJRCO2 ;WISC/RFJ-start of the ar2 data collector ;3/7/00 12:17 PM
|
|
;;4.5;Accounts Receivable;**96,152,156,174,191**;Mar 20, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
Q
|
|
;
|
|
;
|
|
DQ ; start queued task from taskmanager here
|
|
D START(PRCASITE,DATEBEG,DATEEND)
|
|
Q
|
|
;
|
|
;
|
|
START(PRCASITE,DATEBEG,DATEEND) ; start ar2 collector
|
|
N %,BATCNAME,STRTTIME,TOTAL,X,Y
|
|
;
|
|
; set start time
|
|
D NOW^%DTC S STRTTIME=%
|
|
;
|
|
D STATEMNT,PAYDEP,IRS
|
|
;
|
|
; ---------- send to ndb ----------
|
|
K ^TMP($J,"RCRJRCORMM")
|
|
; build the first two control lines in mail message
|
|
S Y=DATEBEG D DD^%DT
|
|
S BATCNAME="AR2-"_$E(Y,1,3)_$E(DATEBEG,6,7)_$TR($P(Y,",",2)," ")
|
|
S Y=DATEEND D DD^%DT
|
|
S BATCNAME=BATCNAME_"-"_$E(Y,1,3)_$E(DATEEND,6,7)_$TR($P(Y,",",2)," ")
|
|
S ^TMP($J,"RCRJRCORMM",1)="T$ "_PRCASITE_"$"_BATCNAME_"$$$$$*"
|
|
; get end time (in %)
|
|
D NOW^%DTC
|
|
S ^TMP($J,"RCRJRCORMM",2)="S$ "_STRTTIME_"^"_%_"$0$5"
|
|
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)
|
|
;
|
|
S XMY("S.PRQN DATA COLLECTION MONITOR@FO-ALBANY.MED.VA.GOV")=""
|
|
S %=$$SENDMSG^RCRJRCOR("AR2 "_$E(DATEEND,4,5)_"/"_$E(DATEEND,2,3)_" NDB DATA FOR SITE "_PRCASITE,.XMY)
|
|
K ^TMP($J,"RCRJRCORMM")
|
|
Q
|
|
;
|
|
;
|
|
STATEMNT ; count statements
|
|
N ADMIN,COUNT,DA,DATA,DATE,DATESTRT,DATESTOP,DEBTOR,INTEREST,PRINBAL
|
|
S DATESTRT=9999999-DATEEND,DATESTOP=9999999.999999-DATEBEG
|
|
;
|
|
S (COUNT,PRINBAL,INTEREST,ADMIN)=0
|
|
S DEBTOR=0 F S DEBTOR=$O(^RC(341,"AD",DEBTOR)) Q:'DEBTOR D
|
|
. S DATE=DATESTRT F S DATE=$O(^RC(341,"AD",DEBTOR,2,DATE)) Q:'DATE!(DATE>DATESTOP) D
|
|
. . S DA=0 F S DA=$O(^RC(341,"AD",DEBTOR,2,DATE,DA)) Q:'DA D
|
|
. . . S DATA=$G(^RC(341,DA,1))
|
|
. . . S COUNT=COUNT+1,PRINBAL=PRINBAL+$P(DATA,"^"),INTEREST=INTEREST+$P(DATA,"^",2),ADMIN=ADMIN+$P(DATA,"^",3)
|
|
;
|
|
; 1 is data collector index for statements
|
|
S TOTAL(1)=COUNT_"^"_PRINBAL_"^"_INTEREST_"^"_ADMIN
|
|
Q
|
|
;
|
|
;
|
|
PAYDEP ; process payments and deposits
|
|
N COUNT,DA,DATA0,DATECONF,DEPAMT,DEPCNT,DEPTICDA,TDATA0,TDATA1,TOTALAMT,TOTALDEP,TRANDA,TYPE
|
|
S (COUNT,TOTALAMT,DEPCNT,TOTALDEP)=0
|
|
S DA=0 F S DA=$O(^RCY(344,DA)) Q:'DA S DATA0=$G(^(DA,0)) I $P(DATA0,"^",8) D
|
|
. S TYPE=$P($G(^RC(341.1,+$P(DATA0,"^",4),0)),"^")
|
|
. I TYPE'["PAYMENT" Q
|
|
. ;
|
|
. ; count payment transactions and amount
|
|
. S DEPAMT=0
|
|
. S TRANDA=0 F S TRANDA=$O(^RCY(344,DA,1,TRANDA)) Q:'TRANDA D
|
|
. . S TDATA0=$G(^RCY(344,DA,1,TRANDA,0)),TDATA1=$G(^(1))
|
|
. . I $P(TDATA1,"^",2)'="" Q
|
|
. . S DEPAMT=DEPAMT+$P(TDATA0,"^",4)
|
|
. . I $P(TDATA0,"^",6)<DATEBEG!($P(TDATA0,"^",6)>DATEEND) Q
|
|
. . I $P(TDATA0,"^",4) S COUNT=COUNT+1,TOTALAMT=TOTALAMT+$P(TDATA0,"^",4)
|
|
. ;
|
|
. ; count total deposits and amount
|
|
. I 'DEPAMT Q
|
|
. S DEPTICDA=$P(DATA0,"^",6) I 'DEPTICDA Q
|
|
. S DATECONF=$P($P($G(^RCY(344.1,DEPTICDA,0)),U,11),".")
|
|
. I DATECONF<DATEBEG!(DATECONF>DATEEND) Q
|
|
. S TOTALDEP=TOTALDEP+DEPAMT
|
|
. I '$D(DEPCNT(DATECONF)) S DEPCNT(DATECONF)="",DEPCNT=DEPCNT+1
|
|
;
|
|
; 2 is data collector index for deposits
|
|
; 3 is data collector index for payment transactions
|
|
S TOTAL(2)=DEPCNT_"^"_TOTALDEP
|
|
S TOTAL(3)=COUNT_"^"_TOTALAMT
|
|
Q
|
|
;
|
|
;
|
|
IRS ; count of irs letters and amounts
|
|
; count of 1st party accounts and bills under $25 with total amt.
|
|
N AMOUNT,BILLDA,COUNT,COUNTED,DATA6,DEBTOR
|
|
N L25BCNT,L25ACNT,L25AMT,L25FLG,DEBAMT,DEBCNT,DATA7,P181DT
|
|
N BAMT,DATA0,I
|
|
S P181DT=$$FMADD^XLFDT(DATEEND,-181)
|
|
S (AMOUNT,COUNT,L25BCNT,L25ACNT,L25AMT)=0
|
|
S DEBTOR=0 F S DEBTOR=$O(^PRCA(430,"C",DEBTOR)) Q:'DEBTOR D
|
|
. S (COUNTED,DEBAMT,DEBCNT,L25FLG)=0
|
|
. S BILLDA=0 F S BILLDA=$O(^PRCA(430,"C",DEBTOR,BILLDA)) Q:'BILLDA D
|
|
. . S DATA6=$G(^PRCA(430,BILLDA,6))
|
|
. . ; if the first party account is still less than $25, get the
|
|
. . ; next active bill and add those dollars
|
|
. . D:'L25FLG
|
|
. . . ; not a 1st party account
|
|
. . . I $P($G(^RCD(340,DEBTOR,0)),U)'[";DPT(" S L25FLG=1 Q
|
|
. . . ; bill not activated for more than 180 days
|
|
. . . Q:$P(DATA6,U,21)>P181DT
|
|
. . . S DATA0=$G(^PRCA(430,BILLDA,0))
|
|
. . . ; bill not active or in suspended status
|
|
. . . ; not necessary to check for open status because of age of
|
|
. . . ; bill (should not be open for more than 30 days)
|
|
. . . I $P(DATA0,"^",8)'=16,$P(DATA0,"^",8)'=40 Q
|
|
. . . S DATA7=$G(^PRCA(430,BILLDA,7))
|
|
. . . S BAMT=0 F I=1:1:5 S BAMT=BAMT+$P(DATA7,U,I)
|
|
. . . ; no outstanding balance on the bill
|
|
. . . Q:'BAMT
|
|
. . . S DEBAMT=DEBAMT+BAMT
|
|
. . . ; accounts is greater than $25, do not count it
|
|
. . . I DEBAMT'<25 S L25FLG=1 Q
|
|
. . . S DEBCNT=DEBCNT+1
|
|
. . . Q
|
|
. . I $P(DATA6,"^",14)<DATEBEG!($P(DATA6,"^",14)>DATEEND) Q
|
|
. . I 'COUNTED S COUNT=COUNT+1,COUNTED=1
|
|
. . S AMOUNT=AMOUNT+$P(DATA6,"^",19)
|
|
. . Q
|
|
. ;increment account less than 25 totals
|
|
. I 'L25FLG,DEBAMT S L25ACNT=L25ACNT+1,L25AMT=L25AMT+DEBAMT,L25BCNT=L25BCNT+DEBCNT
|
|
. Q
|
|
;
|
|
; 4 is data collector index for irs letters and amounts
|
|
S TOTAL(4)=COUNT_"^"_AMOUNT
|
|
;
|
|
; 5 is data collector index for accounts less than $25, total
|
|
; amount of accounts under $25, # of bills covered by those accounts
|
|
S TOTAL(5)=L25ACNT_"^"_L25AMT_"^"_L25BCNT
|
|
Q
|