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

RCDPBPLI.m

Go to the documentation of this file.
  1. RCDPBPLI ;WISC/RFJ - bill profile (build array cont employee/vendor) ;1 Jun 99
  1. ;;4.5;Accounts Receivable;**114,153,301,315,350,372,388,389**;Mar 20, 1995;Build 36
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. ;
  1. INIT ; initialization for list manager list
  1. ; report type for employee or vendor, show description field 106
  1. N COMMDA,DATA,DESCDA,TEXT
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" ",RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM("Date ",RCLINE,1,80,0,IOUON,IOUOFF)
  1. D SET^RCDPBPLM("Description",RCLINE,12,80,0,IOUON,IOUOFF)
  1. D SET^RCDPBPLM("Quantity",RCLINE,35,80,0,IOUON,IOUOFF)
  1. D SET^RCDPBPLM("Units",RCLINE,46,80,0,IOUON,IOUOFF)
  1. D SET^RCDPBPLM("Cost",RCLINE,54,80,0,IOUON,IOUOFF)
  1. D SET^RCDPBPLM("Total Cost",RCLINE,64,80,0,IOUON,IOUOFF)
  1. S DESCDA=0 F S DESCDA=$O(^PRCA(430,RCBILLDA,101,DESCDA)) Q:'DESCDA D
  1. . S DATA=$G(^PRCA(430,RCBILLDA,101,DESCDA,0)) I DATA="" Q
  1. . S RCLINE=RCLINE+1
  1. . D SET^RCDPBPLM($E($P(DATA,U),4,5)_"/"_$E($P(DATA,U),6,7)_"/"_$E($P(DATA,U),2,3),RCLINE,1,80)
  1. . D SET^RCDPBPLM($J($P(DATA,U,3),8,2),RCLINE,35,80)
  1. . D SET^RCDPBPLM($J($P($G(^PRCD(420.5,+$P(DATA,U,5),0)),U),5),RCLINE,46,80)
  1. . D SET^RCDPBPLM($J($P(DATA,U,4),0,4),RCLINE,54,80)
  1. . D SET^RCDPBPLM($J($P(DATA,U,6),10,2),RCLINE,64,80)
  1. . ; show description
  1. . S DATA=""
  1. . S COMMDA=0 F S COMMDA=$O(^PRCA(430,RCBILLDA,101,DESCDA,1,COMMDA)) Q:'COMMDA D
  1. . . S TEXT=$G(^PRCA(430,RCBILLDA,101,DESCDA,1,COMMDA,0)) I TEXT="" Q
  1. . . I $L(DATA_TEXT)>240 D SETDESC(11)
  1. . . S DATA=DATA_$S(DATA="":"",1:" ")_TEXT
  1. . I DATA'="" D SETDESC(11)
  1. . ; make sure all data is processed
  1. . I DATA'="" D SETDESC(11)
  1. Q
  1. ;
  1. ;
  1. SETDESC(STARTCOL) ; set the description line starting in column startcol+1
  1. N %,LENGTH,SPACE
  1. S LENGTH=80-STARTCOL-1
  1. S SPACE="",$P(SPACE," ",80)=""
  1. ; break text at space if possible
  1. I $L(DATA)>LENGTH D
  1. . F %=LENGTH-1:-1:0 Q:$E(DATA,%)=" "
  1. . I % S LENGTH=%
  1. ; set line
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM($E(SPACE,1,STARTCOL)_$E(DATA,1,LENGTH),RCLINE,1,80)
  1. S DATA=$E(DATA,LENGTH+1,255)
  1. I $L(DATA)>LENGTH D SETDESC(STARTCOL)
  1. Q
  1. ;
  1. ;
  1. TRANINIT ; initialization for transaction and ib data display
  1. N BILLCAT,DATA,IBDA,RCDATE,RCLIST,RCTOTAL,RCTRANDA,X
  1. ; get the bill category
  1. S BILLCAT=$P($G(^PRCA(430,RCBILLDA,0)),U,2)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" ",RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" ",RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM("Trans Date Type Amount Description User",RCLINE,1,80,0,IOUON,IOUOFF) ;PRCA*4.5*315 Display User Ini
  1. S RCTOTAL=$$GETTRANS^RCDPBTLM(RCBILLDA)
  1. S RCDATE=0 F S RCDATE=$O(RCLIST(RCDATE)) Q:'RCDATE D
  1. . S RCTRANDA=0 F S RCTRANDA=$O(RCLIST(RCDATE,RCTRANDA)) Q:'RCTRANDA D
  1. . . S RCLINE=RCLINE+1
  1. . . D SET^RCDPBPLM(RCTRANDA,RCLINE,1,80)
  1. . . D SET^RCDPBPLM($E(RCDATE,4,5)_"/"_$E(RCDATE,6,7)_"/"_$E(RCDATE,2,3),RCLINE,13,23) ;PRCA*4.5*388
  1. . . D SET^RCDPBPLM($E($P(RCLIST(RCDATE,RCTRANDA),U),1,14),RCLINE,22,35) ;PRCA*4.5*315, PRCA*4.5*388
  1. . . S X=$P(RCLIST(RCDATE,RCTRANDA),U,2)+$P(RCLIST(RCDATE,RCTRANDA),U,3)+$P(RCLIST(RCDATE,RCTRANDA),U,4)+$P(RCLIST(RCDATE,RCTRANDA),U,5)+$P(RCLIST(RCDATE,RCTRANDA),U,6)
  1. . . D SET^RCDPBPLM($J(X,10,2),RCLINE,37,75) ;PRCA*4.5*315
  1. . . S X=$P(RCLIST(RCDATE,RCTRANDA),U,7) ;PRCA*4.5*315
  1. . . D SET^RCDPBPLM(X,RCLINE,77,80) ;PRCA*4.5*315
  1. . . ;
  1. . . ; for category c-means test, rx copay (sc/nsc)
  1. . . S RCDSPINF=$$GETDSP(RCBILLDA,BILLCAT)
  1. . . I +RCDSPINF D ;PRCA*4.5*372 - Added outpatient Copay check
  1. . . . D STMT^IBRFN1(RCTRANDA)
  1. . . . I '$D(^TMP("IBRFN1",$J)) Q
  1. . . . S IBDA=0 F S IBDA=$O(^TMP("IBRFN1",$J,IBDA)) Q:'IBDA D
  1. . . . . S DATA=^TMP("IBRFN1",$J,IBDA)
  1. . . . . ;if attempting to display a VA RX and there is no prescription data (Manual VA RX Copay)
  1. . . . . I (RCDSPINF=1),($P(DATA,U,7)="") S RCDSPINF="MVA"
  1. . . . . ; show rx
  1. . . . . I RCDSPINF=1 D Q
  1. . . . . . D SET^RCDPBPLM("RX "_$P(DATA,U,2),RCLINE,48,58) ;PRCA*4.5*315 Spacing changed next several lines
  1. . . . . . D SET^RCDPBPLM($P(DATA,U,3),RCLINE,60,75)
  1. . . . . . ; D SET^RCDPBPLM("Qty "_$P(DATA,U,6),RCLINE,77,80)
  1. . . . . ; show outpatient (type of care 430.2 = 4 outpatient care)
  1. . . . . I RCDSPINF=4 D Q
  1. . . . . . D SET^RCDPBPLM("CC RX Fill Date: "_$E($P(DATA,U,3),4,5)_"/"_$E($P(DATA,U,3),6,7)_"/"_$E($P(DATA,U,3),2,3),RCLINE,48,80)
  1. . . . . I RCDSPINF="MVA" D Q
  1. . . . . . D SET^RCDPBPLM("RX Fill Date: "_$E($P(DATA,U,3),4,5)_"/"_$E($P(DATA,U,3),6,7)_"/"_$E($P(DATA,U,3),2,3),RCLINE,48,80)
  1. . . . . I RCDSPINF=5 D Q
  1. . . . . . D SET^RCDPBPLM("OPT LTC Visit Date: "_$E($P(DATA,U,3),4,5)_"/"_$E($P(DATA,U,3),6,7)_"/"_$E($P(DATA,U,3),2,3),RCLINE,48,80)
  1. . . . . I RCDSPINF=6 D Q
  1. . . . . . D SET^RCDPBPLM("INPT LTC From: "_$E($P(DATA,U,3),4,5)_"/"_$E($P(DATA,U,3),6,7)_"/"_$E($P(DATA,U,3),2,3),RCLINE,48,80)
  1. . . . . I RCDSPINF=7 D Q
  1. . . . . . D SET^RCDPBPLM("CC LTC From: "_$E($P(DATA,U,3),4,5)_"/"_$E($P(DATA,U,3),6,7)_"/"_$E($P(DATA,U,3),2,3),RCLINE,48,80)
  1. . . . . I RCDSPINF=2 D Q
  1. . . . . . D SET^RCDPBPLM("OPT Visit Date: "_$E($P(DATA,U,2),4,5)_"/"_$E($P(DATA,U,2),6,7)_"/"_$E($P(DATA,U,2),2,3),RCLINE,48,80)
  1. . . . . ; show inpatient
  1. . . . . D SET^RCDPBPLM("INPT Admit Date: "_$E($P(DATA,U,2),4,5)_"/"_$E($P(DATA,U,2),6,7)_"/"_$E($P(DATA,U,2),2,3),RCLINE,48,80)
  1. . . . K ^TMP("IBRFN1",$J)
  1. Q
  1. ;
  1. REJECT ; ; prca*4.5*301 ; LEG
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" ",RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" ",RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM("CS Reject Data",RCLINE,1,80,0,IOUON,IOUOFF)
  1. D PROFRJA^RCTCSJS1(RCBILLDA,.RCLINE,.OUTARY)
  1. M @VALMAR=OUTARY
  1. K OUTARY
  1. Q
  1. ;
  1. ;
  1. ;
  1. REPAY ; show repayment plan
  1. N REMPMNTS
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" ",RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM("Repayment Plan Data",RCLINE,1,80,0,IOUON,IOUOFF)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Repayment Plan ID",RCLINE,1,80,.01,,,1)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Repayment Plan Date",RCLINE,1,80,.03,,,1)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Repayment Plan Status",RCLINE,1,80,.07,,,1)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Repayment Amount Due",RCLINE,1,80,.06,,,1)
  1. S REMPMNTS="" I $D(RPDATA) S REMPMNTS=$$REMPMNTS^RCRPU3(RPIEN,$G(RPDATA(340.5,RPIEN_",",.06))) ; PRCA*4.5*389
  1. I REMPMNTS'="" S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Payments Remaining: "_REMPMNTS,RCLINE,1,80) ; PRCA*4.5*389
  1. Q
  1. ;
  1. ;
  1. IRS ; irs data
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" ",RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM("Forwarded to IRS",RCLINE,1,80,0,IOUON,IOUOFF)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM("On Date",RCLINE,40,80,68.7)
  1. D SET^RCDPBPLM("Amount",RCLINE,65,80,68.92)
  1. S DATA=$G(^PRCA(430,RCBILLDA,6))
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Principal Balance: "_$J($P(DATA,U,16),10,2),RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Interest Balance: "_$J($P(DATA,U,17),10,2),RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Administrative Balance: "_$J($P(DATA,U,18),10,2),RCLINE,1,80)
  1. Q
  1. ;
  1. ;
  1. DMC ; dmc data
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" ",RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM("Forwarded to DMC",RCLINE,1,80,0,IOUON,IOUOFF)
  1. D SET^RCDPBPLM("On Date",RCLINE,40,80,121)
  1. S DATA=$G(^PRCA(430,RCBILLDA,12))
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Principal Balance: "_$J($P(DATA,U,2),10,2),RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Interest Balance: "_$J($P(DATA,U,3),10,2),RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Administrative Balance: "_$J($P(DATA,U,4),10,2),RCLINE,1,80)
  1. Q
  1. ;
  1. ;
  1. TOP ; top data
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" ",RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM("Forwarded to TOP",RCLINE,1,80,0,IOUON,IOUOFF)
  1. D SET^RCDPBPLM("On Date",RCLINE,40,80,141)
  1. S DATA=$G(^RCD(340,+RCDPDATA(430,RCBILLDA,9,"I"),6))
  1. I $P(DATA,U,6) D
  1. . S Y=$P(DATA,U,6) D DD^%DT
  1. . S RCLINE=RCLINE+1 D SET^RCDPBPLM(" TOP Hold Date: "_Y,RCLINE,1,80)
  1. Q
  1. ;
  1. ;
  1. TCSP ; cross-servicing data referral
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" ",RCLINE,1,80)
  1. ; PRCA*4.5*350
  1. N DEBTOR S DEBTOR=+$G(RCDPDATA(430,RCBILLDA,9,"I"))
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM("Debt "_$S($$RRD^RCTCSPU($G(DEBTOR)):"Re-",1:"")_"Referred to Cross-Servicing",RCLINE,1,80)
  1. D SET^RCDPBPLM(" CS "_$S($$RR^RCTCSPU($G(RCBILLDA)):"Re-",1:"")_"Referred Date",RCLINE,45,80,151)
  1. Q
  1. ;
  1. ;
  1. TCSPRC ; cross-servicing data recall
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" ",RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM("CS Recall Reason:",RCLINE,1,80)
  1. D SET^RCDPBPLM("",RCLINE,19,80,154)
  1. D SET^RCDPBPLM(" CS Recall Date",RCLINE,50,80,153)
  1. Q
  1. ;
  1. ;
  1. INSUR ; show insurance data
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" ",RCLINE,1,80)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM("Insurance Data",RCLINE,1,80,0,IOUON,IOUOFF)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Insured Name",RCLINE,1,80,239)
  1. D SET^RCDPBPLM("Sex",RCLINE,50,80,240)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" ID Number",RCLINE,1,80,242)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Group Name",RCLINE,1,80,243)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Group Number",RCLINE,1,80,244)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Employer Name",RCLINE,1,80,247)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Employee ID Number",RCLINE,1,80,248)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Employer Location",RCLINE,1,80,249)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM("Secondary Ins Carrier",RCLINE,1,80,19)
  1. S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Tertiary Ins Carrier",RCLINE,1,80,19.1)
  1. Q
  1. ;PRCA*4.5*372
  1. GETDSP(RCBILLDA,BILLCAT) ; Determine what the display info should be in Description column
  1. ;
  1. N RCBLCT
  1. ;
  1. ;init the AR category lookup variable
  1. S RCBLCT=BILLCAT
  1. ;
  1. ;If the Bill Category is 18 (C-Means Test) then get the actual category from the Type of Care field.
  1. S:BILLCAT=18 RCBLCT=$P(^PRCA(430,RCBILLDA,0),U,16)
  1. ;
  1. ;get the display flag
  1. Q $$GET1^DIQ(430.2,RCBLCT_",",1.05,"I")