- 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 Jan 18, 2025@02:45:11 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