- 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 Feb 18, 2025@23:05:44 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
