- 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 23, 2025@17:54:26 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
