| [613] | 1 | PRCAI16A ;WISC/RFJ-post init patch 169 continued ; 1 Apr 01
|
|---|
| 2 | ;;4.5;Accounts Receivable;**169**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | START ; start post init (fix exempt transactions)
|
|---|
| 8 | ; break out the exempt transaction to interest and admin
|
|---|
| 9 | N RCDATE,RCTRANDA
|
|---|
| 10 | ;
|
|---|
| 11 | ; start finding exempt transactions and fixing them
|
|---|
| 12 | S RCDATE=9999999 F S RCDATE=$O(^PRCA(433,"AT",14,RCDATE),-1) Q:'RCDATE D
|
|---|
| 13 | . S RCTRANDA=999999999999999
|
|---|
| 14 | . F S RCTRANDA=$O(^PRCA(433,"AT",14,RCDATE,RCTRANDA),-1) Q:'RCTRANDA D FIXEXEM(RCTRANDA)
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | ;
|
|---|
| 18 | FIXEXEM(RCTRANDA) ; fix an exempt charge
|
|---|
| 19 | ; if transaction status not valid, quit
|
|---|
| 20 | I '$$VALID^RCRJRCOT(RCTRANDA) Q
|
|---|
| 21 | ;
|
|---|
| 22 | N ADMIN,BALANCE,CC,INTEREST,MF,RCBALANC,RCBILLDA,RCDATA7,RCLIST,TRANTOTL
|
|---|
| 23 | ;
|
|---|
| 24 | L +^PRCA(433,RCTRANDA)
|
|---|
| 25 | ;
|
|---|
| 26 | ; if node 2 already breaks out the int/admin, quit
|
|---|
| 27 | I $G(^PRCA(433,RCTRANDA,2))'="" L -^PRCA(433,RCTRANDA) Q
|
|---|
| 28 | ;
|
|---|
| 29 | S RCBILLDA=$P(^PRCA(433,RCTRANDA,0),"^",2)
|
|---|
| 30 | ; no bill on transaction
|
|---|
| 31 | I 'RCBILLDA L -^PRCA(433,RCTRANDA) Q
|
|---|
| 32 | ;
|
|---|
| 33 | ; lock the bill and get the current bill balance
|
|---|
| 34 | L +^PRCA(430,RCBILLDA)
|
|---|
| 35 | S RCBALANC=$$GETTRANS^RCDPBTLM(RCBILLDA)
|
|---|
| 36 | S TRANTOTL=$P(^PRCA(433,RCTRANDA,1),"^",5) I 'TRANTOTL D UNLOCK Q
|
|---|
| 37 | ;
|
|---|
| 38 | ; if the bill is in balance and the balance is zero,
|
|---|
| 39 | ; make the transaction all interest
|
|---|
| 40 | I $TR($P(RCBALANC,"^",2,5),"^0")="",$$OUTOFBAL^RCBDBBAL(RCBILLDA)="" S $P(^PRCA(433,RCTRANDA,2),"^",7)=TRANTOTL D UNLOCK Q
|
|---|
| 41 | ;
|
|---|
| 42 | ; if the interest balance is equal to the admin balance and
|
|---|
| 43 | ; the interest balance is zero, move to admin
|
|---|
| 44 | I $P(RCBALANC,"^",2)<0,-$P(RCBALANC,"^",2)=$P(RCBALANC,"^",3) D Q
|
|---|
| 45 | . S ADMIN=$P(RCBALANC,"^",3) I ADMIN>TRANTOTL S ADMIN=TRANTOTL
|
|---|
| 46 | . S INTEREST=TRANTOTL-ADMIN
|
|---|
| 47 | . S (MF,CC)=0
|
|---|
| 48 | . D SET
|
|---|
| 49 | ;
|
|---|
| 50 | ; if the stored interest balance minus the calculated
|
|---|
| 51 | ; interest balance is equal to the transaction total
|
|---|
| 52 | ; of the exemption, then the exemption is
|
|---|
| 53 | ; for all admin.
|
|---|
| 54 | S RCDATA7=$P($G(^PRCA(430,RCBILLDA,7)),"^",1,5)
|
|---|
| 55 | I ($P(RCDATA7,"^",2)-$P(RCBALANC,"^",2))=TRANTOTL D Q
|
|---|
| 56 | . S (INTEREST,MF,CC)=0
|
|---|
| 57 | . S ADMIN=TRANTOTL D SET
|
|---|
| 58 | ;
|
|---|
| 59 | ; calculate the bills balance up to the exempt transaction
|
|---|
| 60 | S BALANCE=$$CALCBAL(0,RCTRANDA-1)
|
|---|
| 61 | ;
|
|---|
| 62 | S (INTEREST,ADMIN,MF,CC)=""
|
|---|
| 63 | S INTEREST=$P(BALANCE,"^",2) I INTEREST<0 S INTEREST=0
|
|---|
| 64 | I INTEREST'<TRANTOTL S INTEREST=TRANTOTL D SET Q
|
|---|
| 65 | ;
|
|---|
| 66 | S ADMIN=$P(BALANCE,"^",3) I ADMIN<0 S ADMIN=0
|
|---|
| 67 | I (INTEREST+ADMIN)'<TRANTOTL S ADMIN=TRANTOTL-INTEREST D SET Q
|
|---|
| 68 | ;
|
|---|
| 69 | S MF=$P(BALANCE,"^",4) I MF<0 S MF=0
|
|---|
| 70 | I (INTEREST+ADMIN+MF)'<TRANTOTL S MF=TRANTOTL-INTEREST-ADMIN D SET Q
|
|---|
| 71 | ;
|
|---|
| 72 | S CC=$P(BALANCE,"^",5) I CC<0 S CC=0
|
|---|
| 73 | I (INTEREST+ADMIN+MF+CC)'<TRANTOTL S CC=TRANTOTL-INTEREST-ADMIN-MF D SET Q
|
|---|
| 74 | ;
|
|---|
| 75 | ; set as all interest
|
|---|
| 76 | S INTEREST=TRANTOTL,(ADMIN,MF,CC)="" D SET
|
|---|
| 77 | Q
|
|---|
| 78 | ;
|
|---|
| 79 | ;
|
|---|
| 80 | SET ; set the exempt node
|
|---|
| 81 | N DATA2
|
|---|
| 82 | S DATA2=$G(^PRCA(433,RCTRANDA,2))
|
|---|
| 83 | I INTEREST S $P(DATA2,"^",7)=INTEREST
|
|---|
| 84 | I ADMIN S $P(DATA2,"^",8)=ADMIN
|
|---|
| 85 | I MF S $P(DATA2,"^",5)=MF
|
|---|
| 86 | I CC S $P(DATA2,"^",6)=CC
|
|---|
| 87 | S ^PRCA(433,RCTRANDA,2)=DATA2
|
|---|
| 88 | D UNLOCK
|
|---|
| 89 | Q
|
|---|
| 90 | ;
|
|---|
| 91 | ;
|
|---|
| 92 | UNLOCK ; unlock the transaction and bill
|
|---|
| 93 | L -^PRCA(433,RCTRANDA)
|
|---|
| 94 | L -^PRCA(430,RCBILLDA)
|
|---|
| 95 | Q
|
|---|
| 96 | ;
|
|---|
| 97 | ;
|
|---|
| 98 | CALCBAL(RCDATE,RCTRANDA) ; calculate a bills balance
|
|---|
| 99 | ; up to a certain date and/or transaction
|
|---|
| 100 | ; rclist(date,tranda) must be defined from calling
|
|---|
| 101 | ; gettrans^rcdpbtlm
|
|---|
| 102 | ;
|
|---|
| 103 | I 'RCDATE N RCDATE S RCDATE=9999999
|
|---|
| 104 | I 'RCTRANDA N RCTRANDA S RCTRANDA=999999999999999
|
|---|
| 105 | ;
|
|---|
| 106 | N ADMBAL,CCBAL,DATE,INTBAL,MFBAL,PRINBAL,TRANDA,RCSTOP
|
|---|
| 107 | S (PRINBAL,INTBAL,ADMBAL,MFBAL,CCBAL)=0
|
|---|
| 108 | ;
|
|---|
| 109 | S DATE="" F S DATE=$O(RCLIST(DATE)) Q:DATE=""!($G(RCSTOP)) D
|
|---|
| 110 | . I $E(DATE,1,7)>$E(RCDATE,1,7) S RCSTOP=1 Q
|
|---|
| 111 | . ;
|
|---|
| 112 | . S TRANDA="" F S TRANDA=$O(RCLIST(DATE,TRANDA)) Q:TRANDA="" D
|
|---|
| 113 | . . I TRANDA>RCTRANDA S RCSTOP=1 Q
|
|---|
| 114 | . . ;
|
|---|
| 115 | . . S PRINBAL=PRINBAL+$P(RCLIST(DATE,TRANDA),"^",2)
|
|---|
| 116 | . . S INTBAL=INTBAL+$P(RCLIST(DATE,TRANDA),"^",3)
|
|---|
| 117 | . . S ADMBAL=ADMBAL+$P(RCLIST(DATE,TRANDA),"^",4)
|
|---|
| 118 | . . S MFBAL=MFBAL+$P(RCLIST(DATE,TRANDA),"^",5)
|
|---|
| 119 | . . S CCBAL=CCBAL+$P(RCLIST(DATE,TRANDA),"^",6)
|
|---|
| 120 | ;
|
|---|
| 121 | Q PRINBAL_"^"_INTBAL_"^"_ADMBAL_"^"_MFBAL_"^"_CCBAL
|
|---|
