RCRJRCO2 ;WISC/RFJ-start of the ar2 data collector ;3/7/00 12:17 PM
;;4.5;Accounts Receivable;**96,152,156,174,191,320**;Mar 20, 1995;Build 30
;;Per VA Directive 6402, 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.DOMAIN.EXT")=""
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,P121DT ;P181Dt change to P121DT - PRCA*4.5*320
N BAMT,DATA0,I
S P121DT=$$FMADD^XLFDT(DATEEND,-121) ;TROR, changed to 121 not 181 - PRCA*4.5*320
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 120 days
. . . Q:$P(DATA6,U,21)>P121DT
. . . 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRJRCO2 5472 printed Apr 09, 2024@20:47 Page 2
RCRJRCO2 ;WISC/RFJ-start of the ar2 data collector ;3/7/00 12:17 PM
+1 ;;4.5;Accounts Receivable;**96,152,156,174,191,320**;Mar 20, 1995;Build 30
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
DQ ; start queued task from taskmanager here
+1 DO START(PRCASITE,DATEBEG,DATEEND)
+2 QUIT
+3 ;
+4 ;
START(PRCASITE,DATEBEG,DATEEND) ; start ar2 collector
+1 NEW %,BATCNAME,STRTTIME,TOTAL,X,Y
+2 ;
+3 ; set start time
+4 DO NOW^%DTC
SET STRTTIME=%
+5 ;
+6 DO STATEMNT
DO PAYDEP
DO IRS
+7 ;
+8 ; ---------- send to ndb ----------
+9 KILL ^TMP($JOB,"RCRJRCORMM")
+10 ; build the first two control lines in mail message
+11 SET Y=DATEBEG
DO DD^%DT
+12 SET BATCNAME="AR2-"_$EXTRACT(Y,1,3)_$EXTRACT(DATEBEG,6,7)_$TRANSLATE($PIECE(Y,",",2)," ")
+13 SET Y=DATEEND
DO DD^%DT
+14 SET BATCNAME=BATCNAME_"-"_$EXTRACT(Y,1,3)_$EXTRACT(DATEEND,6,7)_$TRANSLATE($PIECE(Y,",",2)," ")
+15 SET ^TMP($JOB,"RCRJRCORMM",1)="T$ "_PRCASITE_"$"_BATCNAME_"$$$$$*"
+16 ; get end time (in %)
+17 DO NOW^%DTC
+18 SET ^TMP($JOB,"RCRJRCORMM",2)="S$ "_STRTTIME_"^"_%_"$0$5"
+19 SET ^TMP($JOB,"RCRJRCORMM",3)="D$ :1/1/"_TOTAL(1)_":2/2/"_TOTAL(2)_":3/3/"_TOTAL(3)_":4/4/"_TOTAL(4)_":5/5/"_TOTAL(5)
+20 ;
+21 SET XMY("S.PRQN DATA COLLECTION MONITOR@FO-ALBANY.DOMAIN.EXT")=""
+22 SET %=$$SENDMSG^RCRJRCOR("AR2 "_$EXTRACT(DATEEND,4,5)_"/"_$EXTRACT(DATEEND,2,3)_" NDB DATA FOR SITE "_PRCASITE,.XMY)
+23 KILL ^TMP($JOB,"RCRJRCORMM")
+24 QUIT
+25 ;
+26 ;
STATEMNT ; count statements
+1 NEW ADMIN,COUNT,DA,DATA,DATE,DATESTRT,DATESTOP,DEBTOR,INTEREST,PRINBAL
+2 SET DATESTRT=9999999-DATEEND
SET DATESTOP=9999999.999999-DATEBEG
+3 ;
+4 SET (COUNT,PRINBAL,INTEREST,ADMIN)=0
+5 SET DEBTOR=0
FOR
SET DEBTOR=$ORDER(^RC(341,"AD",DEBTOR))
if 'DEBTOR
QUIT
Begin DoDot:1
+6 SET DATE=DATESTRT
FOR
SET DATE=$ORDER(^RC(341,"AD",DEBTOR,2,DATE))
if 'DATE!(DATE>DATESTOP)
QUIT
Begin DoDot:2
+7 SET DA=0
FOR
SET DA=$ORDER(^RC(341,"AD",DEBTOR,2,DATE,DA))
if 'DA
QUIT
Begin DoDot:3
+8 SET DATA=$GET(^RC(341,DA,1))
+9 SET COUNT=COUNT+1
SET PRINBAL=PRINBAL+$PIECE(DATA,"^")
SET INTEREST=INTEREST+$PIECE(DATA,"^",2)
SET ADMIN=ADMIN+$PIECE(DATA,"^",3)
End DoDot:3
End DoDot:2
End DoDot:1
+10 ;
+11 ; 1 is data collector index for statements
+12 SET TOTAL(1)=COUNT_"^"_PRINBAL_"^"_INTEREST_"^"_ADMIN
+13 QUIT
+14 ;
+15 ;
PAYDEP ; process payments and deposits
+1 NEW COUNT,DA,DATA0,DATECONF,DEPAMT,DEPCNT,DEPTICDA,TDATA0,TDATA1,TOTALAMT,TOTALDEP,TRANDA,TYPE
+2 SET (COUNT,TOTALAMT,DEPCNT,TOTALDEP)=0
+3 SET DA=0
FOR
SET DA=$ORDER(^RCY(344,DA))
if 'DA
QUIT
SET DATA0=$GET(^(DA,0))
IF $PIECE(DATA0,"^",8)
Begin DoDot:1
+4 SET TYPE=$PIECE($GET(^RC(341.1,+$PIECE(DATA0,"^",4),0)),"^")
+5 IF TYPE'["PAYMENT"
QUIT
+6 ;
+7 ; count payment transactions and amount
+8 SET DEPAMT=0
+9 SET TRANDA=0
FOR
SET TRANDA=$ORDER(^RCY(344,DA,1,TRANDA))
if 'TRANDA
QUIT
Begin DoDot:2
+10 SET TDATA0=$GET(^RCY(344,DA,1,TRANDA,0))
SET TDATA1=$GET(^(1))
+11 IF $PIECE(TDATA1,"^",2)'=""
QUIT
+12 SET DEPAMT=DEPAMT+$PIECE(TDATA0,"^",4)
+13 IF $PIECE(TDATA0,"^",6)<DATEBEG!($PIECE(TDATA0,"^",6)>DATEEND)
QUIT
+14 IF $PIECE(TDATA0,"^",4)
SET COUNT=COUNT+1
SET TOTALAMT=TOTALAMT+$PIECE(TDATA0,"^",4)
End DoDot:2
+15 ;
+16 ; count total deposits and amount
+17 IF 'DEPAMT
QUIT
+18 SET DEPTICDA=$PIECE(DATA0,"^",6)
IF 'DEPTICDA
QUIT
+19 SET DATECONF=$PIECE($PIECE($GET(^RCY(344.1,DEPTICDA,0)),U,11),".")
+20 IF DATECONF<DATEBEG!(DATECONF>DATEEND)
QUIT
+21 SET TOTALDEP=TOTALDEP+DEPAMT
+22 IF '$DATA(DEPCNT(DATECONF))
SET DEPCNT(DATECONF)=""
SET DEPCNT=DEPCNT+1
End DoDot:1
+23 ;
+24 ; 2 is data collector index for deposits
+25 ; 3 is data collector index for payment transactions
+26 SET TOTAL(2)=DEPCNT_"^"_TOTALDEP
+27 SET TOTAL(3)=COUNT_"^"_TOTALAMT
+28 QUIT
+29 ;
+30 ;
IRS ; count of irs letters and amounts
+1 ; count of 1st party accounts and bills under $25 with total amt.
+2 NEW AMOUNT,BILLDA,COUNT,COUNTED,DATA6,DEBTOR
+3 ;P181Dt change to P121DT - PRCA*4.5*320
NEW L25BCNT,L25ACNT,L25AMT,L25FLG,DEBAMT,DEBCNT,DATA7,P121DT
+4 NEW BAMT,DATA0,I
+5 ;TROR, changed to 121 not 181 - PRCA*4.5*320
SET P121DT=$$FMADD^XLFDT(DATEEND,-121)
+6 SET (AMOUNT,COUNT,L25BCNT,L25ACNT,L25AMT)=0
+7 SET DEBTOR=0
FOR
SET DEBTOR=$ORDER(^PRCA(430,"C",DEBTOR))
if 'DEBTOR
QUIT
Begin DoDot:1
+8 SET (COUNTED,DEBAMT,DEBCNT,L25FLG)=0
+9 SET BILLDA=0
FOR
SET BILLDA=$ORDER(^PRCA(430,"C",DEBTOR,BILLDA))
if 'BILLDA
QUIT
Begin DoDot:2
+10 SET DATA6=$GET(^PRCA(430,BILLDA,6))
+11 ; if the first party account is still less than $25, get the
+12 ; next active bill and add those dollars
+13 if 'L25FLG
Begin DoDot:3
+14 ; not a 1st party account
+15 IF $PIECE($GET(^RCD(340,DEBTOR,0)),U)'[";DPT("
SET L25FLG=1
QUIT
+16 ; bill not activated for more than 120 days
+17 if $PIECE(DATA6,U,21)>P121DT
QUIT
+18 SET DATA0=$GET(^PRCA(430,BILLDA,0))
+19 ; bill not active or in suspended status
+20 ; not necessary to check for open status because of age of
+21 ; bill (should not be open for more than 30 days)
+22 IF $PIECE(DATA0,"^",8)'=16
IF $PIECE(DATA0,"^",8)'=40
QUIT
+23 SET DATA7=$GET(^PRCA(430,BILLDA,7))
+24 SET BAMT=0
FOR I=1:1:5
SET BAMT=BAMT+$PIECE(DATA7,U,I)
+25 ; no outstanding balance on the bill
+26 if 'BAMT
QUIT
+27 SET DEBAMT=DEBAMT+BAMT
+28 ; accounts is greater than $25, do not count it
+29 IF DEBAMT'<25
SET L25FLG=1
QUIT
+30 SET DEBCNT=DEBCNT+1
+31 QUIT
End DoDot:3
+32 IF $PIECE(DATA6,"^",14)<DATEBEG!($PIECE(DATA6,"^",14)>DATEEND)
QUIT
+33 IF 'COUNTED
SET COUNT=COUNT+1
SET COUNTED=1
+34 SET AMOUNT=AMOUNT+$PIECE(DATA6,"^",19)
+35 QUIT
End DoDot:2
+36 ;increment account less than 25 totals
+37 IF 'L25FLG
IF DEBAMT
SET L25ACNT=L25ACNT+1
SET L25AMT=L25AMT+DEBAMT
SET L25BCNT=L25BCNT+DEBCNT
+38 QUIT
End DoDot:1
+39 ;
+40 ; 4 is data collector index for irs letters and amounts
+41 SET TOTAL(4)=COUNT_"^"_AMOUNT
+42 ;
+43 ; 5 is data collector index for accounts less than $25, total
+44 ; amount of accounts under $25, # of bills covered by those accounts
+45 SET TOTAL(5)=L25ACNT_"^"_L25AMT_"^"_L25BCNT
+46 QUIT
