- 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 Feb 18, 2025@23:14:57 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)