RCDPBPLM ;WISC/RFJ - bill profile ;1 Jun 99
;;4.5;Accounts Receivable;**114,153,159,241,276,303,301,315,388,389**;Mar 20, 1995;Build 36
;;Per VA Directive 6402, this routine should not be modified.
;
;
; called from menu option (19)
;
N RCBILLDA,RCDPFXIT
;
F D Q:'RCBILLDA
. W !! S RCBILLDA=$$SELBILL^RCDPBTLM
. I RCBILLDA<1 S RCBILLDA=0 Q
. D EN^VALM("RCDP BILL PROFILE")
. ; fast exit
. I $G(RCDPFXIT) S RCBILLDA=0
Q
;
;
INIT ; initialization for list manager list
; requires rcbillda
N BILLED,COMMDA,DATA,PAID,RCDPDATA,RCFYDA,RCLINE,REPTYPE,X1,X2,RCDEBTOR,DFN
N RPIEN,RPDATA ; PRCA*4.5*388
K ^TMP("RCDPBPLM",$J),^TMP("VALM VIDEO",$J)
;
; fast exit
I $G(RCDPFXIT) S VALMQUIT=1 Q
;
D DIQ430(RCBILLDA,".01:300")
S RPIEN=+$$GET1^DIQ(430,RCBILLDA_",",45,"I") I RPIEN D GETS^DIQ(340.5,RPIEN_",",".01;.03;.05:.07;.11",,"RPDATA") ; PRCA*4.5*389
;
; set the listmanager line number
S RCLINE=0
;
I '$D(RCDPDATA) Q ;PRCA*4.5*315
S DATA=$$ACCNTHDR^RCDPAPLM(RCDPDATA(430,RCBILLDA,9,"I"))
S RCLINE=RCLINE+1 D SET("Account: "_$P(DATA,"^")_" "_$P(DATA,"^",2),RCLINE,1,80)
D SET($P(DATA,"^",3),RCLINE,60,80)
S %="" I $TR($P(DATA,"^",4,9),"^")'="" S %=$P(DATA,"^",4)_", "_$P(DATA,"^",7)_", "_$P(DATA,"^",8)_" "_$P(DATA,"^",9)
S RCLINE=RCLINE+1 D SET(" Addr: "_%,RCLINE,1,80)
S RCLINE=RCLINE+1 D SET(" Phone: "_$P(DATA,"^",10),RCLINE,1,80)
S RCDEBTOR=$P(^PRCA(430,RCBILLDA,0),U,9)
I RCDEBTOR,($P(^RCD(340,+RCDEBTOR,0),U)["DPT(") S DFN=+^(0) D ; Skip D if no Debtor link
. Q:$$EMGRES^DGUTL(DFN)'["K"
. S RCLINE=RCLINE+1
. D SET("EMERGENCY RESPONSE INDICATOR: HURRICANE KATRINA",RCLINE,1,80)
;
; bill descriptive data
S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
; PRCA*4.5*276 - get 1st/3rd party payment add EEOB indicator when applicable
S PRCOUT=$$COMP3^PRCAAPR(RCBILLDA)
I PRCOUT'="%" S PRCOUT=$$IBEEOBCK^PRCAAPR1(RCBILLDA)
S RCLINE=RCLINE+1 ; D SET("Bill Number",RCLINE,1,80,.01,IOUON,IOUOFF)
; IA# 6060 for $$BILLREJ^IBJTU6
S PRCOUT=PRCOUT_$S($$BILLREJ^IBJTU6($P($P($G(RCDPDATA(430,RCBILLDA,.01,"E")),"^"),"-",2)):"c",1:"") ;PRCA*4.5*303 Add indicator for rejects
D SET("Bill Number: "_$G(PRCOUT)_$P(RCDPDATA(430,RCBILLDA,.01,"E"),"^"),RCLINE,1,80,0,IOUON,IOUOFF)
D SET("Category",RCLINE,40,80,2)
S RCLINE=RCLINE+1 D SET("Date Prepared",RCLINE,1,80,10)
D SET("Status",RCLINE,42,80,8)
S RCLINE=RCLINE+1 D SET("Date Activated",RCLINE,1,80,60)
S RCLINE=RCLINE+1 D SET("Date Status Up",RCLINE,1,80,14)
D SET("By",RCLINE,46,80,17)
;display TP bills Division of Care
I "T"=$P($G(^PRCA(430.2,+RCDPDATA(430,RCBILLDA,2,"I"),0)),"^",6) D
. S RCDIV=$$DIV^IBJDF2(RCBILLDA) I +RCDIV D
.. S RCDIV=$P($G(^DG(40.8,RCDIV,0)),U,1) I RCDIV="" Q
.. S RCLINE=RCLINE+1 D SET("Division of Care: "_RCDIV,RCLINE,1,80)
S RCLINE=RCLINE+1 D SET("Resulting From",RCLINE,1,80,4.5)
I RCDPDATA(430,RCBILLDA,15.1,"E")'="" D
. S RCLINE=RCLINE+1 D SET(" Type of Care",RCLINE,1,80,15.1)
S RCLINE=RCLINE+1 D SET(" Remark",RCLINE,1,80,15)
; display comments if there
I $O(^PRCA(430,RCBILLDA,10,0)) D
. S RCLINE=RCLINE+1 D SET("Comments:",RCLINE,1,80)
. S COMMDA=0 F S COMMDA=$O(^PRCA(430,RCBILLDA,10,COMMDA)) Q:'COMMDA D
.. S RCLINE=RCLINE+1 D SET(" "_$G(^PRCA(430,RCBILLDA,10,COMMDA,0)),RCLINE,1,80)
;
; int/adm rate and date
S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
S DATA=$$INT^RCMSFN01(RCDPDATA(430,RCBILLDA,10,"I"))
S Y=$P(DATA,"^",2) I Y D DD^%DT
S RCLINE=RCLINE+1 D SET("Interest Effective Rate Date: "_Y,RCLINE,1,80)
D SET(" Annual Rate: "_$P(DATA,"^"),RCLINE,55,80)
S DATA=$$ADM^RCMSFN01(RCDPDATA(430,RCBILLDA,10,"I"))
S Y=$P(DATA,"^",2) I Y D DD^%DT
S RCLINE=RCLINE+1 D SET(" Admin Effective Rate Date: "_Y,RCLINE,1,80)
D SET("Monthly Rate: "_$P(DATA,"^"),RCLINE,55,80)
S RCLINE=RCLINE+1 D SET(" Last Int/Admin Charge Date",RCLINE,1,80,67)
;
; put bill balances on first line of second screen
F RCLINE=RCLINE+1:1:16 D SET(" ",RCLINE,1,80)
;
; bill dollars
S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
S RCLINE=RCLINE+1 D SET("Bill Balances Billed Paid",RCLINE,1,80,0,IOUON,IOUOFF)
S RCLINE=RCLINE+1 D SET(" Principal: "_$J(RCDPDATA(430,RCBILLDA,71,"E"),14,2)_$J(RCDPDATA(430,RCBILLDA,77,"E"),14,2),RCLINE,1,80)
D SET(" Original Amt: "_$J(RCDPDATA(430,RCBILLDA,3,"E"),11,2),RCLINE,48,80)
S RCLINE=RCLINE+1 D SET(" Interest: "_$J(RCDPDATA(430,RCBILLDA,72,"E"),14,2)_$J(RCDPDATA(430,RCBILLDA,78,"E"),14,2),RCLINE,1,80)
I $G(RCDPDATA(430,RCBILLDA,131,"E")) D SET("Medicare Contr Adj: "_$J(RCDPDATA(430,RCBILLDA,131,"E"),11,2),RCLINE,48,80)
I RCDPDATA(430,RCBILLDA,74,"E") D
. S RCLINE=RCLINE+1 D SET(" Marshall Fee: "_$J(RCDPDATA(430,RCBILLDA,74,"E"),14,2)_$J(RCDPDATA(430,RCBILLDA,79.1,"E"),14,2),RCLINE,1,80)
I RCDPDATA(430,RCBILLDA,75,"E") D
. S RCLINE=RCLINE+1 D SET(" Court Cost: "_$J(RCDPDATA(430,RCBILLDA,75,"E"),14,2),RCLINE,1,80)
S RCLINE=RCLINE+1 D SET("Administrative: "_$J(RCDPDATA(430,RCBILLDA,73,"E"),14,2)_$J(RCDPDATA(430,RCBILLDA,79,"E"),14,2),RCLINE,1,80,0,IOUON,IOUOFF)
I $G(RCDPDATA(430,RCBILLDA,132,"E")) D SET("Medicare Unreim Exp: "_$J(RCDPDATA(430,RCBILLDA,132,"E"),11,2),RCLINE,48,80)
; compute totals
S BILLED=0 F %=71,72,73,74,75 S BILLED=BILLED+RCDPDATA(430,RCBILLDA,%,"E")
S PAID=0 F %=77,78,79,79.1 S PAID=PAID+RCDPDATA(430,RCBILLDA,%,"E")
S RCLINE=RCLINE+1 D SET(" Current: "_$J(BILLED,14,2)_$J(PAID,14,2),RCLINE,1,80)
;
; show refund if there
I RCDPDATA(430,RCBILLDA,79.18,"E") D
. S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
. S RCLINE=RCLINE+1 D SET("Refunded Amount",RCLINE,1,80,79.18)
. D SET("Date",RCLINE,27,80,79.19)
. D SET("By",RCLINE,50,80,79.21)
;
; accounting data
S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
S RCLINE=RCLINE+1 D SET("Accounting Data",RCLINE,1,80,0,IOUON,IOUOFF)
; fiscal year multiple
D SET("Fiscal Year",RCLINE,20,32,0,IOUON,IOUOFF)
D SET("Approp Code",RCLINE,34,46,0,IOUON,IOUOFF)
D SET("Amount",RCLINE,50,60,0,IOUON,IOUOFF)
S RCFYDA=0 F S RCFYDA=$O(^PRCA(430,RCBILLDA,2,RCFYDA)) Q:'RCFYDA D
. S DATA=$G(^PRCA(430,RCBILLDA,2,RCFYDA,0))
. S RCLINE=RCLINE+1
. D SET($J($P(DATA,"^"),30),RCLINE,1,80) ;fiscal year
. D SET($J(RCDPDATA(430,RCBILLDA,203,"E"),6),RCLINE,39,45) ;fund
. D SET($J($P(DATA,"^",2),8,2),RCLINE,48,80) ;amount
; determine which rsc to display
S %=RCDPDATA(430,RCBILLDA,255.1,"E") I %="" S %=RCDPDATA(430,RCBILLDA,255,"E")
S RCLINE=RCLINE+1 D SET("Rev Srce Code: "_%,RCLINE,1,80)
;
; collection data
S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
S RCLINE=RCLINE+1 D SET("Collection Follow up Data",RCLINE,1,80,0,IOUON,IOUOFF)
S RCLINE=RCLINE+1 D SET(" Letter1",RCLINE,1,80,61)
S RCLINE=RCLINE+1 D SET(" Letter2",RCLINE,1,80,62)
S RCLINE=RCLINE+1 D SET(" Letter3",RCLINE,1,80,63)
S RCLINE=RCLINE+1 D SET(" Letter4",RCLINE,1,80,68)
I RCDPDATA(430,RCBILLDA,68.6,"I") D
. S RCLINE=RCLINE+1 D SET(" IRS Letter",RCLINE,1,80,68.6)
. D SET("Amount",RCLINE,65,80,68.93)
I RCDPDATA(430,RCBILLDA,64,"I") D
. S RCLINE=RCLINE+1 D SET("DC/DOJ Ref Date",RCLINE,1,80,64)
. D SET("To",RCLINE,40,80,65)
. D SET("Amount",RCLINE,65,80,66)
;
BILLRJ ;====== BILL PROFILE REJECT INSERTED HERE ;LEG
I $D(^PRCA(430,RCBILLDA,18)) D REJECT^RCDPBPLI ; prca*4.5*301
;
; repayment plan (show only if there)
I RPIEN D REPAY^RCDPBPLI ; PRCA*4.5*388
;
; irs data (show only if there)
I RCDPDATA(430,RCBILLDA,68.7,"I") D IRS^RCDPBPLI
;
; dmc data (show only if there)
I RCDPDATA(430,RCBILLDA,121,"I") D DMC^RCDPBPLI
;
; top data (show only if there)
I $G(RCDPDATA(430,RCBILLDA,141,"I")) D TOP^RCDPBPLI
;
;
; cross-servicing referral data(show only if there)
I $G(RCDPDATA(430,RCBILLDA,151,"I")) D TCSP^RCDPBPLI
;
;
; cross-servicing recall data(show only if there)
I $G(RCDPDATA(430,RCBILLDA,152,"I"))!$G(RCDPDATA(430,RCBILLDA,153,"I"))!$G(RCDPDATA(430,RCBILLDA,154,"I")) D TCSPRC^RCDPBPLI
;
;
; get the report type based on category. if third party show
; insurance data
S REPTYPE=$P($G(^PRCA(430.2,+RCDPDATA(430,RCBILLDA,2,"I"),0)),"^",6)
I REPTYPE="T" D INSUR^RCDPBPLI
;
; report type for employee or vendor, show description field 106
I REPTYPE="O"!(REPTYPE="V") D INIT^RCDPBPLI
;
; show transactions and reasons
D TRANINIT^RCDPBPLI
;
; set valmcnt to number of lines in the list
S VALMCNT=RCLINE
D HDR
Q
;
;
HDR ; header code for list manager display
; requires rcbillda
S VALMHDR(1)="***** ACCOUNTS RECEIVABLE BILL PROFILE FOR "_$P($G(^PRCA(430,RCBILLDA,0)),"^")_" *****"
; PRCA*4.5*276 - add explanation of '%' for the user
S VALMSG="|% EEOB | Enter ?? for more actions|" ; PRCA*4.5*276
Q
;
;
EXIT ; exit list manager option and clean up
K ^TMP("RCDPBPLM",$J)
Q
;
;
SET(STRING,LINE,COLBEG,COLEND,FIELD,ON,OFF,RPFLG) ; set array
S RPFLG=$G(RPFLG,0) ; PRCA*4.5*388
I $G(FIELD) D
.S STRING=STRING_$S(STRING="":"",1:": ")
.S STRING=STRING_$S(RPFLG:$G(RPDATA(340.5,RPIEN_",",FIELD)),1:$G(RCDPDATA(430,RCBILLDA,FIELD,"E")))
.Q
;
I STRING="",'$G(FIELD) Q
I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80))
D SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLBEG,COLEND-COLBEG+1))
I $G(ON)]""!($G(OFF)]"") D CNTRL^VALM10(LINE,COLBEG,$L(STRING),ON,OFF)
Q
;
;
DIQ430(DA,DR) ; diq call to retrieve data for dr fields in file 430
N D0,DIC,DIQ,DIQ2
K RCDPDATA(430,DA)
S DIQ(0)="IE",DIC="^PRCA(430,",DIQ="RCDPDATA" D EN^DIQ1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPBPLM 9593 printed Oct 16, 2024@17:44:47 Page 2
RCDPBPLM ;WISC/RFJ - bill profile ;1 Jun 99
+1 ;;4.5;Accounts Receivable;**114,153,159,241,276,303,301,315,388,389**;Mar 20, 1995;Build 36
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;
+5 ; called from menu option (19)
+6 ;
+7 NEW RCBILLDA,RCDPFXIT
+8 ;
+9 FOR
Begin DoDot:1
+10 WRITE !!
SET RCBILLDA=$$SELBILL^RCDPBTLM
+11 IF RCBILLDA<1
SET RCBILLDA=0
QUIT
+12 DO EN^VALM("RCDP BILL PROFILE")
+13 ; fast exit
+14 IF $GET(RCDPFXIT)
SET RCBILLDA=0
End DoDot:1
if 'RCBILLDA
QUIT
+15 QUIT
+16 ;
+17 ;
INIT ; initialization for list manager list
+1 ; requires rcbillda
+2 NEW BILLED,COMMDA,DATA,PAID,RCDPDATA,RCFYDA,RCLINE,REPTYPE,X1,X2,RCDEBTOR,DFN
+3 ; PRCA*4.5*388
NEW RPIEN,RPDATA
+4 KILL ^TMP("RCDPBPLM",$JOB),^TMP("VALM VIDEO",$JOB)
+5 ;
+6 ; fast exit
+7 IF $GET(RCDPFXIT)
SET VALMQUIT=1
QUIT
+8 ;
+9 DO DIQ430(RCBILLDA,".01:300")
+10 ; PRCA*4.5*389
SET RPIEN=+$$GET1^DIQ(430,RCBILLDA_",",45,"I")
IF RPIEN
DO GETS^DIQ(340.5,RPIEN_",",".01;.03;.05:.07;.11",,"RPDATA")
+11 ;
+12 ; set the listmanager line number
+13 SET RCLINE=0
+14 ;
+15 ;PRCA*4.5*315
IF '$DATA(RCDPDATA)
QUIT
+16 SET DATA=$$ACCNTHDR^RCDPAPLM(RCDPDATA(430,RCBILLDA,9,"I"))
+17 SET RCLINE=RCLINE+1
DO SET("Account: "_$PIECE(DATA,"^")_" "_$PIECE(DATA,"^",2),RCLINE,1,80)
+18 DO SET($PIECE(DATA,"^",3),RCLINE,60,80)
+19 SET %=""
IF $TRANSLATE($PIECE(DATA,"^",4,9),"^")'=""
SET %=$PIECE(DATA,"^",4)_", "_$PIECE(DATA,"^",7)_", "_$PIECE(DATA,"^",8)_" "_$PIECE(DATA,"^",9)
+20 SET RCLINE=RCLINE+1
DO SET(" Addr: "_%,RCLINE,1,80)
+21 SET RCLINE=RCLINE+1
DO SET(" Phone: "_$PIECE(DATA,"^",10),RCLINE,1,80)
+22 SET RCDEBTOR=$PIECE(^PRCA(430,RCBILLDA,0),U,9)
+23 ; Skip D if no Debtor link
IF RCDEBTOR
IF ($PIECE(^RCD(340,+RCDEBTOR,0),U)["DPT(")
SET DFN=+^(0)
Begin DoDot:1
+24 if $$EMGRES^DGUTL(DFN)'["K"
QUIT
+25 SET RCLINE=RCLINE+1
+26 DO SET("EMERGENCY RESPONSE INDICATOR: HURRICANE KATRINA",RCLINE,1,80)
End DoDot:1
+27 ;
+28 ; bill descriptive data
+29 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+30 ; PRCA*4.5*276 - get 1st/3rd party payment add EEOB indicator when applicable
+31 SET PRCOUT=$$COMP3^PRCAAPR(RCBILLDA)
+32 IF PRCOUT'="%"
SET PRCOUT=$$IBEEOBCK^PRCAAPR1(RCBILLDA)
+33 ; D SET("Bill Number",RCLINE,1,80,.01,IOUON,IOUOFF)
SET RCLINE=RCLINE+1
+34 ; IA# 6060 for $$BILLREJ^IBJTU6
+35 ;PRCA*4.5*303 Add indicator for rejects
SET PRCOUT=PRCOUT_$SELECT($$BILLREJ^IBJTU6($PIECE($PIECE($GET(RCDPDATA(430,RCBILLDA,.01,"E")),"^"),"-",2)):"c",1:"")
+36 DO SET("Bill Number: "_$GET(PRCOUT)_$PIECE(RCDPDATA(430,RCBILLDA,.01,"E"),"^"),RCLINE,1,80,0,IOUON,IOUOFF)
+37 DO SET("Category",RCLINE,40,80,2)
+38 SET RCLINE=RCLINE+1
DO SET("Date Prepared",RCLINE,1,80,10)
+39 DO SET("Status",RCLINE,42,80,8)
+40 SET RCLINE=RCLINE+1
DO SET("Date Activated",RCLINE,1,80,60)
+41 SET RCLINE=RCLINE+1
DO SET("Date Status Up",RCLINE,1,80,14)
+42 DO SET("By",RCLINE,46,80,17)
+43 ;display TP bills Division of Care
+44 IF "T"=$PIECE($GET(^PRCA(430.2,+RCDPDATA(430,RCBILLDA,2,"I"),0)),"^",6)
Begin DoDot:1
+45 SET RCDIV=$$DIV^IBJDF2(RCBILLDA)
IF +RCDIV
Begin DoDot:2
+46 SET RCDIV=$PIECE($GET(^DG(40.8,RCDIV,0)),U,1)
IF RCDIV=""
QUIT
+47 SET RCLINE=RCLINE+1
DO SET("Division of Care: "_RCDIV,RCLINE,1,80)
End DoDot:2
End DoDot:1
+48 SET RCLINE=RCLINE+1
DO SET("Resulting From",RCLINE,1,80,4.5)
+49 IF RCDPDATA(430,RCBILLDA,15.1,"E")'=""
Begin DoDot:1
+50 SET RCLINE=RCLINE+1
DO SET(" Type of Care",RCLINE,1,80,15.1)
End DoDot:1
+51 SET RCLINE=RCLINE+1
DO SET(" Remark",RCLINE,1,80,15)
+52 ; display comments if there
+53 IF $ORDER(^PRCA(430,RCBILLDA,10,0))
Begin DoDot:1
+54 SET RCLINE=RCLINE+1
DO SET("Comments:",RCLINE,1,80)
+55 SET COMMDA=0
FOR
SET COMMDA=$ORDER(^PRCA(430,RCBILLDA,10,COMMDA))
if 'COMMDA
QUIT
Begin DoDot:2
+56 SET RCLINE=RCLINE+1
DO SET(" "_$GET(^PRCA(430,RCBILLDA,10,COMMDA,0)),RCLINE,1,80)
End DoDot:2
End DoDot:1
+57 ;
+58 ; int/adm rate and date
+59 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+60 SET DATA=$$INT^RCMSFN01(RCDPDATA(430,RCBILLDA,10,"I"))
+61 SET Y=$PIECE(DATA,"^",2)
IF Y
DO DD^%DT
+62 SET RCLINE=RCLINE+1
DO SET("Interest Effective Rate Date: "_Y,RCLINE,1,80)
+63 DO SET(" Annual Rate: "_$PIECE(DATA,"^"),RCLINE,55,80)
+64 SET DATA=$$ADM^RCMSFN01(RCDPDATA(430,RCBILLDA,10,"I"))
+65 SET Y=$PIECE(DATA,"^",2)
IF Y
DO DD^%DT
+66 SET RCLINE=RCLINE+1
DO SET(" Admin Effective Rate Date: "_Y,RCLINE,1,80)
+67 DO SET("Monthly Rate: "_$PIECE(DATA,"^"),RCLINE,55,80)
+68 SET RCLINE=RCLINE+1
DO SET(" Last Int/Admin Charge Date",RCLINE,1,80,67)
+69 ;
+70 ; put bill balances on first line of second screen
+71 FOR RCLINE=RCLINE+1:1:16
DO SET(" ",RCLINE,1,80)
+72 ;
+73 ; bill dollars
+74 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+75 SET RCLINE=RCLINE+1
DO SET("Bill Balances Billed Paid",RCLINE,1,80,0,IOUON,IOUOFF)
+76 SET RCLINE=RCLINE+1
DO SET(" Principal: "_$JUSTIFY(RCDPDATA(430,RCBILLDA,71,"E"),14,2)_$JUSTIFY(RCDPDATA(430,RCBILLDA,77,"E"),14,2),RCLINE,1,80)
+77 DO SET(" Original Amt: "_$JUSTIFY(RCDPDATA(430,RCBILLDA,3,"E"),11,2),RCLINE,48,80)
+78 SET RCLINE=RCLINE+1
DO SET(" Interest: "_$JUSTIFY(RCDPDATA(430,RCBILLDA,72,"E"),14,2)_$JUSTIFY(RCDPDATA(430,RCBILLDA,78,"E"),14,2),RCLINE,1,80)
+79 IF $GET(RCDPDATA(430,RCBILLDA,131,"E"))
DO SET("Medicare Contr Adj: "_$JUSTIFY(RCDPDATA(430,RCBILLDA,131,"E"),11,2),RCLINE,48,80)
+80 IF RCDPDATA(430,RCBILLDA,74,"E")
Begin DoDot:1
+81 SET RCLINE=RCLINE+1
DO SET(" Marshall Fee: "_$JUSTIFY(RCDPDATA(430,RCBILLDA,74,"E"),14,2)_$JUSTIFY(RCDPDATA(430,RCBILLDA,79.1,"E"),14,2),RCLINE,1,80)
End DoDot:1
+82 IF RCDPDATA(430,RCBILLDA,75,"E")
Begin DoDot:1
+83 SET RCLINE=RCLINE+1
DO SET(" Court Cost: "_$JUSTIFY(RCDPDATA(430,RCBILLDA,75,"E"),14,2),RCLINE,1,80)
End DoDot:1
+84 SET RCLINE=RCLINE+1
DO SET("Administrative: "_$JUSTIFY(RCDPDATA(430,RCBILLDA,73,"E"),14,2)_$JUSTIFY(RCDPDATA(430,RCBILLDA,79,"E"),14,2),RCLINE,1,80,0,IOUON,IOUOFF)
+85 IF $GET(RCDPDATA(430,RCBILLDA,132,"E"))
DO SET("Medicare Unreim Exp: "_$JUSTIFY(RCDPDATA(430,RCBILLDA,132,"E"),11,2),RCLINE,48,80)
+86 ; compute totals
+87 SET BILLED=0
FOR %=71,72,73,74,75
SET BILLED=BILLED+RCDPDATA(430,RCBILLDA,%,"E")
+88 SET PAID=0
FOR %=77,78,79,79.1
SET PAID=PAID+RCDPDATA(430,RCBILLDA,%,"E")
+89 SET RCLINE=RCLINE+1
DO SET(" Current: "_$JUSTIFY(BILLED,14,2)_$JUSTIFY(PAID,14,2),RCLINE,1,80)
+90 ;
+91 ; show refund if there
+92 IF RCDPDATA(430,RCBILLDA,79.18,"E")
Begin DoDot:1
+93 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+94 SET RCLINE=RCLINE+1
DO SET("Refunded Amount",RCLINE,1,80,79.18)
+95 DO SET("Date",RCLINE,27,80,79.19)
+96 DO SET("By",RCLINE,50,80,79.21)
End DoDot:1
+97 ;
+98 ; accounting data
+99 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+100 SET RCLINE=RCLINE+1
DO SET("Accounting Data",RCLINE,1,80,0,IOUON,IOUOFF)
+101 ; fiscal year multiple
+102 DO SET("Fiscal Year",RCLINE,20,32,0,IOUON,IOUOFF)
+103 DO SET("Approp Code",RCLINE,34,46,0,IOUON,IOUOFF)
+104 DO SET("Amount",RCLINE,50,60,0,IOUON,IOUOFF)
+105 SET RCFYDA=0
FOR
SET RCFYDA=$ORDER(^PRCA(430,RCBILLDA,2,RCFYDA))
if 'RCFYDA
QUIT
Begin DoDot:1
+106 SET DATA=$GET(^PRCA(430,RCBILLDA,2,RCFYDA,0))
+107 SET RCLINE=RCLINE+1
+108 ;fiscal year
DO SET($JUSTIFY($PIECE(DATA,"^"),30),RCLINE,1,80)
+109 ;fund
DO SET($JUSTIFY(RCDPDATA(430,RCBILLDA,203,"E"),6),RCLINE,39,45)
+110 ;amount
DO SET($JUSTIFY($PIECE(DATA,"^",2),8,2),RCLINE,48,80)
End DoDot:1
+111 ; determine which rsc to display
+112 SET %=RCDPDATA(430,RCBILLDA,255.1,"E")
IF %=""
SET %=RCDPDATA(430,RCBILLDA,255,"E")
+113 SET RCLINE=RCLINE+1
DO SET("Rev Srce Code: "_%,RCLINE,1,80)
+114 ;
+115 ; collection data
+116 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+117 SET RCLINE=RCLINE+1
DO SET("Collection Follow up Data",RCLINE,1,80,0,IOUON,IOUOFF)
+118 SET RCLINE=RCLINE+1
DO SET(" Letter1",RCLINE,1,80,61)
+119 SET RCLINE=RCLINE+1
DO SET(" Letter2",RCLINE,1,80,62)
+120 SET RCLINE=RCLINE+1
DO SET(" Letter3",RCLINE,1,80,63)
+121 SET RCLINE=RCLINE+1
DO SET(" Letter4",RCLINE,1,80,68)
+122 IF RCDPDATA(430,RCBILLDA,68.6,"I")
Begin DoDot:1
+123 SET RCLINE=RCLINE+1
DO SET(" IRS Letter",RCLINE,1,80,68.6)
+124 DO SET("Amount",RCLINE,65,80,68.93)
End DoDot:1
+125 IF RCDPDATA(430,RCBILLDA,64,"I")
Begin DoDot:1
+126 SET RCLINE=RCLINE+1
DO SET("DC/DOJ Ref Date",RCLINE,1,80,64)
+127 DO SET("To",RCLINE,40,80,65)
+128 DO SET("Amount",RCLINE,65,80,66)
End DoDot:1
+129 ;
BILLRJ ;====== BILL PROFILE REJECT INSERTED HERE ;LEG
+1 ; prca*4.5*301
IF $DATA(^PRCA(430,RCBILLDA,18))
DO REJECT^RCDPBPLI
+2 ;
+3 ; repayment plan (show only if there)
+4 ; PRCA*4.5*388
IF RPIEN
DO REPAY^RCDPBPLI
+5 ;
+6 ; irs data (show only if there)
+7 IF RCDPDATA(430,RCBILLDA,68.7,"I")
DO IRS^RCDPBPLI
+8 ;
+9 ; dmc data (show only if there)
+10 IF RCDPDATA(430,RCBILLDA,121,"I")
DO DMC^RCDPBPLI
+11 ;
+12 ; top data (show only if there)
+13 IF $GET(RCDPDATA(430,RCBILLDA,141,"I"))
DO TOP^RCDPBPLI
+14 ;
+15 ;
+16 ; cross-servicing referral data(show only if there)
+17 IF $GET(RCDPDATA(430,RCBILLDA,151,"I"))
DO TCSP^RCDPBPLI
+18 ;
+19 ;
+20 ; cross-servicing recall data(show only if there)
+21 IF $GET(RCDPDATA(430,RCBILLDA,152,"I"))!$GET(RCDPDATA(430,RCBILLDA,153,"I"))!$GET(RCDPDATA(430,RCBILLDA,154,"I"))
DO TCSPRC^RCDPBPLI
+22 ;
+23 ;
+24 ; get the report type based on category. if third party show
+25 ; insurance data
+26 SET REPTYPE=$PIECE($GET(^PRCA(430.2,+RCDPDATA(430,RCBILLDA,2,"I"),0)),"^",6)
+27 IF REPTYPE="T"
DO INSUR^RCDPBPLI
+28 ;
+29 ; report type for employee or vendor, show description field 106
+30 IF REPTYPE="O"!(REPTYPE="V")
DO INIT^RCDPBPLI
+31 ;
+32 ; show transactions and reasons
+33 DO TRANINIT^RCDPBPLI
+34 ;
+35 ; set valmcnt to number of lines in the list
+36 SET VALMCNT=RCLINE
+37 DO HDR
+38 QUIT
+39 ;
+40 ;
HDR ; header code for list manager display
+1 ; requires rcbillda
+2 SET VALMHDR(1)="***** ACCOUNTS RECEIVABLE BILL PROFILE FOR "_$PIECE($GET(^PRCA(430,RCBILLDA,0)),"^")_" *****"
+3 ; PRCA*4.5*276 - add explanation of '%' for the user
+4 ; PRCA*4.5*276
SET VALMSG="|% EEOB | Enter ?? for more actions|"
+5 QUIT
+6 ;
+7 ;
EXIT ; exit list manager option and clean up
+1 KILL ^TMP("RCDPBPLM",$JOB)
+2 QUIT
+3 ;
+4 ;
SET(STRING,LINE,COLBEG,COLEND,FIELD,ON,OFF,RPFLG) ; set array
+1 ; PRCA*4.5*388
SET RPFLG=$GET(RPFLG,0)
+2 IF $GET(FIELD)
Begin DoDot:1
+3 SET STRING=STRING_$SELECT(STRING="":"",1:": ")
+4 SET STRING=STRING_$SELECT(RPFLG:$GET(RPDATA(340.5,RPIEN_",",FIELD)),1:$GET(RCDPDATA(430,RCBILLDA,FIELD,"E")))
+5 QUIT
End DoDot:1
+6 ;
+7 IF STRING=""
IF '$GET(FIELD)
QUIT
+8 IF '$DATA(@VALMAR@(LINE,0))
DO SET^VALM10(LINE,$JUSTIFY("",80))
+9 DO SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLBEG,COLEND-COLBEG+1))
+10 IF $GET(ON)]""!($GET(OFF)]"")
DO CNTRL^VALM10(LINE,COLBEG,$LENGTH(STRING),ON,OFF)
+11 QUIT
+12 ;
+13 ;
DIQ430(DA,DR) ; diq call to retrieve data for dr fields in file 430
+1 NEW D0,DIC,DIQ,DIQ2
+2 KILL RCDPDATA(430,DA)
+3 SET DIQ(0)="IE"
SET DIC="^PRCA(430,"
SET DIQ="RCDPDATA"
DO EN^DIQ1
+4 QUIT
