RCRPWL ;EDE/YMG - REPAYMENT PLAN WORKLIST; 07/14/2021
;;4.5;Accounts Receivable;**389,423**;Mar 20, 1995;Build 8
;;Per VA Directive 6402, this routine should not be modified.
;
; This is the main screen for RCRP APPROVAL WORKLIST option
;
Q
;
EN ; entry point
N HASREC,SUPER,VIEW
S SUPER=$S($D(^XUSEC("PRCA RPP SUPER",DUZ)):1,1:0)
S VIEW=$S(SUPER:0,1:2) ; current view - 0 for plans that require review, 1 for approved plans, 2 for denied plans
; load list template
D EN^VALM("PRCA RPP WORKLIST")
Q
;
HDR ; header
S VALMHDR(1)="Current view: "_$S('VIEW:"Plans that require review",VIEW=1:"Approved plans",1:"Denied plans")
S VALMHDR(2)=""
Q
;
INIT ; init variables and list array
S VALMBG=1
D BLD
Q
;
HELP ; help
D FULL^VALM1
W @IOF
W !,"This screen lists repayment plans with term length greater than 36 months that"
W !,"either require supervisor's review, or have that approval denied."
W !,"It also allows users with PRCA RPP SUPER security key to review and"
W !,"subsequently approve / deny such plans."
W !
S VALMBCK="R"
Q
;
EXIT ; exit point
;
D CLEAN^VALM10
D CLEAR^VALM1
Q
;
BLD ; build list of RPPs for display
N RPIEN
D CLEAN^VALM10 S VALMCNT=0
W !!,"Working..."
S RPIEN=0 F S RPIEN=$O(^RCRP(340.5,"F",VIEW,RPIEN)) Q:'RPIEN D
.S VALMCNT=$$BLDLN(VALMCNT,RPIEN)
.I '(VALMCNT#10) W "."
.Q
S HASREC=1 I VALMCNT=0 S HASREC=0,VALMCNT=$$NOREC()
Q
;
NOREC() ; show message when display list is empty
; returns line count in the created array
;
D SET^VALM10(1,"")
D SET^VALM10(2,"")
D SET^VALM10(3,$$SETSTR^VALM1("No repayment plans found.","",28,25))
Q 3
;
BLDLN(LNUM,RPIEN) ; build one line to display
; LNUM - last line number
; RPIEN - ien in file 340.5
;
; returns current line number
;
N AMNT,BAL,DEBTOR,LINE,LN,N0,TERM
S N0=$G(^RCRP(340.5,RPIEN,0)) I N0="" Q LNUM
I "^6^7^8^"[(U_$P(N0,U,7)_U) Q LNUM ; skip plans in "closed", "paid in full", and "terminated" status
S LINE="",LN=LNUM+1
S DEBTOR=$$EXTERNAL^DILFD(340.5,.02,,$P(N0,U,2))
S AMNT=+$P(N0,U,6),BAL=$$CBAL^RCRPU3(RPIEN,$P(N0,U,11)),TERM=$$REMPMNTS^RCRPU3(RPIEN,AMNT) ; PRCA*4.5*423
S LINE=$$SETSTR^VALM1(LN,LINE,1,3)
S LINE=$$SETFLD^VALM1($P(N0,U),LINE,"RPPID")
S LINE=$$SETFLD^VALM1($E(DEBTOR,1,20),LINE,"DEBTOR")
S LINE=$$SETFLD^VALM1($$CJ^XLFSTR($S(TERM>0:TERM,1:"N/A"),4),LINE,"TERM")
S LINE=$$SETFLD^VALM1($$CJ^XLFSTR($S(AMNT>0:"$"_$FN(AMNT,"",2),1:"N/A"),9),LINE,"AMOUNT")
S LINE=$$SETFLD^VALM1($$CJ^XLFSTR($S(BAL>0:"$"_$FN(BAL,"",2),1:"N/A"),9),LINE,"BALANCE")
D SET^VALM10(LN,LINE,LN)
S @VALMAR@("IDX",LN,LN)=RPIEN
Q LN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRPWL 2660 printed Apr 09, 2024@20:50:38 Page 2
RCRPWL ;EDE/YMG - REPAYMENT PLAN WORKLIST; 07/14/2021
+1 ;;4.5;Accounts Receivable;**389,423**;Mar 20, 1995;Build 8
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; This is the main screen for RCRP APPROVAL WORKLIST option
+5 ;
+6 QUIT
+7 ;
EN ; entry point
+1 NEW HASREC,SUPER,VIEW
+2 SET SUPER=$SELECT($DATA(^XUSEC("PRCA RPP SUPER",DUZ)):1,1:0)
+3 ; current view - 0 for plans that require review, 1 for approved plans, 2 for denied plans
SET VIEW=$SELECT(SUPER:0,1:2)
+4 ; load list template
+5 DO EN^VALM("PRCA RPP WORKLIST")
+6 QUIT
+7 ;
HDR ; header
+1 SET VALMHDR(1)="Current view: "_$SELECT('VIEW:"Plans that require review",VIEW=1:"Approved plans",1:"Denied plans")
+2 SET VALMHDR(2)=""
+3 QUIT
+4 ;
INIT ; init variables and list array
+1 SET VALMBG=1
+2 DO BLD
+3 QUIT
+4 ;
HELP ; help
+1 DO FULL^VALM1
+2 WRITE @IOF
+3 WRITE !,"This screen lists repayment plans with term length greater than 36 months that"
+4 WRITE !,"either require supervisor's review, or have that approval denied."
+5 WRITE !,"It also allows users with PRCA RPP SUPER security key to review and"
+6 WRITE !,"subsequently approve / deny such plans."
+7 WRITE !
+8 SET VALMBCK="R"
+9 QUIT
+10 ;
EXIT ; exit point
+1 ;
+2 DO CLEAN^VALM10
+3 DO CLEAR^VALM1
+4 QUIT
+5 ;
BLD ; build list of RPPs for display
+1 NEW RPIEN
+2 DO CLEAN^VALM10
SET VALMCNT=0
+3 WRITE !!,"Working..."
+4 SET RPIEN=0
FOR
SET RPIEN=$ORDER(^RCRP(340.5,"F",VIEW,RPIEN))
if 'RPIEN
QUIT
Begin DoDot:1
+5 SET VALMCNT=$$BLDLN(VALMCNT,RPIEN)
+6 IF '(VALMCNT#10)
WRITE "."
+7 QUIT
End DoDot:1
+8 SET HASREC=1
IF VALMCNT=0
SET HASREC=0
SET VALMCNT=$$NOREC()
+9 QUIT
+10 ;
NOREC() ; show message when display list is empty
+1 ; returns line count in the created array
+2 ;
+3 DO SET^VALM10(1,"")
+4 DO SET^VALM10(2,"")
+5 DO SET^VALM10(3,$$SETSTR^VALM1("No repayment plans found.","",28,25))
+6 QUIT 3
+7 ;
BLDLN(LNUM,RPIEN) ; build one line to display
+1 ; LNUM - last line number
+2 ; RPIEN - ien in file 340.5
+3 ;
+4 ; returns current line number
+5 ;
+6 NEW AMNT,BAL,DEBTOR,LINE,LN,N0,TERM
+7 SET N0=$GET(^RCRP(340.5,RPIEN,0))
IF N0=""
QUIT LNUM
+8 ; skip plans in "closed", "paid in full", and "terminated" status
IF "^6^7^8^"[(U_$PIECE(N0,U,7)_U)
QUIT LNUM
+9 SET LINE=""
SET LN=LNUM+1
+10 SET DEBTOR=$$EXTERNAL^DILFD(340.5,.02,,$PIECE(N0,U,2))
+11 ; PRCA*4.5*423
SET AMNT=+$PIECE(N0,U,6)
SET BAL=$$CBAL^RCRPU3(RPIEN,$PIECE(N0,U,11))
SET TERM=$$REMPMNTS^RCRPU3(RPIEN,AMNT)
+12 SET LINE=$$SETSTR^VALM1(LN,LINE,1,3)
+13 SET LINE=$$SETFLD^VALM1($PIECE(N0,U),LINE,"RPPID")
+14 SET LINE=$$SETFLD^VALM1($EXTRACT(DEBTOR,1,20),LINE,"DEBTOR")
+15 SET LINE=$$SETFLD^VALM1($$CJ^XLFSTR($SELECT(TERM>0:TERM,1:"N/A"),4),LINE,"TERM")
+16 SET LINE=$$SETFLD^VALM1($$CJ^XLFSTR($SELECT(AMNT>0:"$"_$FNUMBER(AMNT,"",2),1:"N/A"),9),LINE,"AMOUNT")
+17 SET LINE=$$SETFLD^VALM1($$CJ^XLFSTR($SELECT(BAL>0:"$"_$FNUMBER(BAL,"",2),1:"N/A"),9),LINE,"BALANCE")
+18 DO SET^VALM10(LN,LINE,LN)
+19 SET @VALMAR@("IDX",LN,LN)=RPIEN
+20 QUIT LN
