RCBDPSL1 ;WISC/RFJ-patient statement top list manager routine ;1 Dec 00
;;4.5;Accounts Receivable;**162**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
INITCONT ; continue building list
;
; initialize line counter and transaction counter
S (RCLINE,RCTRCNT)=0
; initialize patient account totals
S (RCTOTAL(1),RCTOTAL(2),RCTOTAL(3))=0
;
; show transactions by statement date
S RCSTATE=0 F S RCSTATE=$O(^TMP("RCBDPSLMDATA",$J,RCDEBTDA,RCSTATE)) Q:'RCSTATE D
. ; display statement date on listmanager screen
. S RCLINE=RCLINE+1
. S RCSTDATE=RCSTATE I RCSTDATE=10000000 S RCSTDATE="NEW ACTIVITY"
. I RCSTDATE S RCSTDATE=RCSTDATE_"00000" S RCSTDATE=$E(RCSTDATE,4,5)_"/"_$E(RCSTDATE,6,7)_"/"_$E(RCSTDATE,2,3)_" @ "_$E(RCSTDATE,9,10)_":"_$E(RCSTDATE,11,12)
. D SET("Transactions for LAST Patient Statement as of Date: "_RCSTDATE,RCLINE,1,80,0,IORVON,IORVOFF)
. ; initialize totals by statement date
. S (RCTOTAL(4),RCTOTAL(5),RCTOTAL(6))=0
. ; initialize flag marking transactions incomplete
. S RCFINCOM=0
. ;
. S RCDATE=0 F S RCDATE=$O(^TMP("RCBDPSLMDATA",$J,RCDEBTDA,RCSTATE,RCDATE)) Q:'RCDATE D
. . S RCTRANDA="" F S RCTRANDA=$O(^TMP("RCBDPSLMDATA",$J,RCDEBTDA,RCSTATE,RCDATE,RCTRANDA)) Q:RCTRANDA="" D
. . . S RCVALUE=^TMP("RCBDPSLMDATA",$J,RCDEBTDA,RCSTATE,RCDATE,RCTRANDA)
. . . ;
. . . I 'RCTRANDA D SETBILL
. . . I RCTRANDA D SETTRAN
. . . ;
. . . ; compute totals by statement date
. . . S RCTOTAL(4)=RCTOTAL(4)+$P(RCVALUE,"^",2)
. . . S RCTOTAL(5)=RCTOTAL(5)+$P(RCVALUE,"^",3)
. . . S RCTOTAL(6)=RCTOTAL(6)+$P(RCVALUE,"^",4)+$P(RCVALUE,"^",5)+$P(RCVALUE,"^",6)
. . . ;
. . . ; compute totals by patient account
. . . S RCTOTAL(1)=RCTOTAL(1)+$P(RCVALUE,"^",2)
. . . S RCTOTAL(2)=RCTOTAL(2)+$P(RCVALUE,"^",3)
. . . S RCTOTAL(3)=RCTOTAL(3)+$P(RCVALUE,"^",4)+$P(RCVALUE,"^",5)+$P(RCVALUE,"^",6)
. ;
. ; if transaction was set incomplete on any transactions, show why
. I RCFINCOM D
. . S RCLINE=RCLINE+1 D SET(" * indicates transaction",RCLINE,1,80)
. . S RCLINE=RCLINE+1 D SET(" * is MARKed INCOMPLETE",RCLINE,1,80)
. ;
. ; display totals by statement date
. S RCLINE=RCLINE+1
. D SET(" --------- -------- --------",RCLINE,1,80)
. S RCLINE=RCLINE+1
. D SET("TOTAL BY LAST STATEMENT AS OF DATE: "_RCSTDATE,RCLINE,1,80)
. D SET($J(RCTOTAL(4),9,2),RCLINE,53,62)
. D SET($J(RCTOTAL(5),9,2),RCLINE,62,71)
. D SET($J(RCTOTAL(6),9,2),RCLINE,71,80)
. ;
. ; if last statement date, check to see if it is equal to what is stored
. I RCSTATE=$P($P(RCEVENDA,"^"),".") D
. . S RCOUTBAL=0
. . I +RCTOTAL(4)'=+RCEVENT("PB") S RCOUTBAL=1
. . I +RCTOTAL(5)'=+RCEVENT("IN") S RCOUTBAL=1
. . I +RCTOTAL(6)'=(RCEVENT("AD")+RCEVENT("CC")+RCEVENT("MF")) S RCOUTBAL=1
. . I RCOUTBAL D
. . . S RCLINE=RCLINE+1
. . . D SET(" ***** LAST PATIENT STATEMENT OUT OF BALANCE",RCLINE,1,80)
. . . D SET($J(RCEVENT("PB"),9,2),RCLINE,53,62)
. . . D SET($J(RCEVENT("IN"),9,2),RCLINE,62,71)
. . . D SET($J(RCEVENT("AD")+RCEVENT("CC")+RCEVENT("MF"),9,2),RCLINE,71,80)
. ;
. ;
. ; add some extra lines
. S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
. S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
;
; show totals of all transactions displayed in listmanager
S RCLINE=RCLINE+1
D SET(" --------- -------- --------",RCLINE,1,80)
S RCLINE=RCLINE+1
D SET(" TOTAL BALANCE FOR PATIENT ACCOUNT",RCLINE,1,80)
D SET($J(RCTOTAL(1),9,2),RCLINE,53,62)
D SET($J(RCTOTAL(2),9,2),RCLINE,62,71)
D SET($J(RCTOTAL(3),9,2),RCLINE,71,80)
;
; set valmcnt to number of lines in the list
S VALMCNT=RCLINE
D HDR^RCDPAPLM
Q
;
;
SETTRAN ; set a transaction on the listmanager line
N DATE,RCDPDATA
;
; get 433 data
D DIQ433^RCDPTPLM(RCTRANDA,".01;.03;12;19;")
;
; increment line number / transaction counter
S RCLINE=RCLINE+1,RCTRCNT=RCTRCNT+1
;
; bill number
D SET(RCTRCNT,RCLINE,1,80,0,IORVON,IORVOFF)
D SET($E($P(RCDPDATA(433,RCTRANDA,.03,"E"),"-",2)_" ",1,7),RCLINE,6,12)
;
; set transaction number
D SET(RCTRANDA,RCLINE,14,23)
;
; display transaction incomplete
I $P($G(^PRCA(433,RCTRANDA,0)),"^",10) D SET("*",RCLINE,24,24) S RCFINCOM=1
;
; set transaction date
S DATE=$P($G(RCDPDATA(433,RCTRANDA,19,"I")),".") I 'DATE S DATE=" "
I DATE S DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
D SET(DATE,RCLINE,25,33)
;
; set transaction type
D SET($TR(RCDPDATA(433,RCTRANDA,12,"E"),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz"),RCLINE,35,52)
D SET($J($P(RCVALUE,"^",2),9,2),RCLINE,53,62)
D SET($J($P(RCVALUE,"^",3),9,2),RCLINE,62,71)
; add marshal fee and court cost to create admin dollars
D SET($J($P(RCVALUE,"^",4)+$P(RCVALUE,"^",5)+$P(RCVALUE,"^",6),9,2),RCLINE,71,80)
Q
;
;
SETBILL ; set a bill original amount
N DATE
;
; increment line number
S RCLINE=RCLINE+1
;
; bill number
D SET(" ",RCLINE,1,80)
D SET($E($P($P($G(^PRCA(430,+$P(RCVALUE,"^"),0)),"^"),"-",2)_" ",1,7),RCLINE,6,12)
;
; set bill date
S DATE=RCDATE I 'DATE S DATE=" "
I DATE S DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
D SET(DATE,RCLINE,25,33)
;
; set transaction type
D SET("Original Amount",RCLINE,35,52)
D SET($J($P(RCVALUE,"^",2),9,2),RCLINE,53,62)
D SET($J(0,9,2),RCLINE,62,71)
; add marshal fee and court cost to create admin dollars
D SET($J(0,9,2),RCLINE,71,80)
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) 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[HRCBDPSL1 6264 printed Sep 23, 2025@19:18:34 Page 2
RCBDPSL1 ;WISC/RFJ-patient statement top list manager routine ;1 Dec 00
+1 ;;4.5;Accounts Receivable;**162**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
INITCONT ; continue building list
+1 ;
+2 ; initialize line counter and transaction counter
+3 SET (RCLINE,RCTRCNT)=0
+4 ; initialize patient account totals
+5 SET (RCTOTAL(1),RCTOTAL(2),RCTOTAL(3))=0
+6 ;
+7 ; show transactions by statement date
+8 SET RCSTATE=0
FOR
SET RCSTATE=$ORDER(^TMP("RCBDPSLMDATA",$JOB,RCDEBTDA,RCSTATE))
if 'RCSTATE
QUIT
Begin DoDot:1
+9 ; display statement date on listmanager screen
+10 SET RCLINE=RCLINE+1
+11 SET RCSTDATE=RCSTATE
IF RCSTDATE=10000000
SET RCSTDATE="NEW ACTIVITY"
+12 IF RCSTDATE
SET RCSTDATE=RCSTDATE_"00000"
SET RCSTDATE=$EXTRACT(RCSTDATE,4,5)_"/"_$EXTRACT(RCSTDATE,6,7)_"/"_$EXTRACT(RCSTDATE,2,3)_" @ "_$EXTRACT(RCSTDATE,9,10)_":"_$EXTRACT(RCSTDATE,11,12)
+13 DO SET("Transactions for LAST Patient Statement as of Date: "_RCSTDATE,RCLINE,1,80,0,IORVON,IORVOFF)
+14 ; initialize totals by statement date
+15 SET (RCTOTAL(4),RCTOTAL(5),RCTOTAL(6))=0
+16 ; initialize flag marking transactions incomplete
+17 SET RCFINCOM=0
+18 ;
+19 SET RCDATE=0
FOR
SET RCDATE=$ORDER(^TMP("RCBDPSLMDATA",$JOB,RCDEBTDA,RCSTATE,RCDATE))
if 'RCDATE
QUIT
Begin DoDot:2
+20 SET RCTRANDA=""
FOR
SET RCTRANDA=$ORDER(^TMP("RCBDPSLMDATA",$JOB,RCDEBTDA,RCSTATE,RCDATE,RCTRANDA))
if RCTRANDA=""
QUIT
Begin DoDot:3
+21 SET RCVALUE=^TMP("RCBDPSLMDATA",$JOB,RCDEBTDA,RCSTATE,RCDATE,RCTRANDA)
+22 ;
+23 IF 'RCTRANDA
DO SETBILL
+24 IF RCTRANDA
DO SETTRAN
+25 ;
+26 ; compute totals by statement date
+27 SET RCTOTAL(4)=RCTOTAL(4)+$PIECE(RCVALUE,"^",2)
+28 SET RCTOTAL(5)=RCTOTAL(5)+$PIECE(RCVALUE,"^",3)
+29 SET RCTOTAL(6)=RCTOTAL(6)+$PIECE(RCVALUE,"^",4)+$PIECE(RCVALUE,"^",5)+$PIECE(RCVALUE,"^",6)
+30 ;
+31 ; compute totals by patient account
+32 SET RCTOTAL(1)=RCTOTAL(1)+$PIECE(RCVALUE,"^",2)
+33 SET RCTOTAL(2)=RCTOTAL(2)+$PIECE(RCVALUE,"^",3)
+34 SET RCTOTAL(3)=RCTOTAL(3)+$PIECE(RCVALUE,"^",4)+$PIECE(RCVALUE,"^",5)+$PIECE(RCVALUE,"^",6)
End DoDot:3
End DoDot:2
+35 ;
+36 ; if transaction was set incomplete on any transactions, show why
+37 IF RCFINCOM
Begin DoDot:2
+38 SET RCLINE=RCLINE+1
DO SET(" * indicates transaction",RCLINE,1,80)
+39 SET RCLINE=RCLINE+1
DO SET(" * is MARKed INCOMPLETE",RCLINE,1,80)
End DoDot:2
+40 ;
+41 ; display totals by statement date
+42 SET RCLINE=RCLINE+1
+43 DO SET(" --------- -------- --------",RCLINE,1,80)
+44 SET RCLINE=RCLINE+1
+45 DO SET("TOTAL BY LAST STATEMENT AS OF DATE: "_RCSTDATE,RCLINE,1,80)
+46 DO SET($JUSTIFY(RCTOTAL(4),9,2),RCLINE,53,62)
+47 DO SET($JUSTIFY(RCTOTAL(5),9,2),RCLINE,62,71)
+48 DO SET($JUSTIFY(RCTOTAL(6),9,2),RCLINE,71,80)
+49 ;
+50 ; if last statement date, check to see if it is equal to what is stored
+51 IF RCSTATE=$PIECE($PIECE(RCEVENDA,"^"),".")
Begin DoDot:2
+52 SET RCOUTBAL=0
+53 IF +RCTOTAL(4)'=+RCEVENT("PB")
SET RCOUTBAL=1
+54 IF +RCTOTAL(5)'=+RCEVENT("IN")
SET RCOUTBAL=1
+55 IF +RCTOTAL(6)'=(RCEVENT("AD")+RCEVENT("CC")+RCEVENT("MF"))
SET RCOUTBAL=1
+56 IF RCOUTBAL
Begin DoDot:3
+57 SET RCLINE=RCLINE+1
+58 DO SET(" ***** LAST PATIENT STATEMENT OUT OF BALANCE",RCLINE,1,80)
+59 DO SET($JUSTIFY(RCEVENT("PB"),9,2),RCLINE,53,62)
+60 DO SET($JUSTIFY(RCEVENT("IN"),9,2),RCLINE,62,71)
+61 DO SET($JUSTIFY(RCEVENT("AD")+RCEVENT("CC")+RCEVENT("MF"),9,2),RCLINE,71,80)
End DoDot:3
End DoDot:2
+62 ;
+63 ;
+64 ; add some extra lines
+65 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+66 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
End DoDot:1
+67 ;
+68 ; show totals of all transactions displayed in listmanager
+69 SET RCLINE=RCLINE+1
+70 DO SET(" --------- -------- --------",RCLINE,1,80)
+71 SET RCLINE=RCLINE+1
+72 DO SET(" TOTAL BALANCE FOR PATIENT ACCOUNT",RCLINE,1,80)
+73 DO SET($JUSTIFY(RCTOTAL(1),9,2),RCLINE,53,62)
+74 DO SET($JUSTIFY(RCTOTAL(2),9,2),RCLINE,62,71)
+75 DO SET($JUSTIFY(RCTOTAL(3),9,2),RCLINE,71,80)
+76 ;
+77 ; set valmcnt to number of lines in the list
+78 SET VALMCNT=RCLINE
+79 DO HDR^RCDPAPLM
+80 QUIT
+81 ;
+82 ;
SETTRAN ; set a transaction on the listmanager line
+1 NEW DATE,RCDPDATA
+2 ;
+3 ; get 433 data
+4 DO DIQ433^RCDPTPLM(RCTRANDA,".01;.03;12;19;")
+5 ;
+6 ; increment line number / transaction counter
+7 SET RCLINE=RCLINE+1
SET RCTRCNT=RCTRCNT+1
+8 ;
+9 ; bill number
+10 DO SET(RCTRCNT,RCLINE,1,80,0,IORVON,IORVOFF)
+11 DO SET($EXTRACT($PIECE(RCDPDATA(433,RCTRANDA,.03,"E"),"-",2)_" ",1,7),RCLINE,6,12)
+12 ;
+13 ; set transaction number
+14 DO SET(RCTRANDA,RCLINE,14,23)
+15 ;
+16 ; display transaction incomplete
+17 IF $PIECE($GET(^PRCA(433,RCTRANDA,0)),"^",10)
DO SET("*",RCLINE,24,24)
SET RCFINCOM=1
+18 ;
+19 ; set transaction date
+20 SET DATE=$PIECE($GET(RCDPDATA(433,RCTRANDA,19,"I")),".")
IF 'DATE
SET DATE=" "
+21 IF DATE
SET DATE=$EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3)
+22 DO SET(DATE,RCLINE,25,33)
+23 ;
+24 ; set transaction type
+25 DO SET($TRANSLATE(RCDPDATA(433,RCTRANDA,12,"E"),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz"),RCLINE,35,52)
+26 DO SET($JUSTIFY($PIECE(RCVALUE,"^",2),9,2),RCLINE,53,62)
+27 DO SET($JUSTIFY($PIECE(RCVALUE,"^",3),9,2),RCLINE,62,71)
+28 ; add marshal fee and court cost to create admin dollars
+29 DO SET($JUSTIFY($PIECE(RCVALUE,"^",4)+$PIECE(RCVALUE,"^",5)+$PIECE(RCVALUE,"^",6),9,2),RCLINE,71,80)
+30 QUIT
+31 ;
+32 ;
SETBILL ; set a bill original amount
+1 NEW DATE
+2 ;
+3 ; increment line number
+4 SET RCLINE=RCLINE+1
+5 ;
+6 ; bill number
+7 DO SET(" ",RCLINE,1,80)
+8 DO SET($EXTRACT($PIECE($PIECE($GET(^PRCA(430,+$PIECE(RCVALUE,"^"),0)),"^"),"-",2)_" ",1,7),RCLINE,6,12)
+9 ;
+10 ; set bill date
+11 SET DATE=RCDATE
IF 'DATE
SET DATE=" "
+12 IF DATE
SET DATE=$EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3)
+13 DO SET(DATE,RCLINE,25,33)
+14 ;
+15 ; set transaction type
+16 DO SET("Original Amount",RCLINE,35,52)
+17 DO SET($JUSTIFY($PIECE(RCVALUE,"^",2),9,2),RCLINE,53,62)
+18 DO SET($JUSTIFY(0,9,2),RCLINE,62,71)
+19 ; add marshal fee and court cost to create admin dollars
+20 DO SET($JUSTIFY(0,9,2),RCLINE,71,80)
+21 QUIT
+22 ;
+23 ;
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)
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
