- 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 Feb 18, 2025@23:10:19 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