RCRJRCOL ;WISC/RFJ-start of the ar data collector ;1 Mar 97 ;;4.5;Accounts Receivable;**68,96,101,103,170,176,191**;Mar 20, 1995 ;;Per VHA Directive 10-93-142, this routine should not be modified. Q ; ; START(PRCASITE,DATEBEG,DATEEND) ; start ar1 collector and fms data collector N %,ACTDATE,AYEAROLD,BILLDA,CLOSED,CRITERIA,DATA0,DATASTOR,DATE,IBCNS,PREVSTAT,STAT,STRTTIME D KILLTMP ; ; set start time D NOW^%DTC S STRTTIME=% ; S DATASTOR="^TMP($J,""RCRJRCOLNDB"",CRITERIA)" ; ; count new receivables S %=$$GETNEW(DATEBEG,DATEEND,1) ; ; used to determine future payments less than a year old S AYEAROLD=$$FMADD^XLFDT(DATEEND,365) ; ; count current receivables for period and decrease in debts ; do not look at bills not approved/finished (18,20,27,31) S STAT=0 F S STAT=$O(^PRCA(430,"ASDT",STAT)) Q:'STAT I STAT'=18,STAT'=20,STAT'=27,STAT'=31 D . S DATE=0,CLOSED=0 . ; do not look at bills closed before begin date . ; count decrease number of debts, must be closed in month . ; stat 17 (in-active) ; stat 22 (collected/closed) . ; stat 23 (write-off) ; stat 26 (cancelled) . ; stat 39 (cancellation) ; stat 41 (refunded) . I ",17,22,23,26,39,41,"[(","_STAT_",") S DATE=DATEBEG-1,CLOSED=1 . F S DATE=$O(^PRCA(430,"ASDT",STAT,DATE)) Q:'DATE D . . S BILLDA=0 F S BILLDA=$O(^PRCA(430,"ASDT",STAT,DATE,BILLDA)) Q:'BILLDA D . . . ; do not count bills already skipped . . . I $D(^TMP($J,"RCRJRCOL","COUNT",BILLDA,0)) Q . . . S DATA0=$G(^PRCA(430,BILLDA,0)) . . . I '$P(DATA0,"^",12) S ^TMP($J,"RCRJRCOL","COUNT",BILLDA,0)="" Q . . . ; no original amount . . . I $P(DATA0,"^",3)="" S ^TMP($J,"RCRJRCOL","COUNT",BILLDA,0)="" Q . . . ; . . . ; do not look at bills activated after end date . . . S ACTDATE=$P($P($G(^PRCA(430,BILLDA,6)),"^",21),".") . . . I 'ACTDATE!(ACTDATE>DATEEND) S ^TMP($J,"RCRJRCOL","COUNT",BILLDA,0)="" Q . . . ; . . . ; bill is closed before end date, decrease debt . . . I CLOSED,DATE'>DATEEND D Q . . . . ; if previous status was: . . . . ; 18 (new bill), 27 (incomplete), 20 (pend approval) . . . . ; then the bill was never counted as a new receivable . . . . ; and should not be counted as a decrease in debts . . . . S PREVSTAT=$P($G(^PRCA(430,BILLDA,9)),"^",6) . . . . I PREVSTAT=18!(PREVSTAT=20)!(PREVSTAT=27) S ^TMP($J,"RCRJRCOL","COUNT",BILLDA,0)="" Q . . . . D SETTOTAL^RCRJRCO1(17,0,0) . . . ; . . . D CURRENT^RCRJRCOB(BILLDA,DATEEND,AYEAROLD) ; ; collect data from file 433 D START^RCRJRCO1 ; send data to ndb and fms D SEND^RCRJRCOR ; print summary report D SUMMARY^RCRJRCOR ; ; compile and print bad debt report I '$G(RCRJFBDR) D START^RCRJRBD(DATEEND) ; KILLTMP ; kill tmp globals K ^TMP($J,"RCRJRBD") ;stores the bad debt report K ^TMP($J,"RCRJRCOL") ;used internally K ^TMP($J,"RCRJRCOLNDB") ;stores the ndb data K ^TMP($J,"RCRJROIG") ;stores the data for the oig extract K ^TMP($J,"RCRJRCOLSV") ;stores the fms sv code sheet K ^TMP($J,"RCRJRCOLWR") ;stores the fms wr code sheet K ^TMP($J,"RCRJRCOLREPORT") ;stores the user report K ^TMP($J,"RCBMILLDATA") ;stores the mccf/hsif payment split for rx Q ; ; GETNEW(DATEBEG,DATEEND,RCRJFSTO) ; get new receivables between two dates ; rcrjfsto is a flag which is set to 1 for the ndb rollup and it ; will store the data in tmp. If its not a 1, it will count the ; new bills and just return the count ^ amount. N COUNT,DATE,ORIGAMT,PRINBAL S COUNT=0,PRINBAL=0 S DATE=DATEBEG-1 F S DATE=$O(^PRCA(430,"ACTDT",DATE)) Q:'DATE!(DATE>DATEEND) D . S BILLDA=0 F S BILLDA=$O(^PRCA(430,"ACTDT",DATE,BILLDA)) Q:'BILLDA D . . S ORIGAMT=$$TESTNEW(BILLDA,DATEBEG,DATEEND) . . ; not a new receivable . . I ORIGAMT="" S:RCRJFSTO ^TMP($J,"RCRJRCOL","COUNT",BILLDA,0)="" Q . . ; store for ndb . . I RCRJFSTO D SETTOTAL^RCRJRCO1(13,ORIGAMT,0) . . S COUNT=COUNT+1,PRINBAL=PRINBAL+ORIGAMT ; Q COUNT_"^"_PRINBAL ; ; TESTNEW(BILLDA,DATEBEG,DATEEND) ; test to see if a bill is a new receivable ; returns the principal balance if a bill is new N DATA0,STAT S DATA0=$G(^PRCA(430,BILLDA,0)) ; no site I '$P(DATA0,"^",12) Q "" ; bill never had an original amount (prepayments would not be ; picked up here since they do not have an original amount) I $P(DATA0,"^",3)="" Q "" ; S STAT=$P(DATA0,"^",8) ; no status I 'STAT Q "" ; bill was cancelled the same month ;I STAT=26,($E($P(DATA0,"^",14),1,5)=$E(DATEBEG,1,5)) Q "" I STAT=26&($P(DATA0,"^",14)DATEEND)) Q "" ; bill incomplete I STAT=27 Q "" ; bill new I STAT=18 Q "" ; bill pending approval I STAT=20 Q "" ; bill returned from AR (new) I STAT=31 Q "" ; ; yes, its a new receivable, return its original amount Q +$P(DATA0,"^",3) ; ; CRITERIA(BILLDA) ; find a bills criteria/category 1,3,4,5 ; returns 1--3-4-5 where the number is the criteria number ; the second piece is set at settotal^rcrjrco1 ; N %,CRITER1,CRITER35,DATA0,X S DATA0=$G(^PRCA(430,BILLDA,0)) ; ; % = segment S %=$P(DATA0,"^",21) S CRITER1=$S(%=243:1,%=244:3,%=245:2,%=246:8,%=247:9,%=248:10,%=249:5,%=251:14,%=252:16,%=292:6,%=293:7,%=294:11,%=295:19,%=296:20,%=297:4,%=298:12,1:0) ; ; acck = accrual I CRITER1=8,'$$ACCK^PRCAACC(BILLDA) S CRITER1=18 ; I 'CRITER1 D . S %=$P($G(^PRCA(430.2,+$P(DATA0,"^",2),0)),"^",7) . ; % = Category Number: . ; 22 TORT FEASOR . ; 18 SHARING AGREEMENTS . ; 33 PREPAYMENT . ; 40 ADULT DAY HEALTH CARE . ; 41 DOMICILIARY . ; 42 RESPITE CARE-INSTITUTIONAL . ; 43 RESPITE CARE-NON-INSTITUTIONAL . ; 44 GERIATRIC EVAL-INSTITUTIONAL . ; 45 GERIATRIC EVAL-NON-INSTITUTION . ; 46 NURSING HOME CARE-LTC . S CRITER1=$S(%=22:15,%=18:17,%=33:13,%=40:1,%=41:20,%=42:20,%=43:1,%=44:20,%=45:1,%=46:20,1:18) ; ; determine criteria 3,4,5 S CRITER35="0-0-0" I CRITER1>3,CRITER1<8 D . S %=$TR($$CRIT^IBRFN2(BILLDA),"^","-") ;integration agreement 1182 . I %=-1 S CRITER35="3-1-4" Q . I $P(%,"-")="" S $P(%,"-")=3 . I $P(%,"-",2)="" S $P(%,"-",2)=1 . I $P(%,"-",3)="" S $P(%,"-",3)=4 . S CRITER35=% ; Q CRITER1_"--"_CRITER35