| [613] | 1 | RCRJRCOL ;WISC/RFJ-start of the ar data collector ;1 Mar 97
|
|---|
| 2 | ;;4.5;Accounts Receivable;**68,96,101,103,170,176,191**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | START(PRCASITE,DATEBEG,DATEEND) ; start ar1 collector and fms data collector
|
|---|
| 8 | N %,ACTDATE,AYEAROLD,BILLDA,CLOSED,CRITERIA,DATA0,DATASTOR,DATE,IBCNS,PREVSTAT,STAT,STRTTIME
|
|---|
| 9 | D KILLTMP
|
|---|
| 10 | ;
|
|---|
| 11 | ; set start time
|
|---|
| 12 | D NOW^%DTC S STRTTIME=%
|
|---|
| 13 | ;
|
|---|
| 14 | S DATASTOR="^TMP($J,""RCRJRCOLNDB"",CRITERIA)"
|
|---|
| 15 | ;
|
|---|
| 16 | ; count new receivables
|
|---|
| 17 | S %=$$GETNEW(DATEBEG,DATEEND,1)
|
|---|
| 18 | ;
|
|---|
| 19 | ; used to determine future payments less than a year old
|
|---|
| 20 | S AYEAROLD=$$FMADD^XLFDT(DATEEND,365)
|
|---|
| 21 | ;
|
|---|
| 22 | ; count current receivables for period and decrease in debts
|
|---|
| 23 | ; do not look at bills not approved/finished (18,20,27,31)
|
|---|
| 24 | S STAT=0 F S STAT=$O(^PRCA(430,"ASDT",STAT)) Q:'STAT I STAT'=18,STAT'=20,STAT'=27,STAT'=31 D
|
|---|
| 25 | . S DATE=0,CLOSED=0
|
|---|
| 26 | . ; do not look at bills closed before begin date
|
|---|
| 27 | . ; count decrease number of debts, must be closed in month
|
|---|
| 28 | . ; stat 17 (in-active) ; stat 22 (collected/closed)
|
|---|
| 29 | . ; stat 23 (write-off) ; stat 26 (cancelled)
|
|---|
| 30 | . ; stat 39 (cancellation) ; stat 41 (refunded)
|
|---|
| 31 | . I ",17,22,23,26,39,41,"[(","_STAT_",") S DATE=DATEBEG-1,CLOSED=1
|
|---|
| 32 | . F S DATE=$O(^PRCA(430,"ASDT",STAT,DATE)) Q:'DATE D
|
|---|
| 33 | . . S BILLDA=0 F S BILLDA=$O(^PRCA(430,"ASDT",STAT,DATE,BILLDA)) Q:'BILLDA D
|
|---|
| 34 | . . . ; do not count bills already skipped
|
|---|
| 35 | . . . I $D(^TMP($J,"RCRJRCOL","COUNT",BILLDA,0)) Q
|
|---|
| 36 | . . . S DATA0=$G(^PRCA(430,BILLDA,0))
|
|---|
| 37 | . . . I '$P(DATA0,"^",12) S ^TMP($J,"RCRJRCOL","COUNT",BILLDA,0)="" Q
|
|---|
| 38 | . . . ; no original amount
|
|---|
| 39 | . . . I $P(DATA0,"^",3)="" S ^TMP($J,"RCRJRCOL","COUNT",BILLDA,0)="" Q
|
|---|
| 40 | . . . ;
|
|---|
| 41 | . . . ; do not look at bills activated after end date
|
|---|
| 42 | . . . S ACTDATE=$P($P($G(^PRCA(430,BILLDA,6)),"^",21),".")
|
|---|
| 43 | . . . I 'ACTDATE!(ACTDATE>DATEEND) S ^TMP($J,"RCRJRCOL","COUNT",BILLDA,0)="" Q
|
|---|
| 44 | . . . ;
|
|---|
| 45 | . . . ; bill is closed before end date, decrease debt
|
|---|
| 46 | . . . I CLOSED,DATE'>DATEEND D Q
|
|---|
| 47 | . . . . ; if previous status was:
|
|---|
| 48 | . . . . ; 18 (new bill), 27 (incomplete), 20 (pend approval)
|
|---|
| 49 | . . . . ; then the bill was never counted as a new receivable
|
|---|
| 50 | . . . . ; and should not be counted as a decrease in debts
|
|---|
| 51 | . . . . S PREVSTAT=$P($G(^PRCA(430,BILLDA,9)),"^",6)
|
|---|
| 52 | . . . . I PREVSTAT=18!(PREVSTAT=20)!(PREVSTAT=27) S ^TMP($J,"RCRJRCOL","COUNT",BILLDA,0)="" Q
|
|---|
| 53 | . . . . D SETTOTAL^RCRJRCO1(17,0,0)
|
|---|
| 54 | . . . ;
|
|---|
| 55 | . . . D CURRENT^RCRJRCOB(BILLDA,DATEEND,AYEAROLD)
|
|---|
| 56 | ;
|
|---|
| 57 | ; collect data from file 433
|
|---|
| 58 | D START^RCRJRCO1
|
|---|
| 59 | ; send data to ndb and fms
|
|---|
| 60 | D SEND^RCRJRCOR
|
|---|
| 61 | ; print summary report
|
|---|
| 62 | D SUMMARY^RCRJRCOR
|
|---|
| 63 | ;
|
|---|
| 64 | ; compile and print bad debt report
|
|---|
| 65 | I '$G(RCRJFBDR) D START^RCRJRBD(DATEEND)
|
|---|
| 66 | ;
|
|---|
| 67 | KILLTMP ; kill tmp globals
|
|---|
| 68 | K ^TMP($J,"RCRJRBD") ;stores the bad debt report
|
|---|
| 69 | K ^TMP($J,"RCRJRCOL") ;used internally
|
|---|
| 70 | K ^TMP($J,"RCRJRCOLNDB") ;stores the ndb data
|
|---|
| 71 | K ^TMP($J,"RCRJROIG") ;stores the data for the oig extract
|
|---|
| 72 | K ^TMP($J,"RCRJRCOLSV") ;stores the fms sv code sheet
|
|---|
| 73 | K ^TMP($J,"RCRJRCOLWR") ;stores the fms wr code sheet
|
|---|
| 74 | K ^TMP($J,"RCRJRCOLREPORT") ;stores the user report
|
|---|
| 75 | K ^TMP($J,"RCBMILLDATA") ;stores the mccf/hsif payment split for rx
|
|---|
| 76 | Q
|
|---|
| 77 | ;
|
|---|
| 78 | ;
|
|---|
| 79 | GETNEW(DATEBEG,DATEEND,RCRJFSTO) ; get new receivables between two dates
|
|---|
| 80 | ; rcrjfsto is a flag which is set to 1 for the ndb rollup and it
|
|---|
| 81 | ; will store the data in tmp. If its not a 1, it will count the
|
|---|
| 82 | ; new bills and just return the count ^ amount.
|
|---|
| 83 | N COUNT,DATE,ORIGAMT,PRINBAL
|
|---|
| 84 | S COUNT=0,PRINBAL=0
|
|---|
| 85 | S DATE=DATEBEG-1
|
|---|
| 86 | F S DATE=$O(^PRCA(430,"ACTDT",DATE)) Q:'DATE!(DATE>DATEEND) D
|
|---|
| 87 | . S BILLDA=0 F S BILLDA=$O(^PRCA(430,"ACTDT",DATE,BILLDA)) Q:'BILLDA D
|
|---|
| 88 | . . S ORIGAMT=$$TESTNEW(BILLDA,DATEBEG,DATEEND)
|
|---|
| 89 | . . ; not a new receivable
|
|---|
| 90 | . . I ORIGAMT="" S:RCRJFSTO ^TMP($J,"RCRJRCOL","COUNT",BILLDA,0)="" Q
|
|---|
| 91 | . . ; store for ndb
|
|---|
| 92 | . . I RCRJFSTO D SETTOTAL^RCRJRCO1(13,ORIGAMT,0)
|
|---|
| 93 | . . S COUNT=COUNT+1,PRINBAL=PRINBAL+ORIGAMT
|
|---|
| 94 | ;
|
|---|
| 95 | Q COUNT_"^"_PRINBAL
|
|---|
| 96 | ;
|
|---|
| 97 | ;
|
|---|
| 98 | TESTNEW(BILLDA,DATEBEG,DATEEND) ; test to see if a bill is a new receivable
|
|---|
| 99 | ; returns the principal balance if a bill is new
|
|---|
| 100 | N DATA0,STAT
|
|---|
| 101 | S DATA0=$G(^PRCA(430,BILLDA,0))
|
|---|
| 102 | ; no site
|
|---|
| 103 | I '$P(DATA0,"^",12) Q ""
|
|---|
| 104 | ; bill never had an original amount (prepayments would not be
|
|---|
| 105 | ; picked up here since they do not have an original amount)
|
|---|
| 106 | I $P(DATA0,"^",3)="" Q ""
|
|---|
| 107 | ;
|
|---|
| 108 | S STAT=$P(DATA0,"^",8)
|
|---|
| 109 | ; no status
|
|---|
| 110 | I 'STAT Q ""
|
|---|
| 111 | ; bill was cancelled the same month
|
|---|
| 112 | ;I STAT=26,($E($P(DATA0,"^",14),1,5)=$E(DATEBEG,1,5)) Q ""
|
|---|
| 113 | I STAT=26&($P(DATA0,"^",14)<DATEBEG!($P(DATA0,"^",14)>DATEEND)) Q ""
|
|---|
| 114 | ; bill incomplete
|
|---|
| 115 | I STAT=27 Q ""
|
|---|
| 116 | ; bill new
|
|---|
| 117 | I STAT=18 Q ""
|
|---|
| 118 | ; bill pending approval
|
|---|
| 119 | I STAT=20 Q ""
|
|---|
| 120 | ; bill returned from AR (new)
|
|---|
| 121 | I STAT=31 Q ""
|
|---|
| 122 | ;
|
|---|
| 123 | ; yes, its a new receivable, return its original amount
|
|---|
| 124 | Q +$P(DATA0,"^",3)
|
|---|
| 125 | ;
|
|---|
| 126 | ;
|
|---|
| 127 | CRITERIA(BILLDA) ; find a bills criteria/category 1,3,4,5
|
|---|
| 128 | ; returns 1--3-4-5 where the number is the criteria number
|
|---|
| 129 | ; the second piece is set at settotal^rcrjrco1
|
|---|
| 130 | ;
|
|---|
| 131 | N %,CRITER1,CRITER35,DATA0,X
|
|---|
| 132 | S DATA0=$G(^PRCA(430,BILLDA,0))
|
|---|
| 133 | ;
|
|---|
| 134 | ; % = segment
|
|---|
| 135 | S %=$P(DATA0,"^",21)
|
|---|
| 136 | 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)
|
|---|
| 137 | ;
|
|---|
| 138 | ; acck = accrual
|
|---|
| 139 | I CRITER1=8,'$$ACCK^PRCAACC(BILLDA) S CRITER1=18
|
|---|
| 140 | ;
|
|---|
| 141 | I 'CRITER1 D
|
|---|
| 142 | . S %=$P($G(^PRCA(430.2,+$P(DATA0,"^",2),0)),"^",7)
|
|---|
| 143 | . ; % = Category Number:
|
|---|
| 144 | . ; 22 TORT FEASOR
|
|---|
| 145 | . ; 18 SHARING AGREEMENTS
|
|---|
| 146 | . ; 33 PREPAYMENT
|
|---|
| 147 | . ; 40 ADULT DAY HEALTH CARE
|
|---|
| 148 | . ; 41 DOMICILIARY
|
|---|
| 149 | . ; 42 RESPITE CARE-INSTITUTIONAL
|
|---|
| 150 | . ; 43 RESPITE CARE-NON-INSTITUTIONAL
|
|---|
| 151 | . ; 44 GERIATRIC EVAL-INSTITUTIONAL
|
|---|
| 152 | . ; 45 GERIATRIC EVAL-NON-INSTITUTION
|
|---|
| 153 | . ; 46 NURSING HOME CARE-LTC
|
|---|
| 154 | . 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)
|
|---|
| 155 | ;
|
|---|
| 156 | ; determine criteria 3,4,5
|
|---|
| 157 | S CRITER35="0-0-0"
|
|---|
| 158 | I CRITER1>3,CRITER1<8 D
|
|---|
| 159 | . S %=$TR($$CRIT^IBRFN2(BILLDA),"^","-") ;integration agreement 1182
|
|---|
| 160 | . I %=-1 S CRITER35="3-1-4" Q
|
|---|
| 161 | . I $P(%,"-")="" S $P(%,"-")=3
|
|---|
| 162 | . I $P(%,"-",2)="" S $P(%,"-",2)=1
|
|---|
| 163 | . I $P(%,"-",3)="" S $P(%,"-",3)=4
|
|---|
| 164 | . S CRITER35=%
|
|---|
| 165 | ;
|
|---|
| 166 | Q CRITER1_"--"_CRITER35
|
|---|
