RCRPU3.m

RCRPU3 ;EDE/YMG - REPAYMENT PLAN UTILITIES;11/01/2022  8:40 AM

 ;;4.5;Accounts Receivable;**389**;Mar 20, 1995;Build 36

 ;;Per VA Directive 6402, this routine should not be modified.

 ;

 Q

 ;

PMNTS(RPIEN) ; calculate the sum of payments made for a given RPP

 ;

 ; RPIEN - file 340.5 ien

 ;

 ; returns sum of payments in sub-file 340.53

 ;

 N PMDT,PMIEN,RES

 S RES=0

 S PMDT=0 F  S PMDT=$O(^RCRP(340.5,RPIEN,3,"B",PMDT)) Q:'PMDT  D

 .S PMIEN="" F  S PMIEN=+$O(^RCRP(340.5,RPIEN,3,"B",PMDT,PMIEN)) Q:'PMIEN  S RES=RES+$P($G(^RCRP(340.5,RPIEN,3,PMIEN,0)),U,2)

 .Q

 Q RES

 ;

CBAL(RPIEN,TOTAMNT) ; calculate current balance for a given RPP

 ;

 ; RPIEN - file 340.5 ien

 ; TOTAMNT - plan amount owed (340.5/.11), optional

 ;

 ; returns plan amount owed - sum of all payments

 ;

 N RES

 S RES=0

 I +$G(RPIEN)>0 D

 .S TOTAMNT=$G(TOTAMNT,$P($G(^RCRP(340.5,RPIEN,0)),U,11))

 .S RES=TOTAMNT-$$PMNTS(RPIEN)

 .Q

 Q RES

 ;

REMPMNTS(RPIEN,MNAMNT) ; calculate remaining payments for a given RPP

 ;

 ; RPIEN - file 340.5 ien

 ; MNAMNT - amount per month (340.5/.06), optional

 ;

 ; returns # of remaining payments

 ;

 N CBAL,RES

 S RES=0

 I +$G(RPIEN)>0 D

 .S MNAMNT=$G(MNAMNT,$P($G(^RCRP(340.5,RPIEN,0)),U,6))

 .S CBAL=$$CBAL(RPIEN)

 .S RES=CBAL\MNAMNT+$S(CBAL#MNAMNT:1,1:0)

 .Q

 Q RES

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RCRPU3   1319     printed  Apr 09, 2024@20:49:16                                                                                                                                                                                                      Page 2

RCRPU3    ;EDE/YMG - REPAYMENT PLAN UTILITIES;11/01/2022  8:40 AM

 +1       ;;4.5;Accounts Receivable;**389**;Mar 20, 1995;Build 36

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4        QUIT 

 +5       ;

PMNTS(RPIEN) ; calculate the sum of payments made for a given RPP

 +1       ;

 +2       ; RPIEN - file 340.5 ien

 +3       ;

 +4       ; returns sum of payments in sub-file 340.53

 +5       ;

 +6        NEW PMDT,PMIEN,RES

 +7        SET RES=0

 +8        SET PMDT=0

           FOR 

               SET PMDT=$ORDER(^RCRP(340.5,RPIEN,3,"B",PMDT))

               if 'PMDT

                   QUIT 

               Begin DoDot:1

 +9                SET PMIEN=""

                   FOR 

                       SET PMIEN=+$ORDER(^RCRP(340.5,RPIEN,3,"B",PMDT,PMIEN))

                       if 'PMIEN

                           QUIT 

                       SET RES=RES+$PIECE($GET(^RCRP(340.5,RPIEN,3,PMIEN,0)),U,2)

 +10               QUIT 

               End DoDot:1

 +11       QUIT RES

 +12      ;

CBAL(RPIEN,TOTAMNT) ; calculate current balance for a given RPP

 +1       ;

 +2       ; RPIEN - file 340.5 ien

 +3       ; TOTAMNT - plan amount owed (340.5/.11), optional

 +4       ;

 +5       ; returns plan amount owed - sum of all payments

 +6       ;

 +7        NEW RES

 +8        SET RES=0

 +9        IF +$GET(RPIEN)>0

               Begin DoDot:1

 +10               SET TOTAMNT=$GET(TOTAMNT,$PIECE($GET(^RCRP(340.5,RPIEN,0)),U,11))

 +11               SET RES=TOTAMNT-$$PMNTS(RPIEN)

 +12               QUIT 

               End DoDot:1

 +13       QUIT RES

 +14      ;

REMPMNTS(RPIEN,MNAMNT) ; calculate remaining payments for a given RPP

 +1       ;

 +2       ; RPIEN - file 340.5 ien

 +3       ; MNAMNT - amount per month (340.5/.06), optional

 +4       ;

 +5       ; returns # of remaining payments

 +6       ;

 +7        NEW CBAL,RES

 +8        SET RES=0

 +9        IF +$GET(RPIEN)>0

               Begin DoDot:1

 +10               SET MNAMNT=$GET(MNAMNT,$PIECE($GET(^RCRP(340.5,RPIEN,0)),U,6))

 +11               SET CBAL=$$CBAL(RPIEN)

 +12               SET RES=CBAL\MNAMNT+$SELECT(CBAL#MNAMNT:1,1:0)

 +13               QUIT 

               End DoDot:1

 +14       QUIT RES