source: FOIAVistA/tag/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPBTLM.m

RCDPBTLM ;WISC/RFJ - bill transactions List Manager top routine ;1 Jun 99
 ;;4.5;Accounts Receivable;**114,148,153,168,169,198,247**;Mar 20, 1995;Build 5
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
 ;
 ;  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
 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,4,80)
 .   .   D SET^RCDPAPLI($E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3),RCLINE,13,21)
 .   .   D SET^RCDPAPLI($TR($P(RCLIST(DATE,RCTRANDA),"^"),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz"),RCLINE,25,50)
 .   .   D SET^RCDPAPLI($J($P(RCLIST(DATE,RCTRANDA),"^",2),9,2),RCLINE,53,62)
 .   .   D SET^RCDPAPLI($J($P(RCLIST(DATE,RCTRANDA),"^",3),9,2),RCLINE,62,71)
 .   .   ;  add marshal fee and court cost to create admin dollars
 .   .   S ADMIN=$P(RCLIST(DATE,RCTRANDA),"^",4)+$P(RCLIST(DATE,RCTRANDA),"^",5)+$P(RCLIST(DATE,RCTRANDA),"^",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,"^",1),9,2),RCLINE,53,62)
 D SET^RCDPAPLI($J($P(RCTOTAL,"^",2),9,2),RCLINE,62,71)
 D SET^RCDPAPLI($J($P(RCTOTAL,"^",3)+$P(RCTOTAL,"^",4)+$P(RCTOTAL,"^",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),"^",8)=23 S RCDATA7="0^0^0^0^0"
 I +$P(RCDATA7,"^",1)'=+$P(RCTOTAL,"^",1) S RCFOUT=1
 I +$P(RCDATA7,"^",2)'=+$P(RCTOTAL,"^",2) S RCFOUT=1
 I ($P(RCDATA7,"^",3)+$P(RCDATA7,"^",4)+$P(RCDATA7,"^",5))'=+$P(RCTOTAL,"^",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,"^",1),9,2),RCLINE,53,62)
 .   D SET^RCDPAPLI($J($P(RCDATA7,"^",2),9,2),RCLINE,62,71)
 .   D SET^RCDPAPLI($J($P(RCDATA7,"^",3)+$P(RCDATA7,"^",4)+$P(RCDATA7,"^",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),"^",9)
 S DATA=$$ACCNTHDR^RCDPAPLM(RCDEBTDA)
 ;
 S %="",$P(%," ",80)=""
 S VALMHDR(1)=$E("Bill #: "_$G(RCDPDATA(430,RCBILLDA,.01,"E"))_%,1,25)_"Account: "_$P(DATA,"^")_$P(DATA,"^",2)
 S VALMHDR(2)=$E("Status: "_$G(RCDPDATA(430,RCBILLDA,8,"E"))_%,1,25)_$E("   Addr: "_$P(DATA,"^",4)_", "_$P(DATA,"^",7)_", "_$P(DATA,"^",8)_"  "_$P(DATA,"^",9)_%,1,55)
 Q
 S VALMHDR(3)="  "_IORVON_$E("Bill Balance: "_$J($P(RCTOTAL,"^")+$P(RCTOTAL,"^",2)+$P(RCTOTAL,"^",3)+$P(RCTOTAL,"^",4)+$P(RCTOTAL,"^",5),0,2)_%,1,23)_IORVOFF_"  Phone: "_$P(DATA,"^",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,DATA1,DATE,INTBAL,MFBAL,PRINBAL,RCDPDATA,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 DATA1=$G(^PRCA(433,TRANDA,1))
 .   S DATE=$P(DATA1,"^",9) I 'DATE Q
 .   S VALUE=$$TRANVALU(TRANDA) I VALUE="" Q
 .   S RCLIST($P(DATE,"."),TRANDA)=$P($G(^PRCA(430.3,+$P(DATA1,"^",2),0)),"^")_VALUE
 .   ;
 .   ;  calculate bill's balance
 .   S PRINBAL=PRINBAL+$P(VALUE,"^",2)
 .   S INTBAL=INTBAL+$P(VALUE,"^",3)
 .   S ADMBAL=ADMBAL+$P(VALUE,"^",4)
 .   S MFBAL=MFBAL+$P(VALUE,"^",5)
 .   S CCBAL=CCBAL+$P(VALUE,"^",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_"^"_INTBAL_"^"_ADMBAL_"^"_MFBAL_"^"_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,"^"),'$P(VALUE,"^",2),'$P(VALUE,"^",3),'$P(VALUE,"^",4),'$P(VALUE,"^",5) Q ""
 ;  check type for payments, etc, make values (-) to subtract
 S TYPE=$P($G(^PRCA(433,TRANDA,1)),"^",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,"^",1)=-$P(VALUE,"^",1)
 .   S $P(VALUE,"^",2)=-$P(VALUE,"^",2)
 .   S $P(VALUE,"^",3)=-$P(VALUE,"^",3)
 .   S $P(VALUE,"^",4)=-$P(VALUE,"^",4)
 .   S $P(VALUE,"^",5)=-$P(VALUE,"^",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,"^")+$P(VALUE,"^",2)+$P(VALUE,"^",3)+$P(VALUE,"^",4)+$P(VALUE,"^",5),0,2)_")"
 .   S VALUE=""
 Q $G(AMTDISP)_"^"_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 "^" 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^7:7^I X'?1.7N 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)
 I RCBILL<0 W !!,"??" G RET
 E  W !!,$P($G(^PRCA(430,+RCBILL,0)),"^")," "
 Q RCBILL
 ;RCDPBTLM