- 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 Jan 18, 2025@02:50:12 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