PRCADR2 ;SF-ISC/YJK-PRINT ADDRESS,TRANS.,BALANCE ;3/19/97 3:19 PM
V ;;4.5;Accounts Receivable;**45,104,108,149,141,172,241,233,263,301,350**;Mar 20, 1995;Build 66
;;Per VA Directive 6402, this routine should not be modified.
;print debtor's /3rd party address,transaction,balances.
N RCDMC,RCTOP
WR1 W !!,$P(PRCAGL,U,1),?39,"SOC.SEC.NO.: ",?55,PRCASSN
W:$P(PRCAGL,U,2)'="" !,$P(PRCAGL,U,2)
W !,$P(PRCAGL,U,4),", ",PRCASTE," ",$P(PRCAGL,U,6),?39,"DATE OF BIRTH: ",?55,PRCADOB,!,"PHONE NO.: ",$P(PRCAGL,U,9),?39,"DATE POSTED: " S Y=$P($G(^PRCA(430,D0,6)),"^",21) W:'Y "N/A" I Y D DD^%DT W $P(Y,"@")," ",$P(Y,"@",2)
I $G(RCKAT) W !,"EMERGENCY RESPONSE INDICATOR: HURRICANE KATRINA"
I $G(RCDMC) W !,"****Debtor's Account Forwarded To DMC****"
I $G(RCTOP) W !,"****Debtor's Account Forwarded To TOP****"
;PRCA*4.5*350
I $G(RCTCSP) W !,"****Debt ",$S($$RRD^RCTCSPU(Z0):"Re-",1:""),"Referred to Cross-Servicing****"
END1 K %,PRCADOB,PRCASSN,PRCASTE,PRCAGL,Z1,Z2,Z0
Q
;
;
WR2 ;called by EN2^PRCADR
W ! S PRCAGL0=$S($D(^PRCA(433,PRCAEN,0)):^(0),1:""),PRCAG=$S($D(^PRCA(433,PRCAEN,1)):^(1),1:"") Q:(PRCAG="")!(PRCAGL0="")
S PRCATD=$P(PRCAG,U,1),PRCATY=$P(PRCAG,U,2) Q:'$D(^PRCA(430.3,+PRCATY,0)) S PRCATYPE=$P(^(0),U,3) W ?1,$S($P(PRCAGL0,U,10):"*",1:""),?2,+PRCAGL0
I $P(PRCAG,U,3)="" D
.W:PRCATYPE=17 ?12,$P($G(^PRCA(433,PRCAEN,5)),"^",2)
.W:(PRCATYPE=1)!(PRCATYPE=21) ?12,$P(PRCAG,U,4)
I $P(PRCAG,U,3)'="" W ?12,$P(PRCAG,U,3)
S:(PRCATYPE=8)!((PRCATYPE=9)!(PRCATYPE=10)) PRCA("WROFF")=PRCAEN
W:PRCATY?1N.N&(PRCATYPE'=17) ?22,$P(^PRCA(430.3,PRCATY,0),U,1) I (PRCATYPE=2)!(PRCATYPE=20),$P(^PRCA(433,PRCAEN,0),U,7)]"" W "(",$P(^(0),U,7),")"
S Y=PRCATD D DD^%DT S Y(1)=$P(Y,", ",2)
S PRCATD=$E(PRCATD,4,5)_"/"_$E(PRCATD,6,7)_"/"_$E(Y(1),3,4) ;trans date
; if a decrease adjustment, show as negative (patch 4.5*172)
I $P(PRCAG,"^",2)=35,$P(PRCAG,"^",5)>0 S $P(PRCAG,"^",5)=-$P(PRCAG,"^",5)
W ?47,PRCATD,?57,$J($P(PRCAG,U,5),11,2) W:+$P(PRCAGL0,U,4)<2 ?67,"INCOMPLETE"
END2 K PRCAG,PRCATD,PRCATY,PRCATYPE,PRCAGL0
Q ;end of WR2
;
;
WR3 W !,?18,"BALANCES",?31,"PAID"
W !,?44,"LETTER1/ICD:",?58,PRCAL(1)
W !,"PRINCIPAL:",?16,$J(PRCAK("PB"),10,2),?26,$J(PRCAK("PP"),9,2),?44,"LETTER2:",?58,PRCAL(2)
W !,"INTEREST:",?16,$J(PRCAK("IB"),10,2),?26,$J(PRCAK("IP"),9,2),?44,"LETTER3:",?58,PRCAL(3)
W !,"ADMINISTRATIVE:",?16,$J(PRCAK("AB"),10,2),?26,$J(PRCAK("AP"),9,2),?44,"IRS LETTER:",?58,PRCAL(6)
W ! W:PRCAK("MF")>0 "MARSHAL FEE:",?16,$J(PRCAK("MF"),10,2),?26,$J(0,9,2) W ?44,PRCACODE_" REF.DATE:",?62,PRCAL(4)
W:PRCAK("CC")>0 !,"COURT COST:",?16,$J(PRCAK("CC"),10,2),?26,$J(0,9,2)
W !,"CURRENT:",?16,$J(PRCAK("PB")+PRCAK("IB")+PRCAK("AB")+PRCAK("MF")+PRCAK("CC"),10,2),?26,$J(PRCAK("PP")+PRCAK("AP")+PRCAK("IP"),9,2)
K PRCAL I $D(^PRCA(430,D0,6)) S PRCAL=^(6) I $P(PRCAL,"^",15)]"" W !!," Date forwarded to IRS: " S Y=$P(PRCAL,"^",15) D DD^%DT W Y
I $D(PRCAL),$P(PRCAL,"^",16)]"" W !,"Prin/Int/Admin IRS balance: " F X=16:1:18 W +$P(PRCAL,"^",X),"/"
K PRCAL I $G(^PRCA(430,D0,12)) S PRCAL=^(12) I $P(PRCAL,U)]"" W !!," Date forwarded to DMC: " S Y=$P(PRCAL,U) D DD^%DT W Y
I $D(PRCAL),$P(PRCAL,U,2)]"" W !,"Prin/Int/Admin DMC balance: " F X=2:1:4 W +$P(PRCAL,U,X),"/"
I $D(PRCAL),$P($G(^RCD(340,(+$P(^PRCA(430,D0,0),"^",9)),3)),"^",9)'="" W !,"Lesser Withhold Amt to DMC: ",$J($P(^(3),"^",9),0,2)
K PRCAL I $G(^PRCA(430,D0,14)) S PRCAL=^(14) I $P(PRCAL,U)]"" W !!,"Date forwarded to TOP: " S Y=$P(PRCAL,U) D DD^%DT W Y
I $D(PRCAL),$P($G(^RCD(340,(+$P(^PRCA(430,D0,0),"^",9)),6)),"^",6)'="" W !,"TOP Hold Date: " S Y=$P(^(6),"^",6) D DD^%DT W Y
;PRCA*4.5*350
I $G(^PRCA(430,D0,15)) S PRCAL=^(15) I $P(PRCAL,U)]"" W !!,"CS " W:$$RR^RCTCSPU(D0) "Re-" W "Referred Date: " S Y=$P(PRCAL,U) D DD^%DT W Y
END3 K PRCAL,PRCACODE,PRCALT,PRCAK,PRCAGL6,PRCAGL7 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCADR2 3844 printed Dec 13, 2024@01:39:20 Page 2
PRCADR2 ;SF-ISC/YJK-PRINT ADDRESS,TRANS.,BALANCE ;3/19/97 3:19 PM
V ;;4.5;Accounts Receivable;**45,104,108,149,141,172,241,233,263,301,350**;Mar 20, 1995;Build 66
+1 ;;Per VA Directive 6402, this routine should not be modified.
+2 ;print debtor's /3rd party address,transaction,balances.
+3 NEW RCDMC,RCTOP
WR1 WRITE !!,$PIECE(PRCAGL,U,1),?39,"SOC.SEC.NO.: ",?55,PRCASSN
+1 if $PIECE(PRCAGL,U,2)'=""
WRITE !,$PIECE(PRCAGL,U,2)
+2 WRITE !,$PIECE(PRCAGL,U,4),", ",PRCASTE," ",$PIECE(PRCAGL,U,6),?39,"DATE OF BIRTH: ",?55,PRCADOB,!,"PHONE NO.: ",$PIECE(PRCAGL,U,9),?39,"DATE POSTED: "
SET Y=$PIECE($GET(^PRCA(430,D0,6)),"^",21)
if 'Y
WRITE "N/A"
IF Y
DO DD^%DT
WRITE $PIECE(Y,"@")," ",$PIECE(Y,"@",2)
+3 IF $GET(RCKAT)
WRITE !,"EMERGENCY RESPONSE INDICATOR: HURRICANE KATRINA"
+4 IF $GET(RCDMC)
WRITE !,"****Debtor's Account Forwarded To DMC****"
+5 IF $GET(RCTOP)
WRITE !,"****Debtor's Account Forwarded To TOP****"
+6 ;PRCA*4.5*350
+7 IF $GET(RCTCSP)
WRITE !,"****Debt ",$SELECT($$RRD^RCTCSPU(Z0):"Re-",1:""),"Referred to Cross-Servicing****"
END1 KILL %,PRCADOB,PRCASSN,PRCASTE,PRCAGL,Z1,Z2,Z0
+1 QUIT
+2 ;
+3 ;
WR2 ;called by EN2^PRCADR
+1 WRITE !
SET PRCAGL0=$SELECT($DATA(^PRCA(433,PRCAEN,0)):^(0),1:"")
SET PRCAG=$SELECT($DATA(^PRCA(433,PRCAEN,1)):^(1),1:"")
if (PRCAG="")!(PRCAGL0="")
QUIT
+2 SET PRCATD=$PIECE(PRCAG,U,1)
SET PRCATY=$PIECE(PRCAG,U,2)
if '$DATA(^PRCA(430.3,+PRCATY,0))
QUIT
SET PRCATYPE=$PIECE(^(0),U,3)
WRITE ?1,$SELECT($PIECE(PRCAGL0,U,10):"*",1:""),?2,+PRCAGL0
+3 IF $PIECE(PRCAG,U,3)=""
Begin DoDot:1
+4 if PRCATYPE=17
WRITE ?12,$PIECE($GET(^PRCA(433,PRCAEN,5)),"^",2)
+5 if (PRCATYPE=1)!(PRCATYPE=21)
WRITE ?12,$PIECE(PRCAG,U,4)
End DoDot:1
+6 IF $PIECE(PRCAG,U,3)'=""
WRITE ?12,$PIECE(PRCAG,U,3)
+7 if (PRCATYPE=8)!((PRCATYPE=9)!(PRCATYPE=10))
SET PRCA("WROFF")=PRCAEN
+8 if PRCATY?1N.N&(PRCATYPE'=17)
WRITE ?22,$PIECE(^PRCA(430.3,PRCATY,0),U,1)
IF (PRCATYPE=2)!(PRCATYPE=20)
IF $PIECE(^PRCA(433,PRCAEN,0),U,7)]""
WRITE "(",$PIECE(^(0),U,7),")"
+9 SET Y=PRCATD
DO DD^%DT
SET Y(1)=$PIECE(Y,", ",2)
+10 ;trans date
SET PRCATD=$EXTRACT(PRCATD,4,5)_"/"_$EXTRACT(PRCATD,6,7)_"/"_$EXTRACT(Y(1),3,4)
+11 ; if a decrease adjustment, show as negative (patch 4.5*172)
+12 IF $PIECE(PRCAG,"^",2)=35
IF $PIECE(PRCAG,"^",5)>0
SET $PIECE(PRCAG,"^",5)=-$PIECE(PRCAG,"^",5)
+13 WRITE ?47,PRCATD,?57,$JUSTIFY($PIECE(PRCAG,U,5),11,2)
if +$PIECE(PRCAGL0,U,4)<2
WRITE ?67,"INCOMPLETE"
END2 KILL PRCAG,PRCATD,PRCATY,PRCATYPE,PRCAGL0
+1 ;end of WR2
QUIT
+2 ;
+3 ;
WR3 WRITE !,?18,"BALANCES",?31,"PAID"
+1 WRITE !,?44,"LETTER1/ICD:",?58,PRCAL(1)
+2 WRITE !,"PRINCIPAL:",?16,$JUSTIFY(PRCAK("PB"),10,2),?26,$JUSTIFY(PRCAK("PP"),9,2),?44,"LETTER2:",?58,PRCAL(2)
+3 WRITE !,"INTEREST:",?16,$JUSTIFY(PRCAK("IB"),10,2),?26,$JUSTIFY(PRCAK("IP"),9,2),?44,"LETTER3:",?58,PRCAL(3)
+4 WRITE !,"ADMINISTRATIVE:",?16,$JUSTIFY(PRCAK("AB"),10,2),?26,$JUSTIFY(PRCAK("AP"),9,2),?44,"IRS LETTER:",?58,PRCAL(6)
+5 WRITE !
if PRCAK("MF")>0
WRITE "MARSHAL FEE:",?16,$JUSTIFY(PRCAK("MF"),10,2),?26,$JUSTIFY(0,9,2)
WRITE ?44,PRCACODE_" REF.DATE:",?62,PRCAL(4)
+6 if PRCAK("CC")>0
WRITE !,"COURT COST:",?16,$JUSTIFY(PRCAK("CC"),10,2),?26,$JUSTIFY(0,9,2)
+7 WRITE !,"CURRENT:",?16,$JUSTIFY(PRCAK("PB")+PRCAK("IB")+PRCAK("AB")+PRCAK("MF")+PRCAK("CC"),10,2),?26,$JUSTIFY(PRCAK("PP")+PRCAK("AP")+PRCAK("IP"),9,2)
+8 KILL PRCAL
IF $DATA(^PRCA(430,D0,6))
SET PRCAL=^(6)
IF $PIECE(PRCAL,"^",15)]""
WRITE !!," Date forwarded to IRS: "
SET Y=$PIECE(PRCAL,"^",15)
DO DD^%DT
WRITE Y
+9 IF $DATA(PRCAL)
IF $PIECE(PRCAL,"^",16)]""
WRITE !,"Prin/Int/Admin IRS balance: "
FOR X=16:1:18
WRITE +$PIECE(PRCAL,"^",X),"/"
+10 KILL PRCAL
IF $GET(^PRCA(430,D0,12))
SET PRCAL=^(12)
IF $PIECE(PRCAL,U)]""
WRITE !!," Date forwarded to DMC: "
SET Y=$PIECE(PRCAL,U)
DO DD^%DT
WRITE Y
+11 IF $DATA(PRCAL)
IF $PIECE(PRCAL,U,2)]""
WRITE !,"Prin/Int/Admin DMC balance: "
FOR X=2:1:4
WRITE +$PIECE(PRCAL,U,X),"/"
+12 IF $DATA(PRCAL)
IF $PIECE($GET(^RCD(340,(+$PIECE(^PRCA(430,D0,0),"^",9)),3)),"^",9)'=""
WRITE !,"Lesser Withhold Amt to DMC: ",$JUSTIFY($PIECE(^(3),"^",9),0,2)
+13 KILL PRCAL
IF $GET(^PRCA(430,D0,14))
SET PRCAL=^(14)
IF $PIECE(PRCAL,U)]""
WRITE !!,"Date forwarded to TOP: "
SET Y=$PIECE(PRCAL,U)
DO DD^%DT
WRITE Y
+14 IF $DATA(PRCAL)
IF $PIECE($GET(^RCD(340,(+$PIECE(^PRCA(430,D0,0),"^",9)),6)),"^",6)'=""
WRITE !,"TOP Hold Date: "
SET Y=$PIECE(^(6),"^",6)
DO DD^%DT
WRITE Y
+15 ;PRCA*4.5*350
+16 IF $GET(^PRCA(430,D0,15))
SET PRCAL=^(15)
IF $PIECE(PRCAL,U)]""
WRITE !!,"CS "
if $$RR^RCTCSPU(D0)
WRITE "Re-"
WRITE "Referred Date: "
SET Y=$PIECE(PRCAL,U)
DO DD^%DT
WRITE Y
END3 KILL PRCAL,PRCACODE,PRCALT,PRCAK,PRCAGL6,PRCAGL7
QUIT
