RCTCSPU ;ALBANY/BDB - CROSS-SERVICING UTILITIES ;03/15/14 3:34 PM
;;4.5;Accounts Receivable;**301,315,350,400**;Mar 20, 1995;Build 13
;;Per VA Directive 6402, this routine should not be modified.
Q
;
;total amount of bills for a debtor
TOTALB(DEBTOR) ;
N TOTAL,BILL,B7
S TOTAL=0,BILL=0
F S BILL=$O(^PRCA(430,"C",DEBTOR,BILL)) Q:BILL'?1N.N D
.Q:'$D(^PRCA(430,"TCSP",BILL))
.S B7=$G(^PRCA(430,BILL,7))
.S TOTAL=TOTAL+$P(B7,U)+$P(B7,U,2)+$P(B7,U,3)+$P(B7,U,4)+$P(B7,U,5)
Q TOTAL
;
;stop TCSP referral on a bill
STOP ;stop Cross-Servicing referral
N DIC,DIE,DA,DR,DIR,Y,BILL,REASON,COMMENT,EFFDT
I $G(GOTBILL) S BILL=RCBILLDA ;PRCA*4.5*315
I '$G(GOTBILL) S DIC=430,DIC(0)="AEQM" D ^DIC Q:Y<0 ;PRCA*4.5*315
I '$G(GOTBILL) S BILL=+Y ;PRCA*4.5*315
I $P($G(^PRCA(430,BILL,15)),U,7) G DELSTOP
W !,"Stop flag for Cross-Servicing Referral set? : NO"
S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you sure you want to stop the Cross-Servicing Referral for this bill" D ^DIR
I $G(GOTBILL),$D(DIRUT) S RCDPGQ=1 ; account profile listman quit flag *315
I 'Y W !,*7,"No action taken" Q
;
REASON ;ask referral reason
K DIR S DIR("A")="Enter Stop Cross-Servicing Reason ",DA=BILL,DIR(0)="430,159" D ^DIR
Q:(Y="")!(Y=U)
S REASON=Y I REASON="O" D Q:COMMENT=U G REASON:COMMENT=""
.S COMMENT="",DIR("A")="Enter Stop Reason Comment ",DA=BILL,DIR(0)="430,159.1" D ^DIR S COMMENT=Y
.I COMMENT="" W !,"A Reason of Other requires a comment to be entered"
.Q
I REASON'="O",$P($G(^PRCA(430,BILL,15)),U,10)'="" S $P(^(15),U,10)=""
;
;ask effective date
;
S DIR(0)="430,158",DA=BILL,DIR("A")="Enter Effective Date " D ^DIR G:Y=U STOPQ S EFFDT=Y
;
STOPFILE ;set stop referral data in file 430
S $P(^PRCA(430,BILL,15),U,7,10)="1^"_EFFDT_U_REASON_U_$G(COMMENT)
;
W !,"Stop Cross-Servicing Referral complete"
D STOP^RCTCSPD4 ; *315 Create CS Stop Placed comment tx in 433
G STOPQ
;
DELSTOP ;Allows Cross-Servicing Referral to be re-instituted for bill
N I
W !!,*7,"Referral to Cross-Servicing has already been stopped for this bill."
W !,"Stop Cross-Servicing referral effective date: ",$$GET1^DIQ(430,BILL,158,"E")
W !,"Stop Cross-Servicing referral reason : ",$$GET1^DIQ(430,BILL,159,"E")
I $$GET1^DIQ(430,BILL,159,"E")="OTHER" W !,"Stop Cross-Servicing referral comment : ",$$GET1^DIQ(430,BILL,159.1,"E")
S DIR(0)="Y",DIR("A")="Do you wish to re-institute Cross-Servicing Referral for this bill",DIR("B")="NO"
D ^DIR
I $G(GOTBILL),$D(DIRUT) S RCDPGQ=1 G STOPQ ; account profile listman quit flag *315
G EDSTOP:'Y
;
;reset file to allow cross-servicing referral to be re-started
F I=7:1:10 S $P(^PRCA(430,BILL,15),U,I)=""
W !!,"Bill is now eligible to be Referred to Cross-Servicing" D DELSTOP^RCTCSPD4 G STOPQ ; *315 create CS Stop Deleted transaction
;
EDSTOP S DIR(0)="Y",DIR("A")="Do you wish to edit the Stop Referral Data for this bill",DIR("B")="NO" D ^DIR G REASON:Y
STOPQ Q
;
;Set Cross-Servicing recall for a bill
RCLLSETB ;Set Cross-Servicing recall
N DIC,DIE,DA,DR,DIR,Y,BILL,REASON
I '$G(GOTBILL) S DIC=430,DIC(0)="AEQM" D ^DIC Q:Y<0
I '$G(GOTBILL) S BILL=+Y
I $G(GOTBILL) S BILL=RCBILLDA
I $P($G(^PRCA(430,BILL,15)),U,2) G DELSETB
S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you sure you want to set this bill to be recalled from Cross-Servicing" D ^DIR
I $G(GOTBILL),$D(DIRUT) S RCDPGQ=1 ; account profile listman quit flag *315
I 'Y W !,*7,"No action taken" Q
I '$D(^PRCA(430,"TCSP",BILL)) W !,*7,"No action taken. Bill has not been referred to Cross-Servicing." Q
;
RCRSB ;ask recall reason
K DIR S DIR(0)="S^01:DEBT REFERRED IN ERROR;07:AGENCY IS FORGIVING DEBT;08:AGENCY CAN COLLECT THROUGH INTERNAL OFFSET" D ^DIR
Q:(Y="")!(Y=U)
;set recall data in file 430
S REASON=Y
S $P(^PRCA(430,BILL,15),U,2,4)="1^^"_REASON
D CSRCLPL^RCTCSPD5 ; *315 CS Recall Placed comment tx in 433
W !,"Setting this bill for Recall from Cross-Servicing is complete"
G SETBQ
;
RRSET ; Set rerefer for bills PRCA*4.5*350
N BILL,STOP
S STOP=0
F D RRSETB Q:BILL="" Q:STOP
Q
; Set rerefer for bill PRCA*4.5*350
RRSETB ;
N DIC,DIE,DA,DR,DIR,Y,DIROUT,DTOUT,DUOUT,DIRUT
N WR,EXE,DEBTOR,CHECK,REASON,COMMENT,LIEN,QUIT,FIXABLE
S BILL="",LIEN="",QUIT=""
; Still experimenting if to use DIC or DIR
S DIC=430,DIC(0)="AEQMS",DIC("A")="Enter Bill Number for re-referral: "
; we will allow selection of bills here and show error message if we don't like bill.
;S DIC("S")="I $D(^PRCA(430,Y,15))"
D ^DIC
S BILL=+Y S:Y=-1 STOP=1
I STOP Q
S DEBTOR=$P($G(^PRCA(430,BILL,0)),U,9)
I $$RR^RCTCSPU(BILL)=0 D Q:STOP Q:QUIT
. N NZ,REASON,COMMENT
. W !!,"Re-Referral has already been requested",!
. S LIEN=$O(^PRCA(430,BILL,15.5,99999),-1)
. S NZ=^PRCA(430,BILL,15.5,LIEN,0),REASON=$P(NZ,U,4),COMMENT=$P(NZ,U,5)
. W !,"By ",$P(^VA(200,$P(NZ,U,3),0),U)," on ",$$FMTE^XLFDT($P(NZ,U,2),"5Z")," Reason: "
. W $S(REASON="R":"Recall in error",REASON="T":"Treasury reversal",REASON="D":"Defaulted RPP",REASON="O":"Other: "_COMMENT,1:""),!
. K DIR S DIR("A")="Do you want to Cancel this Re-Referral",DIR("B")="NO",DIR(0)="Y" D ^DIR
. I X="" S STOP=1 Q
. I $G(DTOUT) S STOP=1 Q
. I $G(DIROUT) S STOP=1 Q
. I $G(DUOUT) S STOP=1 Q
. I Y D S QUIT=1 Q
. . ; remove LIEN from 15.5. Use DIK?
. . I LIEN=1 K ^PRCA(430,BILL,15.5,0)
. . E S $P(^PRCA(430,BILL,15.5,0),U,2)=430.03,$P(^PRCA(430,BILL,15.5,0),U,3)=LIEN-1,$P(^PRCA(430,BILL,15.5,0),U,4)=$P(^PRCA(430,BILL,15.5,0),U,4)-1
. . K ^PRCA(430,BILL,15.5,LIEN)
. . K ^PRCA(430,BILL,15.5,"B",0,LIEN)
. . D RRCAN^RCTCSPD4
. . W !!,"*** Re-Referral has been cancelled for this bill ***"
. . Q
. K DIR S DIR("A")="Do you want to Update this Re-Referral",DIR("B")="NO",DIR(0)="Y" D ^DIR
. I X="" S QUIT=1 Q
. I $G(DTOUT) S STOP=1 Q
. I $G(DIROUT) S STOP=1 Q
. I $G(DUOUT) S STOP=1 Q
. I X?1"N".E!(X?1"n".E) W !!,"*** No changes applied to this re-referral ***",! S QUIT=1 Q
D
. S CHECK=1
. I 'DEBTOR S CHECK="0^0^Bill has no debtor" Q
. I '$P($G(^PRCA(430,BILL,30)),U),'$P($G(^PRCA(430,BILL,15)),U,3) S CHECK="0^0^Bill is not Returned or Recalled, so can't re-refer" Q
. ; Disabling Stop flag is OK for now, but we will need to clear it at some point. Batch Job?
. S CHECK=$$RSBILCHK^RCTCSPD0(BILL,"3,20")
I 'CHECK D Q
. S FIXABLE=$F(",0,3,5,6,12,15,16,19,20,21,24,26,27,",","_$P(CHECK,U,2)_",")
. I 'FIXABLE W !!,"Unable to complete the re-referral process",!,$P(CHECK,U,3) Q
. W !!,"This bill has issues and will not make it through re-referral process because:",!,$P(CHECK,U,3)
. W !!,"PLEASE CORRECT THIS ISSUE AND THEN RE-REFER THE BILL AGAIN",!
. K DIR S DIR(0)="FO",DIR("A")="Press <ENTER> to continue " D ^DIR
. I (Y=U)!$G(DTOUT)!$G(DUOUT) S STOP=1
; Ask Rerefer Reason and description if O=Other
K DIR S DIR(0)="S^R:Recall in error;T:Treasury reversal;D:Defaulted RPP;O:Other"
S DIR("A")="Select Reason for this re-referral"
D ^DIR
I (Y="")!(Y=U)!$G(DTOUT)!$G(DUOUT) S STOP=1 Q
W !
S REASON=Y
I REASON="O" K DIR S DIR(0)="F^1:30",DIR("A")="Enter ""Other"" description " D ^DIR Q:Y="" Q:Y=U S COMMENT=Y
; Are you sure (do we want to ask this for update to rereferral?)
K DIR S DIR("A")="Are you sure you want to Re-refer this bill for Cross-Servicing",DIR(0)="Y",DIR("B")="YES"
D ^DIR
I (Y=U)!$G(DTOUT)!$G(DUOUT) S STOP=1 Q
I 'Y W !!,"*** No updates applied ***" Q
; user, date, status of rerefer
I LIEN'="" D
. ; That should be all we need for update of last IEN
. S ^PRCA(430,BILL,15.5,LIEN,0)=0_U_DT_U_DUZ_U_REASON_U_$G(COMMENT)
I LIEN="" D
. S LIEN=$O(^PRCA(430,BILL,15.5,99999),-1)+1
. S $P(^PRCA(430,BILL,15.5,0),U,2)=430.03
. S $P(^PRCA(430,BILL,15.5,0),U,3)=LIEN
. S $P(^PRCA(430,BILL,15.5,0),U,4)=$P(^PRCA(430,BILL,15.5,0),U,4)+1
. S ^PRCA(430,BILL,15.5,LIEN,0)=0_U_DT_U_DUZ_U_REASON_U_$G(COMMENT)
. S ^PRCA(430,BILL,15.5,"B",0,LIEN)=""
W !!,"Bill is set to be re-referred to Cross-Servicing in the next weekly transmission"
W !
; file Rerefer Request transaction
D RRREQ^RCTCSPD4
K DIR S DIR(0)="FO",DIR("A")="Press <ENTER> to continue " D ^DIR
W !
I (Y=U)!$G(DTOUT)!$G(DUOUT) S STOP=1 Q
Q
RR(BILL) ; PRCA*4.5*350
; Return: Null = no RR, 0 = RR Requested, 1 = RR Performed
N LIEN
Q:BILL="" ""
S LIEN=$O(^PRCA(430,BILL,15.5,99999),-1)
I LIEN<1 Q ""
Q $P(^PRCA(430,BILL,15.5,LIEN,0),U)
;
RRD(DEBTOR) ; PRCA*4.5*350
; Return: 0 = Debtor has no RR bills, 1 = Debtor has RR bills
Q:DEBTOR="" 0
N BILL,OUT
S BILL="",OUT=0
F S BILL=$O(^PRCA(430,"C",DEBTOR,BILL)) Q:BILL="" I $$RR(BILL) S OUT=1 Q
Q OUT
;
DELSETB ;Allows Cross-Servicing Recall to be deleted for bill
W !!,*7,"This bill has already been set for recall from Cross-Servicing."
I +$P($G(^PRCA(430,BILL,15)),U,3) W !!,"Not available for reactivation. The Recall request has already been processed." G SETBQ
S DIR(0)="Y",DIR("A")="Do you wish to delete the Cross-Servicing Recall for this bill",DIR("B")="NO"
D ^DIR
I $G(GOTBILL),$D(DIRUT) S RCDPGQ=1 G SETBQ ; account profile listman quit flag *315
G EDSETB:'Y
;
;delete the recall
F I=2:1:5 S $P(^PRCA(430,BILL,15),U,I)=""
D DELRCLL^RCTCSPD4 ; *315 Create CS Delete Recall comment tx in 433
W !!,"Recall from Cross-Servicing has been deleted for this bill."
G SETBQ
;
EDSETB S DIR(0)="Y",DIR("A")="Do you wish to edit the Recall data for this bill",DIR("B")="NO" D ^DIR G RCRSB:Y
SETBQ Q
;
;Set Cross-Servicing recall for a debtor
RCLLSETD ;Set Cross-Servicing debtor recall
N DIC,DIE,DA,DR,DIR,Y,DEBTOR,REASON,BILL
; GOTDEBT, RCDEBTDA - are defined if called from List Manager
I '$G(GOTDEBT) S DIC=340,DIC(0)="AEQM" D ^DIC Q:Y<0 ; *315
I '$G(GOTDEBT) S DEBTOR=+Y ; *315
I $G(GOTDEBT) S DEBTOR=RCDEBTDA ; *315
I $P($G(^RCD(340,DEBTOR,7)),U,2),'$P($G(^RCD(340,DEBTOR,7)),U,3) G DELSETD
S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you sure you want to recall this debtor and bills from Cross-Servicing" D ^DIR
I 'Y W !,*7,"No action taken" Q
I '$D(^RCD(340,"TCSP",DEBTOR)) W !,*7,"No action taken. Debtor has not been referred to Cross-Servicing." Q
;
RCRSD ;ask debtor recall reason
K DIR S DIR(0)="340,7.04" D ^DIR
Q:(Y="")!(Y=U)
;set debtor recall data in file 340
S REASON=Y
;S $P(^RCD(340,DEBTOR,7),U,2,4)="1^^"_REASON PRCA*4.5*400
;go through debtor bills and set reason in the bill recall reason
S BILL=0
F S BILL=$O(^PRCA(430,"C",DEBTOR,BILL)) Q:BILL'?1N.N D
.I $D(^PRCA(430,"TCSP",BILL)) D Q ;bill previously sent to TCSP
..S $P(^PRCA(430,BILL,15),U,2,4)="1^^"_REASON ;set the recall flag and reason (TV9)
..D CSRCLPL^RCTCSPD5 ; *315 Create CS RECALL PLACED tx in 433
W !,"Setting this debtor for Recall from Cross-Servicing is complete"
G SETDQ
;
DELSETD ;Allows Cross-Servicing Recall to be deleted for debtor
W !!,*7,"This debtor has already been set for recall from Cross-Servicing."
S DIR(0)="Y",DIR("A")="Do you wish to delete the Cross-Servicing Recall for this debtor",DIR("B")="NO" D ^DIR G EDSETD:'Y
;
;delete the recall in file 340
F I=2:1:4 S $P(^RCD(340,DEBTOR,7),U,I)=""
;go through debtor bills and delete the recall flag & reason
S BILL=0
F S BILL=$O(^PRCA(430,"C",DEBTOR,BILL)) Q:BILL'?1N.N D
.I $D(^PRCA(430,"TCSP",BILL)) D Q ;bill previously sent to TCSP
..S $P(^PRCA(430,BILL,15),U,2)="" ; delete the recall flag PRCA*4.5*315
..S $P(^PRCA(430,BILL,15),U,4)="" ; delete the recall reason
..D DELRCLL^RCTCSPD4 ; *315 CS DEL BILL RECALL in 433
;
W !!,"Recall from Cross-Servicing has been deleted for this debtor."
G SETDQ
;
EDSETD S DIR(0)="Y",DIR("A")="Do you wish to edit the Recall data for this debtor",DIR("B")="NO" D ^DIR G RCRSD:Y
SETDQ Q
;
DECADJ(RCBILLDA,RCTRANDA) ;decrease adjustment transaction history for 5b cross-servicing record
;rcbillda - file 430 bill ien
;rctranda - file 433 transaction ien
N BILL,DIC,DA,DIE,DR,Y,X
I '$D(RCBILLDA)!('$D(RCTRANDA)) Q
S X=RCTRANDA
S DIC="^PRCA(430,"_RCBILLDA_",17,",DIC(0)="L"
I '$D(^PRCA(430,RCBILLDA,17,0)) S ^PRCA(430,RCBILLDA,17,0)="^430.0171PA^0^0"
S DIC("P")=$P(^PRCA(430,RCBILLDA,17,0),"^",2)
S DA(1)=RCBILLDA
S BILL=RCBILLDA
D ^DIC I Y=-1 K DIC,DA Q
S DIE=DIC K DIC
S DA=+Y
S DR="1////1" D ^DIE ; Reinstated the 4 slashes
Q
;
INCADJ(RCBILLDA,RCTRANDA) ;increase adjustment transaction history for 5b cross-servicing record 315/DRF
;rcbillda - file 430 bill ien
;rctranda - file 433 transaction ien
N DIC,DA,DIE,DR,Y,X
I '$D(RCBILLDA)!('$D(RCTRANDA)) Q
S X=RCTRANDA
S DIC="^PRCA(430,"_RCBILLDA_",17,",DIC(0)="L"
I '$D(^PRCA(430,RCBILLDA,17,0)) S ^PRCA(430,RCBILLDA,17,0)="^430.0171PA^0^0"
S DIC("P")=$P(^PRCA(430,RCBILLDA,17,0),"^",2)
S DA(1)=RCBILLDA
D ^DIC I Y=-1 K DIC,DA Q
S DIE=DIC K DIC
S DA=+Y
S DR="1////1" D ^DIE
Q
;
RCLLSETC ;Set Cross-Servicing recall for a case
N DIC,DIE,DA,DR,DIR,Y,BILL,REASON
S DIC=430,DIC(0)="AEQM" D ^DIC Q:Y<0
S BILL=+Y
I $P($G(^PRCA(430,BILL,15)),U,11) G DELSETC
S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you sure you want to set this case to be recalled from Cross-Servicing" D ^DIR
I 'Y W !,*7,"No action taken" Q
I '$D(^PRCA(430,"TCSP",BILL)) W !,*7,"No action taken. Case has not been referred to Cross-Servicing." Q
;
RCRSC ;set case recall reason
;set recall data in file 430 for the bill and the case
S REASON=15
S $P(^PRCA(430,BILL,15),U,11,13)="1^^"_REASON
S $P(^PRCA(430,BILL,15),U,2,4)="1^^"_REASON
;
D RCRSC^RCTCSPD4 ; *315 CS CASE RECALL tx
W !,"Setting this case for Recall from Cross-Servicing is complete"
G SETCQ
;
DELSETC ;Allows Cross-Servicing Recall to be deleted for case
W !!,*7,"This case has already been set for recall from Cross-Servicing."
S DIR(0)="Y",DIR("A")="Do you wish to delete the Cross-Servicing Recall for this case",DIR("B")="NO" D ^DIR G SETCQ:'Y
;
;delete the case recall
F I=11:1:13 S $P(^PRCA(430,BILL,15),U,I)=""
F I=2:1:5 S $P(^PRCA(430,BILL,15),U,I)=""
D DELSETC^RCTCSPD4 ; *315 Create CS Delete Case Recall comment tx in 433
W !!,"Recall from Cross-Servicing has been deleted for this case."
G SETCQ
;
SETCQ Q
;
SSN(DEBT) ;Get SSN for debtor
;Input Debtor (340)
;Output: SSN # or null
NEW Y
S Y=-1 G:'$G(DEBT) Q1
S:DEBT?1N.N DEBT=$P($G(^RCD(340,DEBT,0)),"^")
I DEBT[";DPT(" S Y=$P($G(^DPT(+DEBT,0)),"^",9)
I DEBT[";VA(200," S Y=$P($G(^VA(200,+DEBT,1)),"^",9)
Q1 Q Y
;
Q
;
RECALL(BILL) ; recall bill from cross-servicing due to HRFS flag being set PRCA*4.5*400
;
; BILL - bill to recall (file 430 ien)
;
; returns 1 on success, 0^error on failure
;
N DIERR,FDA,IENS
I BILL'>0 Q "0^Invalid file 430 ien"
L +^PRCA(430,BILL):5 I '$T Q "0^Unable to lock entry"
S IENS=BILL_","
S FDA(430,IENS,152)=1
S FDA(430,IENS,154)="05"
D FILE^DIE("","FDA","DIERR")
I $D(DIERR("DIERR")) Q "0^"_$G(DIERR("DIERR",1,"TEXT",1))
L -^PRCA(430,BILL)
D CSRCLPL1^RCTCSPD5 ; CS Recall Placed comment tx in 433
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCTCSPU 15154 printed Oct 16, 2024@17:49:49 Page 2
RCTCSPU ;ALBANY/BDB - CROSS-SERVICING UTILITIES ;03/15/14 3:34 PM
+1 ;;4.5;Accounts Receivable;**301,315,350,400**;Mar 20, 1995;Build 13
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;total amount of bills for a debtor
TOTALB(DEBTOR) ;
+1 NEW TOTAL,BILL,B7
+2 SET TOTAL=0
SET BILL=0
+3 FOR
SET BILL=$ORDER(^PRCA(430,"C",DEBTOR,BILL))
if BILL'?1N.N
QUIT
Begin DoDot:1
+4 if '$DATA(^PRCA(430,"TCSP",BILL))
QUIT
+5 SET B7=$GET(^PRCA(430,BILL,7))
+6 SET TOTAL=TOTAL+$PIECE(B7,U)+$PIECE(B7,U,2)+$PIECE(B7,U,3)+$PIECE(B7,U,4)+$PIECE(B7,U,5)
End DoDot:1
+7 QUIT TOTAL
+8 ;
+9 ;stop TCSP referral on a bill
STOP ;stop Cross-Servicing referral
+1 NEW DIC,DIE,DA,DR,DIR,Y,BILL,REASON,COMMENT,EFFDT
+2 ;PRCA*4.5*315
IF $GET(GOTBILL)
SET BILL=RCBILLDA
+3 ;PRCA*4.5*315
IF '$GET(GOTBILL)
SET DIC=430
SET DIC(0)="AEQM"
DO ^DIC
if Y<0
QUIT
+4 ;PRCA*4.5*315
IF '$GET(GOTBILL)
SET BILL=+Y
+5 IF $PIECE($GET(^PRCA(430,BILL,15)),U,7)
GOTO DELSTOP
+6 WRITE !,"Stop flag for Cross-Servicing Referral set? : NO"
+7 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Are you sure you want to stop the Cross-Servicing Referral for this bill"
DO ^DIR
+8 ; account profile listman quit flag *315
IF $GET(GOTBILL)
IF $DATA(DIRUT)
SET RCDPGQ=1
+9 IF 'Y
WRITE !,*7,"No action taken"
QUIT
+10 ;
REASON ;ask referral reason
+1 KILL DIR
SET DIR("A")="Enter Stop Cross-Servicing Reason "
SET DA=BILL
SET DIR(0)="430,159"
DO ^DIR
+2 if (Y="")!(Y=U)
QUIT
+3 SET REASON=Y
IF REASON="O"
Begin DoDot:1
+4 SET COMMENT=""
SET DIR("A")="Enter Stop Reason Comment "
SET DA=BILL
SET DIR(0)="430,159.1"
DO ^DIR
SET COMMENT=Y
+5 IF COMMENT=""
WRITE !,"A Reason of Other requires a comment to be entered"
+6 QUIT
End DoDot:1
if COMMENT=U
QUIT
if COMMENT=""
GOTO REASON
+7 IF REASON'="O"
IF $PIECE($GET(^PRCA(430,BILL,15)),U,10)'=""
SET $PIECE(^(15),U,10)=""
+8 ;
+9 ;ask effective date
+10 ;
+11 SET DIR(0)="430,158"
SET DA=BILL
SET DIR("A")="Enter Effective Date "
DO ^DIR
if Y=U
GOTO STOPQ
SET EFFDT=Y
+12 ;
STOPFILE ;set stop referral data in file 430
+1 SET $PIECE(^PRCA(430,BILL,15),U,7,10)="1^"_EFFDT_U_REASON_U_$GET(COMMENT)
+2 ;
+3 WRITE !,"Stop Cross-Servicing Referral complete"
+4 ; *315 Create CS Stop Placed comment tx in 433
DO STOP^RCTCSPD4
+5 GOTO STOPQ
+6 ;
DELSTOP ;Allows Cross-Servicing Referral to be re-instituted for bill
+1 NEW I
+2 WRITE !!,*7,"Referral to Cross-Servicing has already been stopped for this bill."
+3 WRITE !,"Stop Cross-Servicing referral effective date: ",$$GET1^DIQ(430,BILL,158,"E")
+4 WRITE !,"Stop Cross-Servicing referral reason : ",$$GET1^DIQ(430,BILL,159,"E")
+5 IF $$GET1^DIQ(430,BILL,159,"E")="OTHER"
WRITE !,"Stop Cross-Servicing referral comment : ",$$GET1^DIQ(430,BILL,159.1,"E")
+6 SET DIR(0)="Y"
SET DIR("A")="Do you wish to re-institute Cross-Servicing Referral for this bill"
SET DIR("B")="NO"
+7 DO ^DIR
+8 ; account profile listman quit flag *315
IF $GET(GOTBILL)
IF $DATA(DIRUT)
SET RCDPGQ=1
GOTO STOPQ
+9 if 'Y
GOTO EDSTOP
+10 ;
+11 ;reset file to allow cross-servicing referral to be re-started
+12 FOR I=7:1:10
SET $PIECE(^PRCA(430,BILL,15),U,I)=""
+13 ; *315 create CS Stop Deleted transaction
WRITE !!,"Bill is now eligible to be Referred to Cross-Servicing"
DO DELSTOP^RCTCSPD4
GOTO STOPQ
+14 ;
EDSTOP SET DIR(0)="Y"
SET DIR("A")="Do you wish to edit the Stop Referral Data for this bill"
SET DIR("B")="NO"
DO ^DIR
if Y
GOTO REASON
STOPQ QUIT
+1 ;
+2 ;Set Cross-Servicing recall for a bill
RCLLSETB ;Set Cross-Servicing recall
+1 NEW DIC,DIE,DA,DR,DIR,Y,BILL,REASON
+2 IF '$GET(GOTBILL)
SET DIC=430
SET DIC(0)="AEQM"
DO ^DIC
if Y<0
QUIT
+3 IF '$GET(GOTBILL)
SET BILL=+Y
+4 IF $GET(GOTBILL)
SET BILL=RCBILLDA
+5 IF $PIECE($GET(^PRCA(430,BILL,15)),U,2)
GOTO DELSETB
+6 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Are you sure you want to set this bill to be recalled from Cross-Servicing"
DO ^DIR
+7 ; account profile listman quit flag *315
IF $GET(GOTBILL)
IF $DATA(DIRUT)
SET RCDPGQ=1
+8 IF 'Y
WRITE !,*7,"No action taken"
QUIT
+9 IF '$DATA(^PRCA(430,"TCSP",BILL))
WRITE !,*7,"No action taken. Bill has not been referred to Cross-Servicing."
QUIT
+10 ;
RCRSB ;ask recall reason
+1 KILL DIR
SET DIR(0)="S^01:DEBT REFERRED IN ERROR;07:AGENCY IS FORGIVING DEBT;08:AGENCY CAN COLLECT THROUGH INTERNAL OFFSET"
DO ^DIR
+2 if (Y="")!(Y=U)
QUIT
+3 ;set recall data in file 430
+4 SET REASON=Y
+5 SET $PIECE(^PRCA(430,BILL,15),U,2,4)="1^^"_REASON
+6 ; *315 CS Recall Placed comment tx in 433
DO CSRCLPL^RCTCSPD5
+7 WRITE !,"Setting this bill for Recall from Cross-Servicing is complete"
+8 GOTO SETBQ
+9 ;
RRSET ; Set rerefer for bills PRCA*4.5*350
+1 NEW BILL,STOP
+2 SET STOP=0
+3 FOR
DO RRSETB
if BILL=""
QUIT
if STOP
QUIT
+4 QUIT
+5 ; Set rerefer for bill PRCA*4.5*350
RRSETB ;
+1 NEW DIC,DIE,DA,DR,DIR,Y,DIROUT,DTOUT,DUOUT,DIRUT
+2 NEW WR,EXE,DEBTOR,CHECK,REASON,COMMENT,LIEN,QUIT,FIXABLE
+3 SET BILL=""
SET LIEN=""
SET QUIT=""
+4 ; Still experimenting if to use DIC or DIR
+5 SET DIC=430
SET DIC(0)="AEQMS"
SET DIC("A")="Enter Bill Number for re-referral: "
+6 ; we will allow selection of bills here and show error message if we don't like bill.
+7 ;S DIC("S")="I $D(^PRCA(430,Y,15))"
+8 DO ^DIC
+9 SET BILL=+Y
if Y=-1
SET STOP=1
+10 IF STOP
QUIT
+11 SET DEBTOR=$PIECE($GET(^PRCA(430,BILL,0)),U,9)
+12 IF $$RR^RCTCSPU(BILL)=0
Begin DoDot:1
+13 NEW NZ,REASON,COMMENT
+14 WRITE !!,"Re-Referral has already been requested",!
+15 SET LIEN=$ORDER(^PRCA(430,BILL,15.5,99999),-1)
+16 SET NZ=^PRCA(430,BILL,15.5,LIEN,0)
SET REASON=$PIECE(NZ,U,4)
SET COMMENT=$PIECE(NZ,U,5)
+17 WRITE !,"By ",$PIECE(^VA(200,$PIECE(NZ,U,3),0),U)," on ",$$FMTE^XLFDT($PIECE(NZ,U,2),"5Z")," Reason: "
+18 WRITE $SELECT(REASON="R":"Recall in error",REASON="T":"Treasury reversal",REASON="D":"Defaulted RPP",REASON="O":"Other: "_COMMENT,1:""),!
+19 KILL DIR
SET DIR("A")="Do you want to Cancel this Re-Referral"
SET DIR("B")="NO"
SET DIR(0)="Y"
DO ^DIR
+20 IF X=""
SET STOP=1
QUIT
+21 IF $GET(DTOUT)
SET STOP=1
QUIT
+22 IF $GET(DIROUT)
SET STOP=1
QUIT
+23 IF $GET(DUOUT)
SET STOP=1
QUIT
+24 IF Y
Begin DoDot:2
+25 ; remove LIEN from 15.5. Use DIK?
+26 IF LIEN=1
KILL ^PRCA(430,BILL,15.5,0)
+27 IF '$TEST
SET $PIECE(^PRCA(430,BILL,15.5,0),U,2)=430.03
SET $PIECE(^PRCA(430,BILL,15.5,0),U,3)=LIEN-1
SET $PIECE(^PRCA(430,BILL,15.5,0),U,4)=$PIECE(^PRCA(430,BILL,15.5,0),U,4)-1
+28 KILL ^PRCA(430,BILL,15.5,LIEN)
+29 KILL ^PRCA(430,BILL,15.5,"B",0,LIEN)
+30 DO RRCAN^RCTCSPD4
+31 WRITE !!,"*** Re-Referral has been cancelled for this bill ***"
+32 QUIT
End DoDot:2
SET QUIT=1
QUIT
+33 KILL DIR
SET DIR("A")="Do you want to Update this Re-Referral"
SET DIR("B")="NO"
SET DIR(0)="Y"
DO ^DIR
+34 IF X=""
SET QUIT=1
QUIT
+35 IF $GET(DTOUT)
SET STOP=1
QUIT
+36 IF $GET(DIROUT)
SET STOP=1
QUIT
+37 IF $GET(DUOUT)
SET STOP=1
QUIT
+38 IF X?1"N".E!(X?1"n".E)
WRITE !!,"*** No changes applied to this re-referral ***",!
SET QUIT=1
QUIT
End DoDot:1
if STOP
QUIT
if QUIT
QUIT
+39 Begin DoDot:1
+40 SET CHECK=1
+41 IF 'DEBTOR
SET CHECK="0^0^Bill has no debtor"
QUIT
+42 IF '$PIECE($GET(^PRCA(430,BILL,30)),U)
IF '$PIECE($GET(^PRCA(430,BILL,15)),U,3)
SET CHECK="0^0^Bill is not Returned or Recalled, so can't re-refer"
QUIT
+43 ; Disabling Stop flag is OK for now, but we will need to clear it at some point. Batch Job?
+44 SET CHECK=$$RSBILCHK^RCTCSPD0(BILL,"3,20")
End DoDot:1
+45 IF 'CHECK
Begin DoDot:1
+46 SET FIXABLE=$FIND(",0,3,5,6,12,15,16,19,20,21,24,26,27,",","_$PIECE(CHECK,U,2)_",")
+47 IF 'FIXABLE
WRITE !!,"Unable to complete the re-referral process",!,$PIECE(CHECK,U,3)
QUIT
+48 WRITE !!,"This bill has issues and will not make it through re-referral process because:",!,$PIECE(CHECK,U,3)
+49 WRITE !!,"PLEASE CORRECT THIS ISSUE AND THEN RE-REFER THE BILL AGAIN",!
+50 KILL DIR
SET DIR(0)="FO"
SET DIR("A")="Press <ENTER> to continue "
DO ^DIR
+51 IF (Y=U)!$GET(DTOUT)!$GET(DUOUT)
SET STOP=1
End DoDot:1
QUIT
+52 ; Ask Rerefer Reason and description if O=Other
+53 KILL DIR
SET DIR(0)="S^R:Recall in error;T:Treasury reversal;D:Defaulted RPP;O:Other"
+54 SET DIR("A")="Select Reason for this re-referral"
+55 DO ^DIR
+56 IF (Y="")!(Y=U)!$GET(DTOUT)!$GET(DUOUT)
SET STOP=1
QUIT
+57 WRITE !
+58 SET REASON=Y
+59 IF REASON="O"
KILL DIR
SET DIR(0)="F^1:30"
SET DIR("A")="Enter ""Other"" description "
DO ^DIR
if Y=""
QUIT
if Y=U
QUIT
SET COMMENT=Y
+60 ; Are you sure (do we want to ask this for update to rereferral?)
+61 KILL DIR
SET DIR("A")="Are you sure you want to Re-refer this bill for Cross-Servicing"
SET DIR(0)="Y"
SET DIR("B")="YES"
+62 DO ^DIR
+63 IF (Y=U)!$GET(DTOUT)!$GET(DUOUT)
SET STOP=1
QUIT
+64 IF 'Y
WRITE !!,"*** No updates applied ***"
QUIT
+65 ; user, date, status of rerefer
+66 IF LIEN'=""
Begin DoDot:1
+67 ; That should be all we need for update of last IEN
+68 SET ^PRCA(430,BILL,15.5,LIEN,0)=0_U_DT_U_DUZ_U_REASON_U_$GET(COMMENT)
End DoDot:1
+69 IF LIEN=""
Begin DoDot:1
+70 SET LIEN=$ORDER(^PRCA(430,BILL,15.5,99999),-1)+1
+71 SET $PIECE(^PRCA(430,BILL,15.5,0),U,2)=430.03
+72 SET $PIECE(^PRCA(430,BILL,15.5,0),U,3)=LIEN
+73 SET $PIECE(^PRCA(430,BILL,15.5,0),U,4)=$PIECE(^PRCA(430,BILL,15.5,0),U,4)+1
+74 SET ^PRCA(430,BILL,15.5,LIEN,0)=0_U_DT_U_DUZ_U_REASON_U_$GET(COMMENT)
+75 SET ^PRCA(430,BILL,15.5,"B",0,LIEN)=""
End DoDot:1
+76 WRITE !!,"Bill is set to be re-referred to Cross-Servicing in the next weekly transmission"
+77 WRITE !
+78 ; file Rerefer Request transaction
+79 DO RRREQ^RCTCSPD4
+80 KILL DIR
SET DIR(0)="FO"
SET DIR("A")="Press <ENTER> to continue "
DO ^DIR
+81 WRITE !
+82 IF (Y=U)!$GET(DTOUT)!$GET(DUOUT)
SET STOP=1
QUIT
+83 QUIT
RR(BILL) ; PRCA*4.5*350
+1 ; Return: Null = no RR, 0 = RR Requested, 1 = RR Performed
+2 NEW LIEN
+3 if BILL=""
QUIT ""
+4 SET LIEN=$ORDER(^PRCA(430,BILL,15.5,99999),-1)
+5 IF LIEN<1
QUIT ""
+6 QUIT $PIECE(^PRCA(430,BILL,15.5,LIEN,0),U)
+7 ;
RRD(DEBTOR) ; PRCA*4.5*350
+1 ; Return: 0 = Debtor has no RR bills, 1 = Debtor has RR bills
+2 if DEBTOR=""
QUIT 0
+3 NEW BILL,OUT
+4 SET BILL=""
SET OUT=0
+5 FOR
SET BILL=$ORDER(^PRCA(430,"C",DEBTOR,BILL))
if BILL=""
QUIT
IF $$RR(BILL)
SET OUT=1
QUIT
+6 QUIT OUT
+7 ;
DELSETB ;Allows Cross-Servicing Recall to be deleted for bill
+1 WRITE !!,*7,"This bill has already been set for recall from Cross-Servicing."
+2 IF +$PIECE($GET(^PRCA(430,BILL,15)),U,3)
WRITE !!,"Not available for reactivation. The Recall request has already been processed."
GOTO SETBQ
+3 SET DIR(0)="Y"
SET DIR("A")="Do you wish to delete the Cross-Servicing Recall for this bill"
SET DIR("B")="NO"
+4 DO ^DIR
+5 ; account profile listman quit flag *315
IF $GET(GOTBILL)
IF $DATA(DIRUT)
SET RCDPGQ=1
GOTO SETBQ
+6 if 'Y
GOTO EDSETB
+7 ;
+8 ;delete the recall
+9 FOR I=2:1:5
SET $PIECE(^PRCA(430,BILL,15),U,I)=""
+10 ; *315 Create CS Delete Recall comment tx in 433
DO DELRCLL^RCTCSPD4
+11 WRITE !!,"Recall from Cross-Servicing has been deleted for this bill."
+12 GOTO SETBQ
+13 ;
EDSETB SET DIR(0)="Y"
SET DIR("A")="Do you wish to edit the Recall data for this bill"
SET DIR("B")="NO"
DO ^DIR
if Y
GOTO RCRSB
SETBQ QUIT
+1 ;
+2 ;Set Cross-Servicing recall for a debtor
RCLLSETD ;Set Cross-Servicing debtor recall
+1 NEW DIC,DIE,DA,DR,DIR,Y,DEBTOR,REASON,BILL
+2 ; GOTDEBT, RCDEBTDA - are defined if called from List Manager
+3 ; *315
IF '$GET(GOTDEBT)
SET DIC=340
SET DIC(0)="AEQM"
DO ^DIC
if Y<0
QUIT
+4 ; *315
IF '$GET(GOTDEBT)
SET DEBTOR=+Y
+5 ; *315
IF $GET(GOTDEBT)
SET DEBTOR=RCDEBTDA
+6 IF $PIECE($GET(^RCD(340,DEBTOR,7)),U,2)
IF '$PIECE($GET(^RCD(340,DEBTOR,7)),U,3)
GOTO DELSETD
+7 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Are you sure you want to recall this debtor and bills from Cross-Servicing"
DO ^DIR
+8 IF 'Y
WRITE !,*7,"No action taken"
QUIT
+9 IF '$DATA(^RCD(340,"TCSP",DEBTOR))
WRITE !,*7,"No action taken. Debtor has not been referred to Cross-Servicing."
QUIT
+10 ;
RCRSD ;ask debtor recall reason
+1 KILL DIR
SET DIR(0)="340,7.04"
DO ^DIR
+2 if (Y="")!(Y=U)
QUIT
+3 ;set debtor recall data in file 340
+4 SET REASON=Y
+5 ;S $P(^RCD(340,DEBTOR,7),U,2,4)="1^^"_REASON PRCA*4.5*400
+6 ;go through debtor bills and set reason in the bill recall reason
+7 SET BILL=0
+8 FOR
SET BILL=$ORDER(^PRCA(430,"C",DEBTOR,BILL))
if BILL'?1N.N
QUIT
Begin DoDot:1
+9 ;bill previously sent to TCSP
IF $DATA(^PRCA(430,"TCSP",BILL))
Begin DoDot:2
+10 ;set the recall flag and reason (TV9)
SET $PIECE(^PRCA(430,BILL,15),U,2,4)="1^^"_REASON
+11 ; *315 Create CS RECALL PLACED tx in 433
DO CSRCLPL^RCTCSPD5
End DoDot:2
QUIT
End DoDot:1
+12 WRITE !,"Setting this debtor for Recall from Cross-Servicing is complete"
+13 GOTO SETDQ
+14 ;
DELSETD ;Allows Cross-Servicing Recall to be deleted for debtor
+1 WRITE !!,*7,"This debtor has already been set for recall from Cross-Servicing."
+2 SET DIR(0)="Y"
SET DIR("A")="Do you wish to delete the Cross-Servicing Recall for this debtor"
SET DIR("B")="NO"
DO ^DIR
if 'Y
GOTO EDSETD
+3 ;
+4 ;delete the recall in file 340
+5 FOR I=2:1:4
SET $PIECE(^RCD(340,DEBTOR,7),U,I)=""
+6 ;go through debtor bills and delete the recall flag & reason
+7 SET BILL=0
+8 FOR
SET BILL=$ORDER(^PRCA(430,"C",DEBTOR,BILL))
if BILL'?1N.N
QUIT
Begin DoDot:1
+9 ;bill previously sent to TCSP
IF $DATA(^PRCA(430,"TCSP",BILL))
Begin DoDot:2
+10 ; delete the recall flag PRCA*4.5*315
SET $PIECE(^PRCA(430,BILL,15),U,2)=""
+11 ; delete the recall reason
SET $PIECE(^PRCA(430,BILL,15),U,4)=""
+12 ; *315 CS DEL BILL RECALL in 433
DO DELRCLL^RCTCSPD4
End DoDot:2
QUIT
End DoDot:1
+13 ;
+14 WRITE !!,"Recall from Cross-Servicing has been deleted for this debtor."
+15 GOTO SETDQ
+16 ;
EDSETD SET DIR(0)="Y"
SET DIR("A")="Do you wish to edit the Recall data for this debtor"
SET DIR("B")="NO"
DO ^DIR
if Y
GOTO RCRSD
SETDQ QUIT
+1 ;
DECADJ(RCBILLDA,RCTRANDA) ;decrease adjustment transaction history for 5b cross-servicing record
+1 ;rcbillda - file 430 bill ien
+2 ;rctranda - file 433 transaction ien
+3 NEW BILL,DIC,DA,DIE,DR,Y,X
+4 IF '$DATA(RCBILLDA)!('$DATA(RCTRANDA))
QUIT
+5 SET X=RCTRANDA
+6 SET DIC="^PRCA(430,"_RCBILLDA_",17,"
SET DIC(0)="L"
+7 IF '$DATA(^PRCA(430,RCBILLDA,17,0))
SET ^PRCA(430,RCBILLDA,17,0)="^430.0171PA^0^0"
+8 SET DIC("P")=$PIECE(^PRCA(430,RCBILLDA,17,0),"^",2)
+9 SET DA(1)=RCBILLDA
+10 SET BILL=RCBILLDA
+11 DO ^DIC
IF Y=-1
KILL DIC,DA
QUIT
+12 SET DIE=DIC
KILL DIC
+13 SET DA=+Y
+14 ; Reinstated the 4 slashes
SET DR="1////1"
DO ^DIE
+15 QUIT
+16 ;
INCADJ(RCBILLDA,RCTRANDA) ;increase adjustment transaction history for 5b cross-servicing record 315/DRF
+1 ;rcbillda - file 430 bill ien
+2 ;rctranda - file 433 transaction ien
+3 NEW DIC,DA,DIE,DR,Y,X
+4 IF '$DATA(RCBILLDA)!('$DATA(RCTRANDA))
QUIT
+5 SET X=RCTRANDA
+6 SET DIC="^PRCA(430,"_RCBILLDA_",17,"
SET DIC(0)="L"
+7 IF '$DATA(^PRCA(430,RCBILLDA,17,0))
SET ^PRCA(430,RCBILLDA,17,0)="^430.0171PA^0^0"
+8 SET DIC("P")=$PIECE(^PRCA(430,RCBILLDA,17,0),"^",2)
+9 SET DA(1)=RCBILLDA
+10 DO ^DIC
IF Y=-1
KILL DIC,DA
QUIT
+11 SET DIE=DIC
KILL DIC
+12 SET DA=+Y
+13 SET DR="1////1"
DO ^DIE
+14 QUIT
+15 ;
RCLLSETC ;Set Cross-Servicing recall for a case
+1 NEW DIC,DIE,DA,DR,DIR,Y,BILL,REASON
+2 SET DIC=430
SET DIC(0)="AEQM"
DO ^DIC
if Y<0
QUIT
+3 SET BILL=+Y
+4 IF $PIECE($GET(^PRCA(430,BILL,15)),U,11)
GOTO DELSETC
+5 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Are you sure you want to set this case to be recalled from Cross-Servicing"
DO ^DIR
+6 IF 'Y
WRITE !,*7,"No action taken"
QUIT
+7 IF '$DATA(^PRCA(430,"TCSP",BILL))
WRITE !,*7,"No action taken. Case has not been referred to Cross-Servicing."
QUIT
+8 ;
RCRSC ;set case recall reason
+1 ;set recall data in file 430 for the bill and the case
+2 SET REASON=15
+3 SET $PIECE(^PRCA(430,BILL,15),U,11,13)="1^^"_REASON
+4 SET $PIECE(^PRCA(430,BILL,15),U,2,4)="1^^"_REASON
+5 ;
+6 ; *315 CS CASE RECALL tx
DO RCRSC^RCTCSPD4
+7 WRITE !,"Setting this case for Recall from Cross-Servicing is complete"
+8 GOTO SETCQ
+9 ;
DELSETC ;Allows Cross-Servicing Recall to be deleted for case
+1 WRITE !!,*7,"This case has already been set for recall from Cross-Servicing."
+2 SET DIR(0)="Y"
SET DIR("A")="Do you wish to delete the Cross-Servicing Recall for this case"
SET DIR("B")="NO"
DO ^DIR
if 'Y
GOTO SETCQ
+3 ;
+4 ;delete the case recall
+5 FOR I=11:1:13
SET $PIECE(^PRCA(430,BILL,15),U,I)=""
+6 FOR I=2:1:5
SET $PIECE(^PRCA(430,BILL,15),U,I)=""
+7 ; *315 Create CS Delete Case Recall comment tx in 433
DO DELSETC^RCTCSPD4
+8 WRITE !!,"Recall from Cross-Servicing has been deleted for this case."
+9 GOTO SETCQ
+10 ;
SETCQ QUIT
+1 ;
SSN(DEBT) ;Get SSN for debtor
+1 ;Input Debtor (340)
+2 ;Output: SSN # or null
+3 NEW Y
+4 SET Y=-1
if '$GET(DEBT)
GOTO Q1
+5 if DEBT?1N.N
SET DEBT=$PIECE($GET(^RCD(340,DEBT,0)),"^")
+6 IF DEBT[";DPT("
SET Y=$PIECE($GET(^DPT(+DEBT,0)),"^",9)
+7 IF DEBT[";VA(200,"
SET Y=$PIECE($GET(^VA(200,+DEBT,1)),"^",9)
Q1 QUIT Y
+1 ;
+2 QUIT
+3 ;
RECALL(BILL) ; recall bill from cross-servicing due to HRFS flag being set PRCA*4.5*400
+1 ;
+2 ; BILL - bill to recall (file 430 ien)
+3 ;
+4 ; returns 1 on success, 0^error on failure
+5 ;
+6 NEW DIERR,FDA,IENS
+7 IF BILL'>0
QUIT "0^Invalid file 430 ien"
+8 LOCK +^PRCA(430,BILL):5
IF '$TEST
QUIT "0^Unable to lock entry"
+9 SET IENS=BILL_","
+10 SET FDA(430,IENS,152)=1
+11 SET FDA(430,IENS,154)="05"
+12 DO FILE^DIE("","FDA","DIERR")
+13 IF $DATA(DIERR("DIERR"))
QUIT "0^"_$GET(DIERR("DIERR",1,"TEXT",1))
+14 LOCK -^PRCA(430,BILL)
+15 ; CS Recall Placed comment tx in 433
DO CSRCLPL1^RCTCSPD5
+16 QUIT 1
