RCBDPSLM ;WISC/RFJ-patient statement top list manager routine ;1 Dec 00
;;4.5;Accounts Receivable;**162,198**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
N RCDEBTDA
;
F D Q:'RCDEBTDA
. W !! S RCDEBTDA=$$SELACCT
. I RCDEBTDA<1 S RCDEBTDA=0 Q
. D EN^VALM("RCBD PATIENT STATEMENT")
Q
;
;
INIT ; initialization for list manager list
N ORIGAMT,RCBILLDA,RCDATE,RCEVENDA,RCEVENT,RCFINCOM,RCLINE,RCOUTBAL,RCSTATE,RCSTDATE,RCTOTAL,RCTRANDA,RCTRCNT,RCVALUE
K ^TMP("RCBDPSLM",$J),^TMP("RCBDPSLMDATA",$J)
;
;
; get the last event (patient statement) entry
S RCEVENDA=$$LASTEVNT^RCBDFST1(RCDEBTDA)
I RCEVENDA D EVENTBAL^RCBDFST1(+RCEVENDA)
;
; build list of bills (original amount) by statement date
S RCDATE=0 F S RCDATE=$O(^PRCA(430,"ATD",RCDEBTDA,RCDATE)) Q:'RCDATE D
. S RCBILLDA=0 F S RCBILLDA=$O(^PRCA(430,"ATD",RCDEBTDA,RCDATE,RCBILLDA)) Q:'RCBILLDA D
. . S ORIGAMT=+$P(^PRCA(430,RCBILLDA,0),"^",3) I 'ORIGAMT Q
. . ;
. . ; estimate statement date
. . S RCSTATE=$P(RCEVENDA,"^",2)
. . I RCDATE>$P(RCEVENDA,"^",2) S RCSTATE=10000000
. . ;
. . S ^TMP("RCBDPSLMDATA",$J,RCDEBTDA,RCSTATE,RCDATE,0)=RCBILLDA_"^"_ORIGAMT
;
; build list of transactions by statement date
S RCDATE=0 F S RCDATE=$O(^PRCA(433,"ATD",RCDEBTDA,RCDATE)) Q:'RCDATE D
. S RCTRANDA=0 F S RCTRANDA=$O(^PRCA(433,"ATD",RCDEBTDA,RCDATE,RCTRANDA)) Q:'RCTRANDA D
. . ; get transaction value, no value, quit
. . S RCVALUE=$$TRANVALU^RCDPBTLM(RCTRANDA) I RCVALUE="" Q
. . ; special case for prepayments (26)
. . I $P(^PRCA(430,+$P($G(^PRCA(433,RCTRANDA,0)),"^",2),0),"^",2)=26 D
. . . S $P(RCVALUE,"^",2)=-$P(RCVALUE,"^",2)
. . ;
. . ; estimate statement date
. . S RCSTATE=$P(RCEVENDA,"^",2)
. . I RCDATE>$P(RCEVENDA,"^",2) S RCSTATE=10000000
. . I $P(^PRCA(433,RCTRANDA,0),"^",10) S RCSTATE=10000000
. . ;
. . S ^TMP("RCBDPSLMDATA",$J,RCDEBTDA,RCSTATE,RCDATE,RCTRANDA)=RCVALUE
;
D INITCONT^RCBDPSL1
Q
;
;
HDR ; header code for list manager display
D HDR^RCDPAPLM
Q
;
;
EXIT ; exit list manager option and clean up
K ^TMP("RCBDPSLM",$J),^TMP("RCBDPSLMDATA",$J)
Q
;
;
SELACCT() ; select a first party acct
; returns -1 for timeout or ^, 0 for no selection, or ien of bill
N %,%Y,C,DIC,DILN,DTOUT,DUOUT,X,Y
N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
S DIC="^RCD(340,",DIC(0)="QEAM",DIC("A")="Select First Party ACCOUNT: "
S DIC("S")="I $P($G(^RCD(340,+Y,0)),U)[""DPT("""
D ^DIC
I Y<0,'$G(DUOUT),'$G(DTOUT) S Y=0
Q +Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBDPSLM 2657 printed Dec 13, 2024@01:42:33 Page 2
RCBDPSLM ;WISC/RFJ-patient statement top list manager routine ;1 Dec 00
+1 ;;4.5;Accounts Receivable;**162,198**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 NEW RCDEBTDA
+5 ;
+6 FOR
Begin DoDot:1
+7 WRITE !!
SET RCDEBTDA=$$SELACCT
+8 IF RCDEBTDA<1
SET RCDEBTDA=0
QUIT
+9 DO EN^VALM("RCBD PATIENT STATEMENT")
End DoDot:1
if 'RCDEBTDA
QUIT
+10 QUIT
+11 ;
+12 ;
INIT ; initialization for list manager list
+1 NEW ORIGAMT,RCBILLDA,RCDATE,RCEVENDA,RCEVENT,RCFINCOM,RCLINE,RCOUTBAL,RCSTATE,RCSTDATE,RCTOTAL,RCTRANDA,RCTRCNT,RCVALUE
+2 KILL ^TMP("RCBDPSLM",$JOB),^TMP("RCBDPSLMDATA",$JOB)
+3 ;
+4 ;
+5 ; get the last event (patient statement) entry
+6 SET RCEVENDA=$$LASTEVNT^RCBDFST1(RCDEBTDA)
+7 IF RCEVENDA
DO EVENTBAL^RCBDFST1(+RCEVENDA)
+8 ;
+9 ; build list of bills (original amount) by statement date
+10 SET RCDATE=0
FOR
SET RCDATE=$ORDER(^PRCA(430,"ATD",RCDEBTDA,RCDATE))
if 'RCDATE
QUIT
Begin DoDot:1
+11 SET RCBILLDA=0
FOR
SET RCBILLDA=$ORDER(^PRCA(430,"ATD",RCDEBTDA,RCDATE,RCBILLDA))
if 'RCBILLDA
QUIT
Begin DoDot:2
+12 SET ORIGAMT=+$PIECE(^PRCA(430,RCBILLDA,0),"^",3)
IF 'ORIGAMT
QUIT
+13 ;
+14 ; estimate statement date
+15 SET RCSTATE=$PIECE(RCEVENDA,"^",2)
+16 IF RCDATE>$PIECE(RCEVENDA,"^",2)
SET RCSTATE=10000000
+17 ;
+18 SET ^TMP("RCBDPSLMDATA",$JOB,RCDEBTDA,RCSTATE,RCDATE,0)=RCBILLDA_"^"_ORIGAMT
End DoDot:2
End DoDot:1
+19 ;
+20 ; build list of transactions by statement date
+21 SET RCDATE=0
FOR
SET RCDATE=$ORDER(^PRCA(433,"ATD",RCDEBTDA,RCDATE))
if 'RCDATE
QUIT
Begin DoDot:1
+22 SET RCTRANDA=0
FOR
SET RCTRANDA=$ORDER(^PRCA(433,"ATD",RCDEBTDA,RCDATE,RCTRANDA))
if 'RCTRANDA
QUIT
Begin DoDot:2
+23 ; get transaction value, no value, quit
+24 SET RCVALUE=$$TRANVALU^RCDPBTLM(RCTRANDA)
IF RCVALUE=""
QUIT
+25 ; special case for prepayments (26)
+26 IF $PIECE(^PRCA(430,+$PIECE($GET(^PRCA(433,RCTRANDA,0)),"^",2),0),"^",2)=26
Begin DoDot:3
+27 SET $PIECE(RCVALUE,"^",2)=-$PIECE(RCVALUE,"^",2)
End DoDot:3
+28 ;
+29 ; estimate statement date
+30 SET RCSTATE=$PIECE(RCEVENDA,"^",2)
+31 IF RCDATE>$PIECE(RCEVENDA,"^",2)
SET RCSTATE=10000000
+32 IF $PIECE(^PRCA(433,RCTRANDA,0),"^",10)
SET RCSTATE=10000000
+33 ;
+34 SET ^TMP("RCBDPSLMDATA",$JOB,RCDEBTDA,RCSTATE,RCDATE,RCTRANDA)=RCVALUE
End DoDot:2
End DoDot:1
+35 ;
+36 DO INITCONT^RCBDPSL1
+37 QUIT
+38 ;
+39 ;
HDR ; header code for list manager display
+1 DO HDR^RCDPAPLM
+2 QUIT
+3 ;
+4 ;
EXIT ; exit list manager option and clean up
+1 KILL ^TMP("RCBDPSLM",$JOB),^TMP("RCBDPSLMDATA",$JOB)
+2 QUIT
+3 ;
+4 ;
SELACCT() ; select a first party acct
+1 ; returns -1 for timeout or ^, 0 for no selection, or ien of bill
+2 NEW %,%Y,C,DIC,DILN,DTOUT,DUOUT,X,Y
+3 NEW DPTNOFZY,DPTNOFZK
SET (DPTNOFZY,DPTNOFZK)=1
+4 SET DIC="^RCD(340,"
SET DIC(0)="QEAM"
SET DIC("A")="Select First Party ACCOUNT: "
+5 SET DIC("S")="I $P($G(^RCD(340,+Y,0)),U)[""DPT("""
+6 DO ^DIC
+7 IF Y<0
IF '$GET(DUOUT)
IF '$GET(DTOUT)
SET Y=0
+8 QUIT +Y
