- 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 Mar 13, 2025@20:52:50 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
