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