RCDPAPLI ;WISC/RFJ-account profile top list manager init ;1 Jun 99
;;4.5;Accounts Receivable;**114,141,241,303,301,315,350**;Mar 20, 1995;Build 66
;;Per VA Directive 6402, this routine should not be modified.
Q
;
INIT ; init for list manager screen
N DMCDATA,RCBILLDA,RCCOMM,RCDATA,RCDATE,RCLINE,RCSTATDA,RCTOTAL
N TOP4,TOP6
K ^TMP("RCDPAPLM",$J),^TMP("RCDPAPLMX",$J),^TMP("VALM VIDEO",$J)
;
; fast exit
I $G(RCDPFXIT) S VALMQUIT=1 Q
;
I '$G(RCDEBTDA) D Q
. D SET("",1,1,80)
. D SET("***** Select an ACCOUNT *****",2,1,80)
. S VALMCNT=2
. D HDR^RCDPAPLM
;
; get bills for a debtor
D GETBILLS^RCDPAPST(RCDEBTDA)
;
I '$O(^TMP("RCDPAPST",$J,0)) D Q
. D SET("",1,1,80,IORVOFF,IORVOFF)
. D SET(" ***** Account does not have any bills *****",2,1,80)
. S VALMCNT=2
. S RCTOTAL(1)=0
. D HDR^RCDPAPLM
;
; set the listmanager line number
S RCLINE=0
;
S RCDATE=9999999 F S RCDATE=$O(^TMP("RCDPAPST",$J,RCDATE),-1) Q:'RCDATE D
. S RCSTATDA=0 F S RCSTATDA=$O(^TMP("RCDPAPST",$J,RCDATE,RCSTATDA)) Q:'RCSTATDA D
. . S RCBILLDA=0 F S RCBILLDA=$O(^TMP("RCDPAPST",$J,RCDATE,RCSTATDA,RCBILLDA)) Q:'RCBILLDA D
. . . S RCDATA=^TMP("RCDPAPST",$J,RCDATE,RCSTATDA,RCBILLDA)
. . . ; add up dollars owed by account (all bills)
. . . S RCTOTAL(1)=$G(RCTOTAL(1))+$P(RCDATA,"^")
. . . S RCTOTAL(2)=$G(RCTOTAL(2))+$P(RCDATA,"^",2)
. . . S RCTOTAL(3)=$G(RCTOTAL(3))+$P(RCDATA,"^",3)
. . . ;
. . . ; if not a selected status, do not display
. . . I ("^"_$G(^DISV(DUZ,"RCDPAPLM","STATUS"))_"^")'[("^"_RCSTATDA_"^") Q
. . . ;
. . . ; display the bill in listmanager if the status selected
. . . D SETBILL
. . . ;
. . . ; add up dollars owed by account (bills displayed)
. . . S RCTOTAL(4)=$G(RCTOTAL(4))+$P(RCDATA,"^")
. . . S RCTOTAL(5)=$G(RCTOTAL(5))+$P(RCDATA,"^",2)
. . . S RCTOTAL(6)=$G(RCTOTAL(6))+$P(RCDATA,"^",3)
;
; show totals of all bills displayed in listmanager
S RCLINE=RCLINE+1
D SET(" --------- -------- --------",RCLINE,1,80)
S RCLINE=RCLINE+1
D SET(" TOTAL BALANCE OWED FOR ALL BILLS DISPLAYED",RCLINE,1,80)
D SET($J($G(RCTOTAL(4)),9,2),RCLINE,53,62)
D SET($J($G(RCTOTAL(5)),9,2),RCLINE,62,71)
D SET($J($G(RCTOTAL(6)),9,2),RCLINE,71,80)
;
; get the pending payments for the debtor
S RCTOTAL("PP")=$$PENDPAY^RCDPURET($P(^RCD(340,RCDEBTDA,0),"^"))
I $O(^TMP($J,"RCDPUREC","PP",0)) D
. S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
. S RCLINE=RCLINE+1 D SET("Pending Payments",RCLINE,1,80,0,IORVON,IORVOFF)
. N %,DATA,DATE,RECEIPT,RECTDA,TRANDA,TYPE
. S RECTDA=0 F S RECTDA=$O(^TMP($J,"RCDPUREC","PP",RECTDA)) Q:'RECTDA D
. . S RECEIPT=$P($G(^RCY(344,RECTDA,0)),"^")
. . S TYPE=$E($P($G(^RC(341.1,+$P(^RCY(344,RECTDA,0),"^",4),0)),"^"),1,14)
. . S TRANDA=0 F S TRANDA=$O(^TMP($J,"RCDPUREC","PP",RECTDA,TRANDA)) Q:'TRANDA D
. . . S DATA=^TMP($J,"RCDPUREC","PP",RECTDA,TRANDA)
. . . S RCLINE=RCLINE+1
. . . D SET(RECEIPT_"/"_TRANDA,RCLINE,1,80)
. . . S DATE=$P(DATA,"^",6)
. . . S DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
. . . D SET(DATE,RCLINE,13,21)
. . . ; build type of payment display
. . . S %=$E(TYPE_" ",1,14)
. . . I $P(DATA,"^",7)'="" S %=%_"/"_$P(DATA,"^",7) ; check #
. . . I $P(DATA,"^",8)'="" S %=%_"/"_$P(DATA,"^",8) ; bank #
. . . I $P(DATA,"^",2)'="" S %=%_"/"_$P(DATA,"^",2) ; confirmation
. . . D SET(%,RCLINE,29,53)
. . . ; show amount paid
. . . D SET($J($P(DATA,"^",4),9,2),RCLINE,53,62)
. S RCLINE=RCLINE+1
. D SET(" ---------",RCLINE,1,80)
. S RCLINE=RCLINE+1
. D SET(" TOTAL PENDING PAYMENTS",RCLINE,1,80)
. D SET($J($G(RCTOTAL("PP")),9,2),RCLINE,53,62)
. K ^TMP($J,"RCDPUREC","PP")
;
; dmc info
I $D(^RCD(340,"DMC",1,+RCDEBTDA)) D
. S DMCDATA=$G(^RCD(340,+RCDEBTDA,3))
. S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
. S RCLINE=RCLINE+1
. D SET("** Account forwarded to DMC: "_$S('$P(DMCDATA,"^",2):"",1:$$SLH^RCFN01($P(DMCDATA,"^",2))),RCLINE,1,80)
. D SET("Total DMC Amount: "_$J($P(DMCDATA,"^",5),9,2),RCLINE,50,80)
. I $P(DMCDATA,"^",9)'="" D
. . S RCLINE=RCLINE+1
. . D SET(" ",RCLINE,1,80)
. . D SET("Lesser Amt to DMC: "_$J($P(DMCDATA,"^",9),9,2),RCLINE,49,80)
; top info
I $D(^RCD(340,"TOP",+RCDEBTDA)) D
. S TOP6=$G(^RCD(340,+RCDEBTDA,6)),TOP4=$G(^(4))
. S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
. S RCLINE=RCLINE+1
. D SET("** Account forwarded to TOP: "_$S('$P(TOP6,"^"):"",1:$$SLH^RCFN01($P(TOP6,"^"))),RCLINE,1,80)
. D SET("Total TOP Amount: "_$J($P(TOP4,"^",3),13,2),RCLINE,45,80)
. I $P(TOP6,"^",6)'="" D
. . S RCLINE=RCLINE+1
. . D SET(" ",RCLINE,1,80)
. . D SET("TOP Hold Date: "_$$SLH^RCFN01($P(TOP6,"^",6)),RCLINE,45,80)
;
; cross-servicing info
I $D(^RCD(340,"TCSP",+RCDEBTDA)) D
. S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
. S RCLINE=RCLINE+1
. ; PRCA*4.5*350
. D SET^RCDPBPLM("Debt "_$S($$RRD^RCTCSPU(+RCDEBTDA):"Re-",1:"")_"Referred to Cross-Servicing",RCLINE,1,80)
. D SET("Total CS Debt: "_$J($$TOTALB^RCTCSPU(+RCDEBTDA),13,2),RCLINE,45,80)
;
; show if hurricane katrina vet
I $P(^RCD(340,+RCDEBTDA,0),U)["DPT(" S DFN=+^(0) D
. Q:$$EMGRES^DGUTL(DFN)'["K"
. S RCLINE=RCLINE+1
. D SET("EMERGENCY RESPONSE INDICATOR: HURRICANE KATRINA",RCLINE,1,80)
;
; show comments if they exist
I $O(^RCD(340,RCDEBTDA,2,0)) D
. S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
. S RCLINE=RCLINE+1 D SET("Comments",RCLINE,1,80,0,IOUON,IOUOFF)
. S RCCOMM=0 F S RCCOMM=$O(^RCD(340,RCDEBTDA,2,RCCOMM)) Q:'RCCOMM D
. . S RCLINE=RCLINE+1 D SET(^RCD(340,RCDEBTDA,2,RCCOMM,0),RCLINE,1,80)
;
K ^TMP("RCDPAPST",$J)
;
; set valmcnt to number of lines in the list
S VALMCNT=RCLINE
D HDR^RCDPAPLM
Q
;
;
SETBILL ; set a bill on the listmanager line
N DATE,IBCNDATA,RCDPDATA,REJECT,VALUE
D DIQ430^RCDPBPLM(RCBILLDA,".01;2;3;8;60;")
;
S RCLINE=RCLINE+1
;
; create an index array for bill lookup in list
S ^TMP("RCDPAPLM",$J,"IDX",RCLINE,RCLINE)=RCBILLDA
;
; bill number
;PRCA*4.5*303 - add reject indicator to kbill ; IA# 6060
S REJECT=$$BILLREJ^IBJTU6($P(RCDPDATA(430,RCBILLDA,.01,"E"),"-",2))
D SET(RCLINE,RCLINE,1,80,0,IORVON,IORVOFF)
D SET($S(REJECT:"c",1:"")_$E($P(RCDPDATA(430,RCBILLDA,.01,"E"),"-",2)_" ",1,7),RCLINE,7,14,0) ;PRCA*3.5*315 increase left margin
;PRCA*4.5*303 - End
;
; PRCA*4.5*315 - add "x" or "y" indicator to kbill
N CSDATE1,CSDATE2,RCIND
S CSDATE1=$$GET1^DIQ(430,RCBILLDA,"DATE BILL REFERRED TO TCSP","I")
S CSDATE2=$$GET1^DIQ(430,RCBILLDA,"ORIGINAL DATE REFERRED TO TCSP","I")
D SET(RCLINE,RCLINE,1,80,0,IORVON,IORVOFF)
S RCIND=$S(CSDATE1'="":"x",CSDATE2'="":"y",1:"")
I RCIND]"" D SET(RCIND_$E($P(RCDPDATA(430,RCBILLDA,.01,"E"),"-",2)_" ",1,7),RCLINE,7,15,0)
I RCIND="" D SET(RCIND_$E($P(RCDPDATA(430,RCBILLDA,.01,"E"),"-",2)_" ",1,7),RCLINE,8,15,0)
;PRCA*4.5*315 End
;
; get date of care
D DIQ399^RCXFMSUR(RCBILLDA)
S DATE=$G(IBCNDATA(399,RCBILLDA,151,"I"))
I 'DATE S DATE=$G(RCDPDATA(430,RCBILLDA,60,"I"))
S DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
;D SET(DATE,RCLINE,13,21,0)
D SET(DATE,RCLINE,17,24,0) ;PRCA*4.5*315
;
; status (field 8)
;D SET("",RCLINE,23,26,8)
D SET("",RCLINE,27,30,8) ;PRCA*4.5*315
;
; type of care
;D SET("",RCLINE,29,71,2)
D SET("",RCLINE,33,53,2) ;PRCA*4.5*315
;
; principle, interest, admin
D SET($J($P(RCDATA,"^"),9,2),RCLINE,53,62,0)
D SET($J($P(RCDATA,"^",2),9,2),RCLINE,62,71,0)
D SET($J($P(RCDATA,"^",3),9,2),RCLINE,71,80,0)
Q
;
;
SET(STRING,LINE,COLBEG,COLEND,FIELD,ON,OFF) ; set array
I $G(FIELD) S STRING=STRING_$S(STRING="":"",1:": ")_$G(RCDPDATA(430,RCBILLDA,FIELD,"E"))
I STRING="",'$G(FIELD) D SET^VALM10(LINE,$J("",80)) 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[HRCDPAPLI 8395 printed Dec 13, 2024@01:43:48 Page 2
RCDPAPLI ;WISC/RFJ-account profile top list manager init ;1 Jun 99
+1 ;;4.5;Accounts Receivable;**114,141,241,303,301,315,350**;Mar 20, 1995;Build 66
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
INIT ; init for list manager screen
+1 NEW DMCDATA,RCBILLDA,RCCOMM,RCDATA,RCDATE,RCLINE,RCSTATDA,RCTOTAL
+2 NEW TOP4,TOP6
+3 KILL ^TMP("RCDPAPLM",$JOB),^TMP("RCDPAPLMX",$JOB),^TMP("VALM VIDEO",$JOB)
+4 ;
+5 ; fast exit
+6 IF $GET(RCDPFXIT)
SET VALMQUIT=1
QUIT
+7 ;
+8 IF '$GET(RCDEBTDA)
Begin DoDot:1
+9 DO SET("",1,1,80)
+10 DO SET("***** Select an ACCOUNT *****",2,1,80)
+11 SET VALMCNT=2
+12 DO HDR^RCDPAPLM
End DoDot:1
QUIT
+13 ;
+14 ; get bills for a debtor
+15 DO GETBILLS^RCDPAPST(RCDEBTDA)
+16 ;
+17 IF '$ORDER(^TMP("RCDPAPST",$JOB,0))
Begin DoDot:1
+18 DO SET("",1,1,80,IORVOFF,IORVOFF)
+19 DO SET(" ***** Account does not have any bills *****",2,1,80)
+20 SET VALMCNT=2
+21 SET RCTOTAL(1)=0
+22 DO HDR^RCDPAPLM
End DoDot:1
QUIT
+23 ;
+24 ; set the listmanager line number
+25 SET RCLINE=0
+26 ;
+27 SET RCDATE=9999999
FOR
SET RCDATE=$ORDER(^TMP("RCDPAPST",$JOB,RCDATE),-1)
if 'RCDATE
QUIT
Begin DoDot:1
+28 SET RCSTATDA=0
FOR
SET RCSTATDA=$ORDER(^TMP("RCDPAPST",$JOB,RCDATE,RCSTATDA))
if 'RCSTATDA
QUIT
Begin DoDot:2
+29 SET RCBILLDA=0
FOR
SET RCBILLDA=$ORDER(^TMP("RCDPAPST",$JOB,RCDATE,RCSTATDA,RCBILLDA))
if 'RCBILLDA
QUIT
Begin DoDot:3
+30 SET RCDATA=^TMP("RCDPAPST",$JOB,RCDATE,RCSTATDA,RCBILLDA)
+31 ; add up dollars owed by account (all bills)
+32 SET RCTOTAL(1)=$GET(RCTOTAL(1))+$PIECE(RCDATA,"^")
+33 SET RCTOTAL(2)=$GET(RCTOTAL(2))+$PIECE(RCDATA,"^",2)
+34 SET RCTOTAL(3)=$GET(RCTOTAL(3))+$PIECE(RCDATA,"^",3)
+35 ;
+36 ; if not a selected status, do not display
+37 IF ("^"_$GET(^DISV(DUZ,"RCDPAPLM","STATUS"))_"^")'[("^"_RCSTATDA_"^")
QUIT
+38 ;
+39 ; display the bill in listmanager if the status selected
+40 DO SETBILL
+41 ;
+42 ; add up dollars owed by account (bills displayed)
+43 SET RCTOTAL(4)=$GET(RCTOTAL(4))+$PIECE(RCDATA,"^")
+44 SET RCTOTAL(5)=$GET(RCTOTAL(5))+$PIECE(RCDATA,"^",2)
+45 SET RCTOTAL(6)=$GET(RCTOTAL(6))+$PIECE(RCDATA,"^",3)
End DoDot:3
End DoDot:2
End DoDot:1
+46 ;
+47 ; show totals of all bills displayed in listmanager
+48 SET RCLINE=RCLINE+1
+49 DO SET(" --------- -------- --------",RCLINE,1,80)
+50 SET RCLINE=RCLINE+1
+51 DO SET(" TOTAL BALANCE OWED FOR ALL BILLS DISPLAYED",RCLINE,1,80)
+52 DO SET($JUSTIFY($GET(RCTOTAL(4)),9,2),RCLINE,53,62)
+53 DO SET($JUSTIFY($GET(RCTOTAL(5)),9,2),RCLINE,62,71)
+54 DO SET($JUSTIFY($GET(RCTOTAL(6)),9,2),RCLINE,71,80)
+55 ;
+56 ; get the pending payments for the debtor
+57 SET RCTOTAL("PP")=$$PENDPAY^RCDPURET($PIECE(^RCD(340,RCDEBTDA,0),"^"))
+58 IF $ORDER(^TMP($JOB,"RCDPUREC","PP",0))
Begin DoDot:1
+59 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+60 SET RCLINE=RCLINE+1
DO SET("Pending Payments",RCLINE,1,80,0,IORVON,IORVOFF)
+61 NEW %,DATA,DATE,RECEIPT,RECTDA,TRANDA,TYPE
+62 SET RECTDA=0
FOR
SET RECTDA=$ORDER(^TMP($JOB,"RCDPUREC","PP",RECTDA))
if 'RECTDA
QUIT
Begin DoDot:2
+63 SET RECEIPT=$PIECE($GET(^RCY(344,RECTDA,0)),"^")
+64 SET TYPE=$EXTRACT($PIECE($GET(^RC(341.1,+$PIECE(^RCY(344,RECTDA,0),"^",4),0)),"^"),1,14)
+65 SET TRANDA=0
FOR
SET TRANDA=$ORDER(^TMP($JOB,"RCDPUREC","PP",RECTDA,TRANDA))
if 'TRANDA
QUIT
Begin DoDot:3
+66 SET DATA=^TMP($JOB,"RCDPUREC","PP",RECTDA,TRANDA)
+67 SET RCLINE=RCLINE+1
+68 DO SET(RECEIPT_"/"_TRANDA,RCLINE,1,80)
+69 SET DATE=$PIECE(DATA,"^",6)
+70 SET DATE=$EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3)
+71 DO SET(DATE,RCLINE,13,21)
+72 ; build type of payment display
+73 SET %=$EXTRACT(TYPE_" ",1,14)
+74 ; check #
IF $PIECE(DATA,"^",7)'=""
SET %=%_"/"_$PIECE(DATA,"^",7)
+75 ; bank #
IF $PIECE(DATA,"^",8)'=""
SET %=%_"/"_$PIECE(DATA,"^",8)
+76 ; confirmation
IF $PIECE(DATA,"^",2)'=""
SET %=%_"/"_$PIECE(DATA,"^",2)
+77 DO SET(%,RCLINE,29,53)
+78 ; show amount paid
+79 DO SET($JUSTIFY($PIECE(DATA,"^",4),9,2),RCLINE,53,62)
End DoDot:3
End DoDot:2
+80 SET RCLINE=RCLINE+1
+81 DO SET(" ---------",RCLINE,1,80)
+82 SET RCLINE=RCLINE+1
+83 DO SET(" TOTAL PENDING PAYMENTS",RCLINE,1,80)
+84 DO SET($JUSTIFY($GET(RCTOTAL("PP")),9,2),RCLINE,53,62)
+85 KILL ^TMP($JOB,"RCDPUREC","PP")
End DoDot:1
+86 ;
+87 ; dmc info
+88 IF $DATA(^RCD(340,"DMC",1,+RCDEBTDA))
Begin DoDot:1
+89 SET DMCDATA=$GET(^RCD(340,+RCDEBTDA,3))
+90 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+91 SET RCLINE=RCLINE+1
+92 DO SET("** Account forwarded to DMC: "_$SELECT('$PIECE(DMCDATA,"^",2):"",1:$$SLH^RCFN01($PIECE(DMCDATA,"^",2))),RCLINE,1,80)
+93 DO SET("Total DMC Amount: "_$JUSTIFY($PIECE(DMCDATA,"^",5),9,2),RCLINE,50,80)
+94 IF $PIECE(DMCDATA,"^",9)'=""
Begin DoDot:2
+95 SET RCLINE=RCLINE+1
+96 DO SET(" ",RCLINE,1,80)
+97 DO SET("Lesser Amt to DMC: "_$JUSTIFY($PIECE(DMCDATA,"^",9),9,2),RCLINE,49,80)
End DoDot:2
End DoDot:1
+98 ; top info
+99 IF $DATA(^RCD(340,"TOP",+RCDEBTDA))
Begin DoDot:1
+100 SET TOP6=$GET(^RCD(340,+RCDEBTDA,6))
SET TOP4=$GET(^(4))
+101 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+102 SET RCLINE=RCLINE+1
+103 DO SET("** Account forwarded to TOP: "_$SELECT('$PIECE(TOP6,"^"):"",1:$$SLH^RCFN01($PIECE(TOP6,"^"))),RCLINE,1,80)
+104 DO SET("Total TOP Amount: "_$JUSTIFY($PIECE(TOP4,"^",3),13,2),RCLINE,45,80)
+105 IF $PIECE(TOP6,"^",6)'=""
Begin DoDot:2
+106 SET RCLINE=RCLINE+1
+107 DO SET(" ",RCLINE,1,80)
+108 DO SET("TOP Hold Date: "_$$SLH^RCFN01($PIECE(TOP6,"^",6)),RCLINE,45,80)
End DoDot:2
End DoDot:1
+109 ;
+110 ; cross-servicing info
+111 IF $DATA(^RCD(340,"TCSP",+RCDEBTDA))
Begin DoDot:1
+112 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+113 SET RCLINE=RCLINE+1
+114 ; PRCA*4.5*350
+115 DO SET^RCDPBPLM("Debt "_$SELECT($$RRD^RCTCSPU(+RCDEBTDA):"Re-",1:"")_"Referred to Cross-Servicing",RCLINE,1,80)
+116 DO SET("Total CS Debt: "_$JUSTIFY($$TOTALB^RCTCSPU(+RCDEBTDA),13,2),RCLINE,45,80)
End DoDot:1
+117 ;
+118 ; show if hurricane katrina vet
+119 IF $PIECE(^RCD(340,+RCDEBTDA,0),U)["DPT("
SET DFN=+^(0)
Begin DoDot:1
+120 if $$EMGRES^DGUTL(DFN)'["K"
QUIT
+121 SET RCLINE=RCLINE+1
+122 DO SET("EMERGENCY RESPONSE INDICATOR: HURRICANE KATRINA",RCLINE,1,80)
End DoDot:1
+123 ;
+124 ; show comments if they exist
+125 IF $ORDER(^RCD(340,RCDEBTDA,2,0))
Begin DoDot:1
+126 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+127 SET RCLINE=RCLINE+1
DO SET("Comments",RCLINE,1,80,0,IOUON,IOUOFF)
+128 SET RCCOMM=0
FOR
SET RCCOMM=$ORDER(^RCD(340,RCDEBTDA,2,RCCOMM))
if 'RCCOMM
QUIT
Begin DoDot:2
+129 SET RCLINE=RCLINE+1
DO SET(^RCD(340,RCDEBTDA,2,RCCOMM,0),RCLINE,1,80)
End DoDot:2
End DoDot:1
+130 ;
+131 KILL ^TMP("RCDPAPST",$JOB)
+132 ;
+133 ; set valmcnt to number of lines in the list
+134 SET VALMCNT=RCLINE
+135 DO HDR^RCDPAPLM
+136 QUIT
+137 ;
+138 ;
SETBILL ; set a bill on the listmanager line
+1 NEW DATE,IBCNDATA,RCDPDATA,REJECT,VALUE
+2 DO DIQ430^RCDPBPLM(RCBILLDA,".01;2;3;8;60;")
+3 ;
+4 SET RCLINE=RCLINE+1
+5 ;
+6 ; create an index array for bill lookup in list
+7 SET ^TMP("RCDPAPLM",$JOB,"IDX",RCLINE,RCLINE)=RCBILLDA
+8 ;
+9 ; bill number
+10 ;PRCA*4.5*303 - add reject indicator to kbill ; IA# 6060
+11 SET REJECT=$$BILLREJ^IBJTU6($PIECE(RCDPDATA(430,RCBILLDA,.01,"E"),"-",2))
+12 DO SET(RCLINE,RCLINE,1,80,0,IORVON,IORVOFF)
+13 ;PRCA*3.5*315 increase left margin
DO SET($SELECT(REJECT:"c",1:"")_$EXTRACT($PIECE(RCDPDATA(430,RCBILLDA,.01,"E"),"-",2)_" ",1,7),RCLINE,7,14,0)
+14 ;PRCA*4.5*303 - End
+15 ;
+16 ; PRCA*4.5*315 - add "x" or "y" indicator to kbill
+17 NEW CSDATE1,CSDATE2,RCIND
+18 SET CSDATE1=$$GET1^DIQ(430,RCBILLDA,"DATE BILL REFERRED TO TCSP","I")
+19 SET CSDATE2=$$GET1^DIQ(430,RCBILLDA,"ORIGINAL DATE REFERRED TO TCSP","I")
+20 DO SET(RCLINE,RCLINE,1,80,0,IORVON,IORVOFF)
+21 SET RCIND=$SELECT(CSDATE1'="":"x",CSDATE2'="":"y",1:"")
+22 IF RCIND]""
DO SET(RCIND_$EXTRACT($PIECE(RCDPDATA(430,RCBILLDA,.01,"E"),"-",2)_" ",1,7),RCLINE,7,15,0)
+23 IF RCIND=""
DO SET(RCIND_$EXTRACT($PIECE(RCDPDATA(430,RCBILLDA,.01,"E"),"-",2)_" ",1,7),RCLINE,8,15,0)
+24 ;PRCA*4.5*315 End
+25 ;
+26 ; get date of care
+27 DO DIQ399^RCXFMSUR(RCBILLDA)
+28 SET DATE=$GET(IBCNDATA(399,RCBILLDA,151,"I"))
+29 IF 'DATE
SET DATE=$GET(RCDPDATA(430,RCBILLDA,60,"I"))
+30 SET DATE=$EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3)
+31 ;D SET(DATE,RCLINE,13,21,0)
+32 ;PRCA*4.5*315
DO SET(DATE,RCLINE,17,24,0)
+33 ;
+34 ; status (field 8)
+35 ;D SET("",RCLINE,23,26,8)
+36 ;PRCA*4.5*315
DO SET("",RCLINE,27,30,8)
+37 ;
+38 ; type of care
+39 ;D SET("",RCLINE,29,71,2)
+40 ;PRCA*4.5*315
DO SET("",RCLINE,33,53,2)
+41 ;
+42 ; principle, interest, admin
+43 DO SET($JUSTIFY($PIECE(RCDATA,"^"),9,2),RCLINE,53,62,0)
+44 DO SET($JUSTIFY($PIECE(RCDATA,"^",2),9,2),RCLINE,62,71,0)
+45 DO SET($JUSTIFY($PIECE(RCDATA,"^",3),9,2),RCLINE,71,80,0)
+46 QUIT
+47 ;
+48 ;
SET(STRING,LINE,COLBEG,COLEND,FIELD,ON,OFF) ; set array
+1 IF $GET(FIELD)
SET STRING=STRING_$SELECT(STRING="":"",1:": ")_$GET(RCDPDATA(430,RCBILLDA,FIELD,"E"))
+2 IF STRING=""
IF '$GET(FIELD)
DO SET^VALM10(LINE,$JUSTIFY("",80))
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
