PRCAP377 ;EDE/YMG - PRCA*4.5*377 POST INSTALL; 12/04/20
;;4.5;Accounts Receivable;**377**;Mar 20, 1995;Build 45
;Per VA Directive 6402, this routine should not be modified.
Q
;
EN ; entry point
D BMES^XPDUTL(" >> Start of the Post-Installation routine for PRCA*4.5*377")
; Add 2 new entries to the Transaction Type file
D UPD4303
; Initialize the Repayment Plan Process field in the Transaction Type File
D ADDRPP
; convert repayment plans in file 430 to entries in file 340.5
D CONVERT
D BMES^XPDUTL(" >> End of the Post-Installation routine for PRCA*4.5*377")
Q
;
CONVERT ; convert repayment plans in file 430 to entries in file 340.5
N AMNT,BILL,CAT,CNT,DEBTOR,FDA,FDAIEN,IENS,N0,N4,N15,NEWTOT,NUMPMNT,RCRPIEN,REFDMC,REFTOP,RPPCNT,RPPID,STARTDT,TOTAL,Z
D MES^XPDUTL("Converting existing repayment plans...")
K ^TMP("PRCAP377",$J)
S (CNT,RPPCNT)=0
; loop through AR bills with ACTIVE status
S BILL=0 F S BILL=$O(^PRCA(430,"AC",16,BILL)) Q:BILL="" D
.S N0=^PRCA(430,BILL,0),CAT=+$P(N0,U,2) I CAT'>0 Q
.S TOTAL=$$BALANCE^RCRPRPU(BILL) I TOTAL'>0 Q ; skip if total balance is 0
.S N4=$G(^PRCA(430,BILL,4)) I N4="" Q ; skip if node 4 in file 430 is blank - no repayment plan
.I +$P(N4,U,5)>0 Q ; skip if 430/45 is populated - this entry has been converted already
.S N15=$G(^PRCA(430,BILL,15))
.I +$P(N15,U)>0,$P(N15,U,3)="" Q ; skip if bill was referred to TSCP and was not recalled
.S DEBTOR=+$P($G(^PRCA(430,BILL,0)),U,9) ; file 340 ien
.I '$$GET1^DIQ(430.2,CAT_",",1.06,"I") D Q ; skip if not eligible for RPP and add to exception report
..S ^TMP("PRCAP377",$J,"CAT",DEBTOR,BILL)=CAT ; AR category - ien in file 430.2
..Q
.S RCRPIEN=+$O(^RCRP(340.5,"E",DEBTOR,""))
.S AMNT=+$P(N4,U,3) I 'AMNT Q
.S CNT=CNT+1 I '$D(ZTQUEUED) W:CNT#500=0 "."
.S STARTDT=$$GETSTART^RCRPU(DT)
.I 'RCRPIEN D
..; no entry in 340.5, create new plan
..S Z="000000"_($P($G(^RCRP(340.5,0)),U,3)+1)
..S RPPID=$$GETID^RCRPU(DEBTOR)_$E(Z,$L(Z)-5,$L(Z))
..S FDA(340.5,"+1,",.01)=RPPID ; RPP ID
..S FDA(340.5,"+1,",.02)=DEBTOR ; ptr to file 340
..S FDA(340.5,"+1,",.03)=DT ; creation date
..S FDA(340.5,"+1,",.04)=STARTDT ; start date
..S FDA(340.5,"+1,",.06)=AMNT ; amount per month (from 430/43)
..S FDA(340.5,"+1,",.07)=2 ; status (set to "current")
..S FDA(340.5,"+1,",.08)=DT ; status date
..S FDA(340.5,"+1,",.09)=0 ; # of forbearances
..D UPDATE^DIE("","FDA","FDAIEN")
..S RCRPIEN=FDAIEN(1) K FDAIEN I 'RCRPIEN Q
..D NEWAUDT(RCRPIEN) ; update sub-file 340.54
..D UPDDBTR^RCRPU(RCRPIEN,DEBTOR) ; update debtor file (340)
..S RPPCNT=RPPCNT+1
..S ^TMP("PRCAP377",$J,"CNV",RCRPIEN)=RPPID_U_DEBTOR
..Q
.; skip bills with monthly amount that differs from the rest of repayment plan, add them to exception report
.I AMNT'=$P(^RCRP(340.5,RCRPIEN,0),U,6) D Q
..I '$D(^TMP("PRCAP377",$J,"AMNT")) S ^TMP("PRCAP377",$J,"AMNT")=$P(^RCRP(340.5,RCRPIEN,0),U,6) ; monthly amount in repayment plan
..S ^TMP("PRCAP377",$J,"AMNT",DEBTOR,BILL)=AMNT ; monthly amount for this bill
..Q
.; if bill was referred to TOP or DMC, add it to TOP/DMC report
.S REFDMC=+$P($G(^PRCA(430,BILL,12)),U)
.S REFTOP=+$P($G(^PRCA(430,BILL,14)),U)
.I REFTOP!REFDMC S ^TMP("PRCAP377",$J,"REF",DEBTOR,RCRPIEN,BILL)=$S(REFTOP:"TOP",1:"DMC")
.;
.D UPDBILL^RCRPU(RCRPIEN,BILL) ; update sub-file 340.56
.; update fields 430/41 and 430/45
.S IENS=BILL_","
.S FDA(430,IENS,41)=DT
.S FDA(430,IENS,45)=RCRPIEN
.D FILE^DIE("","FDA")
.; add new transaction to file 433
.D TRAN^RCRPU(BILL,TOTAL,67)
.; update field 340.5/.11 (plan amount owed)
.S FDA(340.5,RCRPIEN_",",.11)=TOTAL+$P(^RCRP(340.5,RCRPIEN,0),U,11) D FILE^DIE("","FDA")
.; update schedule (sub-file 340.52)
.I AMNT D
..S NEWTOT=$P(^RCRP(340.5,RCRPIEN,0),U,11)
..S NUMPMNT=NEWTOT\AMNT I NEWTOT#AMNT S NUMPMNT=NUMPMNT+1 ; # of payments (amount owed / amount per month, rounded up)
..D UPDSCHED(RCRPIEN,+$P(^RCRP(340.5,RCRPIEN,0),U,5),NUMPMNT,$S('$D(^RCRP(340.5,RCRPIEN,2)):STARTDT,1:""))
..; update # of payments
..S FDA(340.5,RCRPIEN_",",.05)=NUMPMNT D FILE^DIE("","FDA")
..Q
.Q
D MES^XPDUTL(" Done.")
D MSG(CNT,RPPCNT),MSG1,MSG2
K ^TMP("PRCAP377",$J)
Q
;
UPDSCHED(RCIEN,RCORLN,RCNEWLN,RCSTDT) ; Update RPP schedule.
;
; RCRPIEN - IEN of the Repayment Plan being adjusted
; RCORLN - Original Term Length of the payments
; RCNEWLN - New Term Length
; RCSTDT - Plan start date (required for initial schedule, optional for adjustments)
;
N DA,DIK,RCFLG,RCLP,RCLP1,RCPD,RCSUB
;
S RCSTDT=$G(RCSTDT)
S RCFLG=0
; Find the last date by looking for the last entry and grabbing the first piece.
I RCSTDT="" S RCSTDT=$P($G(^RCRP(340.5,RCIEN,2,RCORLN,0)),U,1),RCFLG=1
; Clear RPP Temp array
K ^TMP("RCRPP",$J)
;find all of the payments paid, stop on the first unpaid.
S RCLP=0 F S RCLP=$O(^RCRP(340.5,RCIEN,2,RCLP)) Q:'RCLP S RCPD=$P($G(^RCRP(340.5,RCIEN,2,RCLP,0)),U,2) Q:'RCPD
; Count the new remaining payment out.
S RCLP1=RCLP+RCNEWLN-1 ;first missing payment + new length of payment - 1 for the first missing payment)
; remove the remaining payments from schedule
F S RCLP1=$O(^RCRP(340.5,RCIEN,2,RCLP1)) Q:'RCLP1 D
.S DA(1)=RCIEN,DA=RCLP1,DIK="^RCRP(340.5,"_DA(1)_",2,"
.D ^DIK K DA,DIK
.Q
; add new payments to schedule.
D BLDPLN^RCRPU(RCSTDT,(RCNEWLN-RCORLN),RCFLG)
; Add the new months to the Schedule
; Update the Schedule Node
S RCSUB=0 F S RCSUB=$O(^TMP("RCRPP",$J,"PLAN",RCSUB)) Q:'RCSUB D UPDSCHED^RCRPU(RCIEN,RCSUB)
; Clear temp array
K ^TMP("RCRPP",$J)
;
Q
;
NEWAUDT(RCRPIEN) ; create new entry in sub-file 340.54
;
; RCRPIEN - file 340.5 ien
;
N FDA,IENS
S IENS="+1,"_RCRPIEN_","
S FDA(340.54,IENS,.01)=DT ; date of change
S FDA(340.54,IENS,1)="N" ; type of change = "NEW"
S FDA(340.54,IENS,2)=.5 ; who changed = POSTMASTER
S FDA(340.54,IENS,3)="N" ; comment = "NEW PLAN"
D UPDATE^DIE("","FDA")
Q
;
MSG(BILCNT,RPPCNT) ; send Mailman notification for # of bills converted
;
; BILCNT - number of converted bills
; RPPCNT - number of repayment plans created
;
N BAL,CNT,DEBTOR,DIFROM,IENS,RPIEN,RPPID,SSN,STAT,XMDUZ,XMMG,XMSUB,XMTEXT,XMY,Z
D MES^XPDUTL("Sending conversion message...")
S CNT=1,^TMP("PRCAP377",$J,"MSG",CNT)="Conversion of existing repayment plans has been completed"
S CNT=CNT+1,^TMP("PRCAP377",$J,"MSG",CNT)="Total number of repayment plans created: "_RPPCNT
S CNT=CNT+1,^TMP("PRCAP377",$J,"MSG",CNT)="Total number of bills converted: "_BILCNT
S CNT=CNT+1,^TMP("PRCAP377",$J,"MSG",CNT)=""
;
I RPPCNT>0 D
.S CNT=CNT+1,^TMP("PRCAP377",$J,"MSG",CNT)="The following repayment plans have been created:"
.S CNT=CNT+1,^TMP("PRCAP377",$J,"MSG",CNT)=""
.S CNT=CNT+1,^TMP("PRCAP377",$J,"MSG",CNT)="Repayment Plan ID Debtor SSN Status Balance"
.S CNT=CNT+1,^TMP("PRCAP377",$J,"MSG",CNT)="-------------------------------------------------------------------------------"
.S RPIEN="" F S RPIEN=$O(^TMP("PRCAP377",$J,"CNV",RPIEN)) Q:RPIEN="" D
..S Z=$G(^TMP("PRCAP377",$J,"CNV",RPIEN)),RPPID=$P(Z,U),DEBTOR=$P(Z,U,2)
..S IENS=RPIEN_",",STAT=$$GET1^DIQ(340.5,IENS,.07),BAL=$$GET1^DIQ(340.5,IENS,.11)
..S Z=$$SSN^RCFN01(DEBTOR),SSN=$E(Z,$L(Z)-3,$L(Z)) I SSN'>0 S SSN=" N/A" ; last 4 of ssn
..S CNT=CNT+1
..S ^TMP("PRCAP377",$J,"MSG",CNT)=RPPID_" "_$$LJ^XLFSTR($$NAM^RCFN01(DEBTOR),"30T")_" "_SSN_" "_STAT_" $"_$FN(BAL,"",2)
..Q
.Q
S XMSUB="PRCA*4.5*377 AR REPAYMENT PLAN CONVERSION",XMDUZ="AR PACKAGE"
S XMY("G.RC REPAY PLANS")="",XMTEXT="^TMP(""PRCAP377"","_$J_",""MSG"","
D ^XMD
I $G(XMMG) D MES^XPDUTL(XMMG)
K ^TMP("PRCAP377",$J,"MSG")
D MES^XPDUTL(" Done.")
Q
;
MSG1 ; send Mailman notification for exception report
N BILL,CNT,DEBTOR,DIFROM,XMDUZ,XMMG,XMSUB,XMTEXT,XMY
I '$D(^TMP("PRCAP377",$J,"AMNT")),'$D(^TMP("PRCAP377",$J,"CAT")) Q ; nothing to send - bail out
D MES^XPDUTL("Sending exceptions report message...")
S CNT=1,^TMP("PRCAP377",$J,"MSG",CNT)="The following exceptions were encountered during the conversion:"
S CNT=CNT+1,^TMP("PRCAP377",$J,"MSG",CNT)=""
I $D(^TMP("PRCAP377",$J,"AMNT")) D
.S CNT=CNT+1,^TMP("PRCAP377",$J,"MSG",CNT)="Bills not added to converted plan. Repay amount associated"
.S CNT=CNT+1,^TMP("PRCAP377",$J,"MSG",CNT)="with individual bill differs from plan. Please review."
.S CNT=CNT+1,^TMP("PRCAP377",$J,"MSG",CNT)=""
.S DEBTOR="" F S DEBTOR=$O(^TMP("PRCAP377",$J,"AMNT",DEBTOR)) Q:DEBTOR="" D
..S BILL="" F S BILL=$O(^TMP("PRCAP377",$J,"AMNT",DEBTOR,BILL)) Q:BILL="" D
...S CNT=CNT+1
...S ^TMP("PRCAP377",$J,"MSG",CNT)=$$LJ^XLFSTR($$NAM^RCFN01(DEBTOR),"30T")_" "_$$LJ^XLFSTR($$GET1^DIQ(430,BILL_",",.01),"15T")_" $"_$FN(^TMP("PRCAP377",$J,"AMNT",DEBTOR,BILL),"",2)
...Q
..Q
.S CNT=CNT+1,^TMP("PRCAP377",$J,"MSG",CNT)=""
.Q
I $D(^TMP("PRCAP377",$J,"CAT")) D
.S CNT=CNT+1,^TMP("PRCAP377",$J,"MSG",CNT)="Bills with AR categories not eligible for conversion"
.S CNT=CNT+1,^TMP("PRCAP377",$J,"MSG",CNT)=""
.S DEBTOR="" F S DEBTOR=$O(^TMP("PRCAP377",$J,"CAT",DEBTOR)) Q:DEBTOR="" D
..S BILL="" F S BILL=$O(^TMP("PRCAP377",$J,"CAT",DEBTOR,BILL)) Q:BILL="" D
...S CNT=CNT+1
...S ^TMP("PRCAP377",$J,"MSG",CNT)=$$LJ^XLFSTR($$NAM^RCFN01(DEBTOR),"30T")_" "_$$LJ^XLFSTR($$GET1^DIQ(430,BILL_",",.01),"15T")_" "_$$LJ^XLFSTR($$GET1^DIQ(430.2,^TMP("PRCAP377",$J,"CAT",DEBTOR,BILL)_",",.01),"15T")
...Q
..Q
.Q
S XMSUB="PRCA*4.5*377 AR REPAYMENT PLAN CONVERSION EXCEPTIONS",XMDUZ="AR PACKAGE"
S XMY("G.RC REPAY PLANS")="",XMTEXT="^TMP(""PRCAP377"","_$J_",""MSG"","
D ^XMD
I $G(XMMG) D MES^XPDUTL(XMMG)
K ^TMP("PRCAP377",$J,"MSG")
D MES^XPDUTL(" Done.")
Q
;
MSG2 ; send Mailman notification for TOP/DMC report
N BILL,CNT,DEBTOR,DIFROM,RCRPIEN,REF,XMDUZ,XMMG,XMSUB,XMTEXT,XMY
I '$D(^TMP("PRCAP377",$J,"REF")) Q ; nothing to send - bail out
D MES^XPDUTL("Sending TOP/DMC referrals report message...")
S CNT=1,^TMP("PRCAP377",$J,"MSG",CNT)="The following bills are referred to TOP /DMC:"
S CNT=CNT+1,^TMP("PRCAP377",$J,"MSG",CNT)=""
S DEBTOR="" F S DEBTOR=$O(^TMP("PRCAP377",$J,"REF",DEBTOR)) Q:DEBTOR="" D
.S RCRPIEN="" F S RCRPIEN=$O(^TMP("PRCAP377",$J,"REF",DEBTOR,RCRPIEN)) Q:RCRPIEN="" D
..S BILL="" F S BILL=$O(^TMP("PRCAP377",$J,"REF",DEBTOR,RCRPIEN,BILL)) Q:BILL="" D
...S REF=^TMP("PRCAP377",$J,"REF",DEBTOR,RCRPIEN,BILL)
...S CNT=CNT+1
...S ^TMP("PRCAP377",$J,"MSG",CNT)=$$LJ^XLFSTR($$NAM^RCFN01(DEBTOR),"30T")_" "_$$LJ^XLFSTR($$GET1^DIQ(340.5,RCRPIEN_",",.01),"20T")
...S ^TMP("PRCAP377",$J,"MSG",CNT)=^TMP("PRCAP377",$J,"MSG",CNT)_" "_$$LJ^XLFSTR($$GET1^DIQ(430,BILL_",",.01),"15T")_" "_REF
...Q
..Q
.Q
S XMSUB="PRCA*4.5*377 AR REPAYMENT PLAN BILLS REFERRED TO TOP/DMC",XMDUZ="AR PACKAGE"
S XMY("G.RC REPAY PLANS")="",XMTEXT="^TMP(""PRCAP377"","_$J_",""MSG"","
D ^XMD
I $G(XMMG) D MES^XPDUTL(XMMG)
K ^TMP("PRCAP377",$J,"MSG")
D MES^XPDUTL(" Done.")
Q
;
UPD4303 ; Update the Transaction Type file (#430.3) with 3 new Transaction types.
N LOOP,RCIEN,RCDATA,RCCNNM
N X,Y,DIE,DA,DR,DTOUT,EXDATA,RCDATAB,DIK
;
; Grab all of the entries to update
D MES^XPDUTL(" -> Adding new Transaction Types into the ACCOUNTS RECEIVABLE TRANS.TYPE file (430.3).")
S Y=-1
F LOOP=1:1 S RCDATA=$T(TRDAT+LOOP) Q:$P(RCDATA,";",3)="END" D
. S DR=""
. ;Extract the new ACTION TYPE to be added.
. ;Store in array for adding to the file (#350.1).
. Q:RCDATA="" ;go to next entry if Category is not to be updated.
. ;
. S RCCNNM=$P(RCDATA,";",3)
. S RCIEN=$O(^PRCA(430.3,"B",RCCNNM,""))
. Q:RCIEN>0
. ; File the update along with inactivate the ACTION TYPE
. S DLAYGO=430.3,DIC="^PRCA(430.3,",DIC(0)="L",X=RCCNNM
. I '+RCIEN D FILE^DICN S RCIEN=+Y K DIC,DINUM,DLAYGO
. S DR="1////"_$P(RCDATA,";",4) ; ABBREVIATION
. S DR=DR_";2////"_$P(RCDATA,";",5) ; STATUS NUMBER
. S DR=DR_";3////"_$P(RCDATA,";",6) ; CALM CODE
. S DR=DR_";5////"_$P(RCDATA,";",8) ; CBO EXTRACT FLAG
. ;
. S DIE="^PRCA(430.3,",DA=RCIEN
. D ^DIE
. K DR,DA,DIE
. ;re-index new entry here
. S DA=RCIEN,DIK="^PRCA(430.3,"
. D IX^DIK
. K DR,DA,DIK
Q
;
TRDAT ; Fee Service to inactivate
;;EDIT REPAYMENT PLAN;EZ;67;0;;0
;;CLOSE REPAYMENT PLAN;RZ;68;0;;0
;;RPP TERMINATED;RT;69;0;;0
;;END
Q
;
ADDRPP ; Update the Transaction Type file (#430.3) with data for the new Repayment Plan field.
N LOOP,RCIEN,RCDATA,RCCNNM
N X,Y,DIE,DA,DR,DTOUT,EXDATA,RCDATAB,DIK
;
; Grab all of the entries to update
D MES^XPDUTL(" -> Updating entries in the ACCOUNTS RECEIVABLE TRANS.TYPE file (430.3). to populate the REPAYMENT PLAN PROCESS field.")
S Y=-1
F LOOP=1:1 S RCDATA=$T(RPPDAT+LOOP) Q:$P(RCDATA,";",3)="END" D
. S DR=""
. ;Extract the new ACTION TYPE to be added.
. ;Store in array for adding to the file (#350.1).
. Q:RCDATA="" ;go to next entry if Category is not to be updated.
. ;
. S RCCNNM=$P(RCDATA,";",3)
. S RCIEN=$O(^PRCA(430.3,"B",RCCNNM,""))
. ; File the update along with inactivate the ACTION TYPE
. S DLAYGO=430.3,DIC="^PRCA(430.3,",DIC(0)="L",X=RCCNNM
. I '+RCIEN D FILE^DICN S RCIEN=+Y K DIC,DINUM,DLAYGO
. S DR="6////"_$P(RCDATA,";",4) ; ABBREVIATION
. ;
. S DIE="^PRCA(430.3,",DA=RCIEN
. D ^DIE
. ;re-index new entry here
. S DA=RCIEN,DIK="^PRCA(430.3," D IX^DIK
. K DR
Q
;
RPPDAT ; Transaction Types to update
;;INCREASE ADJUSTMENT;I
;;PAYMENT (IN PART);P
;;CASH COLLECTION BY RC/DOJ;P
;;TERM.BY FIS.OFFICER;D
;;TERM.BY COMPROMISE;D
;;WAIVED IN FULL;D
;;WAIVED IN PART;D
;;ADMIN.COST CHARGE;I
;;INTEREST/ADM. CHARGE;I
;;EXEMPT INT/ADM. COST;D
;;WRITE-OFF;D
;;MARSHAL/COURT COST;I
;;TERM.BY RC/DOJ;D
;;PAYMENT (IN FULL);P
;;DECREASE ADJUSTMENT;D
;;CHARGE SUSPENDED;D
;;RE-ESTABLISH;I
;;END
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAP377 13979 printed Nov 22, 2024@16:50:59 Page 2
PRCAP377 ;EDE/YMG - PRCA*4.5*377 POST INSTALL; 12/04/20
+1 ;;4.5;Accounts Receivable;**377**;Mar 20, 1995;Build 45
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
EN ; entry point
+1 DO BMES^XPDUTL(" >> Start of the Post-Installation routine for PRCA*4.5*377")
+2 ; Add 2 new entries to the Transaction Type file
+3 DO UPD4303
+4 ; Initialize the Repayment Plan Process field in the Transaction Type File
+5 DO ADDRPP
+6 ; convert repayment plans in file 430 to entries in file 340.5
+7 DO CONVERT
+8 DO BMES^XPDUTL(" >> End of the Post-Installation routine for PRCA*4.5*377")
+9 QUIT
+10 ;
CONVERT ; convert repayment plans in file 430 to entries in file 340.5
+1 NEW AMNT,BILL,CAT,CNT,DEBTOR,FDA,FDAIEN,IENS,N0,N4,N15,NEWTOT,NUMPMNT,RCRPIEN,REFDMC,REFTOP,RPPCNT,RPPID,STARTDT,TOTAL,Z
+2 DO MES^XPDUTL("Converting existing repayment plans...")
+3 KILL ^TMP("PRCAP377",$JOB)
+4 SET (CNT,RPPCNT)=0
+5 ; loop through AR bills with ACTIVE status
+6 SET BILL=0
FOR
SET BILL=$ORDER(^PRCA(430,"AC",16,BILL))
if BILL=""
QUIT
Begin DoDot:1
+7 SET N0=^PRCA(430,BILL,0)
SET CAT=+$PIECE(N0,U,2)
IF CAT'>0
QUIT
+8 ; skip if total balance is 0
SET TOTAL=$$BALANCE^RCRPRPU(BILL)
IF TOTAL'>0
QUIT
+9 ; skip if node 4 in file 430 is blank - no repayment plan
SET N4=$GET(^PRCA(430,BILL,4))
IF N4=""
QUIT
+10 ; skip if 430/45 is populated - this entry has been converted already
IF +$PIECE(N4,U,5)>0
QUIT
+11 SET N15=$GET(^PRCA(430,BILL,15))
+12 ; skip if bill was referred to TSCP and was not recalled
IF +$PIECE(N15,U)>0
IF $PIECE(N15,U,3)=""
QUIT
+13 ; file 340 ien
SET DEBTOR=+$PIECE($GET(^PRCA(430,BILL,0)),U,9)
+14 ; skip if not eligible for RPP and add to exception report
IF '$$GET1^DIQ(430.2,CAT_",",1.06,"I")
Begin DoDot:2
+15 ; AR category - ien in file 430.2
SET ^TMP("PRCAP377",$JOB,"CAT",DEBTOR,BILL)=CAT
+16 QUIT
End DoDot:2
QUIT
+17 SET RCRPIEN=+$ORDER(^RCRP(340.5,"E",DEBTOR,""))
+18 SET AMNT=+$PIECE(N4,U,3)
IF 'AMNT
QUIT
+19 SET CNT=CNT+1
IF '$DATA(ZTQUEUED)
if CNT#500=0
WRITE "."
+20 SET STARTDT=$$GETSTART^RCRPU(DT)
+21 IF 'RCRPIEN
Begin DoDot:2
+22 ; no entry in 340.5, create new plan
+23 SET Z="000000"_($PIECE($GET(^RCRP(340.5,0)),U,3)+1)
+24 SET RPPID=$$GETID^RCRPU(DEBTOR)_$EXTRACT(Z,$LENGTH(Z)-5,$LENGTH(Z))
+25 ; RPP ID
SET FDA(340.5,"+1,",.01)=RPPID
+26 ; ptr to file 340
SET FDA(340.5,"+1,",.02)=DEBTOR
+27 ; creation date
SET FDA(340.5,"+1,",.03)=DT
+28 ; start date
SET FDA(340.5,"+1,",.04)=STARTDT
+29 ; amount per month (from 430/43)
SET FDA(340.5,"+1,",.06)=AMNT
+30 ; status (set to "current")
SET FDA(340.5,"+1,",.07)=2
+31 ; status date
SET FDA(340.5,"+1,",.08)=DT
+32 ; # of forbearances
SET FDA(340.5,"+1,",.09)=0
+33 DO UPDATE^DIE("","FDA","FDAIEN")
+34 SET RCRPIEN=FDAIEN(1)
KILL FDAIEN
IF 'RCRPIEN
QUIT
+35 ; update sub-file 340.54
DO NEWAUDT(RCRPIEN)
+36 ; update debtor file (340)
DO UPDDBTR^RCRPU(RCRPIEN,DEBTOR)
+37 SET RPPCNT=RPPCNT+1
+38 SET ^TMP("PRCAP377",$JOB,"CNV",RCRPIEN)=RPPID_U_DEBTOR
+39 QUIT
End DoDot:2
+40 ; skip bills with monthly amount that differs from the rest of repayment plan, add them to exception report
+41 IF AMNT'=$PIECE(^RCRP(340.5,RCRPIEN,0),U,6)
Begin DoDot:2
+42 ; monthly amount in repayment plan
IF '$DATA(^TMP("PRCAP377",$JOB,"AMNT"))
SET ^TMP("PRCAP377",$JOB,"AMNT")=$PIECE(^RCRP(340.5,RCRPIEN,0),U,6)
+43 ; monthly amount for this bill
SET ^TMP("PRCAP377",$JOB,"AMNT",DEBTOR,BILL)=AMNT
+44 QUIT
End DoDot:2
QUIT
+45 ; if bill was referred to TOP or DMC, add it to TOP/DMC report
+46 SET REFDMC=+$PIECE($GET(^PRCA(430,BILL,12)),U)
+47 SET REFTOP=+$PIECE($GET(^PRCA(430,BILL,14)),U)
+48 IF REFTOP!REFDMC
SET ^TMP("PRCAP377",$JOB,"REF",DEBTOR,RCRPIEN,BILL)=$SELECT(REFTOP:"TOP",1:"DMC")
+49 ;
+50 ; update sub-file 340.56
DO UPDBILL^RCRPU(RCRPIEN,BILL)
+51 ; update fields 430/41 and 430/45
+52 SET IENS=BILL_","
+53 SET FDA(430,IENS,41)=DT
+54 SET FDA(430,IENS,45)=RCRPIEN
+55 DO FILE^DIE("","FDA")
+56 ; add new transaction to file 433
+57 DO TRAN^RCRPU(BILL,TOTAL,67)
+58 ; update field 340.5/.11 (plan amount owed)
+59 SET FDA(340.5,RCRPIEN_",",.11)=TOTAL+$PIECE(^RCRP(340.5,RCRPIEN,0),U,11)
DO FILE^DIE("","FDA")
+60 ; update schedule (sub-file 340.52)
+61 IF AMNT
Begin DoDot:2
+62 SET NEWTOT=$PIECE(^RCRP(340.5,RCRPIEN,0),U,11)
+63 ; # of payments (amount owed / amount per month, rounded up)
SET NUMPMNT=NEWTOT\AMNT
IF NEWTOT#AMNT
SET NUMPMNT=NUMPMNT+1
+64 DO UPDSCHED(RCRPIEN,+$PIECE(^RCRP(340.5,RCRPIEN,0),U,5),NUMPMNT,$SELECT('$DATA(^RCRP(340.5,RCRPIEN,2)):STARTDT,1:""))
+65 ; update # of payments
+66 SET FDA(340.5,RCRPIEN_",",.05)=NUMPMNT
DO FILE^DIE("","FDA")
+67 QUIT
End DoDot:2
+68 QUIT
End DoDot:1
+69 DO MES^XPDUTL(" Done.")
+70 DO MSG(CNT,RPPCNT)
DO MSG1
DO MSG2
+71 KILL ^TMP("PRCAP377",$JOB)
+72 QUIT
+73 ;
UPDSCHED(RCIEN,RCORLN,RCNEWLN,RCSTDT) ; Update RPP schedule.
+1 ;
+2 ; RCRPIEN - IEN of the Repayment Plan being adjusted
+3 ; RCORLN - Original Term Length of the payments
+4 ; RCNEWLN - New Term Length
+5 ; RCSTDT - Plan start date (required for initial schedule, optional for adjustments)
+6 ;
+7 NEW DA,DIK,RCFLG,RCLP,RCLP1,RCPD,RCSUB
+8 ;
+9 SET RCSTDT=$GET(RCSTDT)
+10 SET RCFLG=0
+11 ; Find the last date by looking for the last entry and grabbing the first piece.
+12 IF RCSTDT=""
SET RCSTDT=$PIECE($GET(^RCRP(340.5,RCIEN,2,RCORLN,0)),U,1)
SET RCFLG=1
+13 ; Clear RPP Temp array
+14 KILL ^TMP("RCRPP",$JOB)
+15 ;find all of the payments paid, stop on the first unpaid.
+16 SET RCLP=0
FOR
SET RCLP=$ORDER(^RCRP(340.5,RCIEN,2,RCLP))
if 'RCLP
QUIT
SET RCPD=$PIECE($GET(^RCRP(340.5,RCIEN,2,RCLP,0)),U,2)
if 'RCPD
QUIT
+17 ; Count the new remaining payment out.
+18 ;first missing payment + new length of payment - 1 for the first missing payment)
SET RCLP1=RCLP+RCNEWLN-1
+19 ; remove the remaining payments from schedule
+20 FOR
SET RCLP1=$ORDER(^RCRP(340.5,RCIEN,2,RCLP1))
if 'RCLP1
QUIT
Begin DoDot:1
+21 SET DA(1)=RCIEN
SET DA=RCLP1
SET DIK="^RCRP(340.5,"_DA(1)_",2,"
+22 DO ^DIK
KILL DA,DIK
+23 QUIT
End DoDot:1
+24 ; add new payments to schedule.
+25 DO BLDPLN^RCRPU(RCSTDT,(RCNEWLN-RCORLN),RCFLG)
+26 ; Add the new months to the Schedule
+27 ; Update the Schedule Node
+28 SET RCSUB=0
FOR
SET RCSUB=$ORDER(^TMP("RCRPP",$JOB,"PLAN",RCSUB))
if 'RCSUB
QUIT
DO UPDSCHED^RCRPU(RCIEN,RCSUB)
+29 ; Clear temp array
+30 KILL ^TMP("RCRPP",$JOB)
+31 ;
+32 QUIT
+33 ;
NEWAUDT(RCRPIEN) ; create new entry in sub-file 340.54
+1 ;
+2 ; RCRPIEN - file 340.5 ien
+3 ;
+4 NEW FDA,IENS
+5 SET IENS="+1,"_RCRPIEN_","
+6 ; date of change
SET FDA(340.54,IENS,.01)=DT
+7 ; type of change = "NEW"
SET FDA(340.54,IENS,1)="N"
+8 ; who changed = POSTMASTER
SET FDA(340.54,IENS,2)=.5
+9 ; comment = "NEW PLAN"
SET FDA(340.54,IENS,3)="N"
+10 DO UPDATE^DIE("","FDA")
+11 QUIT
+12 ;
MSG(BILCNT,RPPCNT) ; send Mailman notification for # of bills converted
+1 ;
+2 ; BILCNT - number of converted bills
+3 ; RPPCNT - number of repayment plans created
+4 ;
+5 NEW BAL,CNT,DEBTOR,DIFROM,IENS,RPIEN,RPPID,SSN,STAT,XMDUZ,XMMG,XMSUB,XMTEXT,XMY,Z
+6 DO MES^XPDUTL("Sending conversion message...")
+7 SET CNT=1
SET ^TMP("PRCAP377",$JOB,"MSG",CNT)="Conversion of existing repayment plans has been completed"
+8 SET CNT=CNT+1
SET ^TMP("PRCAP377",$JOB,"MSG",CNT)="Total number of repayment plans created: "_RPPCNT
+9 SET CNT=CNT+1
SET ^TMP("PRCAP377",$JOB,"MSG",CNT)="Total number of bills converted: "_BILCNT
+10 SET CNT=CNT+1
SET ^TMP("PRCAP377",$JOB,"MSG",CNT)=""
+11 ;
+12 IF RPPCNT>0
Begin DoDot:1
+13 SET CNT=CNT+1
SET ^TMP("PRCAP377",$JOB,"MSG",CNT)="The following repayment plans have been created:"
+14 SET CNT=CNT+1
SET ^TMP("PRCAP377",$JOB,"MSG",CNT)=""
+15 SET CNT=CNT+1
SET ^TMP("PRCAP377",$JOB,"MSG",CNT)="Repayment Plan ID Debtor SSN Status Balance"
+16 SET CNT=CNT+1
SET ^TMP("PRCAP377",$JOB,"MSG",CNT)="-------------------------------------------------------------------------------"
+17 SET RPIEN=""
FOR
SET RPIEN=$ORDER(^TMP("PRCAP377",$JOB,"CNV",RPIEN))
if RPIEN=""
QUIT
Begin DoDot:2
+18 SET Z=$GET(^TMP("PRCAP377",$JOB,"CNV",RPIEN))
SET RPPID=$PIECE(Z,U)
SET DEBTOR=$PIECE(Z,U,2)
+19 SET IENS=RPIEN_","
SET STAT=$$GET1^DIQ(340.5,IENS,.07)
SET BAL=$$GET1^DIQ(340.5,IENS,.11)
+20 ; last 4 of ssn
SET Z=$$SSN^RCFN01(DEBTOR)
SET SSN=$EXTRACT(Z,$LENGTH(Z)-3,$LENGTH(Z))
IF SSN'>0
SET SSN=" N/A"
+21 SET CNT=CNT+1
+22 SET ^TMP("PRCAP377",$JOB,"MSG",CNT)=RPPID_" "_$$LJ^XLFSTR($$NAM^RCFN01(DEBTOR),"30T")_" "_SSN_" "_STAT_" $"_$FNUMBER(BAL,"",2)
+23 QUIT
End DoDot:2
+24 QUIT
End DoDot:1
+25 SET XMSUB="PRCA*4.5*377 AR REPAYMENT PLAN CONVERSION"
SET XMDUZ="AR PACKAGE"
+26 SET XMY("G.RC REPAY PLANS")=""
SET XMTEXT="^TMP(""PRCAP377"","_$JOB_",""MSG"","
+27 DO ^XMD
+28 IF $GET(XMMG)
DO MES^XPDUTL(XMMG)
+29 KILL ^TMP("PRCAP377",$JOB,"MSG")
+30 DO MES^XPDUTL(" Done.")
+31 QUIT
+32 ;
MSG1 ; send Mailman notification for exception report
+1 NEW BILL,CNT,DEBTOR,DIFROM,XMDUZ,XMMG,XMSUB,XMTEXT,XMY
+2 ; nothing to send - bail out
IF '$DATA(^TMP("PRCAP377",$JOB,"AMNT"))
IF '$DATA(^TMP("PRCAP377",$JOB,"CAT"))
QUIT
+3 DO MES^XPDUTL("Sending exceptions report message...")
+4 SET CNT=1
SET ^TMP("PRCAP377",$JOB,"MSG",CNT)="The following exceptions were encountered during the conversion:"
+5 SET CNT=CNT+1
SET ^TMP("PRCAP377",$JOB,"MSG",CNT)=""
+6 IF $DATA(^TMP("PRCAP377",$JOB,"AMNT"))
Begin DoDot:1
+7 SET CNT=CNT+1
SET ^TMP("PRCAP377",$JOB,"MSG",CNT)="Bills not added to converted plan. Repay amount associated"
+8 SET CNT=CNT+1
SET ^TMP("PRCAP377",$JOB,"MSG",CNT)="with individual bill differs from plan. Please review."
+9 SET CNT=CNT+1
SET ^TMP("PRCAP377",$JOB,"MSG",CNT)=""
+10 SET DEBTOR=""
FOR
SET DEBTOR=$ORDER(^TMP("PRCAP377",$JOB,"AMNT",DEBTOR))
if DEBTOR=""
QUIT
Begin DoDot:2
+11 SET BILL=""
FOR
SET BILL=$ORDER(^TMP("PRCAP377",$JOB,"AMNT",DEBTOR,BILL))
if BILL=""
QUIT
Begin DoDot:3
+12 SET CNT=CNT+1
+13 SET ^TMP("PRCAP377",$JOB,"MSG",CNT)=$$LJ^XLFSTR($$NAM^RCFN01(DEBTOR),"30T")_" "_$$LJ^XLFSTR($$GET1^DIQ(430,BILL_",",.01),"15T")_" $"_$FNUMBER(^TMP("PRCAP377",$JOB,"AMNT",DEBTOR,BILL),"",2)
+14 QUIT
End DoDot:3
+15 QUIT
End DoDot:2
+16 SET CNT=CNT+1
SET ^TMP("PRCAP377",$JOB,"MSG",CNT)=""
+17 QUIT
End DoDot:1
+18 IF $DATA(^TMP("PRCAP377",$JOB,"CAT"))
Begin DoDot:1
+19 SET CNT=CNT+1
SET ^TMP("PRCAP377",$JOB,"MSG",CNT)="Bills with AR categories not eligible for conversion"
+20 SET CNT=CNT+1
SET ^TMP("PRCAP377",$JOB,"MSG",CNT)=""
+21 SET DEBTOR=""
FOR
SET DEBTOR=$ORDER(^TMP("PRCAP377",$JOB,"CAT",DEBTOR))
if DEBTOR=""
QUIT
Begin DoDot:2
+22 SET BILL=""
FOR
SET BILL=$ORDER(^TMP("PRCAP377",$JOB,"CAT",DEBTOR,BILL))
if BILL=""
QUIT
Begin DoDot:3
+23 SET CNT=CNT+1
+24 SET ^TMP("PRCAP377",$JOB,"MSG",CNT)=$$LJ^XLFSTR($$NAM^RCFN01(DEBTOR),"30T")_" "_$$LJ^XLFSTR($$GET1^DIQ(430,BILL_",",.01),"15T")_" "_$$LJ^XLFSTR($$GET1^DIQ(430.2,^TMP("PRCAP377",$JOB,"CAT",DEBTOR,BILL)_",",.01),"15T")
+25 QUIT
End DoDot:3
+26 QUIT
End DoDot:2
+27 QUIT
End DoDot:1
+28 SET XMSUB="PRCA*4.5*377 AR REPAYMENT PLAN CONVERSION EXCEPTIONS"
SET XMDUZ="AR PACKAGE"
+29 SET XMY("G.RC REPAY PLANS")=""
SET XMTEXT="^TMP(""PRCAP377"","_$JOB_",""MSG"","
+30 DO ^XMD
+31 IF $GET(XMMG)
DO MES^XPDUTL(XMMG)
+32 KILL ^TMP("PRCAP377",$JOB,"MSG")
+33 DO MES^XPDUTL(" Done.")
+34 QUIT
+35 ;
MSG2 ; send Mailman notification for TOP/DMC report
+1 NEW BILL,CNT,DEBTOR,DIFROM,RCRPIEN,REF,XMDUZ,XMMG,XMSUB,XMTEXT,XMY
+2 ; nothing to send - bail out
IF '$DATA(^TMP("PRCAP377",$JOB,"REF"))
QUIT
+3 DO MES^XPDUTL("Sending TOP/DMC referrals report message...")
+4 SET CNT=1
SET ^TMP("PRCAP377",$JOB,"MSG",CNT)="The following bills are referred to TOP /DMC:"
+5 SET CNT=CNT+1
SET ^TMP("PRCAP377",$JOB,"MSG",CNT)=""
+6 SET DEBTOR=""
FOR
SET DEBTOR=$ORDER(^TMP("PRCAP377",$JOB,"REF",DEBTOR))
if DEBTOR=""
QUIT
Begin DoDot:1
+7 SET RCRPIEN=""
FOR
SET RCRPIEN=$ORDER(^TMP("PRCAP377",$JOB,"REF",DEBTOR,RCRPIEN))
if RCRPIEN=""
QUIT
Begin DoDot:2
+8 SET BILL=""
FOR
SET BILL=$ORDER(^TMP("PRCAP377",$JOB,"REF",DEBTOR,RCRPIEN,BILL))
if BILL=""
QUIT
Begin DoDot:3
+9 SET REF=^TMP("PRCAP377",$JOB,"REF",DEBTOR,RCRPIEN,BILL)
+10 SET CNT=CNT+1
+11 SET ^TMP("PRCAP377",$JOB,"MSG",CNT)=$$LJ^XLFSTR($$NAM^RCFN01(DEBTOR),"30T")_" "_$$LJ^XLFSTR($$GET1^DIQ(340.5,RCRPIEN_",",.01),"20T")
+12 SET ^TMP("PRCAP377",$JOB,"MSG",CNT)=^TMP("PRCAP377",$JOB,"MSG",CNT)_" "_$$LJ^XLFSTR($$GET1^DIQ(430,BILL_",",.01),"15T")_" "_REF
+13 QUIT
End DoDot:3
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 SET XMSUB="PRCA*4.5*377 AR REPAYMENT PLAN BILLS REFERRED TO TOP/DMC"
SET XMDUZ="AR PACKAGE"
+17 SET XMY("G.RC REPAY PLANS")=""
SET XMTEXT="^TMP(""PRCAP377"","_$JOB_",""MSG"","
+18 DO ^XMD
+19 IF $GET(XMMG)
DO MES^XPDUTL(XMMG)
+20 KILL ^TMP("PRCAP377",$JOB,"MSG")
+21 DO MES^XPDUTL(" Done.")
+22 QUIT
+23 ;
UPD4303 ; Update the Transaction Type file (#430.3) with 3 new Transaction types.
+1 NEW LOOP,RCIEN,RCDATA,RCCNNM
+2 NEW X,Y,DIE,DA,DR,DTOUT,EXDATA,RCDATAB,DIK
+3 ;
+4 ; Grab all of the entries to update
+5 DO MES^XPDUTL(" -> Adding new Transaction Types into the ACCOUNTS RECEIVABLE TRANS.TYPE file (430.3).")
+6 SET Y=-1
+7 FOR LOOP=1:1
SET RCDATA=$TEXT(TRDAT+LOOP)
if $PIECE(RCDATA,";",3)="END"
QUIT
Begin DoDot:1
+8 SET DR=""
+9 ;Extract the new ACTION TYPE to be added.
+10 ;Store in array for adding to the file (#350.1).
+11 ;go to next entry if Category is not to be updated.
if RCDATA=""
QUIT
+12 ;
+13 SET RCCNNM=$PIECE(RCDATA,";",3)
+14 SET RCIEN=$ORDER(^PRCA(430.3,"B",RCCNNM,""))
+15 if RCIEN>0
QUIT
+16 ; File the update along with inactivate the ACTION TYPE
+17 SET DLAYGO=430.3
SET DIC="^PRCA(430.3,"
SET DIC(0)="L"
SET X=RCCNNM
+18 IF '+RCIEN
DO FILE^DICN
SET RCIEN=+Y
KILL DIC,DINUM,DLAYGO
+19 ; ABBREVIATION
SET DR="1////"_$PIECE(RCDATA,";",4)
+20 ; STATUS NUMBER
SET DR=DR_";2////"_$PIECE(RCDATA,";",5)
+21 ; CALM CODE
SET DR=DR_";3////"_$PIECE(RCDATA,";",6)
+22 ; CBO EXTRACT FLAG
SET DR=DR_";5////"_$PIECE(RCDATA,";",8)
+23 ;
+24 SET DIE="^PRCA(430.3,"
SET DA=RCIEN
+25 DO ^DIE
+26 KILL DR,DA,DIE
+27 ;re-index new entry here
+28 SET DA=RCIEN
SET DIK="^PRCA(430.3,"
+29 DO IX^DIK
+30 KILL DR,DA,DIK
End DoDot:1
+31 QUIT
+32 ;
TRDAT ; Fee Service to inactivate
+1 ;;EDIT REPAYMENT PLAN;EZ;67;0;;0
+2 ;;CLOSE REPAYMENT PLAN;RZ;68;0;;0
+3 ;;RPP TERMINATED;RT;69;0;;0
+4 ;;END
+5 QUIT
+6 ;
ADDRPP ; Update the Transaction Type file (#430.3) with data for the new Repayment Plan field.
+1 NEW LOOP,RCIEN,RCDATA,RCCNNM
+2 NEW X,Y,DIE,DA,DR,DTOUT,EXDATA,RCDATAB,DIK
+3 ;
+4 ; Grab all of the entries to update
+5 DO MES^XPDUTL(" -> Updating entries in the ACCOUNTS RECEIVABLE TRANS.TYPE file (430.3). to populate the REPAYMENT PLAN PROCESS field.")
+6 SET Y=-1
+7 FOR LOOP=1:1
SET RCDATA=$TEXT(RPPDAT+LOOP)
if $PIECE(RCDATA,";",3)="END"
QUIT
Begin DoDot:1
+8 SET DR=""
+9 ;Extract the new ACTION TYPE to be added.
+10 ;Store in array for adding to the file (#350.1).
+11 ;go to next entry if Category is not to be updated.
if RCDATA=""
QUIT
+12 ;
+13 SET RCCNNM=$PIECE(RCDATA,";",3)
+14 SET RCIEN=$ORDER(^PRCA(430.3,"B",RCCNNM,""))
+15 ; File the update along with inactivate the ACTION TYPE
+16 SET DLAYGO=430.3
SET DIC="^PRCA(430.3,"
SET DIC(0)="L"
SET X=RCCNNM
+17 IF '+RCIEN
DO FILE^DICN
SET RCIEN=+Y
KILL DIC,DINUM,DLAYGO
+18 ; ABBREVIATION
SET DR="6////"_$PIECE(RCDATA,";",4)
+19 ;
+20 SET DIE="^PRCA(430.3,"
SET DA=RCIEN
+21 DO ^DIE
+22 ;re-index new entry here
+23 SET DA=RCIEN
SET DIK="^PRCA(430.3,"
DO IX^DIK
+24 KILL DR
End DoDot:1
+25 QUIT
+26 ;
RPPDAT ; Transaction Types to update
+1 ;;INCREASE ADJUSTMENT;I
+2 ;;PAYMENT (IN PART);P
+3 ;;CASH COLLECTION BY RC/DOJ;P
+4 ;;TERM.BY FIS.OFFICER;D
+5 ;;TERM.BY COMPROMISE;D
+6 ;;WAIVED IN FULL;D
+7 ;;WAIVED IN PART;D
+8 ;;ADMIN.COST CHARGE;I
+9 ;;INTEREST/ADM. CHARGE;I
+10 ;;EXEMPT INT/ADM. COST;D
+11 ;;WRITE-OFF;D
+12 ;;MARSHAL/COURT COST;I
+13 ;;TERM.BY RC/DOJ;D
+14 ;;PAYMENT (IN FULL);P
+15 ;;DECREASE ADJUSTMENT;D
+16 ;;CHARGE SUSPENDED;D
+17 ;;RE-ESTABLISH;I
+18 ;;END
+19 QUIT
