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