RCDPTPLI ;WISC/RFJ - transaction profile init to build array ;1 Jun 99
;;4.5;Accounts Receivable;**114,153,365,372,392**;Mar 20, 1995;Build 10
;;Per VA Directive 6402, this routine should not be modified.
; Reference to FILE #350 in ICR #4541
Q
;
;
INIT ; initialization for list manager list
; requires rctranda
N %,COMMDA,DATA,DATA3,DATA8,RCDPDATA,RCFYDA,RCLINE,RCSPACE,RCX,SHOWBAL,SHOWCOL,TOTAL3,TOTAL8,TRANTYPE,RCTOC
K ^TMP("RCDPTPLM",$J),^TMP("VALM VIDEO",$J)
;
D DIQ433^RCDPTPLM(RCTRANDA,".01;.03;5.02;5.03;11;12;13;14;15;17;19;42;86;88;")
S TRANTYPE=RCDPDATA(433,RCTRANDA,12,"I")
;
S RCSPACE="",$P(RCSPACE," ",81)=""
;
; set the listmanager line number 1
S RCLINE=1
D SET("Transaction",RCLINE,1,40,.01)
D SET("Type",RCLINE,41,80,12)
;
S RCLINE=RCLINE+1
D SET(" TransDate",RCLINE,1,80,11)
; increase/decrease adjustment
I TRANTYPE=1!(TRANTYPE=35) D
. I RCDPDATA(433,RCTRANDA,88,"I") D SET("Contract Adj",RCLINE,47,80)
. D SET("Adjustment",RCLINE,64,80,14)
; payment
I TRANTYPE=2!(TRANTYPE=34) D SET("Receipt",RCLINE,38,80,13)
; terminated
I TRANTYPE=8!(TRANTYPE=9) D SET("TermReason",RCLINE,35,80,17)
;
S RCLINE=RCLINE+1
D SET(" Processed",RCLINE,1,80,19)
D SET(" By",RCLINE,41,80,42)
;
S RCLINE=RCLINE+1
D SET(" Trans Amt: "_$J(RCDPDATA(433,RCTRANDA,15,"E"),0,2),RCLINE,1,80)
;
S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
;
; fiscal year multiple
S RCLINE=RCLINE+1
D SET("Fiscal Year",RCLINE,28,40,0,IOUON,IOUOFF)
D SET("Principal Amount",RCLINE,44,60,0,IOUON,IOUOFF)
D SET("FY Trans Amount",RCLINE,64,80,0,IOUON,IOUOFF)
S RCFYDA=0 F S RCFYDA=$O(^PRCA(433,RCTRANDA,4,RCFYDA)) Q:'RCFYDA D
. S DATA=$G(^PRCA(433,RCTRANDA,4,RCFYDA,0))
. S RCLINE=RCLINE+1
. D SET($J($P(DATA,"^"),38),RCLINE,1,80) ;fiscal year
. D SET($J($P(DATA,"^",2),19,2),RCLINE,41,60) ;prin amt
. D SET($J($P(DATA,"^",5),19,2),RCLINE,60,80) ;fy trans amt
;
; admin cost/charge
I TRANTYPE=12!(TRANTYPE=13)!(TRANTYPE=14) D
. S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
. S DATA=$P($G(^PRCA(433,RCTRANDA,2)),"^",1,9)
. I $TR(DATA,"^0")="" Q
. S RCLINE=RCLINE+1 D SET("Administrative Cost Charge:",RCLINE,1,80,0,IOUON,IOUOFF)
. I $P(DATA,"^",1) S RCLINE=RCLINE+1 D SET(" IRS Locator: "_$J($P(DATA,"^",1),10,2),RCLINE,1,80)
. I $P(DATA,"^",2) S RCLINE=RCLINE+1 D SET(" Credit Agency: "_$J($P(DATA,"^",2),10,2),RCLINE,1,80)
. I $P(DATA,"^",3) S RCLINE=RCLINE+1 D SET(" DMV Locator: "_$J($P(DATA,"^",3),10,2),RCLINE,1,80)
. I $P(DATA,"^",4) S RCLINE=RCLINE+1 D SET(" Consumer Rep: "_$J($P(DATA,"^",4),10,2),RCLINE,1,80)
. I $P(DATA,"^",5) S RCLINE=RCLINE+1 D SET(" Marshall Fee: "_$J($P(DATA,"^",5),10,2),RCLINE,1,80)
. I $P(DATA,"^",6) S RCLINE=RCLINE+1 D SET(" Court Cost: "_$J($P(DATA,"^",6),10,2),RCLINE,1,80)
. I $P(DATA,"^",7) S RCLINE=RCLINE+1 D SET("Interest Charge: "_$J($P(DATA,"^",7),10,2),RCLINE,1,80)
. I $P(DATA,"^",8) S RCLINE=RCLINE+1 D SET(" Admin Charge: "_$J($P(DATA,"^",8),10,2),RCLINE,1,80)
. I $P(DATA,"^",9) S RCLINE=RCLINE+1 D SET(" Penalty Charge: "_$J($P(DATA,"^",9),10,2),RCLINE,1,80)
;
;
; collections and balances
; set flag to display balances if there are any
S DATA8=$P($G(^PRCA(433,RCTRANDA,8)),"^",1,5)
S SHOWBAL=1 I $TR(DATA8,"^0")="" S SHOWBAL=0
; set flag to display collections if there are any
S DATA3=$P($G(^PRCA(433,RCTRANDA,3)),"^",1,5)
S SHOWCOL=1 I $TR(DATA3,"^0")="" S SHOWCOL=0
; show data
I SHOWBAL!(SHOWCOL) D
. S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
. F %=1:1:5 S TOTAL3=$G(TOTAL3)+$P(DATA3,"^",%),TOTAL8=$G(TOTAL8)+$P(DATA8,"^",%)
. S RCLINE=RCLINE+1 D SET("Balances",RCLINE,19,26,0,IOUON,IOUOFF)
. I SHOWCOL D SET("Collections",RCLINE,34,55,0,IOUON,IOUOFF)
. S RCLINE=RCLINE+1 D SET(" Principal: "_$J($P(DATA8,"^",1),10,2),RCLINE,1,80)
. I SHOWCOL D SET($J($P(DATA3,"^",1),10,2),RCLINE,35,55)
. S RCLINE=RCLINE+1 D SET(" Interest: "_$J($P(DATA8,"^",2),10,2),RCLINE,1,80)
. I SHOWCOL D SET($J($P(DATA3,"^",2),10,2),RCLINE,35,55)
. S RCLINE=RCLINE+1 D SET("Administrative: "_$J($P(DATA8,"^",3),10,2),RCLINE,1,80)
. I SHOWCOL D SET($J($P(DATA3,"^",3),10,2),RCLINE,35,55)
. S RCLINE=RCLINE+1 D SET(" Marshall Fee: "_$J($P(DATA8,"^",4),10,2),RCLINE,1,80)
. I SHOWCOL D SET($J($P(DATA3,"^",4),10,2),RCLINE,35,55)
. S RCLINE=RCLINE+1 D SET(" Court Cost: "_$J($P(DATA8,"^",5),10,2),RCLINE,1,80,0,IOUON,IOUOFF)
. I SHOWCOL D SET($J($P(DATA3,"^",5),10,2),RCLINE,35,55,0,IOUON,IOUOFF)
. S RCLINE=RCLINE+1 D SET(" Total: "_$J(TOTAL8,10,2),RCLINE,1,80)
. I SHOWCOL D SET($J(TOTAL3,10,2),RCLINE,35,55)
;
; brief comments, followup date
S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
S RCLINE=RCLINE+1 D SET("Brief Comment",RCLINE,1,80,5.02)
D SET("Follow-up Date",RCLINE,51,80,5.03)
;
; comments
S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
S RCLINE=RCLINE+1 D SET("Comments:",RCLINE,1,80,0,IOUON,IOUOFF)
I RCDPDATA(433,RCTRANDA,86,"E")'="" S RCLINE=RCLINE+1 D SET("",RCLINE,1,80,86)
S COMMDA=0 F S COMMDA=$O(^PRCA(433,RCTRANDA,7,COMMDA)) Q:'COMMDA D
. S RCX=^PRCA(433,RCTRANDA,7,COMMDA,0)
. S RCLINE=RCLINE+1 D SET($E(RCX,1,79),RCLINE,1,80)
. I $E(RCX,80,159)'="" S RCLINE=RCLINE+1 D SET($E(RCX,80,159),RCLINE,1,80)
. I $E(RCX,160,239)'="" S RCLINE=RCLINE+1 D SET($E(RCX,160,239),RCLINE,1,80)
S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
;
; show integrated billing data
N BILLCAT,BILLDA,BILLNO,IBATYP,IBDA,IBZ,N0,RCDSPFLG,TMPDT,TRCARE
S BILLDA=+$P(^PRCA(433,RCTRANDA,0),"^",2),TRCARE=0
S N0=$G(^PRCA(430,BILLDA,0)),BILLNO=$P(N0,U),BILLCAT=$P(N0,U,2) ; PRCA*4.5*392
;
;PRCA*4.5*365 - moved vaild AR Category check to the field DISPLAY ON BILL PROFILE? field
; in the AR Category (430.2) file. If RCDSPFLG contains NULL or 0, no IB info
; will display. Otherwise it contains a code that will determine what info is
; displayed.
S RCDSPFLG=$$GET1^DIQ(430.2,BILLCAT_",",1.04,"I")
I BILLCAT=18 D
.S RCTOC=$P(^PRCA(430,BILLDA,0),"^",16)
.S RCDSPFLG=$$GET1^DIQ(430.2,RCTOC_",",1.04,"I")
.Q
I BILLCAT=31 D ; Tricare Patient category is a special case PRCA*4.5*392
.S IBZ=$O(^IB("ABIL",BILLNO,""),-1) ; get last IB action
.S IBATYP=$$GET1^DIQ(350,IBZ_",",.03,"I") ; get IB action type (file 350.1 ien)
.I "^68^71^"[(U_IBATYP_U) S RCDSPFLG=5,TRCARE=1 ; Tricare RX
.I "^69^72^"[(U_IBATYP_U) S RCDSPFLG=2,TRCARE=1 ; Tricare outpatient
.I "^70^73^"[(U_IBATYP_U) S RCDSPFLG=4,TRCARE=1 ; Tricare inpatient
.Q
I +$G(RCDSPFLG) D
.D STMT^IBRFN1(RCTRANDA)
.I '$D(^TMP("IBRFN1",$J)) Q
.; start on 2nd screen if not there already
.F RCLINE=RCLINE:1:15 D SET(" ",RCLINE,1,80)
.S RCLINE=RCLINE+1 D SET("Integrated Billing Data",RCLINE,1,80,0,IOUON,IOUOFF)
.S IBDA=0 F S IBDA=$O(^TMP("IBRFN1",$J,IBDA)) Q:'IBDA D
..S DATA=^TMP("IBRFN1",$J,IBDA)
..;Start PRCA*4.5*372
..; If piece 7 is not filled in, and it is a pharmacy transaction, the transaction was manually created. Treat like a CC RX.
..I RCDSPFLG=1,$P(DATA,U,7)="" S RCDSPFLG="MVA"
..;end PRCA*4.5*372
..;if more than one ib data transaction to display, skip a line
..I IBDA>1 S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
..S RCLINE=RCLINE+1 D SET("IB Ref #: "_$P(DATA,"^"),RCLINE,1,80)
..; show VA RX via ECME (RCDSPFLG=1)
..I RCDSPFLG=1 D Q
...D SET("Pharmacy",RCLINE,28,80)
...D SET("Charge Amt: "_$J($P(DATA,U,8),0,2),RCLINE,60,80)
...S RCLINE=RCLINE+1
...D SET(" Rx#: "_$P(DATA,U,2),RCLINE,1,80)
...D SET("Drug: "_$P(DATA,U,3),RCLINE,22,80)
...S TMPDT=$$FMTE^XLFDT($P(DATA,U,7),"2DZ") D SET("Re/Fill Date: "_TMPDT,RCLINE,58,80) ; PRCA*4.5*392
...S RCLINE=RCLINE+1
...D SET(" Physician: "_$P(DATA,U,5),RCLINE,1,48)
...D SET("Days Supply: "_$P(DATA,U,4),RCLINE,48,80)
...D SET("Qty: "_$P(DATA,U,6),RCLINE,67,80)
...Q
..; show outpatient (type of care 430.2 = 4 outpatient care), OR RCDSPFLG=2 (Other Outpatient) or 5 (CC RX)
..;Start PRCA*4.5*372
..;Manually billed RX
..I RCDSPFLG="MVA" D Q
...D SET("Pharmacy",RCLINE,25,80)
...S TMPDT=$$FMTE^XLFDT($P(DATA,U,3),"2DZ") D SET("Fill Date: "_TMPDT,RCLINE,38,80) ; PRCA*4.5*392
...D SET("Charge Amt: "_$J($P(DATA,U,8),0,2),RCLINE,60,80)
...Q
..;end PRCA*4.5*372
..I ($P(^PRCA(430,BILLDA,0),U,16)=4)!(RCDSPFLG=2)!(RCDSPFLG=5) D Q
...;Start PRCA*4.5*372
...I RCDSPFLG=5 D Q
....D SET($S(TRCARE:"Tricare RX",1:"Comm Care RX"),RCLINE,25,80) ; PRCA*4.5*392
....I TRCARE S $P(DATA,U,3)=$P(DATA,U,2) ; special case for Tricare RX - move fill date to the correct piece PRCA*4.5*392
....S TMPDT=$$FMTE^XLFDT($P(DATA,U,3),"2DZ") D SET("Fill Date: "_TMPDT,RCLINE,38,80) ; PRCA*4.5*392
....D SET("Charge Amt: "_$J($P(DATA,U,8),0,2),RCLINE,60,80)
....Q
...;end PRCA*4.5*372
...D SET("Outpatient",RCLINE,26,80)
...S TMPDT=$$FMTE^XLFDT($P(DATA,U,2),"2DZ") D SET("Visit Date: "_TMPDT,RCLINE,37,80) ; PRCA*4.5*392
...D SET("Charge Amt: "_$J($P(DATA,U,8),0,2),RCLINE,60,80)
...Q
..;Start PRCA*4.5*372
..; show inpatient [ RCDSPFLG=3 (LTC) or 4 (inpatient) ]
..D:RCDSPFLG=3 SET("Long Term Care",RCLINE,28,80)
..D:RCDSPFLG'=3 SET("Inpatient",RCLINE,28,80)
..;end PRCA*4.5*372
..D SET("Charge Amt: "_$J($P(DATA,U,8),0,2),RCLINE,60,80)
..S RCLINE=RCLINE+1
..S TMPDT=$$FMTE^XLFDT($P(DATA,U,2),"2DZ") D SET(" Admission Date: "_TMPDT,RCLINE,1,80) ; PRCA*4.5*392
..S TMPDT=$$FMTE^XLFDT($P(DATA,U,5),"2DZ") D SET("Discharge Date: "_TMPDT,RCLINE,56,80) ; PRCA*4.5*392
..S RCLINE=RCLINE+1
..S TMPDT=$$FMTE^XLFDT($P(DATA,U,3),"2DZ") D SET(" Bill Cycle Begin Date: "_TMPDT,RCLINE,1,80)
..S TMPDT=$$FMTE^XLFDT($P(DATA,U,4),"2DZ") D SET("End Date: "_TMPDT,RCLINE,62,80)
..Q
.K ^TMP("IBRFN1",$J)
.Q
; set valmcnt to number of lines in the list
S VALMCNT=RCLINE
Q
;
;
SET(STRING,LINE,COLBEG,COLEND,FIELD,ON,OFF) ; set array
I $G(FIELD) S STRING=STRING_$S(STRING="":"",1:": ")_$G(RCDPDATA(433,RCTRANDA,FIELD,"E"))
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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPTPLI 10356 printed Dec 13, 2024@01:46:32 Page 2
RCDPTPLI ;WISC/RFJ - transaction profile init to build array ;1 Jun 99
+1 ;;4.5;Accounts Receivable;**114,153,365,372,392**;Mar 20, 1995;Build 10
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ; Reference to FILE #350 in ICR #4541
+4 QUIT
+5 ;
+6 ;
INIT ; initialization for list manager list
+1 ; requires rctranda
+2 NEW %,COMMDA,DATA,DATA3,DATA8,RCDPDATA,RCFYDA,RCLINE,RCSPACE,RCX,SHOWBAL,SHOWCOL,TOTAL3,TOTAL8,TRANTYPE,RCTOC
+3 KILL ^TMP("RCDPTPLM",$JOB),^TMP("VALM VIDEO",$JOB)
+4 ;
+5 DO DIQ433^RCDPTPLM(RCTRANDA,".01;.03;5.02;5.03;11;12;13;14;15;17;19;42;86;88;")
+6 SET TRANTYPE=RCDPDATA(433,RCTRANDA,12,"I")
+7 ;
+8 SET RCSPACE=""
SET $PIECE(RCSPACE," ",81)=""
+9 ;
+10 ; set the listmanager line number 1
+11 SET RCLINE=1
+12 DO SET("Transaction",RCLINE,1,40,.01)
+13 DO SET("Type",RCLINE,41,80,12)
+14 ;
+15 SET RCLINE=RCLINE+1
+16 DO SET(" TransDate",RCLINE,1,80,11)
+17 ; increase/decrease adjustment
+18 IF TRANTYPE=1!(TRANTYPE=35)
Begin DoDot:1
+19 IF RCDPDATA(433,RCTRANDA,88,"I")
DO SET("Contract Adj",RCLINE,47,80)
+20 DO SET("Adjustment",RCLINE,64,80,14)
End DoDot:1
+21 ; payment
+22 IF TRANTYPE=2!(TRANTYPE=34)
DO SET("Receipt",RCLINE,38,80,13)
+23 ; terminated
+24 IF TRANTYPE=8!(TRANTYPE=9)
DO SET("TermReason",RCLINE,35,80,17)
+25 ;
+26 SET RCLINE=RCLINE+1
+27 DO SET(" Processed",RCLINE,1,80,19)
+28 DO SET(" By",RCLINE,41,80,42)
+29 ;
+30 SET RCLINE=RCLINE+1
+31 DO SET(" Trans Amt: "_$JUSTIFY(RCDPDATA(433,RCTRANDA,15,"E"),0,2),RCLINE,1,80)
+32 ;
+33 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+34 ;
+35 ; fiscal year multiple
+36 SET RCLINE=RCLINE+1
+37 DO SET("Fiscal Year",RCLINE,28,40,0,IOUON,IOUOFF)
+38 DO SET("Principal Amount",RCLINE,44,60,0,IOUON,IOUOFF)
+39 DO SET("FY Trans Amount",RCLINE,64,80,0,IOUON,IOUOFF)
+40 SET RCFYDA=0
FOR
SET RCFYDA=$ORDER(^PRCA(433,RCTRANDA,4,RCFYDA))
if 'RCFYDA
QUIT
Begin DoDot:1
+41 SET DATA=$GET(^PRCA(433,RCTRANDA,4,RCFYDA,0))
+42 SET RCLINE=RCLINE+1
+43 ;fiscal year
DO SET($JUSTIFY($PIECE(DATA,"^"),38),RCLINE,1,80)
+44 ;prin amt
DO SET($JUSTIFY($PIECE(DATA,"^",2),19,2),RCLINE,41,60)
+45 ;fy trans amt
DO SET($JUSTIFY($PIECE(DATA,"^",5),19,2),RCLINE,60,80)
End DoDot:1
+46 ;
+47 ; admin cost/charge
+48 IF TRANTYPE=12!(TRANTYPE=13)!(TRANTYPE=14)
Begin DoDot:1
+49 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+50 SET DATA=$PIECE($GET(^PRCA(433,RCTRANDA,2)),"^",1,9)
+51 IF $TRANSLATE(DATA,"^0")=""
QUIT
+52 SET RCLINE=RCLINE+1
DO SET("Administrative Cost Charge:",RCLINE,1,80,0,IOUON,IOUOFF)
+53 IF $PIECE(DATA,"^",1)
SET RCLINE=RCLINE+1
DO SET(" IRS Locator: "_$JUSTIFY($PIECE(DATA,"^",1),10,2),RCLINE,1,80)
+54 IF $PIECE(DATA,"^",2)
SET RCLINE=RCLINE+1
DO SET(" Credit Agency: "_$JUSTIFY($PIECE(DATA,"^",2),10,2),RCLINE,1,80)
+55 IF $PIECE(DATA,"^",3)
SET RCLINE=RCLINE+1
DO SET(" DMV Locator: "_$JUSTIFY($PIECE(DATA,"^",3),10,2),RCLINE,1,80)
+56 IF $PIECE(DATA,"^",4)
SET RCLINE=RCLINE+1
DO SET(" Consumer Rep: "_$JUSTIFY($PIECE(DATA,"^",4),10,2),RCLINE,1,80)
+57 IF $PIECE(DATA,"^",5)
SET RCLINE=RCLINE+1
DO SET(" Marshall Fee: "_$JUSTIFY($PIECE(DATA,"^",5),10,2),RCLINE,1,80)
+58 IF $PIECE(DATA,"^",6)
SET RCLINE=RCLINE+1
DO SET(" Court Cost: "_$JUSTIFY($PIECE(DATA,"^",6),10,2),RCLINE,1,80)
+59 IF $PIECE(DATA,"^",7)
SET RCLINE=RCLINE+1
DO SET("Interest Charge: "_$JUSTIFY($PIECE(DATA,"^",7),10,2),RCLINE,1,80)
+60 IF $PIECE(DATA,"^",8)
SET RCLINE=RCLINE+1
DO SET(" Admin Charge: "_$JUSTIFY($PIECE(DATA,"^",8),10,2),RCLINE,1,80)
+61 IF $PIECE(DATA,"^",9)
SET RCLINE=RCLINE+1
DO SET(" Penalty Charge: "_$JUSTIFY($PIECE(DATA,"^",9),10,2),RCLINE,1,80)
End DoDot:1
+62 ;
+63 ;
+64 ; collections and balances
+65 ; set flag to display balances if there are any
+66 SET DATA8=$PIECE($GET(^PRCA(433,RCTRANDA,8)),"^",1,5)
+67 SET SHOWBAL=1
IF $TRANSLATE(DATA8,"^0")=""
SET SHOWBAL=0
+68 ; set flag to display collections if there are any
+69 SET DATA3=$PIECE($GET(^PRCA(433,RCTRANDA,3)),"^",1,5)
+70 SET SHOWCOL=1
IF $TRANSLATE(DATA3,"^0")=""
SET SHOWCOL=0
+71 ; show data
+72 IF SHOWBAL!(SHOWCOL)
Begin DoDot:1
+73 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+74 FOR %=1:1:5
SET TOTAL3=$GET(TOTAL3)+$PIECE(DATA3,"^",%)
SET TOTAL8=$GET(TOTAL8)+$PIECE(DATA8,"^",%)
+75 SET RCLINE=RCLINE+1
DO SET("Balances",RCLINE,19,26,0,IOUON,IOUOFF)
+76 IF SHOWCOL
DO SET("Collections",RCLINE,34,55,0,IOUON,IOUOFF)
+77 SET RCLINE=RCLINE+1
DO SET(" Principal: "_$JUSTIFY($PIECE(DATA8,"^",1),10,2),RCLINE,1,80)
+78 IF SHOWCOL
DO SET($JUSTIFY($PIECE(DATA3,"^",1),10,2),RCLINE,35,55)
+79 SET RCLINE=RCLINE+1
DO SET(" Interest: "_$JUSTIFY($PIECE(DATA8,"^",2),10,2),RCLINE,1,80)
+80 IF SHOWCOL
DO SET($JUSTIFY($PIECE(DATA3,"^",2),10,2),RCLINE,35,55)
+81 SET RCLINE=RCLINE+1
DO SET("Administrative: "_$JUSTIFY($PIECE(DATA8,"^",3),10,2),RCLINE,1,80)
+82 IF SHOWCOL
DO SET($JUSTIFY($PIECE(DATA3,"^",3),10,2),RCLINE,35,55)
+83 SET RCLINE=RCLINE+1
DO SET(" Marshall Fee: "_$JUSTIFY($PIECE(DATA8,"^",4),10,2),RCLINE,1,80)
+84 IF SHOWCOL
DO SET($JUSTIFY($PIECE(DATA3,"^",4),10,2),RCLINE,35,55)
+85 SET RCLINE=RCLINE+1
DO SET(" Court Cost: "_$JUSTIFY($PIECE(DATA8,"^",5),10,2),RCLINE,1,80,0,IOUON,IOUOFF)
+86 IF SHOWCOL
DO SET($JUSTIFY($PIECE(DATA3,"^",5),10,2),RCLINE,35,55,0,IOUON,IOUOFF)
+87 SET RCLINE=RCLINE+1
DO SET(" Total: "_$JUSTIFY(TOTAL8,10,2),RCLINE,1,80)
+88 IF SHOWCOL
DO SET($JUSTIFY(TOTAL3,10,2),RCLINE,35,55)
End DoDot:1
+89 ;
+90 ; brief comments, followup date
+91 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+92 SET RCLINE=RCLINE+1
DO SET("Brief Comment",RCLINE,1,80,5.02)
+93 DO SET("Follow-up Date",RCLINE,51,80,5.03)
+94 ;
+95 ; comments
+96 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+97 SET RCLINE=RCLINE+1
DO SET("Comments:",RCLINE,1,80,0,IOUON,IOUOFF)
+98 IF RCDPDATA(433,RCTRANDA,86,"E")'=""
SET RCLINE=RCLINE+1
DO SET("",RCLINE,1,80,86)
+99 SET COMMDA=0
FOR
SET COMMDA=$ORDER(^PRCA(433,RCTRANDA,7,COMMDA))
if 'COMMDA
QUIT
Begin DoDot:1
+100 SET RCX=^PRCA(433,RCTRANDA,7,COMMDA,0)
+101 SET RCLINE=RCLINE+1
DO SET($EXTRACT(RCX,1,79),RCLINE,1,80)
+102 IF $EXTRACT(RCX,80,159)'=""
SET RCLINE=RCLINE+1
DO SET($EXTRACT(RCX,80,159),RCLINE,1,80)
+103 IF $EXTRACT(RCX,160,239)'=""
SET RCLINE=RCLINE+1
DO SET($EXTRACT(RCX,160,239),RCLINE,1,80)
End DoDot:1
+104 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+105 ;
+106 ; show integrated billing data
+107 NEW BILLCAT,BILLDA,BILLNO,IBATYP,IBDA,IBZ,N0,RCDSPFLG,TMPDT,TRCARE
+108 SET BILLDA=+$PIECE(^PRCA(433,RCTRANDA,0),"^",2)
SET TRCARE=0
+109 ; PRCA*4.5*392
SET N0=$GET(^PRCA(430,BILLDA,0))
SET BILLNO=$PIECE(N0,U)
SET BILLCAT=$PIECE(N0,U,2)
+110 ;
+111 ;PRCA*4.5*365 - moved vaild AR Category check to the field DISPLAY ON BILL PROFILE? field
+112 ; in the AR Category (430.2) file. If RCDSPFLG contains NULL or 0, no IB info
+113 ; will display. Otherwise it contains a code that will determine what info is
+114 ; displayed.
+115 SET RCDSPFLG=$$GET1^DIQ(430.2,BILLCAT_",",1.04,"I")
+116 IF BILLCAT=18
Begin DoDot:1
+117 SET RCTOC=$PIECE(^PRCA(430,BILLDA,0),"^",16)
+118 SET RCDSPFLG=$$GET1^DIQ(430.2,RCTOC_",",1.04,"I")
+119 QUIT
End DoDot:1
+120 ; Tricare Patient category is a special case PRCA*4.5*392
IF BILLCAT=31
Begin DoDot:1
+121 ; get last IB action
SET IBZ=$ORDER(^IB("ABIL",BILLNO,""),-1)
+122 ; get IB action type (file 350.1 ien)
SET IBATYP=$$GET1^DIQ(350,IBZ_",",.03,"I")
+123 ; Tricare RX
IF "^68^71^"[(U_IBATYP_U)
SET RCDSPFLG=5
SET TRCARE=1
+124 ; Tricare outpatient
IF "^69^72^"[(U_IBATYP_U)
SET RCDSPFLG=2
SET TRCARE=1
+125 ; Tricare inpatient
IF "^70^73^"[(U_IBATYP_U)
SET RCDSPFLG=4
SET TRCARE=1
+126 QUIT
End DoDot:1
+127 IF +$GET(RCDSPFLG)
Begin DoDot:1
+128 DO STMT^IBRFN1(RCTRANDA)
+129 IF '$DATA(^TMP("IBRFN1",$JOB))
QUIT
+130 ; start on 2nd screen if not there already
+131 FOR RCLINE=RCLINE:1:15
DO SET(" ",RCLINE,1,80)
+132 SET RCLINE=RCLINE+1
DO SET("Integrated Billing Data",RCLINE,1,80,0,IOUON,IOUOFF)
+133 SET IBDA=0
FOR
SET IBDA=$ORDER(^TMP("IBRFN1",$JOB,IBDA))
if 'IBDA
QUIT
Begin DoDot:2
+134 SET DATA=^TMP("IBRFN1",$JOB,IBDA)
+135 ;Start PRCA*4.5*372
+136 ; If piece 7 is not filled in, and it is a pharmacy transaction, the transaction was manually created. Treat like a CC RX.
+137 IF RCDSPFLG=1
IF $PIECE(DATA,U,7)=""
SET RCDSPFLG="MVA"
+138 ;end PRCA*4.5*372
+139 ;if more than one ib data transaction to display, skip a line
+140 IF IBDA>1
SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+141 SET RCLINE=RCLINE+1
DO SET("IB Ref #: "_$PIECE(DATA,"^"),RCLINE,1,80)
+142 ; show VA RX via ECME (RCDSPFLG=1)
+143 IF RCDSPFLG=1
Begin DoDot:3
+144 DO SET("Pharmacy",RCLINE,28,80)
+145 DO SET("Charge Amt: "_$JUSTIFY($PIECE(DATA,U,8),0,2),RCLINE,60,80)
+146 SET RCLINE=RCLINE+1
+147 DO SET(" Rx#: "_$PIECE(DATA,U,2),RCLINE,1,80)
+148 DO SET("Drug: "_$PIECE(DATA,U,3),RCLINE,22,80)
+149 ; PRCA*4.5*392
SET TMPDT=$$FMTE^XLFDT($PIECE(DATA,U,7),"2DZ")
DO SET("Re/Fill Date: "_TMPDT,RCLINE,58,80)
+150 SET RCLINE=RCLINE+1
+151 DO SET(" Physician: "_$PIECE(DATA,U,5),RCLINE,1,48)
+152 DO SET("Days Supply: "_$PIECE(DATA,U,4),RCLINE,48,80)
+153 DO SET("Qty: "_$PIECE(DATA,U,6),RCLINE,67,80)
+154 QUIT
End DoDot:3
QUIT
+155 ; show outpatient (type of care 430.2 = 4 outpatient care), OR RCDSPFLG=2 (Other Outpatient) or 5 (CC RX)
+156 ;Start PRCA*4.5*372
+157 ;Manually billed RX
+158 IF RCDSPFLG="MVA"
Begin DoDot:3
+159 DO SET("Pharmacy",RCLINE,25,80)
+160 ; PRCA*4.5*392
SET TMPDT=$$FMTE^XLFDT($PIECE(DATA,U,3),"2DZ")
DO SET("Fill Date: "_TMPDT,RCLINE,38,80)
+161 DO SET("Charge Amt: "_$JUSTIFY($PIECE(DATA,U,8),0,2),RCLINE,60,80)
+162 QUIT
End DoDot:3
QUIT
+163 ;end PRCA*4.5*372
+164 IF ($PIECE(^PRCA(430,BILLDA,0),U,16)=4)!(RCDSPFLG=2)!(RCDSPFLG=5)
Begin DoDot:3
+165 ;Start PRCA*4.5*372
+166 IF RCDSPFLG=5
Begin DoDot:4
+167 ; PRCA*4.5*392
DO SET($SELECT(TRCARE:"Tricare RX",1:"Comm Care RX"),RCLINE,25,80)
+168 ; special case for Tricare RX - move fill date to the correct piece PRCA*4.5*392
IF TRCARE
SET $PIECE(DATA,U,3)=$PIECE(DATA,U,2)
+169 ; PRCA*4.5*392
SET TMPDT=$$FMTE^XLFDT($PIECE(DATA,U,3),"2DZ")
DO SET("Fill Date: "_TMPDT,RCLINE,38,80)
+170 DO SET("Charge Amt: "_$JUSTIFY($PIECE(DATA,U,8),0,2),RCLINE,60,80)
+171 QUIT
End DoDot:4
QUIT
+172 ;end PRCA*4.5*372
+173 DO SET("Outpatient",RCLINE,26,80)
+174 ; PRCA*4.5*392
SET TMPDT=$$FMTE^XLFDT($PIECE(DATA,U,2),"2DZ")
DO SET("Visit Date: "_TMPDT,RCLINE,37,80)
+175 DO SET("Charge Amt: "_$JUSTIFY($PIECE(DATA,U,8),0,2),RCLINE,60,80)
+176 QUIT
End DoDot:3
QUIT
+177 ;Start PRCA*4.5*372
+178 ; show inpatient [ RCDSPFLG=3 (LTC) or 4 (inpatient) ]
+179 if RCDSPFLG=3
DO SET("Long Term Care",RCLINE,28,80)
+180 if RCDSPFLG'=3
DO SET("Inpatient",RCLINE,28,80)
+181 ;end PRCA*4.5*372
+182 DO SET("Charge Amt: "_$JUSTIFY($PIECE(DATA,U,8),0,2),RCLINE,60,80)
+183 SET RCLINE=RCLINE+1
+184 ; PRCA*4.5*392
SET TMPDT=$$FMTE^XLFDT($PIECE(DATA,U,2),"2DZ")
DO SET(" Admission Date: "_TMPDT,RCLINE,1,80)
+185 ; PRCA*4.5*392
SET TMPDT=$$FMTE^XLFDT($PIECE(DATA,U,5),"2DZ")
DO SET("Discharge Date: "_TMPDT,RCLINE,56,80)
+186 SET RCLINE=RCLINE+1
+187 SET TMPDT=$$FMTE^XLFDT($PIECE(DATA,U,3),"2DZ")
DO SET(" Bill Cycle Begin Date: "_TMPDT,RCLINE,1,80)
+188 SET TMPDT=$$FMTE^XLFDT($PIECE(DATA,U,4),"2DZ")
DO SET("End Date: "_TMPDT,RCLINE,62,80)
+189 QUIT
End DoDot:2
+190 KILL ^TMP("IBRFN1",$JOB)
+191 QUIT
End DoDot:1
+192 ; set valmcnt to number of lines in the list
+193 SET VALMCNT=RCLINE
+194 QUIT
+195 ;
+196 ;
SET(STRING,LINE,COLBEG,COLEND,FIELD,ON,OFF) ; set array
+1 IF $GET(FIELD)
SET STRING=STRING_$SELECT(STRING="":"",1:": ")_$GET(RCDPDATA(433,RCTRANDA,FIELD,"E"))
+2 IF STRING=""
IF '$GET(FIELD)
QUIT
+3 IF '$DATA(@VALMAR@(LINE,0))
DO SET^VALM10(LINE,$JUSTIFY("",80))
+4 DO SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLBEG,COLEND-COLBEG+1))
+5 IF $GET(ON)]""!($GET(OFF)]"")
DO CNTRL^VALM10(LINE,COLBEG,$LENGTH(STRING),ON,OFF)
+6 QUIT
+7 ;
