RCDPBTLM ;WISC/RFJ - bill transactions List Manager top routine ;1 Jun 99
;;4.5;Accounts Receivable;**114,148,153,168,169,198,247,271,276,315,372**;Mar 20, 1995;Build 9
;;Per VA Directive 6402, this routine should not be modified.
;
; Reference to $$REC^IBRFN supported by DBIA 2031
;
; called from menu option (19)
;
N RCBILLDA,RCDPFXIT
;
F D Q:'RCBILLDA
. W !! S RCBILLDA=$$SELBILL
. I RCBILLDA<1 S RCBILLDA=0 Q
. D EN^VALM("RCDP TRANSACTIONS LIST")
. ; fast exit
. I $G(RCDPFXIT) S RCBILLDA=0
Q
;
;
INIT ; initialization for list manager list
; requires rcbillda
; PRCA*3.5*315 - Replaced "^" with VA Standard Variable U throughout
N ADMIN,DATE,RCLINE,RCLIST,RCTOTAL,RCTRAN,RCTRANDA
K ^TMP("RCDPBTLM",$J),^TMP("VALM VIDEO",$J)
;
; fast exit
I $G(RCDPFXIT) S VALMQUIT=1 Q
;
; set the List Manager line number
S RCLINE=0
; set the List Manager transaction number
S RCTRAN=0
;
; get transactions and balance for bill
S RCTOTAL=$$GETTRANS(RCBILLDA)
;
S DATE="" F S DATE=$O(RCLIST(DATE)) Q:'DATE D
. S RCTRANDA="" F S RCTRANDA=$O(RCLIST(DATE,RCTRANDA)) Q:RCTRANDA="" D
. . S RCLINE=RCLINE+1
. . ;
. . ; create an index array for transaction lookup in list
. . I RCTRANDA D
. . . S RCTRAN=RCTRAN+1
. . . S ^TMP("RCDPBTLM",$J,"IDX",RCTRAN,RCTRAN)=RCTRANDA
. . . D SET^RCDPAPLI(RCTRAN,RCLINE,1,80,0,IORVON,IORVOFF)
. . ;
. . D SET^RCDPAPLI($S(RCTRANDA:RCTRANDA,1:" "),RCLINE,5,80) ; PRCA*4.5*315 Incr left margin
. . D SET^RCDPAPLI($E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3),RCLINE,17,25)
. . D SET^RCDPAPLI($TR($P(RCLIST(DATE,RCTRANDA),U),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz"),RCLINE,27,51)
. . D SET^RCDPAPLI($J($P(RCLIST(DATE,RCTRANDA),U,2),9,2),RCLINE,53,62)
. . D SET^RCDPAPLI($J($P(RCLIST(DATE,RCTRANDA),U,3),9,2),RCLINE,62,71)
. . ; add marshal fee and court cost to create admin dollars
. . S ADMIN=$P(RCLIST(DATE,RCTRANDA),U,4)+$P(RCLIST(DATE,RCTRANDA),U,5)+$P(RCLIST(DATE,RCTRANDA),U,6)
. . D SET^RCDPAPLI($J(ADMIN,9,2),RCLINE,71,80)
;
; show totals
S RCLINE=RCLINE+1
D SET^RCDPAPLI(" --------- -------- --------",RCLINE,1,80)
S RCLINE=RCLINE+1
D SET^RCDPAPLI(" TOTAL BALANCE FOR BILL",RCLINE,1,80)
D SET^RCDPAPLI($J($P(RCTOTAL,U,1),9,2),RCLINE,53,62)
D SET^RCDPAPLI($J($P(RCTOTAL,U,2),9,2),RCLINE,62,71)
D SET^RCDPAPLI($J($P(RCTOTAL,U,3)+$P(RCTOTAL,U,4)+$P(RCTOTAL,U,5),9,2),RCLINE,71,80)
;
; compare totals to what is stored in the file
N RCDATA7,RCFOUT
S RCDATA7=$G(^PRCA(430,RCBILLDA,7))
; for a write-off bill, the balance should equal all zeros, for
; these bills, node 7 is the write-off amount, so for the out of
; balance check to work, node 7 needs to be adjusted to all zeros
I $P(^PRCA(430,RCBILLDA,0),U,8)=23 S RCDATA7="0^0^0^0^0"
I +$P(RCDATA7,U,1)'=+$P(RCTOTAL,U,1) S RCFOUT=1
I +$P(RCDATA7,U,2)'=+$P(RCTOTAL,U,2) S RCFOUT=1
I ($P(RCDATA7,U,3)+$P(RCDATA7,U,4)+$P(RCDATA7,U,5))'=+$P(RCTOTAL,U,3) S RCFOUT=1
I $G(RCFOUT) D
. S RCLINE=RCLINE+1
. D SET^RCDPAPLI(" ",RCLINE,1,80)
. S RCLINE=RCLINE+1
. D SET^RCDPAPLI(" STORED BALANCE FOR BILL (** INCORRECT **)",RCLINE,1,80)
. D SET^RCDPAPLI($J($P(RCDATA7,U,1),9,2),RCLINE,53,62)
. D SET^RCDPAPLI($J($P(RCDATA7,U,2),9,2),RCLINE,62,71)
. D SET^RCDPAPLI($J($P(RCDATA7,U,3)+$P(RCDATA7,U,4)+$P(RCDATA7,U,5),9,2),RCLINE,71,80)
;
; set valmcnt to number of lines in the list
S VALMCNT=RCLINE
D HDR
Q
;
;
HDR ; header code for list manager display
; requires rcbillda
N %,DATA,RCDEBTDA,RCDPDATA
;
D DIQ430^RCDPBPLM(RCBILLDA,".01;8;")
;
S RCDEBTDA=$P(^PRCA(430,RCBILLDA,0),U,9)
S DATA=$$ACCNTHDR^RCDPAPLM(RCDEBTDA)
;
S %="",$P(%," ",80)=""
; PRCA*4.5*276 - get EEOB indicator for 1st/3rd party payment and attach to bill when applicable
S PRCOUT=$$COMP3^PRCAAPR(RCBILLDA)
I PRCOUT'="%" S PRCOUT=$$IBEEOBCK^PRCAAPR1(RCBILLDA)
S VALMHDR(1)=$E("Bill #: "_$G(PRCOUT)_$G(RCDPDATA(430,RCBILLDA,.01,"E"))_%,1,25)_"Account: "_$P(DATA,U)_$P(DATA,U,2)
S VALMHDR(2)=$E("Status: "_$G(RCDPDATA(430,RCBILLDA,8,"E"))_%,1,25)_$E(" Addr: "_$P(DATA,U,4)_", "_$P(DATA,U,7)_", "_$P(DATA,U,8)_" "_$P(DATA,U,9)_%,1,55)
; PRCA*4.5*276 - show caption for user
S VALMSG="|% EEOB | Enter ?? for more actions |" ; PRCA*4.5*276
Q
S VALMHDR(3)=" "_IORVON_$E("Bill Balance: "_$J($P(RCTOTAL,U)+$P(RCTOTAL,U,2)+$P(RCTOTAL,U,3)+$P(RCTOTAL,U,4)+$P(RCTOTAL,U,5),0,2)_%,1,23)_IORVOFF_" Phone: "_$P(DATA,U,10)
Q
;
;
EXIT ; exit list manager option and clean up
K ^TMP("RCDPBTLM",$J),^TMP("RCDPBTLMX",$J)
Q
;
;
SELBILL() ; select a bill
; returns -1 for timeout or ^, 0 for no selection, or ien of bill
N %,%Y,C,DIC,DTOUT,DUOUT,RCBEFLUP,X,Y
N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
N RCY,DIR,DIRUT
; allow user to get the record using bill# or ECME#
S DIR("A")="Select (B)ILL or (E)CME#: "
S DIR(0)="SA^B:BILL NUMBER;E:ECME#"
S DIR("B")="B"
D ^DIR K DIR I $D(DIRUT) Q 0
S RCY=Y
I RCY="E" Q $$SELECME
S DIC="^PRCA(430,",DIC(0)="QEAM",DIC("A")="Select BILL: "
S DIC("W")="D DICW^RCBEUBI1"
; special lookup on input
S RCBEFLUP=1
D ^DIC
I Y<0,'$G(DUOUT),'$G(DTOUT) S Y=0
Q +Y
;
;
GETTRANS(BILLDA) ; original amount goes first for bill
; returns list of transactions in
; rclist(date,tranda)=trantype ^ principle ^ interest ^ admin
; returns principle balance ^ interest balance ^ admin balance
; ^ marshall fee balance ^ court cost balance
N %,ADMBAL,AMTDISP,CCBAL,DATA0,DATA1,DATE,INTBAL,MFBAL,PRINBAL,RCDPDATA,RCUSER,TRANDA,VALUE
;
D DIQ430^RCDPBPLM(BILLDA,"3;60;")
;
K RCLIST
S (ADMBAL,CCBAL,INTBAL,MFBAL,PRINBAL)=0
S PRINBAL=RCDPDATA(430,BILLDA,3,"I")
; loop transaction and add to list
S TRANDA=0 F S TRANDA=$O(^PRCA(433,"C",BILLDA,TRANDA)) Q:'TRANDA D
. S DATA0=$G(^PRCA(433,TRANDA,0)) ;PRCA*4.5*315 Needed for User ID
. S RCUSER=$P(DATA0,U,9) ;PRCA*4.5*315
. S RCUSER=$$GET1^DIQ(200,RCUSER_",",1) ;PRCA*4.5*315
. S DATA1=$G(^PRCA(433,TRANDA,1))
. S DATE=$P(DATA1,U,9) I 'DATE Q
. S VALUE=$$TRANVALU(TRANDA) ;PRCA*4.5*315 (was I VALUE="" Q)
. S RCLIST($P(DATE,"."),TRANDA)=$P($G(^PRCA(430.3,+$P(DATA1,U,2),0)),U)_VALUE
. S $P(RCLIST($P(DATE,"."),TRANDA),U,7)=RCUSER ;PRCA*4.5*315
. ;
. ; calculate bill's balance
. S PRINBAL=PRINBAL+$P(VALUE,U,2)
. S INTBAL=INTBAL+$P(VALUE,U,3)
. S ADMBAL=ADMBAL+$P(VALUE,U,4)
. S MFBAL=MFBAL+$P(VALUE,U,5)
. S CCBAL=CCBAL+$P(VALUE,U,6)
;
S DATE=$G(RCDPDATA(430,BILLDA,60,"I"))
; check to make sure activation date is not greater than first transaction
S %=$O(RCLIST(0)) I DATE>% S DATE=%
S RCLIST(+$P(DATE,"."),0)="original amount^"_RCDPDATA(430,BILLDA,3,"I")
;
Q PRINBAL_U_INTBAL_U_ADMBAL_U_MFBAL_U_CCBAL
;
;
TRANVALU(TRANDA) ; return the transaction value as displayed (with + or - sign)
N TYPE,VALUE
S VALUE=$$TRANBAL^RCRJRCOT(TRANDA)
; no dollars on transaction
I '$P(VALUE,U),'$P(VALUE,U,2),'$P(VALUE,U,3),'$P(VALUE,U,4),'$P(VALUE,U,5) Q ""
; check type for payments, etc, make values (-) to subtract
S TYPE=$P($G(^PRCA(433,TRANDA,1)),U,2)
I TYPE=2!(TYPE=8)!(TYPE=9)!(TYPE=10)!(TYPE=11)!(TYPE=14)!(TYPE=29)!(TYPE=34)!(TYPE=35)!(TYPE=41) D
. S $P(VALUE,U,1)=-$P(VALUE,U,1)
. S $P(VALUE,U,2)=-$P(VALUE,U,2)
. S $P(VALUE,U,3)=-$P(VALUE,U,3)
. S $P(VALUE,U,4)=-$P(VALUE,U,4)
. S $P(VALUE,U,5)=-$P(VALUE,U,5)
;
; the following transaction types should not change the bills balance
; return the amount displayed in the description and 0 for value
; refer to RC 3, refer to DOJ 4, reestablish 5, returned 6 and 32
; repayment plan 25, amended 33, suspended 47, unsuspended 46
K AMTDISP
I TYPE=3!(TYPE=4)!(TYPE=5)!(TYPE=6)!(TYPE=25)!(TYPE=32)!(TYPE=33)!(TYPE=46)!(TYPE=47) D
. S AMTDISP=" ($"_$J($P(VALUE,U)+$P(VALUE,U,2)+$P(VALUE,U,3)+$P(VALUE,U,4)+$P(VALUE,U,5),0,2)_")"
. S VALUE=""
Q $G(AMTDISP)_U_VALUE
;
SELECME() ;
; function takes the user input of the ECME # to return a valid ien of file 430
; if an invalid ECME is evaluated then the process keeps asking the user for ECME #
; until a valid ECME# is entered or until the user enters a U or null value
; output - returns the IEN of the record entry in the ACCOUNT RECEIVABLE file (#430) or "??"
N RCECME,RCBILL,DIR,DIRUT,Y
S DIR(0)="FO^1:12^I X'?1.12N W !!,""Cannot contain alpha characters"" K X"
S DIR("A")="Select ECME#"
RET D ^DIR I $D(DIRUT) Q 0
S RCECME=$S(+Y>0:Y,1:0)
S RCBILL=$$REC^IBRFN(RCECME) ; IA 2031
I RCBILL<0 W !!,"??" G RET
E W !!,$P($G(^PRCA(430,+RCBILL,0)),U)," "
Q RCBILL
;RCDPBTLM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPBTLM 8827 printed Nov 22, 2024@16:54:10 Page 2
RCDPBTLM ;WISC/RFJ - bill transactions List Manager top routine ;1 Jun 99
+1 ;;4.5;Accounts Receivable;**114,148,153,168,169,198,247,271,276,315,372**;Mar 20, 1995;Build 9
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Reference to $$REC^IBRFN supported by DBIA 2031
+5 ;
+6 ; called from menu option (19)
+7 ;
+8 NEW RCBILLDA,RCDPFXIT
+9 ;
+10 FOR
Begin DoDot:1
+11 WRITE !!
SET RCBILLDA=$$SELBILL
+12 IF RCBILLDA<1
SET RCBILLDA=0
QUIT
+13 DO EN^VALM("RCDP TRANSACTIONS LIST")
+14 ; fast exit
+15 IF $GET(RCDPFXIT)
SET RCBILLDA=0
End DoDot:1
if 'RCBILLDA
QUIT
+16 QUIT
+17 ;
+18 ;
INIT ; initialization for list manager list
+1 ; requires rcbillda
+2 ; PRCA*3.5*315 - Replaced "^" with VA Standard Variable U throughout
+3 NEW ADMIN,DATE,RCLINE,RCLIST,RCTOTAL,RCTRAN,RCTRANDA
+4 KILL ^TMP("RCDPBTLM",$JOB),^TMP("VALM VIDEO",$JOB)
+5 ;
+6 ; fast exit
+7 IF $GET(RCDPFXIT)
SET VALMQUIT=1
QUIT
+8 ;
+9 ; set the List Manager line number
+10 SET RCLINE=0
+11 ; set the List Manager transaction number
+12 SET RCTRAN=0
+13 ;
+14 ; get transactions and balance for bill
+15 SET RCTOTAL=$$GETTRANS(RCBILLDA)
+16 ;
+17 SET DATE=""
FOR
SET DATE=$ORDER(RCLIST(DATE))
if 'DATE
QUIT
Begin DoDot:1
+18 SET RCTRANDA=""
FOR
SET RCTRANDA=$ORDER(RCLIST(DATE,RCTRANDA))
if RCTRANDA=""
QUIT
Begin DoDot:2
+19 SET RCLINE=RCLINE+1
+20 ;
+21 ; create an index array for transaction lookup in list
+22 IF RCTRANDA
Begin DoDot:3
+23 SET RCTRAN=RCTRAN+1
+24 SET ^TMP("RCDPBTLM",$JOB,"IDX",RCTRAN,RCTRAN)=RCTRANDA
+25 DO SET^RCDPAPLI(RCTRAN,RCLINE,1,80,0,IORVON,IORVOFF)
End DoDot:3
+26 ;
+27 ; PRCA*4.5*315 Incr left margin
DO SET^RCDPAPLI($SELECT(RCTRANDA:RCTRANDA,1:" "),RCLINE,5,80)
+28 DO SET^RCDPAPLI($EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3),RCLINE,17,25)
+29 DO SET^RCDPAPLI($TRANSLATE($PIECE(RCLIST(DATE,RCTRANDA),U),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz"),RCLINE,27,51)
+30 DO SET^RCDPAPLI($JUSTIFY($PIECE(RCLIST(DATE,RCTRANDA),U,2),9,2),RCLINE,53,62)
+31 DO SET^RCDPAPLI($JUSTIFY($PIECE(RCLIST(DATE,RCTRANDA),U,3),9,2),RCLINE,62,71)
+32 ; add marshal fee and court cost to create admin dollars
+33 SET ADMIN=$PIECE(RCLIST(DATE,RCTRANDA),U,4)+$PIECE(RCLIST(DATE,RCTRANDA),U,5)+$PIECE(RCLIST(DATE,RCTRANDA),U,6)
+34 DO SET^RCDPAPLI($JUSTIFY(ADMIN,9,2),RCLINE,71,80)
End DoDot:2
End DoDot:1
+35 ;
+36 ; show totals
+37 SET RCLINE=RCLINE+1
+38 DO SET^RCDPAPLI(" --------- -------- --------",RCLINE,1,80)
+39 SET RCLINE=RCLINE+1
+40 DO SET^RCDPAPLI(" TOTAL BALANCE FOR BILL",RCLINE,1,80)
+41 DO SET^RCDPAPLI($JUSTIFY($PIECE(RCTOTAL,U,1),9,2),RCLINE,53,62)
+42 DO SET^RCDPAPLI($JUSTIFY($PIECE(RCTOTAL,U,2),9,2),RCLINE,62,71)
+43 DO SET^RCDPAPLI($JUSTIFY($PIECE(RCTOTAL,U,3)+$PIECE(RCTOTAL,U,4)+$PIECE(RCTOTAL,U,5),9,2),RCLINE,71,80)
+44 ;
+45 ; compare totals to what is stored in the file
+46 NEW RCDATA7,RCFOUT
+47 SET RCDATA7=$GET(^PRCA(430,RCBILLDA,7))
+48 ; for a write-off bill, the balance should equal all zeros, for
+49 ; these bills, node 7 is the write-off amount, so for the out of
+50 ; balance check to work, node 7 needs to be adjusted to all zeros
+51 IF $PIECE(^PRCA(430,RCBILLDA,0),U,8)=23
SET RCDATA7="0^0^0^0^0"
+52 IF +$PIECE(RCDATA7,U,1)'=+$PIECE(RCTOTAL,U,1)
SET RCFOUT=1
+53 IF +$PIECE(RCDATA7,U,2)'=+$PIECE(RCTOTAL,U,2)
SET RCFOUT=1
+54 IF ($PIECE(RCDATA7,U,3)+$PIECE(RCDATA7,U,4)+$PIECE(RCDATA7,U,5))'=+$PIECE(RCTOTAL,U,3)
SET RCFOUT=1
+55 IF $GET(RCFOUT)
Begin DoDot:1
+56 SET RCLINE=RCLINE+1
+57 DO SET^RCDPAPLI(" ",RCLINE,1,80)
+58 SET RCLINE=RCLINE+1
+59 DO SET^RCDPAPLI(" STORED BALANCE FOR BILL (** INCORRECT **)",RCLINE,1,80)
+60 DO SET^RCDPAPLI($JUSTIFY($PIECE(RCDATA7,U,1),9,2),RCLINE,53,62)
+61 DO SET^RCDPAPLI($JUSTIFY($PIECE(RCDATA7,U,2),9,2),RCLINE,62,71)
+62 DO SET^RCDPAPLI($JUSTIFY($PIECE(RCDATA7,U,3)+$PIECE(RCDATA7,U,4)+$PIECE(RCDATA7,U,5),9,2),RCLINE,71,80)
End DoDot:1
+63 ;
+64 ; set valmcnt to number of lines in the list
+65 SET VALMCNT=RCLINE
+66 DO HDR
+67 QUIT
+68 ;
+69 ;
HDR ; header code for list manager display
+1 ; requires rcbillda
+2 NEW %,DATA,RCDEBTDA,RCDPDATA
+3 ;
+4 DO DIQ430^RCDPBPLM(RCBILLDA,".01;8;")
+5 ;
+6 SET RCDEBTDA=$PIECE(^PRCA(430,RCBILLDA,0),U,9)
+7 SET DATA=$$ACCNTHDR^RCDPAPLM(RCDEBTDA)
+8 ;
+9 SET %=""
SET $PIECE(%," ",80)=""
+10 ; PRCA*4.5*276 - get EEOB indicator for 1st/3rd party payment and attach to bill when applicable
+11 SET PRCOUT=$$COMP3^PRCAAPR(RCBILLDA)
+12 IF PRCOUT'="%"
SET PRCOUT=$$IBEEOBCK^PRCAAPR1(RCBILLDA)
+13 SET VALMHDR(1)=$EXTRACT("Bill #: "_$GET(PRCOUT)_$GET(RCDPDATA(430,RCBILLDA,.01,"E"))_%,1,25)_"Account: "_$PIECE(DATA,U)_$PIECE(DATA,U,2)
+14 SET VALMHDR(2)=$EXTRACT("Status: "_$GET(RCDPDATA(430,RCBILLDA,8,"E"))_%,1,25)_$EXTRACT(" Addr: "_$PIECE(DATA,U,4)_", "_$PIECE(DATA,U,7)_", "_$PIECE(DATA,U,8)_" "_$PIECE(DATA,U,9)_%,1,55)
+15 ; PRCA*4.5*276 - show caption for user
+16 ; PRCA*4.5*276
SET VALMSG="|% EEOB | Enter ?? for more actions |"
+17 QUIT
+18 SET VALMHDR(3)=" "_IORVON_$EXTRACT("Bill Balance: "_$JUSTIFY($PIECE(RCTOTAL,U)+$PIECE(RCTOTAL,U,2)+$PIECE(RCTOTAL,U,3)+$PIECE(RCTOTAL,U,4)+$PIECE(RCTOTAL,U,5),0,2)_%,1,23)_IORVOFF_" Phone: "_$PIECE(DATA,U,10)
+19 QUIT
+20 ;
+21 ;
EXIT ; exit list manager option and clean up
+1 KILL ^TMP("RCDPBTLM",$JOB),^TMP("RCDPBTLMX",$JOB)
+2 QUIT
+3 ;
+4 ;
SELBILL() ; select a bill
+1 ; returns -1 for timeout or ^, 0 for no selection, or ien of bill
+2 NEW %,%Y,C,DIC,DTOUT,DUOUT,RCBEFLUP,X,Y
+3 NEW DPTNOFZY,DPTNOFZK
SET (DPTNOFZY,DPTNOFZK)=1
+4 NEW RCY,DIR,DIRUT
+5 ; allow user to get the record using bill# or ECME#
+6 SET DIR("A")="Select (B)ILL or (E)CME#: "
+7 SET DIR(0)="SA^B:BILL NUMBER;E:ECME#"
+8 SET DIR("B")="B"
+9 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
QUIT 0
+10 SET RCY=Y
+11 IF RCY="E"
QUIT $$SELECME
+12 SET DIC="^PRCA(430,"
SET DIC(0)="QEAM"
SET DIC("A")="Select BILL: "
+13 SET DIC("W")="D DICW^RCBEUBI1"
+14 ; special lookup on input
+15 SET RCBEFLUP=1
+16 DO ^DIC
+17 IF Y<0
IF '$GET(DUOUT)
IF '$GET(DTOUT)
SET Y=0
+18 QUIT +Y
+19 ;
+20 ;
GETTRANS(BILLDA) ; original amount goes first for bill
+1 ; returns list of transactions in
+2 ; rclist(date,tranda)=trantype ^ principle ^ interest ^ admin
+3 ; returns principle balance ^ interest balance ^ admin balance
+4 ; ^ marshall fee balance ^ court cost balance
+5 NEW %,ADMBAL,AMTDISP,CCBAL,DATA0,DATA1,DATE,INTBAL,MFBAL,PRINBAL,RCDPDATA,RCUSER,TRANDA,VALUE
+6 ;
+7 DO DIQ430^RCDPBPLM(BILLDA,"3;60;")
+8 ;
+9 KILL RCLIST
+10 SET (ADMBAL,CCBAL,INTBAL,MFBAL,PRINBAL)=0
+11 SET PRINBAL=RCDPDATA(430,BILLDA,3,"I")
+12 ; loop transaction and add to list
+13 SET TRANDA=0
FOR
SET TRANDA=$ORDER(^PRCA(433,"C",BILLDA,TRANDA))
if 'TRANDA
QUIT
Begin DoDot:1
+14 ;PRCA*4.5*315 Needed for User ID
SET DATA0=$GET(^PRCA(433,TRANDA,0))
+15 ;PRCA*4.5*315
SET RCUSER=$PIECE(DATA0,U,9)
+16 ;PRCA*4.5*315
SET RCUSER=$$GET1^DIQ(200,RCUSER_",",1)
+17 SET DATA1=$GET(^PRCA(433,TRANDA,1))
+18 SET DATE=$PIECE(DATA1,U,9)
IF 'DATE
QUIT
+19 ;PRCA*4.5*315 (was I VALUE="" Q)
SET VALUE=$$TRANVALU(TRANDA)
+20 SET RCLIST($PIECE(DATE,"."),TRANDA)=$PIECE($GET(^PRCA(430.3,+$PIECE(DATA1,U,2),0)),U)_VALUE
+21 ;PRCA*4.5*315
SET $PIECE(RCLIST($PIECE(DATE,"."),TRANDA),U,7)=RCUSER
+22 ;
+23 ; calculate bill's balance
+24 SET PRINBAL=PRINBAL+$PIECE(VALUE,U,2)
+25 SET INTBAL=INTBAL+$PIECE(VALUE,U,3)
+26 SET ADMBAL=ADMBAL+$PIECE(VALUE,U,4)
+27 SET MFBAL=MFBAL+$PIECE(VALUE,U,5)
+28 SET CCBAL=CCBAL+$PIECE(VALUE,U,6)
End DoDot:1
+29 ;
+30 SET DATE=$GET(RCDPDATA(430,BILLDA,60,"I"))
+31 ; check to make sure activation date is not greater than first transaction
+32 SET %=$ORDER(RCLIST(0))
IF DATE>%
SET DATE=%
+33 SET RCLIST(+$PIECE(DATE,"."),0)="original amount^"_RCDPDATA(430,BILLDA,3,"I")
+34 ;
+35 QUIT PRINBAL_U_INTBAL_U_ADMBAL_U_MFBAL_U_CCBAL
+36 ;
+37 ;
TRANVALU(TRANDA) ; return the transaction value as displayed (with + or - sign)
+1 NEW TYPE,VALUE
+2 SET VALUE=$$TRANBAL^RCRJRCOT(TRANDA)
+3 ; no dollars on transaction
+4 IF '$PIECE(VALUE,U)
IF '$PIECE(VALUE,U,2)
IF '$PIECE(VALUE,U,3)
IF '$PIECE(VALUE,U,4)
IF '$PIECE(VALUE,U,5)
QUIT ""
+5 ; check type for payments, etc, make values (-) to subtract
+6 SET TYPE=$PIECE($GET(^PRCA(433,TRANDA,1)),U,2)
+7 IF TYPE=2!(TYPE=8)!(TYPE=9)!(TYPE=10)!(TYPE=11)!(TYPE=14)!(TYPE=29)!(TYPE=34)!(TYPE=35)!(TYPE=41)
Begin DoDot:1
+8 SET $PIECE(VALUE,U,1)=-$PIECE(VALUE,U,1)
+9 SET $PIECE(VALUE,U,2)=-$PIECE(VALUE,U,2)
+10 SET $PIECE(VALUE,U,3)=-$PIECE(VALUE,U,3)
+11 SET $PIECE(VALUE,U,4)=-$PIECE(VALUE,U,4)
+12 SET $PIECE(VALUE,U,5)=-$PIECE(VALUE,U,5)
End DoDot:1
+13 ;
+14 ; the following transaction types should not change the bills balance
+15 ; return the amount displayed in the description and 0 for value
+16 ; refer to RC 3, refer to DOJ 4, reestablish 5, returned 6 and 32
+17 ; repayment plan 25, amended 33, suspended 47, unsuspended 46
+18 KILL AMTDISP
+19 IF TYPE=3!(TYPE=4)!(TYPE=5)!(TYPE=6)!(TYPE=25)!(TYPE=32)!(TYPE=33)!(TYPE=46)!(TYPE=47)
Begin DoDot:1
+20 SET AMTDISP=" ($"_$JUSTIFY($PIECE(VALUE,U)+$PIECE(VALUE,U,2)+$PIECE(VALUE,U,3)+$PIECE(VALUE,U,4)+$PIECE(VALUE,U,5),0,2)_")"
+21 SET VALUE=""
End DoDot:1
+22 QUIT $GET(AMTDISP)_U_VALUE
+23 ;
SELECME() ;
+1 ; function takes the user input of the ECME # to return a valid ien of file 430
+2 ; if an invalid ECME is evaluated then the process keeps asking the user for ECME #
+3 ; until a valid ECME# is entered or until the user enters a U or null value
+4 ; output - returns the IEN of the record entry in the ACCOUNT RECEIVABLE file (#430) or "??"
+5 NEW RCECME,RCBILL,DIR,DIRUT,Y
+6 SET DIR(0)="FO^1:12^I X'?1.12N W !!,""Cannot contain alpha characters"" K X"
+7 SET DIR("A")="Select ECME#"
RET DO ^DIR
IF $DATA(DIRUT)
QUIT 0
+1 SET RCECME=$SELECT(+Y>0:Y,1:0)
+2 ; IA 2031
SET RCBILL=$$REC^IBRFN(RCECME)
+3 IF RCBILL<0
WRITE !!,"??"
GOTO RET
+4 IF '$TEST
WRITE !!,$PIECE($GET(^PRCA(430,+RCBILL,0)),U)," "
+5 QUIT RCBILL
+6 ;RCDPBTLM
