RCTCSPD0 ;ALBANY/RGB - CROSS-SERVICING TRANSMISSION START ;06/15/17 3:34 PM
;;4.5;Accounts Receivable;**327,337,350,343**;Mar 20, 1995;Build 59
;;Per VA Directive 6402, this routine should not be modified.
;
;PRCA*4.5*327 new setup/finish extraction from RCTCSPD and
; modify XTMP file kill to work correctly for
; 5 days after Tuesday run.
; Also, send mail message to 'TCSP' mailgroup
; to report any missing/corrupted debtor entries.
;
;PRCA*4.5*337 Modify the top node of ^XTMP work files
; to have ONLY ^XTMP(namespace,0) to insure
; correct purging outcome.
;PRCA*4.5*350 Added RS1 tag to have non-global variables setup
;
SETUP ;Entry point from nightly process PRCABJ
;
;initialize temporary global, variables
;
K ^TMP("RCTCSPD",$J)
K ^XTMP("RCTCSPD")
K ^XTMP("RCTCSPDN")
S ^XTMP("RCTCSPD",0)=$$FMADD^XLFDT(DT,5)_"^"_DT
S ^XTMP("RCTCSPDN",0)=$$FMADD^XLFDT(DT,5)_"^"_DT
RESTART D NOW^%DTC S ^XTMP("RCTCSPD",$J,"ZZASTART")=%
RS1 S SITE=$E($$SITE^RCMSITE(),1,3),SITECD=$P(^RC(342,1,3),U,5)
S ACTDT=3150801 ;activation date for all sites except beckley, little rock, upstate ny
S:SITE=598 ACTDT=3150201 ;activation date for little rock
S:SITE=517 ACTDT=3150201 ;activation date for beckley
S:SITE=528 ACTDT=3150201 ;activation date for upstate ny
S SITE40=$O(^RC(342,1,40,"A"),-1) I SITE40?1.N S SITE40=$P($G(^RC(342,1,40,SITE40,0)),U)
S X1=DT,X2=-151 D C^%DTC S RC151DT=X ; PRCA*4.5*343 - change from 150 to 151 days ago, namespace variable
S X1=DT,X2=+60 D C^%DTC S F60DT=X
S (CNTR(1),CNTR(2),CNTR("2A"),CNTR("2C"),CNTR(3),CNTR("5A"),CNTR("5B"))=0
Q
FINISH ;sends mailman message to TCSP mail group to show batch fully completed
I $D(^XTMP("RCTCSPD",$J,"ZZUNDEF")) D UNDEF
N XMY,XMDUZ,XMSUB,XMTEXT,BMSG
S XMDUZ="AR PACKAGE"
S XMY("G.TCSP")=""
S XMSUB="*** Batch Completion Notice ***"
S BMSG(1)="The batch run and transmission completed on "_(17000000+^XTMP("RCTCSPD",$J,"ZZHCOMPLETE"))
S XMTEXT="BMSG("
Q:$G(ONEBILL)
D ^XMD
K ^TMP("RCTCSPD",$J)
Q
UNDEF ;send message to mail group for any undefined debtor entries found
N XMY,XMDUZ,XMSUB,XMTEXT,BMSG,IEN,CTR
S XMDUZ="AR PACKAGE"
S XMY("G.TCSP")=""
S XMSUB="**** FAILED DEBTOR ACTION NOTICE ***"
S BMSG(1)="The following corrupted debtor records were found during the batch run."
S BMSG(2)="They can be found in xref ^PRCA(430,_""C""_) and have no file 340 entry or a"
S BMSG(3)="corrupted entry (missing node 0 or 1)."
s BMSG(4)=" "
S BMSG(97)=" "
S BMSG(98)="*** These corrupt debtor file records must be reported to ***"
S BMSG(99)="*** region IT staff to be corrected immediately !! ***"
S IEN=0,CTR=4 F S IEN=$O(^XTMP("RCTCSPD",$J,"ZZUNDEF",IEN)) Q:'IEN D
. S CTR=CTR+1,BMSG(CTR)="CORRUPT DEBTOR INTERNAL: "_IEN
S XMTEXT="BMSG("
Q:$G(ONEBILL)
D ^XMD
Q
RSBILCHK(BILL,NOCHK) ; PRCA*4.5*350
; Input: BILL - IEN for 430
; NOCHK - Comma separated value
; Output: 1 - bill passed
; 0^fail#^message - bill failed^fail number^fail message
; *************************************************************************
; This is a copy of bill sending logic from RSBILL, except that it only checks if the bill passes or not and doesn't send any messages.
; If you are updating RSBILL, please update this as well. Alternatively, RSBILL can be rewritten.
; *************************************************************************
N B0,B4,B6,B7,B9,B12,B121,B14,B15,B16,B19,B20,ACTION,TOTAL,CAT
N ACTDT,RC181DT,F60DT,X1,X2,SITE,CNTR,DEBTOR,DEBTOR0,DEBTOR1,DEBTOR3,DEBTOR7,DEBTOR8,RCDFN,DEMCS
S NOCHK=","_$G(NOCHK)_","
S B0=$G(^PRCA(430,BILL,0)),B4=$G(^(4)),B6=$G(^(6)),B7=$G(^(7)),B9=$G(^(9)),B12=$G(^(12)),B121=$G(^(12.1)),B14=$G(^(14)),B15=$G(^(15)),B16=$G(^(16)),B19=$G(^(19)),B20=$G(^(20))
S DEBTOR=$P($G(^PRCA(430,BILL,0)),U,9)
I 'DEBTOR,NOCHK'[",0," Q "0^0^Bill has no debtor"
I NOCHK'[",0,",'$D(^RCD(340,DEBTOR,0)) Q "0^0^Bill has bad debtor"
S DEBTOR0=^RCD(340,DEBTOR,0),DEBTOR1=$G(^(1)),DEBTOR3=$G(^(3)),DEBTOR7=$G(^(7))
S DEBTOR8=$O(^RCD(340,DEBTOR,8,"A"),-1) I DEBTOR8?1.N S DEBTOR8=$P($G(^RCD(340,DEBTOR,8,DEBTOR8,0)),U)
D RS1^RCTCSPD0
S RCDFN=+DEBTOR0
S DEMCS=$$DEM^RCTCSP1(RCDFN)
I ($P(B6,U,21)\1)<ACTDT,NOCHK'[",1," Q "0^1^Bill's DATE ACCOUNT ACTIVATED "_$$FMTE^XLFDT($P(B6,U,21),"5D")_" is before site CS activation date" ;cs activation date cutoff
;Not needed, we can't quit here. RCLLCHK sends recalls for recall request bills and <$25 bills.
;It could also set 15 fields from 1 to 10
;I $D(^PRCA(430,"TCSP",BILL)),$$RCLLCHK^RCTCSP2(BILL) Q ;bill previously sent to TCSP
;This looks to be updates to currently referred bill. It sends potentially 2, 2A, 2C or 5B, none of which matters for debt.
;I $$UPDCHK(BILL) Q
I +$P(B14,U,1),NOCHK'[",4," Q "0^4^Bill was referred to TOP on "_$$FMTE^XLFDT($P(B14,U),"5D")
I +$P(B12,U,1),NOCHK'[",7," Q "0^7^DATE SENT TO DMC "_$$FMTE^XLFDT($P(B4,U),"5D")_" is set for the bill"
I $P(B121,U,1)="N",NOCHK'[",8," Q "0^8^DMC DEBT is not valid"
I $P(B121,U,1)="P",NOCHK'[",9," Q "0^9^DMC DEBT is pending"
I $P(B6,U,4),($P(B6,U,5)="DOJ"),NOCHK'[",10," Q "0^10^Bill has been referred to DOJ on "_$$FMTE^XLFDT($P(B6,U,4),"5D")
I +$P(DEMCS,U,4),NOCHK'[",11," Q "0^11^Debtor is deceased"
; Patch PRCA*4.5*338 (and maybe 351) will be replacing logic for errors 12, 13 and 14 with this:
;Q:'$$RFCHK^RCTOPD(CAT,"N",1.03,$P(B6,U,21)) ;PRCA*4.5*338 - Use RFCHK^RCTOPD to determine if the Category can be referred using the new date based algorithm.
I '$P(B0,U,2),NOCHK'[",12," Q "0^12^Bill has no CATEGORY"
S CAT=$P($G(^PRCA(430.2,$P(B0,U,2),0)),U,7)
I 'CAT,NOCHK'[",13," Q "0^13^Bill CATEGORY has no CATEGORY NUMBER"
I '$$RFCHK^RCTOPD(CAT,"N",1.03,$P(B6,U,21)),NOCHK'[",14," Q "0^14^Bill CATEGORY number "_CAT_" is not TCSP referable"
I B4,NOCHK'[",2," Q "0^2^Bill is on repayment plan started "_$$FMTE^XLFDT($P(B4,U),"5D")
I +$P(B15,U,7),NOCHK'[",3," Q "0^3^Bill has STOP FLAG set"
I DEBTOR8="S",NOCHK'[",26," Q "0^26^Debtor has STOP FLAG set" ;quit if debtor is stopped PRCA*4.5*350
I SITE40="S",NOCHK'[",27," Q "0^27^Site is stopped from sending referrals" ; quit if site is stopped PRCA*4.5*350
;dpn checks
I $P(B20,U,3)=1,(10000+$G(^RC(342,1,"CS")))>DT,'$P(B20,U,4),NOCHK'[",15," Q "0^15^DPN request not made yet"
I $P(B20,U,3)=1,(10000+$G(^RC(342,1,"CS")))>DT,$P(B20,U,4),'$P(B20,U,5),NOCHK'[",16," Q "0^16^DPN letter is not printed yet"
I $P(B20,U,3)=1,(10000+$G(^RC(342,1,"CS")))>DT,$P(B20,U,4),$P(B20,U,5) D I X<60,NOCHK'[",17," Q "0^17^Less than 60 days from DPN letter printed date "_$$FMTE^XLFDT($P(B20,U,5),"5D")
.N X1,X2
.S X1=DT,X2=$P(B20,U,5) D ^%DTC
S BILLDT=$P(B6,U,1),PREPDT=$P(B0,U,10) ; PRCA*4.5*343 - change BILLDT from DATE ACCOUNT ACTIVATED (#60) to LETTER1(#61) field
I BILLDT>RC151DT,NOCHK'[",18," Q "0^18^Must be 151 days or more after LETTER1 date "_$$FMTE^XLFDT($P(B6,U),"5D") ; PRCA*4.5*343 - change to 151 days
I $P(DEBTOR1,"^",9)=1,NOCHK'[",5," Q "0^5^Debtor address marked unknown"
I $E($P(DEMCS,U,3),1,5)="00000",NOCHK'[",6," Q "0^6^SSN "_$P(DEMCS,U,3)_" is not valid"
I $P(B0,U,8)'=16,NOCHK'[",19," Q "0^19^Bill is not set to ACTIVE"
; For rerefer, error 20 is not a showstopper.
I $P(B15,U,2),NOCHK'[",20," Q "0^20^Bill is marked as recalled"
; Note: that is not a showstopper for re-refer, I think, but it is for refer.
I $D(^PRCA(430,"TCSP",BILL)),NOCHK'[",21," Q "0^21^Bill previously sent to TCSP"
S TOTAL=$P(B7,U)+$P(B7,U,2)+$P(B7,U,3)+$P(B7,U,4)+$P(B7,U,5)
I TOTAL<25,NOCHK'[",22," Q "0^22^Bills less than $25 can't be referred"
I $D(^PRCA(430,"TCSP",BILL)),NOCHK'[",23," Q "0^23^Bill is already referred"
I '$P(B6,U,3),NOCHK'[",24," Q "0^24^Third Letter has not been sent"
Q 1
RRMARK ;
N I
F I=2,3,4,5,7,8,9,10 S $P(B15,U,I)="",$P(^PRCA(430,BILL,15),U,I)=""
I $P($G(^PRCA(430,BILL,30)),U) K ^PRCA(430,"AN",$P(^PRCA(430,BILL,30),U),BILL) S $P(^PRCA(430,BILL,30),U)="" S $P(^PRCA(430,BILL,30),U,9)=1
S I=$O(^PRCA(430,BILL,15.5,99999),-1)
S $P(^PRCA(430,BILL,15.5,0),U,2)=430.03
S $P(^PRCA(430,BILL,15.5,0),U,3)=I+1
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,I+1,0)=1_U_DT_U_$P($G(^PRCA(430,BILL,15.5,I,0)),U,3)
S ^PRCA(430,BILL,15.5,"B",1,I)=""
D NEWADI
Q
NEWADI ;Make new Agency Debt ID trailer PRCA*4.5*350
N TRAIL,CHK
S TRAIL=$P($G(^PRCA(430,BILL,21)),U,2)
I TRAIL="" S TRAIL="AA"
E S CHK=($A(TRAIL)-65)*26+($A(TRAIL,2)-65)+1,TRAIL=$C(CHK\26+65)_$C(CHK#26+65)
S $P(B15,U,15)=TRAIL,$P(^PRCA(430,BILL,21),U,2)=TRAIL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCTCSPD0 8681 printed Sep 23, 2025@19:25:04 Page 2
RCTCSPD0 ;ALBANY/RGB - CROSS-SERVICING TRANSMISSION START ;06/15/17 3:34 PM
+1 ;;4.5;Accounts Receivable;**327,337,350,343**;Mar 20, 1995;Build 59
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;PRCA*4.5*327 new setup/finish extraction from RCTCSPD and
+5 ; modify XTMP file kill to work correctly for
+6 ; 5 days after Tuesday run.
+7 ; Also, send mail message to 'TCSP' mailgroup
+8 ; to report any missing/corrupted debtor entries.
+9 ;
+10 ;PRCA*4.5*337 Modify the top node of ^XTMP work files
+11 ; to have ONLY ^XTMP(namespace,0) to insure
+12 ; correct purging outcome.
+13 ;PRCA*4.5*350 Added RS1 tag to have non-global variables setup
+14 ;
SETUP ;Entry point from nightly process PRCABJ
+1 ;
+2 ;initialize temporary global, variables
+3 ;
+4 KILL ^TMP("RCTCSPD",$JOB)
+5 KILL ^XTMP("RCTCSPD")
+6 KILL ^XTMP("RCTCSPDN")
+7 SET ^XTMP("RCTCSPD",0)=$$FMADD^XLFDT(DT,5)_"^"_DT
+8 SET ^XTMP("RCTCSPDN",0)=$$FMADD^XLFDT(DT,5)_"^"_DT
RESTART DO NOW^%DTC
SET ^XTMP("RCTCSPD",$JOB,"ZZASTART")=%
RS1 SET SITE=$EXTRACT($$SITE^RCMSITE(),1,3)
SET SITECD=$PIECE(^RC(342,1,3),U,5)
+1 ;activation date for all sites except beckley, little rock, upstate ny
SET ACTDT=3150801
+2 ;activation date for little rock
if SITE=598
SET ACTDT=3150201
+3 ;activation date for beckley
if SITE=517
SET ACTDT=3150201
+4 ;activation date for upstate ny
if SITE=528
SET ACTDT=3150201
+5 SET SITE40=$ORDER(^RC(342,1,40,"A"),-1)
IF SITE40?1.N
SET SITE40=$PIECE($GET(^RC(342,1,40,SITE40,0)),U)
+6 ; PRCA*4.5*343 - change from 150 to 151 days ago, namespace variable
SET X1=DT
SET X2=-151
DO C^%DTC
SET RC151DT=X
+7 SET X1=DT
SET X2=+60
DO C^%DTC
SET F60DT=X
+8 SET (CNTR(1),CNTR(2),CNTR("2A"),CNTR("2C"),CNTR(3),CNTR("5A"),CNTR("5B"))=0
+9 QUIT
FINISH ;sends mailman message to TCSP mail group to show batch fully completed
+1 IF $DATA(^XTMP("RCTCSPD",$JOB,"ZZUNDEF"))
DO UNDEF
+2 NEW XMY,XMDUZ,XMSUB,XMTEXT,BMSG
+3 SET XMDUZ="AR PACKAGE"
+4 SET XMY("G.TCSP")=""
+5 SET XMSUB="*** Batch Completion Notice ***"
+6 SET BMSG(1)="The batch run and transmission completed on "_(17000000+^XTMP("RCTCSPD",$JOB,"ZZHCOMPLETE"))
+7 SET XMTEXT="BMSG("
+8 if $GET(ONEBILL)
QUIT
+9 DO ^XMD
+10 KILL ^TMP("RCTCSPD",$JOB)
+11 QUIT
UNDEF ;send message to mail group for any undefined debtor entries found
+1 NEW XMY,XMDUZ,XMSUB,XMTEXT,BMSG,IEN,CTR
+2 SET XMDUZ="AR PACKAGE"
+3 SET XMY("G.TCSP")=""
+4 SET XMSUB="**** FAILED DEBTOR ACTION NOTICE ***"
+5 SET BMSG(1)="The following corrupted debtor records were found during the batch run."
+6 SET BMSG(2)="They can be found in xref ^PRCA(430,_""C""_) and have no file 340 entry or a"
+7 SET BMSG(3)="corrupted entry (missing node 0 or 1)."
+8 SET BMSG(4)=" "
+9 SET BMSG(97)=" "
+10 SET BMSG(98)="*** These corrupt debtor file records must be reported to ***"
+11 SET BMSG(99)="*** region IT staff to be corrected immediately !! ***"
+12 SET IEN=0
SET CTR=4
FOR
SET IEN=$ORDER(^XTMP("RCTCSPD",$JOB,"ZZUNDEF",IEN))
if 'IEN
QUIT
Begin DoDot:1
+13 SET CTR=CTR+1
SET BMSG(CTR)="CORRUPT DEBTOR INTERNAL: "_IEN
End DoDot:1
+14 SET XMTEXT="BMSG("
+15 if $GET(ONEBILL)
QUIT
+16 DO ^XMD
+17 QUIT
RSBILCHK(BILL,NOCHK) ; PRCA*4.5*350
+1 ; Input: BILL - IEN for 430
+2 ; NOCHK - Comma separated value
+3 ; Output: 1 - bill passed
+4 ; 0^fail#^message - bill failed^fail number^fail message
+5 ; *************************************************************************
+6 ; This is a copy of bill sending logic from RSBILL, except that it only checks if the bill passes or not and doesn't send any messages.
+7 ; If you are updating RSBILL, please update this as well. Alternatively, RSBILL can be rewritten.
+8 ; *************************************************************************
+9 NEW B0,B4,B6,B7,B9,B12,B121,B14,B15,B16,B19,B20,ACTION,TOTAL,CAT
+10 NEW ACTDT,RC181DT,F60DT,X1,X2,SITE,CNTR,DEBTOR,DEBTOR0,DEBTOR1,DEBTOR3,DEBTOR7,DEBTOR8,RCDFN,DEMCS
+11 SET NOCHK=","_$GET(NOCHK)_","
+12 SET B0=$GET(^PRCA(430,BILL,0))
SET B4=$GET(^(4))
SET B6=$GET(^(6))
SET B7=$GET(^(7))
SET B9=$GET(^(9))
SET B12=$GET(^(12))
SET B121=$GET(^(12.1))
SET B14=$GET(^(14))
SET B15=$GET(^(15))
SET B16=$GET(^(16))
SET B19=$GET(^(19))
SET B20=$GET(^(20))
+13 SET DEBTOR=$PIECE($GET(^PRCA(430,BILL,0)),U,9)
+14 IF 'DEBTOR
IF NOCHK'[",0,"
QUIT "0^0^Bill has no debtor"
+15 IF NOCHK'[",0,"
IF '$DATA(^RCD(340,DEBTOR,0))
QUIT "0^0^Bill has bad debtor"
+16 SET DEBTOR0=^RCD(340,DEBTOR,0)
SET DEBTOR1=$GET(^(1))
SET DEBTOR3=$GET(^(3))
SET DEBTOR7=$GET(^(7))
+17 SET DEBTOR8=$ORDER(^RCD(340,DEBTOR,8,"A"),-1)
IF DEBTOR8?1.N
SET DEBTOR8=$PIECE($GET(^RCD(340,DEBTOR,8,DEBTOR8,0)),U)
+18 DO RS1^RCTCSPD0
+19 SET RCDFN=+DEBTOR0
+20 SET DEMCS=$$DEM^RCTCSP1(RCDFN)
+21 ;cs activation date cutoff
IF ($PIECE(B6,U,21)\1)<ACTDT
IF NOCHK'[",1,"
QUIT "0^1^Bill's DATE ACCOUNT ACTIVATED "_$$FMTE^XLFDT($PIECE(B6,U,21),"5D")_" is before site CS activation date"
+22 ;Not needed, we can't quit here. RCLLCHK sends recalls for recall request bills and <$25 bills.
+23 ;It could also set 15 fields from 1 to 10
+24 ;I $D(^PRCA(430,"TCSP",BILL)),$$RCLLCHK^RCTCSP2(BILL) Q ;bill previously sent to TCSP
+25 ;This looks to be updates to currently referred bill. It sends potentially 2, 2A, 2C or 5B, none of which matters for debt.
+26 ;I $$UPDCHK(BILL) Q
+27 IF +$PIECE(B14,U,1)
IF NOCHK'[",4,"
QUIT "0^4^Bill was referred to TOP on "_$$FMTE^XLFDT($PIECE(B14,U),"5D")
+28 IF +$PIECE(B12,U,1)
IF NOCHK'[",7,"
QUIT "0^7^DATE SENT TO DMC "_$$FMTE^XLFDT($PIECE(B4,U),"5D")_" is set for the bill"
+29 IF $PIECE(B121,U,1)="N"
IF NOCHK'[",8,"
QUIT "0^8^DMC DEBT is not valid"
+30 IF $PIECE(B121,U,1)="P"
IF NOCHK'[",9,"
QUIT "0^9^DMC DEBT is pending"
+31 IF $PIECE(B6,U,4)
IF ($PIECE(B6,U,5)="DOJ")
IF NOCHK'[",10,"
QUIT "0^10^Bill has been referred to DOJ on "_$$FMTE^XLFDT($PIECE(B6,U,4),"5D")
+32 IF +$PIECE(DEMCS,U,4)
IF NOCHK'[",11,"
QUIT "0^11^Debtor is deceased"
+33 ; Patch PRCA*4.5*338 (and maybe 351) will be replacing logic for errors 12, 13 and 14 with this:
+34 ;Q:'$$RFCHK^RCTOPD(CAT,"N",1.03,$P(B6,U,21)) ;PRCA*4.5*338 - Use RFCHK^RCTOPD to determine if the Category can be referred using the new date based algorithm.
+35 IF '$PIECE(B0,U,2)
IF NOCHK'[",12,"
QUIT "0^12^Bill has no CATEGORY"
+36 SET CAT=$PIECE($GET(^PRCA(430.2,$PIECE(B0,U,2),0)),U,7)
+37 IF 'CAT
IF NOCHK'[",13,"
QUIT "0^13^Bill CATEGORY has no CATEGORY NUMBER"
+38 IF '$$RFCHK^RCTOPD(CAT,"N",1.03,$PIECE(B6,U,21))
IF NOCHK'[",14,"
QUIT "0^14^Bill CATEGORY number "_CAT_" is not TCSP referable"
+39 IF B4
IF NOCHK'[",2,"
QUIT "0^2^Bill is on repayment plan started "_$$FMTE^XLFDT($PIECE(B4,U),"5D")
+40 IF +$PIECE(B15,U,7)
IF NOCHK'[",3,"
QUIT "0^3^Bill has STOP FLAG set"
+41 ;quit if debtor is stopped PRCA*4.5*350
IF DEBTOR8="S"
IF NOCHK'[",26,"
QUIT "0^26^Debtor has STOP FLAG set"
+42 ; quit if site is stopped PRCA*4.5*350
IF SITE40="S"
IF NOCHK'[",27,"
QUIT "0^27^Site is stopped from sending referrals"
+43 ;dpn checks
+44 IF $PIECE(B20,U,3)=1
IF (10000+$GET(^RC(342,1,"CS")))>DT
IF '$PIECE(B20,U,4)
IF NOCHK'[",15,"
QUIT "0^15^DPN request not made yet"
+45 IF $PIECE(B20,U,3)=1
IF (10000+$GET(^RC(342,1,"CS")))>DT
IF $PIECE(B20,U,4)
IF '$PIECE(B20,U,5)
IF NOCHK'[",16,"
QUIT "0^16^DPN letter is not printed yet"
+46 IF $PIECE(B20,U,3)=1
IF (10000+$GET(^RC(342,1,"CS")))>DT
IF $PIECE(B20,U,4)
IF $PIECE(B20,U,5)
Begin DoDot:1
+47 NEW X1,X2
+48 SET X1=DT
SET X2=$PIECE(B20,U,5)
DO ^%DTC
End DoDot:1
IF X<60
IF NOCHK'[",17,"
QUIT "0^17^Less than 60 days from DPN letter printed date "_$$FMTE^XLFDT($PIECE(B20,U,5),"5D")
+49 ; PRCA*4.5*343 - change BILLDT from DATE ACCOUNT ACTIVATED (#60) to LETTER1(#61) field
SET BILLDT=$PIECE(B6,U,1)
SET PREPDT=$PIECE(B0,U,10)
+50 ; PRCA*4.5*343 - change to 151 days
IF BILLDT>RC151DT
IF NOCHK'[",18,"
QUIT "0^18^Must be 151 days or more after LETTER1 date "_$$FMTE^XLFDT($PIECE(B6,U),"5D")
+51 IF $PIECE(DEBTOR1,"^",9)=1
IF NOCHK'[",5,"
QUIT "0^5^Debtor address marked unknown"
+52 IF $EXTRACT($PIECE(DEMCS,U,3),1,5)="00000"
IF NOCHK'[",6,"
QUIT "0^6^SSN "_$PIECE(DEMCS,U,3)_" is not valid"
+53 IF $PIECE(B0,U,8)'=16
IF NOCHK'[",19,"
QUIT "0^19^Bill is not set to ACTIVE"
+54 ; For rerefer, error 20 is not a showstopper.
+55 IF $PIECE(B15,U,2)
IF NOCHK'[",20,"
QUIT "0^20^Bill is marked as recalled"
+56 ; Note: that is not a showstopper for re-refer, I think, but it is for refer.
+57 IF $DATA(^PRCA(430,"TCSP",BILL))
IF NOCHK'[",21,"
QUIT "0^21^Bill previously sent to TCSP"
+58 SET TOTAL=$PIECE(B7,U)+$PIECE(B7,U,2)+$PIECE(B7,U,3)+$PIECE(B7,U,4)+$PIECE(B7,U,5)
+59 IF TOTAL<25
IF NOCHK'[",22,"
QUIT "0^22^Bills less than $25 can't be referred"
+60 IF $DATA(^PRCA(430,"TCSP",BILL))
IF NOCHK'[",23,"
QUIT "0^23^Bill is already referred"
+61 IF '$PIECE(B6,U,3)
IF NOCHK'[",24,"
QUIT "0^24^Third Letter has not been sent"
+62 QUIT 1
RRMARK ;
+1 NEW I
+2 FOR I=2,3,4,5,7,8,9,10
SET $PIECE(B15,U,I)=""
SET $PIECE(^PRCA(430,BILL,15),U,I)=""
+3 IF $PIECE($GET(^PRCA(430,BILL,30)),U)
KILL ^PRCA(430,"AN",$PIECE(^PRCA(430,BILL,30),U),BILL)
SET $PIECE(^PRCA(430,BILL,30),U)=""
SET $PIECE(^PRCA(430,BILL,30),U,9)=1
+4 SET I=$ORDER(^PRCA(430,BILL,15.5,99999),-1)
+5 SET $PIECE(^PRCA(430,BILL,15.5,0),U,2)=430.03
+6 SET $PIECE(^PRCA(430,BILL,15.5,0),U,3)=I+1
+7 SET $PIECE(^PRCA(430,BILL,15.5,0),U,4)=$PIECE(^PRCA(430,BILL,15.5,0),U,4)+1
+8 SET ^PRCA(430,BILL,15.5,I+1,0)=1_U_DT_U_$PIECE($GET(^PRCA(430,BILL,15.5,I,0)),U,3)
+9 SET ^PRCA(430,BILL,15.5,"B",1,I)=""
+10 DO NEWADI
+11 QUIT
NEWADI ;Make new Agency Debt ID trailer PRCA*4.5*350
+1 NEW TRAIL,CHK
+2 SET TRAIL=$PIECE($GET(^PRCA(430,BILL,21)),U,2)
+3 IF TRAIL=""
SET TRAIL="AA"
+4 IF '$TEST
SET CHK=($ASCII(TRAIL)-65)*26+($ASCII(TRAIL,2)-65)+1
SET TRAIL=$CHAR(CHK\26+65)_$CHAR(CHK#26+65)
+5 SET $PIECE(B15,U,15)=TRAIL
SET $PIECE(^PRCA(430,BILL,21),U,2)=TRAIL
+6 QUIT
