Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDPBPLM

RCDPBPLM.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;
  1. ; called from menu option (19)
  1. ;
  1. N RCBILLDA,RCDPFXIT
  1. ;
  1. F D Q:'RCBILLDA
  1. . W !! S RCBILLDA=$$SELBILL^RCDPBTLM
  1. . I RCBILLDA<1 S RCBILLDA=0 Q
  1. . D EN^VALM("RCDP BILL PROFILE")
  1. . ; fast exit
  1. . I $G(RCDPFXIT) S RCBILLDA=0
  1. Q
  1. ;
  1. ;
  1. INIT ; initialization for list manager list
  1. ; requires rcbillda
  1. N BILLED,COMMDA,DATA,PAID,RCDPDATA,RCFYDA,RCLINE,REPTYPE,X1,X2,RCDEBTOR,DFN
  1. N RPIEN,RPDATA ; PRCA*4.5*388
  1. K ^TMP("RCDPBPLM",$J),^TMP("VALM VIDEO",$J)
  1. ;
  1. ; fast exit
  1. I $G(RCDPFXIT) S VALMQUIT=1 Q
  1. ;
  1. D DIQ430(RCBILLDA,".01:300")
  1. 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
  1. ;
  1. ; set the listmanager line number
  1. S RCLINE=0
  1. ;
  1. I '$D(RCDPDATA) Q ;PRCA*4.5*315
  1. S DATA=$$ACCNTHDR^RCDPAPLM(RCDPDATA(430,RCBILLDA,9,"I"))
  1. S RCLINE=RCLINE+1 D SET("Account: "_$P(DATA,"^")_" "_$P(DATA,"^",2),RCLINE,1,80)
  1. D SET($P(DATA,"^",3),RCLINE,60,80)
  1. S %="" I $TR($P(DATA,"^",4,9),"^")'="" S %=$P(DATA,"^",4)_", "_$P(DATA,"^",7)_", "_$P(DATA,"^",8)_" "_$P(DATA,"^",9)
  1. S RCLINE=RCLINE+1 D SET(" Addr: "_%,RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET(" Phone: "_$P(DATA,"^",10),RCLINE,1,80)
  1. S RCDEBTOR=$P(^PRCA(430,RCBILLDA,0),U,9)
  1. I RCDEBTOR,($P(^RCD(340,+RCDEBTOR,0),U)["DPT(") S DFN=+^(0) D ; Skip D if no Debtor link
  1. . Q:$$EMGRES^DGUTL(DFN)'["K"
  1. . S RCLINE=RCLINE+1
  1. . D SET("EMERGENCY RESPONSE INDICATOR: HURRICANE KATRINA",RCLINE,1,80)
  1. ;
  1. ; bill descriptive data
  1. S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
  1. ; PRCA*4.5*276 - get 1st/3rd party payment add EEOB indicator when applicable
  1. S PRCOUT=$$COMP3^PRCAAPR(RCBILLDA)
  1. I PRCOUT'="%" S PRCOUT=$$IBEEOBCK^PRCAAPR1(RCBILLDA)
  1. S RCLINE=RCLINE+1 ; D SET("Bill Number",RCLINE,1,80,.01,IOUON,IOUOFF)
  1. ; IA# 6060 for $$BILLREJ^IBJTU6
  1. 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
  1. D SET("Bill Number: "_$G(PRCOUT)_$P(RCDPDATA(430,RCBILLDA,.01,"E"),"^"),RCLINE,1,80,0,IOUON,IOUOFF)
  1. D SET("Category",RCLINE,40,80,2)
  1. S RCLINE=RCLINE+1 D SET("Date Prepared",RCLINE,1,80,10)
  1. D SET("Status",RCLINE,42,80,8)
  1. S RCLINE=RCLINE+1 D SET("Date Activated",RCLINE,1,80,60)
  1. S RCLINE=RCLINE+1 D SET("Date Status Up",RCLINE,1,80,14)
  1. D SET("By",RCLINE,46,80,17)
  1. ;display TP bills Division of Care
  1. I "T"=$P($G(^PRCA(430.2,+RCDPDATA(430,RCBILLDA,2,"I"),0)),"^",6) D
  1. . S RCDIV=$$DIV^IBJDF2(RCBILLDA) I +RCDIV D
  1. .. S RCDIV=$P($G(^DG(40.8,RCDIV,0)),U,1) I RCDIV="" Q
  1. .. S RCLINE=RCLINE+1 D SET("Division of Care: "_RCDIV,RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET("Resulting From",RCLINE,1,80,4.5)
  1. I RCDPDATA(430,RCBILLDA,15.1,"E")'="" D
  1. . S RCLINE=RCLINE+1 D SET(" Type of Care",RCLINE,1,80,15.1)
  1. S RCLINE=RCLINE+1 D SET(" Remark",RCLINE,1,80,15)
  1. ; display comments if there
  1. I $O(^PRCA(430,RCBILLDA,10,0)) D
  1. . S RCLINE=RCLINE+1 D SET("Comments:",RCLINE,1,80)
  1. . S COMMDA=0 F S COMMDA=$O(^PRCA(430,RCBILLDA,10,COMMDA)) Q:'COMMDA D
  1. .. S RCLINE=RCLINE+1 D SET(" "_$G(^PRCA(430,RCBILLDA,10,COMMDA,0)),RCLINE,1,80)
  1. ;
  1. ; int/adm rate and date
  1. S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
  1. S DATA=$$INT^RCMSFN01(RCDPDATA(430,RCBILLDA,10,"I"))
  1. S Y=$P(DATA,"^",2) I Y D DD^%DT
  1. S RCLINE=RCLINE+1 D SET("Interest Effective Rate Date: "_Y,RCLINE,1,80)
  1. D SET(" Annual Rate: "_$P(DATA,"^"),RCLINE,55,80)
  1. S DATA=$$ADM^RCMSFN01(RCDPDATA(430,RCBILLDA,10,"I"))
  1. S Y=$P(DATA,"^",2) I Y D DD^%DT
  1. S RCLINE=RCLINE+1 D SET(" Admin Effective Rate Date: "_Y,RCLINE,1,80)
  1. D SET("Monthly Rate: "_$P(DATA,"^"),RCLINE,55,80)
  1. S RCLINE=RCLINE+1 D SET(" Last Int/Admin Charge Date",RCLINE,1,80,67)
  1. ;
  1. ; put bill balances on first line of second screen
  1. F RCLINE=RCLINE+1:1:16 D SET(" ",RCLINE,1,80)
  1. ;
  1. ; bill dollars
  1. S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET("Bill Balances Billed Paid",RCLINE,1,80,0,IOUON,IOUOFF)
  1. 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)
  1. D SET(" Original Amt: "_$J(RCDPDATA(430,RCBILLDA,3,"E"),11,2),RCLINE,48,80)
  1. 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)
  1. I $G(RCDPDATA(430,RCBILLDA,131,"E")) D SET("Medicare Contr Adj: "_$J(RCDPDATA(430,RCBILLDA,131,"E"),11,2),RCLINE,48,80)
  1. I RCDPDATA(430,RCBILLDA,74,"E") D
  1. . 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)
  1. I RCDPDATA(430,RCBILLDA,75,"E") D
  1. . S RCLINE=RCLINE+1 D SET(" Court Cost: "_$J(RCDPDATA(430,RCBILLDA,75,"E"),14,2),RCLINE,1,80)
  1. 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)
  1. I $G(RCDPDATA(430,RCBILLDA,132,"E")) D SET("Medicare Unreim Exp: "_$J(RCDPDATA(430,RCBILLDA,132,"E"),11,2),RCLINE,48,80)
  1. ; compute totals
  1. S BILLED=0 F %=71,72,73,74,75 S BILLED=BILLED+RCDPDATA(430,RCBILLDA,%,"E")
  1. S PAID=0 F %=77,78,79,79.1 S PAID=PAID+RCDPDATA(430,RCBILLDA,%,"E")
  1. S RCLINE=RCLINE+1 D SET(" Current: "_$J(BILLED,14,2)_$J(PAID,14,2),RCLINE,1,80)
  1. ;
  1. ; show refund if there
  1. I RCDPDATA(430,RCBILLDA,79.18,"E") D
  1. . S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
  1. . S RCLINE=RCLINE+1 D SET("Refunded Amount",RCLINE,1,80,79.18)
  1. . D SET("Date",RCLINE,27,80,79.19)
  1. . D SET("By",RCLINE,50,80,79.21)
  1. ;
  1. ; accounting data
  1. S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET("Accounting Data",RCLINE,1,80,0,IOUON,IOUOFF)
  1. ; fiscal year multiple
  1. D SET("Fiscal Year",RCLINE,20,32,0,IOUON,IOUOFF)
  1. D SET("Approp Code",RCLINE,34,46,0,IOUON,IOUOFF)
  1. D SET("Amount",RCLINE,50,60,0,IOUON,IOUOFF)
  1. S RCFYDA=0 F S RCFYDA=$O(^PRCA(430,RCBILLDA,2,RCFYDA)) Q:'RCFYDA D
  1. . S DATA=$G(^PRCA(430,RCBILLDA,2,RCFYDA,0))
  1. . S RCLINE=RCLINE+1
  1. . D SET($J($P(DATA,"^"),30),RCLINE,1,80) ;fiscal year
  1. . D SET($J(RCDPDATA(430,RCBILLDA,203,"E"),6),RCLINE,39,45) ;fund
  1. . D SET($J($P(DATA,"^",2),8,2),RCLINE,48,80) ;amount
  1. ; determine which rsc to display
  1. S %=RCDPDATA(430,RCBILLDA,255.1,"E") I %="" S %=RCDPDATA(430,RCBILLDA,255,"E")
  1. S RCLINE=RCLINE+1 D SET("Rev Srce Code: "_%,RCLINE,1,80)
  1. ;
  1. ; collection data
  1. S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET("Collection Follow up Data",RCLINE,1,80,0,IOUON,IOUOFF)
  1. S RCLINE=RCLINE+1 D SET(" Letter1",RCLINE,1,80,61)
  1. S RCLINE=RCLINE+1 D SET(" Letter2",RCLINE,1,80,62)
  1. S RCLINE=RCLINE+1 D SET(" Letter3",RCLINE,1,80,63)
  1. S RCLINE=RCLINE+1 D SET(" Letter4",RCLINE,1,80,68)
  1. I RCDPDATA(430,RCBILLDA,68.6,"I") D
  1. . S RCLINE=RCLINE+1 D SET(" IRS Letter",RCLINE,1,80,68.6)
  1. . D SET("Amount",RCLINE,65,80,68.93)
  1. I RCDPDATA(430,RCBILLDA,64,"I") D
  1. . S RCLINE=RCLINE+1 D SET("DC/DOJ Ref Date",RCLINE,1,80,64)
  1. . D SET("To",RCLINE,40,80,65)
  1. . D SET("Amount",RCLINE,65,80,66)
  1. ;
  1. BILLRJ ;====== BILL PROFILE REJECT INSERTED HERE ;LEG
  1. I $D(^PRCA(430,RCBILLDA,18)) D REJECT^RCDPBPLI ; prca*4.5*301
  1. ;
  1. ; repayment plan (show only if there)
  1. I RPIEN D REPAY^RCDPBPLI ; PRCA*4.5*388
  1. ;
  1. ; irs data (show only if there)
  1. I RCDPDATA(430,RCBILLDA,68.7,"I") D IRS^RCDPBPLI
  1. ;
  1. ; dmc data (show only if there)
  1. I RCDPDATA(430,RCBILLDA,121,"I") D DMC^RCDPBPLI
  1. ;
  1. ; top data (show only if there)
  1. I $G(RCDPDATA(430,RCBILLDA,141,"I")) D TOP^RCDPBPLI
  1. ;
  1. ;
  1. ; cross-servicing referral data(show only if there)
  1. I $G(RCDPDATA(430,RCBILLDA,151,"I")) D TCSP^RCDPBPLI
  1. ;
  1. ;
  1. ; cross-servicing recall data(show only if there)
  1. I $G(RCDPDATA(430,RCBILLDA,152,"I"))!$G(RCDPDATA(430,RCBILLDA,153,"I"))!$G(RCDPDATA(430,RCBILLDA,154,"I")) D TCSPRC^RCDPBPLI
  1. ;
  1. ;
  1. ; get the report type based on category. if third party show
  1. ; insurance data
  1. S REPTYPE=$P($G(^PRCA(430.2,+RCDPDATA(430,RCBILLDA,2,"I"),0)),"^",6)
  1. I REPTYPE="T" D INSUR^RCDPBPLI
  1. ;
  1. ; report type for employee or vendor, show description field 106
  1. I REPTYPE="O"!(REPTYPE="V") D INIT^RCDPBPLI
  1. ;
  1. ; show transactions and reasons
  1. D TRANINIT^RCDPBPLI
  1. ;
  1. ; set valmcnt to number of lines in the list
  1. S VALMCNT=RCLINE
  1. D HDR
  1. Q
  1. ;
  1. ;
  1. HDR ; header code for list manager display
  1. ; requires rcbillda
  1. S VALMHDR(1)="***** ACCOUNTS RECEIVABLE BILL PROFILE FOR "_$P($G(^PRCA(430,RCBILLDA,0)),"^")_" *****"
  1. ; PRCA*4.5*276 - add explanation of '%' for the user
  1. S VALMSG="|% EEOB | Enter ?? for more actions|" ; PRCA*4.5*276
  1. Q
  1. ;
  1. ;
  1. EXIT ; exit list manager option and clean up
  1. K ^TMP("RCDPBPLM",$J)
  1. Q
  1. ;
  1. ;
  1. SET(STRING,LINE,COLBEG,COLEND,FIELD,ON,OFF,RPFLG) ; set array
  1. S RPFLG=$G(RPFLG,0) ; PRCA*4.5*388
  1. I $G(FIELD) D
  1. .S STRING=STRING_$S(STRING="":"",1:": ")
  1. .S STRING=STRING_$S(RPFLG:$G(RPDATA(340.5,RPIEN_",",FIELD)),1:$G(RCDPDATA(430,RCBILLDA,FIELD,"E")))
  1. .Q
  1. ;
  1. I STRING="",'$G(FIELD) Q
  1. I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80))
  1. D SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLBEG,COLEND-COLBEG+1))
  1. I $G(ON)]""!($G(OFF)]"") D CNTRL^VALM10(LINE,COLBEG,$L(STRING),ON,OFF)
  1. Q
  1. ;
  1. ;
  1. DIQ430(DA,DR) ; diq call to retrieve data for dr fields in file 430
  1. N D0,DIC,DIQ,DIQ2
  1. K RCDPDATA(430,DA)
  1. S DIQ(0)="IE",DIC="^PRCA(430,",DIQ="RCDPDATA" D EN^DIQ1
  1. Q