202 lines
9.5 KiB
Mathematica
202 lines
9.5 KiB
Mathematica
PRCAI162 ;WISC/RFJ-post init patch 162 ;4 Oct 00
|
|
;;4.5;Accounts Receivable;**162**;Mar 20, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
Q
|
|
;
|
|
;
|
|
START ; start post init
|
|
D BMES^XPDUTL(" >> Adding a time to exempted interest/admin transactions ...")
|
|
;
|
|
N %,DATA1,RCDATE,RCDAY,RCTRANDA,RCTRDATE
|
|
;
|
|
; get the sites statement day
|
|
S RCDAY=+$P($G(^RC(342,1,0)),"^",11) I 'RCDAY Q
|
|
I $L(RCDAY)=1 S RCDAY="0"_RCDAY
|
|
;
|
|
; start with june 2000 and loop each date to make sure
|
|
; the time is entered on exempt transactions. this date
|
|
; is the same as the date interest and admin charges are
|
|
; added (statement date minus 3 days). if a charge is
|
|
; exempted on the same day, make sure there is a time.
|
|
F RCDATE=30006:1:30012 D
|
|
. S RCTRDATE=$$FMADD^XLFDT(RCDATE_RCDAY,-3)
|
|
. ;
|
|
. ; loop transaction on the date
|
|
. S RCTRANDA=0 F S RCTRANDA=$O(^PRCA(433,"AT",14,RCTRDATE,RCTRANDA)) Q:'RCTRANDA D
|
|
. . S DATA1=$G(^PRCA(433,RCTRANDA,1))
|
|
. . I $P($P(DATA1,"^",9),".",2)="" S %=$$EDIT433^RCBEUTRA(RCTRANDA,"19////"_RCTRDATE_".2359;")
|
|
;
|
|
D BMES^XPDUTL(" >> Fixing RC DOJ CODE field on payment transactions ...")
|
|
;
|
|
; loop payment transactions and fix RC DOJ CODE field 7, file 433
|
|
N PAYTYPE,RCDATE,RCRECTDA,RCTRAN,RCTRANDA,RCTYPE
|
|
F RCTRAN=2,34 S RCDATE=0 F S RCDATE=$O(^PRCA(433,"AT",RCTRAN,RCDATE)) Q:'RCDATE D
|
|
. S RCTRANDA=0 F S RCTRANDA=$O(^PRCA(433,"AT",RCTRAN,RCDATE,RCTRANDA)) Q:'RCTRANDA D
|
|
. . ; get the type of payment
|
|
. . S RCTYPE=$P($G(^PRCA(433,RCTRANDA,0)),"^",7)
|
|
. . ; type of payment does not exist or is correct
|
|
. . I RCTYPE="" Q
|
|
. . I RCTYPE="DC"!(RCTYPE="DOJ")!(RCTYPE="IRS")!(RCTYPE="RC")!(RCTYPE="TOP") Q
|
|
. . ; check to see if it is set as the receipt number, if not quit
|
|
. . S RCRECTDA=$O(^RCY(344,"B",RCTYPE,0)) I 'RCRECTDA Q
|
|
. . ; get the type of payment on the receipt
|
|
. . S PAYTYPE=$P($G(^RCY(344,RCRECTDA,0)),"^",4)
|
|
. . ; set the transaction type of payment
|
|
. . S RCTYPE=""
|
|
. . I PAYTYPE=3 S RCTYPE="RC"
|
|
. . I PAYTYPE=5 S RCTYPE="DOJ"
|
|
. . I PAYTYPE=11 S RCTYPE="IRS"
|
|
. . I PAYTYPE=13 S RCTYPE="TOP"
|
|
. . S $P(^PRCA(433,RCTRANDA,0),"^",7)=RCTYPE
|
|
;
|
|
D REPAY
|
|
Q
|
|
;
|
|
;
|
|
REPAY ; fix repayment plans
|
|
D BMES^XPDUTL(" >> Fixing Repayment Plans ...")
|
|
;
|
|
N COUNT,DATA,DATA0,DATA2,DATA3,DATA4,DATE,INTADM,LINE,PAYAMT,RCAMT,RCDATE,RCBILLDA,RCPAY,RCPAYAMT,RCREPDA,RCSTOP,RCSTOP1,RCTRAN,RCTRANDA,RCTRANDB,REPAYAMT,REPAYDAT,RSC,TYPE,XMDUN,XMY,XMZ
|
|
K ^TMP("PRCAI162",$J)
|
|
;
|
|
D MES^XPDUTL(" ...looping payment transactions.")
|
|
; loop all payment transactions and build a list of repayments by bill
|
|
; and by date paid
|
|
F RCTRAN=2,34 S RCDATE=0 F S RCDATE=$O(^PRCA(433,"AT",RCTRAN,RCDATE)) Q:'RCDATE D
|
|
. S RCTRANDA=0 F S RCTRANDA=$O(^PRCA(433,"AT",RCTRAN,RCDATE,RCTRANDA)) Q:'RCTRANDA D
|
|
. . ; get the bill for the payment
|
|
. . S RCBILLDA=+$P($G(^PRCA(433,RCTRANDA,0)),"^",2) I 'RCBILLDA Q
|
|
. . ;
|
|
. . ; get the repayment data
|
|
. . I '$O(^PRCA(430,RCBILLDA,5,0)) Q
|
|
. . S DATA4=$G(^PRCA(430,RCBILLDA,4))
|
|
. . S REPAYAMT=+$P(DATA4,"^",3) I 'REPAYAMT Q
|
|
. . S REPAYDAT=+$P($P(DATA4,"^"),".") I 'REPAYDAT Q
|
|
. . ; verify the payment date after repayment plan established
|
|
. . I RCDATE<REPAYDAT Q
|
|
. . ; verify the paid amount is less than the repayment amount
|
|
. . S RCAMT=+$P($G(^PRCA(433,RCTRANDA,1)),"^",5) I RCAMT<REPAYAMT Q
|
|
. . ;
|
|
. . S ^TMP("PRCAI162",$J,RCBILLDA,RCDATE,RCTRANDA)=RCAMT
|
|
;
|
|
; this is used to store data to generate the mailman message
|
|
K ^TMP("PRCAI162REPAY")
|
|
;
|
|
D MES^XPDUTL(" ...fixing repayment plan payment errors.")
|
|
;
|
|
; loop the payments stored by bill and date paid and build an array
|
|
; of repayments in rcpay(count)
|
|
S RCBILLDA=0 F S RCBILLDA=$O(^TMP("PRCAI162",$J,RCBILLDA)) Q:'RCBILLDA D
|
|
. S REPAYAMT=+$P($G(^PRCA(430,RCBILLDA,4)),"^",3)
|
|
. K RCPAY
|
|
. S COUNT=0
|
|
. S RCDATE=0 F S RCDATE=$O(^TMP("PRCAI162",$J,RCBILLDA,RCDATE)) Q:'RCDATE D
|
|
. . S RCTRANDA=0 F S RCTRANDA=$O(^TMP("PRCAI162",$J,RCBILLDA,RCDATE,RCTRANDA)) Q:'RCTRANDA D
|
|
. . . S RCPAYAMT=^TMP("PRCAI162",$J,RCBILLDA,RCDATE,RCTRANDA)
|
|
. . . F D Q:RCPAYAMT<REPAYAMT
|
|
. . . . S COUNT=COUNT+1,RCPAY(COUNT)=RCTRANDA
|
|
. . . . S RCPAYAMT=RCPAYAMT-REPAYAMT
|
|
. ;
|
|
. ; now loop the repayments and make sure they match the rcpay(count)
|
|
. ; array of repayments against the bill
|
|
. S RCREPDA=0 F COUNT=1:1 S RCREPDA=$O(^PRCA(430,RCBILLDA,5,RCREPDA)) Q:'RCREPDA D
|
|
. . S DATA0=$G(^PRCA(430,RCBILLDA,5,RCREPDA,0)) I DATA0="" Q
|
|
. . ; if no payments left, the repayment plan should no longer
|
|
. . ; show payments being received
|
|
. . I '$D(RCPAY(COUNT)) D Q
|
|
. . . I $P(DATA0,"^",2)'=0!($P(DATA0,"^",4)'="") S $P(DATA0,"^",2)=0,$P(DATA0,"^",4)="" D SET(DATA0)
|
|
. . ;
|
|
. . ; payment recorded on wrong transaction
|
|
. . I $P(DATA0,"^",2)=1,$P(DATA0,"^",4)'=RCPAY(COUNT) D Q
|
|
. . . S $P(DATA0,"^",4)=RCPAY(COUNT) D SET(DATA0)
|
|
. . ;
|
|
. . ; payment not shown as being made
|
|
. . I $P(DATA0,"^",2)=0,$P(DATA0,"^",4)'=RCPAY(COUNT) D Q
|
|
. . . S $P(DATA0,"^",2)=1,$P(DATA0,"^",4)=RCPAY(COUNT) D SET(DATA0)
|
|
. . . ;
|
|
. . . ;
|
|
. . . ; check for int/admin charges applied after the payment transaction received
|
|
. . . ; this is used to build the mailman message showing potential problems
|
|
. . . S RCSTOP=0
|
|
. . . S RCTRANDA=RCPAY(COUNT) F S RCTRANDA=$O(^PRCA(433,"C",RCBILLDA,RCTRANDA)) Q:'RCTRANDA D I RCSTOP Q
|
|
. . . . ; only look at the int/admin charges after 8/1/2000
|
|
. . . . I $P($G(^PRCA(433,RCTRANDA,1)),"^",9)<3000801 Q
|
|
. . . . ; found an interest/admin charge
|
|
. . . . I $P($G(^PRCA(433,RCTRANDA,1)),"^",2)=13 D
|
|
. . . . . S DATA2=$G(^PRCA(433,RCTRANDA,2))
|
|
. . . . . S ^TMP("PRCAI162REPAY",RCBILLDA,RCTRANDA,"IA")=$P(DATA2,"^",7)_"^"_$P(DATA2,"^",8)
|
|
. . . . . S RCSTOP=1
|
|
. . . . . ;
|
|
. . . . . ; get the next payment transaction
|
|
. . . . . S RCSTOP1=0
|
|
. . . . . S RCTRANDB=RCTRANDA F S RCTRANDB=$O(^PRCA(433,"C",RCBILLDA,RCTRANDB)) Q:'RCTRANDB D I RCSTOP1 Q
|
|
. . . . . . S TYPE=$P($G(^PRCA(433,RCTRANDB,1)),"^",2)
|
|
. . . . . . I TYPE=2!(TYPE=34) D
|
|
. . . . . . . S DATA3=$G(^PRCA(433,RCTRANDB,3))
|
|
. . . . . . . S ^TMP("PRCAI162REPAY",RCBILLDA,RCTRANDA,"PA")=$P(DATA3,"^",2)_"^"_$P(DATA3,"^",3)_"^"_RCTRANDB
|
|
. . . . . . . S RCSTOP1=1
|
|
;
|
|
D MES^XPDUTL(" ...generating mailman message to G.RCDP PAYMENTS.")
|
|
;
|
|
; generate mailman message to user
|
|
K ^TMP($J,"RCRJRCORMM")
|
|
S ^TMP($J,"RCRJRCORMM",1)="The following bills need to be reviewed. The interest and"
|
|
S ^TMP($J,"RCRJRCORMM",2)="admin charges shown below may need to be exempted. The"
|
|
S ^TMP($J,"RCRJRCORMM",3)="payments shown below may require a decrease to the principal"
|
|
S ^TMP($J,"RCRJRCORMM",4)="on the bill and a modification to FMS. Interest is reported"
|
|
S ^TMP($J,"RCRJRCORMM",5)="to FMS in fund 1435 and admin in fund 3220. The Revenue"
|
|
S ^TMP($J,"RCRJRCORMM",6)="Source Code has been included for the bill to help in creating"
|
|
S ^TMP($J,"RCRJRCORMM",7)="a transfer from 1435 or 3220 to fund 5287."
|
|
S ^TMP($J,"RCRJRCORMM",8)=" "
|
|
;
|
|
S ^TMP($J,"RCRJRCORMM",9)="BILL# RSC TRANS# DATE TYPE "_$J("INTEREST",8)_$J("ADMIN",8)
|
|
S ^TMP($J,"RCRJRCORMM",10)="-----------------------------------------------------------------------------"
|
|
S LINE=10
|
|
;
|
|
S RCBILLDA=0 F S RCBILLDA=$O(^TMP("PRCAI162REPAY",RCBILLDA)) Q:'RCBILLDA D
|
|
. ; get the revenue source code
|
|
. S RSC=$$CALCRSC^RCXFMSUR(RCBILLDA)
|
|
. S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE)=" "
|
|
. S COUNT=0
|
|
. S RCTRANDA=0 F S RCTRANDA=$O(^TMP("PRCAI162REPAY",RCBILLDA,RCTRANDA)) Q:'RCTRANDA D
|
|
. . S INTADM=$G(^TMP("PRCAI162REPAY",RCBILLDA,RCTRANDA,"IA"))
|
|
. . S PAYAMT=$G(^TMP("PRCAI162REPAY",RCBILLDA,RCTRANDA,"PA"))
|
|
. . ;
|
|
. . ; first time bill is displayed
|
|
. . I COUNT=0 S DATA=$E($P(^PRCA(430,RCBILLDA,0),"^")_" ",1,12)_$E(RSC_" ",1,6)
|
|
. . E S DATA=" "_" "
|
|
. . S COUNT=1
|
|
. . ;
|
|
. . S DATA=DATA_$E(RCTRANDA_" ",1,12)
|
|
. . S DATE=$P($G(^PRCA(433,RCTRANDA,1)),"^",9) I DATE="" S DATE=" "
|
|
. . S DATA=DATA_$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)_" "
|
|
. . S DATA=DATA_"Interest/Admin Charge"
|
|
. . S DATA=DATA_$J($P(INTADM,"^"),8,2)_$J($P(INTADM,"^",2),8,2)
|
|
. . S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE)=DATA
|
|
. . ; if payment, show it also
|
|
. . I PAYAMT'="" D
|
|
. . . S DATA=" "_" "
|
|
. . . S DATA=DATA_$E($P(PAYAMT,"^",3)_" ",1,12)
|
|
. . . S DATE=$P($G(^PRCA(433,$P(PAYAMT,"^",3),1)),"^",9) I DATE="" S DATE=" "
|
|
. . . S DATA=DATA_$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)_" "
|
|
. . . S DATA=DATA_"Payment "
|
|
. . . S DATA=DATA_$J($P(PAYAMT,"^"),8,2)_$J($P(PAYAMT,"^",2),8,2)
|
|
. . . S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE)=DATA
|
|
;
|
|
I LINE=10 S ^TMP($J,"RCRJRCORMM",11)="<<No Bills Or Transactions Found For You to Review>>"
|
|
;
|
|
; send mail message
|
|
N DIFROM ; need to be newed or mailman will not deliver the message
|
|
S XMY("G.RCDP PAYMENTS")=""
|
|
S XMY(.5)=""
|
|
S XMY(DUZ)=""
|
|
S XMZ=$$SENDMSG^RCRJRCOR("AR Patch 162 Interest/Admin Transactions",.XMY)
|
|
K ^TMP($J,"RCRJRCORMM")
|
|
K ^TMP("PRCAI162",$J),^TMP("PRCAI162REPAY",$J)
|
|
Q
|
|
;
|
|
;
|
|
SET(DATA0) ; set the repayment plan data node
|
|
S ^PRCA(430,RCBILLDA,5,RCREPDA,0)=DATA0
|
|
Q
|