RCRPWL1 ;EDE/YMG - REPAYMENT PLAN WORKLIST ACTIONS; 07/15/2021
;;4.5;Accounts Receivable;**389,423**;Mar 20, 1995;Build 8
;;Per VA Directive 6402, this routine should not be modified.
;
; List Manager actions for RCRP APPROVAL WORKLIST option
;
Q
;
AB ; add bills
N RPIEN,SEL,Z
D FULL^VALM1
D EN^VALM2($G(XQORNOD(0)),"S")
S SEL=$O(VALMY("")) I SEL,$D(@VALMAR@("IDX",SEL,SEL)) D
.S RPIEN=+$G(@VALMAR@("IDX",SEL,SEL)) I 'RPIEN W !!,"Invalid selection." Q
.I $$GET36^RCRPWLUT(RPIEN)'=1 W !!,"You can only add bills to an approved repayment plan." Q
.D EN1^RCRPADD(RPIEN)
.Q
S VALMBCK="R"
Q
;
AP ; account profile
N DBTR,RPIEN,SEL
D FULL^VALM1
D EN^VALM2($G(XQORNOD(0)),"S")
S SEL=$O(VALMY("")) I SEL,$D(@VALMAR@("IDX",SEL,SEL)) D
.S RPIEN=+$G(@VALMAR@("IDX",SEL,SEL)) I 'RPIEN W !!,"Invalid selection." Q
.S DBTR=$P(^RCRP(340.5,RPIEN,0),U,2)
.D EN1^PRCAAPR(DBTR)
.Q
S VALMBCK="R"
Q
;
CV ; change view
N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT
S VALMBCK="R"
D CLEAR^VALM1
I SUPER D
.S DIR("A")="Select (A)pproved plans, (D)enied plans, or plans that (R)equire review: "
.S DIR(0)="SA^A:Approved plans;D:Denied plans;R:Plans that require review"
.Q
I 'SUPER D
.S DIR("A")="Select (A)pproved plans or (D)enied plans: "
.S DIR(0)="SA^A:Approved plans;D:Denied plans"
.Q
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q
S VIEW=$S(Y="R":0,Y="A":1,1:2)
S VALMBG=1 D HDR^RCRPWL,BLD^RCRPWL
Q
;
ED ; edit terms
N RPIEN,SEL
D FULL^VALM1
D EN^VALM2($G(XQORNOD(0)),"S")
S SEL=$O(VALMY("")) I SEL,$D(@VALMAR@("IDX",SEL,SEL)) D
.S RPIEN=+$G(@VALMAR@("IDX",SEL,SEL)) I 'RPIEN W !!,"Invalid selection." Q
.I $$GET36^RCRPWLUT(RPIEN)'=2 W !!,"You can only edit terms of a denied repayment plan." Q
.D EDITPLAN^RCRPENTR(RPIEN)
.Q
S VALMBCK="R"
Q
;
EX ; export to Excel
N POP,ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
S VALMBCK="R"
D FULL^VALM1
K IOP,IO("Q")
S %ZIS="MQ",%ZIS("B")="",POP=0 D ^%ZIS Q:POP
I $D(IO("Q")) D Q ; queued output
.S ZTDESC="Repayment Plan Worklist Export",ZTRTN="EXPORT^RCRPWL1"
.S ZTSAVE("VIEW")="",ZTSAVE("ZTREQ")="@"
.D ^%ZTLOAD,HOME^%ZIS
.I $G(ZTSK) W !!,"Export has started with task# ",ZTSK,".",! D PAUSE^RCRPRPU
.Q
D EXPORT
D HOME^%ZIS
Q
;
EXPORT ; actual Excel export, called from tag EX
N AMNT,BAL,EXTDT,LN,N0,RPIEN,TERM
S EXTDT=$$FMTE^XLFDT(DT)
U IO
W !,"Repayment Plan Worklist Export",U,EXTDT,U,$S('VIEW:"Plans that require review",VIEW=1:"Approved plans",1:"Denied plans")
W !,"RPP ID^Debtor^Term Length^Monthly Payment^Current Balance"
I '$D(@VALMAR@("IDX")) W !,"No repayment plans found." G EXPORTX
S LN=0 F S LN=$O(@VALMAR@("IDX",LN)) Q:'LN D
.S RPIEN=@VALMAR@("IDX",LN,LN)
.S N0=$G(^RCRP(340.5,RPIEN,0))
.S AMNT=+$P(N0,U,6),BAL=$$CBAL^RCRPU3(RPIEN,$P(N0,U,11)),TERM=$$REMPMNTS^RCRPU3(RPIEN,AMNT) ; PRCA*4.5*423
.W !,$P(N0,U),U,$$EXTERNAL^DILFD(340.5,.02,,$P(N0,U,2)),U,TERM,U,$FN(AMNT,"",2),U,$FN(BAL,"",2) ; PRCA*4.5*423
.Q
EXPORTX ; exit point
U 0 I '$D(ZTQUEUED) D GOON^VALM1
Q
;
IN ; RPP inquiry
N RPIEN,SEL
D FULL^VALM1
D EN^VALM2($G(XQORNOD(0)),"S")
S SEL=$O(VALMY("")) I SEL,$D(@VALMAR@("IDX",SEL,SEL)) D
.S RPIEN=+$G(@VALMAR@("IDX",SEL,SEL)) I 'RPIEN W !!,"Invalid selection." Q
.D EN1^RCRPINQ(RPIEN)
.Q
S VALMBCK="R"
Q
;
RV ; review plan
N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT
N CURFLG,FLG,RPIEN,SEL
D FULL^VALM1
D EN^VALM2($G(XQORNOD(0)),"S")
S SEL=$O(VALMY("")) I SEL,$D(@VALMAR@("IDX",SEL,SEL)) D
.S RPIEN=+$G(@VALMAR@("IDX",SEL,SEL)) I 'RPIEN W !!,"Invalid selection." Q
.S DIR("A")="Please (A)pprove or (D)eny this repayment plan: "
.S DIR(0)="SA^A:Approve;D:Deny"
.D ^DIR
.I $D(DTOUT)!$D(DUOUT) Q
.S FLG=$S(Y="A":1,Y="D":2,1:"")
.S CURFLG=$$GET36^RCRPWLUT(RPIEN)
.I FLG>0 D
..I FLG=CURFLG W !!,"This plan has already been ",$S(CURFLG=1:"approved",1:"denied"),"." D GOON^VALM1 Q
..I CURFLG>0 Q:'$$RVCONF(FLG)
..D UPDFLG36^RCRPU1(RPIEN,FLG)
..D UPDAUDIT^RCRPU2(RPIEN,DT,"E",$S(FLG=1:"SM",1:"SD"),"")
..D:FLG=2 MSGDEN^RCRPWLUT(RPIEN)
..D CLEAR^VALM1,BLD^RCRPWL
..Q
.Q
S VALMBCK="R"
Q
;
RVCONF(RVFLG) ; prompt to confirm supervisor approval/denial
;
; RVFLG - 1 for approval, 2 for denial
;
; returns 1 if user confirms, 0 otherwise
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
I RVFLG'>0 Q
S DIR(0)="Y"
S DIR("A")="This plan has been "_$S(RVFLG=1:"denied",1:"approved")_". Do you wish to continue with "_$S(RVFLG=2:"denial",1:"approval")_"? (Y/N)"
D ^DIR
Q $S(+Y<1:0,1:1)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRPWL1 4537 printed Dec 13, 2024@01:48:33 Page 2
RCRPWL1 ;EDE/YMG - REPAYMENT PLAN WORKLIST ACTIONS; 07/15/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 ; List Manager actions for RCRP APPROVAL WORKLIST option
+5 ;
+6 QUIT
+7 ;
AB ; add bills
+1 NEW RPIEN,SEL,Z
+2 DO FULL^VALM1
+3 DO EN^VALM2($GET(XQORNOD(0)),"S")
+4 SET SEL=$ORDER(VALMY(""))
IF SEL
IF $DATA(@VALMAR@("IDX",SEL,SEL))
Begin DoDot:1
+5 SET RPIEN=+$GET(@VALMAR@("IDX",SEL,SEL))
IF 'RPIEN
WRITE !!,"Invalid selection."
QUIT
+6 IF $$GET36^RCRPWLUT(RPIEN)'=1
WRITE !!,"You can only add bills to an approved repayment plan."
QUIT
+7 DO EN1^RCRPADD(RPIEN)
+8 QUIT
End DoDot:1
+9 SET VALMBCK="R"
+10 QUIT
+11 ;
AP ; account profile
+1 NEW DBTR,RPIEN,SEL
+2 DO FULL^VALM1
+3 DO EN^VALM2($GET(XQORNOD(0)),"S")
+4 SET SEL=$ORDER(VALMY(""))
IF SEL
IF $DATA(@VALMAR@("IDX",SEL,SEL))
Begin DoDot:1
+5 SET RPIEN=+$GET(@VALMAR@("IDX",SEL,SEL))
IF 'RPIEN
WRITE !!,"Invalid selection."
QUIT
+6 SET DBTR=$PIECE(^RCRP(340.5,RPIEN,0),U,2)
+7 DO EN1^PRCAAPR(DBTR)
+8 QUIT
End DoDot:1
+9 SET VALMBCK="R"
+10 QUIT
+11 ;
CV ; change view
+1 NEW X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT
+2 SET VALMBCK="R"
+3 DO CLEAR^VALM1
+4 IF SUPER
Begin DoDot:1
+5 SET DIR("A")="Select (A)pproved plans, (D)enied plans, or plans that (R)equire review: "
+6 SET DIR(0)="SA^A:Approved plans;D:Denied plans;R:Plans that require review"
+7 QUIT
End DoDot:1
+8 IF 'SUPER
Begin DoDot:1
+9 SET DIR("A")="Select (A)pproved plans or (D)enied plans: "
+10 SET DIR(0)="SA^A:Approved plans;D:Denied plans"
+11 QUIT
End DoDot:1
+12 DO ^DIR
+13 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+14 SET VIEW=$SELECT(Y="R":0,Y="A":1,1:2)
+15 SET VALMBG=1
DO HDR^RCRPWL
DO BLD^RCRPWL
+16 QUIT
+17 ;
ED ; edit terms
+1 NEW RPIEN,SEL
+2 DO FULL^VALM1
+3 DO EN^VALM2($GET(XQORNOD(0)),"S")
+4 SET SEL=$ORDER(VALMY(""))
IF SEL
IF $DATA(@VALMAR@("IDX",SEL,SEL))
Begin DoDot:1
+5 SET RPIEN=+$GET(@VALMAR@("IDX",SEL,SEL))
IF 'RPIEN
WRITE !!,"Invalid selection."
QUIT
+6 IF $$GET36^RCRPWLUT(RPIEN)'=2
WRITE !!,"You can only edit terms of a denied repayment plan."
QUIT
+7 DO EDITPLAN^RCRPENTR(RPIEN)
+8 QUIT
End DoDot:1
+9 SET VALMBCK="R"
+10 QUIT
+11 ;
EX ; export to Excel
+1 NEW POP,ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
+2 SET VALMBCK="R"
+3 DO FULL^VALM1
+4 KILL IOP,IO("Q")
+5 SET %ZIS="MQ"
SET %ZIS("B")=""
SET POP=0
DO ^%ZIS
if POP
QUIT
+6 ; queued output
IF $DATA(IO("Q"))
Begin DoDot:1
+7 SET ZTDESC="Repayment Plan Worklist Export"
SET ZTRTN="EXPORT^RCRPWL1"
+8 SET ZTSAVE("VIEW")=""
SET ZTSAVE("ZTREQ")="@"
+9 DO ^%ZTLOAD
DO HOME^%ZIS
+10 IF $GET(ZTSK)
WRITE !!,"Export has started with task# ",ZTSK,".",!
DO PAUSE^RCRPRPU
+11 QUIT
End DoDot:1
QUIT
+12 DO EXPORT
+13 DO HOME^%ZIS
+14 QUIT
+15 ;
EXPORT ; actual Excel export, called from tag EX
+1 NEW AMNT,BAL,EXTDT,LN,N0,RPIEN,TERM
+2 SET EXTDT=$$FMTE^XLFDT(DT)
+3 USE IO
+4 WRITE !,"Repayment Plan Worklist Export",U,EXTDT,U,$SELECT('VIEW:"Plans that require review",VIEW=1:"Approved plans",1:"Denied plans")
+5 WRITE !,"RPP ID^Debtor^Term Length^Monthly Payment^Current Balance"
+6 IF '$DATA(@VALMAR@("IDX"))
WRITE !,"No repayment plans found."
GOTO EXPORTX
+7 SET LN=0
FOR
SET LN=$ORDER(@VALMAR@("IDX",LN))
if 'LN
QUIT
Begin DoDot:1
+8 SET RPIEN=@VALMAR@("IDX",LN,LN)
+9 SET N0=$GET(^RCRP(340.5,RPIEN,0))
+10 ; 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)
+11 ; PRCA*4.5*423
WRITE !,$PIECE(N0,U),U,$$EXTERNAL^DILFD(340.5,.02,,$PIECE(N0,U,2)),U,TERM,U,$FNUMBER(AMNT,"",2),U,$FNUMBER(BAL,"",2)
+12 QUIT
End DoDot:1
EXPORTX ; exit point
+1 USE 0
IF '$DATA(ZTQUEUED)
DO GOON^VALM1
+2 QUIT
+3 ;
IN ; RPP inquiry
+1 NEW RPIEN,SEL
+2 DO FULL^VALM1
+3 DO EN^VALM2($GET(XQORNOD(0)),"S")
+4 SET SEL=$ORDER(VALMY(""))
IF SEL
IF $DATA(@VALMAR@("IDX",SEL,SEL))
Begin DoDot:1
+5 SET RPIEN=+$GET(@VALMAR@("IDX",SEL,SEL))
IF 'RPIEN
WRITE !!,"Invalid selection."
QUIT
+6 DO EN1^RCRPINQ(RPIEN)
+7 QUIT
End DoDot:1
+8 SET VALMBCK="R"
+9 QUIT
+10 ;
RV ; review plan
+1 NEW X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT
+2 NEW CURFLG,FLG,RPIEN,SEL
+3 DO FULL^VALM1
+4 DO EN^VALM2($GET(XQORNOD(0)),"S")
+5 SET SEL=$ORDER(VALMY(""))
IF SEL
IF $DATA(@VALMAR@("IDX",SEL,SEL))
Begin DoDot:1
+6 SET RPIEN=+$GET(@VALMAR@("IDX",SEL,SEL))
IF 'RPIEN
WRITE !!,"Invalid selection."
QUIT
+7 SET DIR("A")="Please (A)pprove or (D)eny this repayment plan: "
+8 SET DIR(0)="SA^A:Approve;D:Deny"
+9 DO ^DIR
+10 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+11 SET FLG=$SELECT(Y="A":1,Y="D":2,1:"")
+12 SET CURFLG=$$GET36^RCRPWLUT(RPIEN)
+13 IF FLG>0
Begin DoDot:2
+14 IF FLG=CURFLG
WRITE !!,"This plan has already been ",$SELECT(CURFLG=1:"approved",1:"denied"),"."
DO GOON^VALM1
QUIT
+15 IF CURFLG>0
if '$$RVCONF(FLG)
QUIT
+16 DO UPDFLG36^RCRPU1(RPIEN,FLG)
+17 DO UPDAUDIT^RCRPU2(RPIEN,DT,"E",$SELECT(FLG=1:"SM",1:"SD"),"")
+18 if FLG=2
DO MSGDEN^RCRPWLUT(RPIEN)
+19 DO CLEAR^VALM1
DO BLD^RCRPWL
+20 QUIT
End DoDot:2
+21 QUIT
End DoDot:1
+22 SET VALMBCK="R"
+23 QUIT
+24 ;
RVCONF(RVFLG) ; prompt to confirm supervisor approval/denial
+1 ;
+2 ; RVFLG - 1 for approval, 2 for denial
+3 ;
+4 ; returns 1 if user confirms, 0 otherwise
+5 ;
+6 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+7 IF RVFLG'>0
QUIT
+8 SET DIR(0)="Y"
+9 SET DIR("A")="This plan has been "_$SELECT(RVFLG=1:"denied",1:"approved")_". Do you wish to continue with "_$SELECT(RVFLG=2:"denial",1:"approval")_"? (Y/N)"
+10 DO ^DIR
+11 QUIT $SELECT(+Y<1:0,1:1)
