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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAI162 9890 printed Apr 09, 2024@20:52:31 Page 2
PRCAI162 ;WISC/RFJ-post init patch 162 ;4 Oct 00
+1 ;;4.5;Accounts Receivable;**162**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
START ; start post init
+1 DO BMES^XPDUTL(" >> Adding a time to exempted interest/admin transactions ...")
+2 ;
+3 NEW %,DATA1,RCDATE,RCDAY,RCTRANDA,RCTRDATE
+4 ;
+5 ; get the sites statement day
+6 SET RCDAY=+$PIECE($GET(^RC(342,1,0)),"^",11)
IF 'RCDAY
QUIT
+7 IF $LENGTH(RCDAY)=1
SET RCDAY="0"_RCDAY
+8 ;
+9 ; start with june 2000 and loop each date to make sure
+10 ; the time is entered on exempt transactions. this date
+11 ; is the same as the date interest and admin charges are
+12 ; added (statement date minus 3 days). if a charge is
+13 ; exempted on the same day, make sure there is a time.
+14 FOR RCDATE=30006:1:30012
Begin DoDot:1
+15 SET RCTRDATE=$$FMADD^XLFDT(RCDATE_RCDAY,-3)
+16 ;
+17 ; loop transaction on the date
+18 SET RCTRANDA=0
FOR
SET RCTRANDA=$ORDER(^PRCA(433,"AT",14,RCTRDATE,RCTRANDA))
if 'RCTRANDA
QUIT
Begin DoDot:2
+19 SET DATA1=$GET(^PRCA(433,RCTRANDA,1))
+20 IF $PIECE($PIECE(DATA1,"^",9),".",2)=""
SET %=$$EDIT433^RCBEUTRA(RCTRANDA,"19////"_RCTRDATE_".2359;")
End DoDot:2
End DoDot:1
+21 ;
+22 DO BMES^XPDUTL(" >> Fixing RC DOJ CODE field on payment transactions ...")
+23 ;
+24 ; loop payment transactions and fix RC DOJ CODE field 7, file 433
+25 NEW PAYTYPE,RCDATE,RCRECTDA,RCTRAN,RCTRANDA,RCTYPE
+26 FOR RCTRAN=2,34
SET RCDATE=0
FOR
SET RCDATE=$ORDER(^PRCA(433,"AT",RCTRAN,RCDATE))
if 'RCDATE
QUIT
Begin DoDot:1
+27 SET RCTRANDA=0
FOR
SET RCTRANDA=$ORDER(^PRCA(433,"AT",RCTRAN,RCDATE,RCTRANDA))
if 'RCTRANDA
QUIT
Begin DoDot:2
+28 ; get the type of payment
+29 SET RCTYPE=$PIECE($GET(^PRCA(433,RCTRANDA,0)),"^",7)
+30 ; type of payment does not exist or is correct
+31 IF RCTYPE=""
QUIT
+32 IF RCTYPE="DC"!(RCTYPE="DOJ")!(RCTYPE="IRS")!(RCTYPE="RC")!(RCTYPE="TOP")
QUIT
+33 ; check to see if it is set as the receipt number, if not quit
+34 SET RCRECTDA=$ORDER(^RCY(344,"B",RCTYPE,0))
IF 'RCRECTDA
QUIT
+35 ; get the type of payment on the receipt
+36 SET PAYTYPE=$PIECE($GET(^RCY(344,RCRECTDA,0)),"^",4)
+37 ; set the transaction type of payment
+38 SET RCTYPE=""
+39 IF PAYTYPE=3
SET RCTYPE="RC"
+40 IF PAYTYPE=5
SET RCTYPE="DOJ"
+41 IF PAYTYPE=11
SET RCTYPE="IRS"
+42 IF PAYTYPE=13
SET RCTYPE="TOP"
+43 SET $PIECE(^PRCA(433,RCTRANDA,0),"^",7)=RCTYPE
End DoDot:2
End DoDot:1
+44 ;
+45 DO REPAY
+46 QUIT
+47 ;
+48 ;
REPAY ; fix repayment plans
+1 DO BMES^XPDUTL(" >> Fixing Repayment Plans ...")
+2 ;
+3 NEW 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
+4 KILL ^TMP("PRCAI162",$JOB)
+5 ;
+6 DO MES^XPDUTL(" ...looping payment transactions.")
+7 ; loop all payment transactions and build a list of repayments by bill
+8 ; and by date paid
+9 FOR RCTRAN=2,34
SET RCDATE=0
FOR
SET RCDATE=$ORDER(^PRCA(433,"AT",RCTRAN,RCDATE))
if 'RCDATE
QUIT
Begin DoDot:1
+10 SET RCTRANDA=0
FOR
SET RCTRANDA=$ORDER(^PRCA(433,"AT",RCTRAN,RCDATE,RCTRANDA))
if 'RCTRANDA
QUIT
Begin DoDot:2
+11 ; get the bill for the payment
+12 SET RCBILLDA=+$PIECE($GET(^PRCA(433,RCTRANDA,0)),"^",2)
IF 'RCBILLDA
QUIT
+13 ;
+14 ; get the repayment data
+15 IF '$ORDER(^PRCA(430,RCBILLDA,5,0))
QUIT
+16 SET DATA4=$GET(^PRCA(430,RCBILLDA,4))
+17 SET REPAYAMT=+$PIECE(DATA4,"^",3)
IF 'REPAYAMT
QUIT
+18 SET REPAYDAT=+$PIECE($PIECE(DATA4,"^"),".")
IF 'REPAYDAT
QUIT
+19 ; verify the payment date after repayment plan established
+20 IF RCDATE<REPAYDAT
QUIT
+21 ; verify the paid amount is less than the repayment amount
+22 SET RCAMT=+$PIECE($GET(^PRCA(433,RCTRANDA,1)),"^",5)
IF RCAMT<REPAYAMT
QUIT
+23 ;
+24 SET ^TMP("PRCAI162",$JOB,RCBILLDA,RCDATE,RCTRANDA)=RCAMT
End DoDot:2
End DoDot:1
+25 ;
+26 ; this is used to store data to generate the mailman message
+27 KILL ^TMP("PRCAI162REPAY")
+28 ;
+29 DO MES^XPDUTL(" ...fixing repayment plan payment errors.")
+30 ;
+31 ; loop the payments stored by bill and date paid and build an array
+32 ; of repayments in rcpay(count)
+33 SET RCBILLDA=0
FOR
SET RCBILLDA=$ORDER(^TMP("PRCAI162",$JOB,RCBILLDA))
if 'RCBILLDA
QUIT
Begin DoDot:1
+34 SET REPAYAMT=+$PIECE($GET(^PRCA(430,RCBILLDA,4)),"^",3)
+35 KILL RCPAY
+36 SET COUNT=0
+37 SET RCDATE=0
FOR
SET RCDATE=$ORDER(^TMP("PRCAI162",$JOB,RCBILLDA,RCDATE))
if 'RCDATE
QUIT
Begin DoDot:2
+38 SET RCTRANDA=0
FOR
SET RCTRANDA=$ORDER(^TMP("PRCAI162",$JOB,RCBILLDA,RCDATE,RCTRANDA))
if 'RCTRANDA
QUIT
Begin DoDot:3
+39 SET RCPAYAMT=^TMP("PRCAI162",$JOB,RCBILLDA,RCDATE,RCTRANDA)
+40 FOR
Begin DoDot:4
+41 SET COUNT=COUNT+1
SET RCPAY(COUNT)=RCTRANDA
+42 SET RCPAYAMT=RCPAYAMT-REPAYAMT
End DoDot:4
if RCPAYAMT<REPAYAMT
QUIT
End DoDot:3
End DoDot:2
+43 ;
+44 ; now loop the repayments and make sure they match the rcpay(count)
+45 ; array of repayments against the bill
+46 SET RCREPDA=0
FOR COUNT=1:1
SET RCREPDA=$ORDER(^PRCA(430,RCBILLDA,5,RCREPDA))
if 'RCREPDA
QUIT
Begin DoDot:2
+47 SET DATA0=$GET(^PRCA(430,RCBILLDA,5,RCREPDA,0))
IF DATA0=""
QUIT
+48 ; if no payments left, the repayment plan should no longer
+49 ; show payments being received
+50 IF '$DATA(RCPAY(COUNT))
Begin DoDot:3
+51 IF $PIECE(DATA0,"^",2)'=0!($PIECE(DATA0,"^",4)'="")
SET $PIECE(DATA0,"^",2)=0
SET $PIECE(DATA0,"^",4)=""
DO SET(DATA0)
End DoDot:3
QUIT
+52 ;
+53 ; payment recorded on wrong transaction
+54 IF $PIECE(DATA0,"^",2)=1
IF $PIECE(DATA0,"^",4)'=RCPAY(COUNT)
Begin DoDot:3
+55 SET $PIECE(DATA0,"^",4)=RCPAY(COUNT)
DO SET(DATA0)
End DoDot:3
QUIT
+56 ;
+57 ; payment not shown as being made
+58 IF $PIECE(DATA0,"^",2)=0
IF $PIECE(DATA0,"^",4)'=RCPAY(COUNT)
Begin DoDot:3
+59 SET $PIECE(DATA0,"^",2)=1
SET $PIECE(DATA0,"^",4)=RCPAY(COUNT)
DO SET(DATA0)
+60 ;
+61 ;
+62 ; check for int/admin charges applied after the payment transaction received
+63 ; this is used to build the mailman message showing potential problems
+64 SET RCSTOP=0
+65 SET RCTRANDA=RCPAY(COUNT)
FOR
SET RCTRANDA=$ORDER(^PRCA(433,"C",RCBILLDA,RCTRANDA))
if 'RCTRANDA
QUIT
Begin DoDot:4
+66 ; only look at the int/admin charges after 8/1/2000
+67 IF $PIECE($GET(^PRCA(433,RCTRANDA,1)),"^",9)<3000801
QUIT
+68 ; found an interest/admin charge
+69 IF $PIECE($GET(^PRCA(433,RCTRANDA,1)),"^",2)=13
Begin DoDot:5
+70 SET DATA2=$GET(^PRCA(433,RCTRANDA,2))
+71 SET ^TMP("PRCAI162REPAY",RCBILLDA,RCTRANDA,"IA")=$PIECE(DATA2,"^",7)_"^"_$PIECE(DATA2,"^",8)
+72 SET RCSTOP=1
+73 ;
+74 ; get the next payment transaction
+75 SET RCSTOP1=0
+76 SET RCTRANDB=RCTRANDA
FOR
SET RCTRANDB=$ORDER(^PRCA(433,"C",RCBILLDA,RCTRANDB))
if 'RCTRANDB
QUIT
Begin DoDot:6
+77 SET TYPE=$PIECE($GET(^PRCA(433,RCTRANDB,1)),"^",2)
+78 IF TYPE=2!(TYPE=34)
Begin DoDot:7
+79 SET DATA3=$GET(^PRCA(433,RCTRANDB,3))
+80 SET ^TMP("PRCAI162REPAY",RCBILLDA,RCTRANDA,"PA")=$PIECE(DATA3,"^",2)_"^"_$PIECE(DATA3,"^",3)_"^"_RCTRANDB
+81 SET RCSTOP1=1
End DoDot:7
End DoDot:6
IF RCSTOP1
QUIT
End DoDot:5
End DoDot:4
IF RCSTOP
QUIT
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+82 ;
+83 DO MES^XPDUTL(" ...generating mailman message to G.RCDP PAYMENTS.")
+84 ;
+85 ; generate mailman message to user
+86 KILL ^TMP($JOB,"RCRJRCORMM")
+87 SET ^TMP($JOB,"RCRJRCORMM",1)="The following bills need to be reviewed. The interest and"
+88 SET ^TMP($JOB,"RCRJRCORMM",2)="admin charges shown below may need to be exempted. The"
+89 SET ^TMP($JOB,"RCRJRCORMM",3)="payments shown below may require a decrease to the principal"
+90 SET ^TMP($JOB,"RCRJRCORMM",4)="on the bill and a modification to FMS. Interest is reported"
+91 SET ^TMP($JOB,"RCRJRCORMM",5)="to FMS in fund 1435 and admin in fund 3220. The Revenue"
+92 SET ^TMP($JOB,"RCRJRCORMM",6)="Source Code has been included for the bill to help in creating"
+93 SET ^TMP($JOB,"RCRJRCORMM",7)="a transfer from 1435 or 3220 to fund 5287."
+94 SET ^TMP($JOB,"RCRJRCORMM",8)=" "
+95 ;
+96 SET ^TMP($JOB,"RCRJRCORMM",9)="BILL# RSC TRANS# DATE TYPE "_$JUSTIFY("INTEREST",8)_$JUSTIFY("ADMIN",8)
+97 SET ^TMP($JOB,"RCRJRCORMM",10)="-----------------------------------------------------------------------------"
+98 SET LINE=10
+99 ;
+100 SET RCBILLDA=0
FOR
SET RCBILLDA=$ORDER(^TMP("PRCAI162REPAY",RCBILLDA))
if 'RCBILLDA
QUIT
Begin DoDot:1
+101 ; get the revenue source code
+102 SET RSC=$$CALCRSC^RCXFMSUR(RCBILLDA)
+103 SET LINE=LINE+1
SET ^TMP($JOB,"RCRJRCORMM",LINE)=" "
+104 SET COUNT=0
+105 SET RCTRANDA=0
FOR
SET RCTRANDA=$ORDER(^TMP("PRCAI162REPAY",RCBILLDA,RCTRANDA))
if 'RCTRANDA
QUIT
Begin DoDot:2
+106 SET INTADM=$GET(^TMP("PRCAI162REPAY",RCBILLDA,RCTRANDA,"IA"))
+107 SET PAYAMT=$GET(^TMP("PRCAI162REPAY",RCBILLDA,RCTRANDA,"PA"))
+108 ;
+109 ; first time bill is displayed
+110 IF COUNT=0
SET DATA=$EXTRACT($PIECE(^PRCA(430,RCBILLDA,0),"^")_" ",1,12)_$EXTRACT(RSC_" ",1,6)
+111 IF '$TEST
SET DATA=" "_" "
+112 SET COUNT=1
+113 ;
+114 SET DATA=DATA_$EXTRACT(RCTRANDA_" ",1,12)
+115 SET DATE=$PIECE($GET(^PRCA(433,RCTRANDA,1)),"^",9)
IF DATE=""
SET DATE=" "
+116 SET DATA=DATA_$EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3)_" "
+117 SET DATA=DATA_"Interest/Admin Charge"
+118 SET DATA=DATA_$JUSTIFY($PIECE(INTADM,"^"),8,2)_$JUSTIFY($PIECE(INTADM,"^",2),8,2)
+119 SET LINE=LINE+1
SET ^TMP($JOB,"RCRJRCORMM",LINE)=DATA
+120 ; if payment, show it also
+121 IF PAYAMT'=""
Begin DoDot:3
+122 SET DATA=" "_" "
+123 SET DATA=DATA_$EXTRACT($PIECE(PAYAMT,"^",3)_" ",1,12)
+124 SET DATE=$PIECE($GET(^PRCA(433,$PIECE(PAYAMT,"^",3),1)),"^",9)
IF DATE=""
SET DATE=" "
+125 SET DATA=DATA_$EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3)_" "
+126 SET DATA=DATA_"Payment "
+127 SET DATA=DATA_$JUSTIFY($PIECE(PAYAMT,"^"),8,2)_$JUSTIFY($PIECE(PAYAMT,"^",2),8,2)
+128 SET LINE=LINE+1
SET ^TMP($JOB,"RCRJRCORMM",LINE)=DATA
End DoDot:3
End DoDot:2
End DoDot:1
+129 ;
+130 IF LINE=10
SET ^TMP($JOB,"RCRJRCORMM",11)="<<No Bills Or Transactions Found For You to Review>>"
+131 ;
+132 ; send mail message
+133 ; need to be newed or mailman will not deliver the message
NEW DIFROM
+134 SET XMY("G.RCDP PAYMENTS")=""
+135 SET XMY(.5)=""
+136 SET XMY(DUZ)=""
+137 SET XMZ=$$SENDMSG^RCRJRCOR("AR Patch 162 Interest/Admin Transactions",.XMY)
+138 KILL ^TMP($JOB,"RCRJRCORMM")
+139 KILL ^TMP("PRCAI162",$JOB),^TMP("PRCAI162REPAY",$JOB)
+140 QUIT
+141 ;
+142 ;
SET(DATA0) ; set the repayment plan data node
+1 SET ^PRCA(430,RCBILLDA,5,RCREPDA,0)=DATA0
+2 QUIT
