- 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 Mar 13, 2025@20:45:27 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
