RCDPAPST ;WISC/RFJ-account profile bill status select ;1 Jun 99
;;4.5;Accounts Receivable;**114,168**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
SELSTAT ; select a status called from listmanager
D FULL^VALM1
S VALMBCK="R"
;
W !!,"This option will allow you to specify which bill statuses to display."
D GETSTAT(RCDEBTDA)
;
D INIT^RCDPAPLM
Q
;
;
GETSTAT(RCDEBTDA) ; select the list of statuses of bills to display for an account
; if rcdebtda passed, it will show selectable statuses for this account
N %,DIR,DIRUT,RCRJFLAG,RCSTAT,RCSTATSL,STATDA,STATLIST,X,Y
;
; get the status list for the user
D STATDEF
;
; build list of possible statuses for AR package (show statuses used)
S STATLIST=""
S STATDA=0 F S STATDA=$O(^PRCA(430,"ASDT",STATDA)) Q:'STATDA D
. S RCSTAT(STATDA)=$P($G(^PRCA(430.3,STATDA,0)),"^")
. S STATLIST=STATLIST_STATDA_":"_$E(RCSTAT(STATDA),1,20)_";"
S STATLIST=STATLIST_"*:ALL statuses;-:NO statuses;"
;
F D Q:$G(RCRJFLAG)
. D SHOWSTAT(RCDEBTDA)
. S DIR(0)="SOA^"_STATLIST,DIR("A")="Select STATUS of bills to display: "
. D ^DIR
. I $D(DIRUT) S RCRJFLAG=1 Q
. I Y="*" S %=0 F S %=$O(RCSTAT(%)) Q:'% S RCSTATSL(%)=1
. I Y="-" K RCSTATSL Q
. S Y=+Y
. I $D(RCSTAT(Y)) D
. . I $D(RCSTATSL(Y)) K RCSTATSL(Y) W " un-selected" Q
. . S RCSTATSL(Y)=1 W " selected"
;
; save as default for user
S STATLIST=""
S STATDA=0 F S STATDA=$O(RCSTATSL(STATDA)) Q:'STATDA S STATLIST=STATLIST_STATDA_"^"
S ^DISV(DUZ,"RCDPAPLM","STATUS")=STATLIST
Q
;
;
STATDEF ; get list of statuses for the user
; returns RCSTATSL(statda)
N %,STATDA
; build default selected statuses
K RCSTATSL
F %=1:1 S STATDA=$P($G(^DISV(DUZ,"RCDPAPLM","STATUS")),"^",%) Q:'STATDA S RCSTATSL(STATDA)=1
Q
;
;
DEFAULT ; set the default statuses
W !
W !,"When using this option, you have the option to select bills to display by"
W !,"status. You can select a list of statuses of the bills to display. After"
W !,"you select the list of statuses, the option will retain the list of selected"
W !,"statuses for the next time you enter this option. Since you currently do"
W !,"not have any statuses selected for your list, the default statuses of"
W !,"active, open, pending calm, and refund review will be automatically"
W !,"selected for your list now."
; active(16), open(42), pending calm(21), refund review(44)
S ^DISV(DUZ,"RCDPAPLM","STATUS")="16^42^21^44"
Q
;
;
SHOWSTAT(RCDEBTDA) ; show list of statuses
N OFFSET,STARS,STATDA
W !!?3,"The following is a list of available statuses for bills:"
W !?3,"--------------------------------------------------------"
S OFFSET=0
S STATDA=0 F S STATDA=$O(RCSTAT(STATDA)) Q:'STATDA D
. I OFFSET=0 W !
. W ?(OFFSET)
. ; does account have bills under status, if yes show stars
. S STARS=" "
. I $G(RCDEBTDA),$D(^PRCA(430,"AS",RCDEBTDA,STATDA)) S STARS="**"
. W STARS," ",$E(STATDA_" ",1,2)," ",$E(RCSTAT(STATDA)_" ",1,16)
. ; user has status selected
. I $G(RCSTATSL(STATDA)) W " selected"
. S OFFSET=OFFSET+44
. I OFFSET>44 S OFFSET=0
W !,"** indicates account has bills under status **",!
Q
;
;
GETBILLS(RCDEBTDA) ; bills for account
; returns a list of bills in ^tmp("rcdpapst",$j,actdate,status,bill)
N BILLDA,DATE,STATDA
K ^TMP("RCDPAPST",$J)
;
S STATDA=0 F S STATDA=$O(^PRCA(430,"AS",RCDEBTDA,STATDA)) Q:'STATDA D
. S BILLDA=0 F S BILLDA=$O(^PRCA(430,"AS",RCDEBTDA,STATDA,BILLDA)) Q:'BILLDA D
. . S DATE=$P($G(^PRCA(430,BILLDA,6)),"^",21) I 'DATE Q
. . S ^TMP("RCDPAPST",$J,$P(DATE,"."),STATDA,BILLDA)=$$BILLBAL(BILLDA,0)
Q
;
;
BILLBAL(BILLDA,EXTERNAL) ; return a bills current balance principal ^ interest ^ admin
; set the external flag if data is being reported to an external system
; like fms, ndb, ig, etc.
N ADMIN,CATEG,DATA7,INTEREST,PRINCPAL,STATDA
S DATA7=$G(^PRCA(430,BILLDA,7))
S PRINCPAL=$P(DATA7,"^")
S INTEREST=$P(DATA7,"^",2)
S ADMIN=$P(DATA7,"^",3)+$P(DATA7,"^",4)+$P(DATA7,"^",5)
;
S CATEG=$P(^PRCA(430,BILLDA,0),"^",2),STATDA=$P(^(0),"^",8)
;
; special case for prepayments (26)
I CATEG=26 D
. S PRINCPAL=-PRINCPAL,(INTEREST,ADMIN)=0
. ; bill status not open, active, or in refund review
. I STATDA'=42,STATDA'=16,STATDA'=44 S PRINCPAL=0
;
; if the bill's status is write-off, balance and int = 0
I STATDA=23 S (PRINCPAL,INTEREST,ADMIN)=0
; if the bill's status is suspended, balance and int = 0
; this would be for collecting payments only, external systems
; still would get the bills balance
I STATDA=40,'$G(EXTERNAL) S (PRINCPAL,INTEREST,ADMIN)=0
;
Q PRINCPAL_"^"_INTEREST_"^"_ADMIN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPAPST 4842 printed Sep 23, 2025@19:19:52 Page 2
RCDPAPST ;WISC/RFJ-account profile bill status select ;1 Jun 99
+1 ;;4.5;Accounts Receivable;**114,168**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
SELSTAT ; select a status called from listmanager
+1 DO FULL^VALM1
+2 SET VALMBCK="R"
+3 ;
+4 WRITE !!,"This option will allow you to specify which bill statuses to display."
+5 DO GETSTAT(RCDEBTDA)
+6 ;
+7 DO INIT^RCDPAPLM
+8 QUIT
+9 ;
+10 ;
GETSTAT(RCDEBTDA) ; select the list of statuses of bills to display for an account
+1 ; if rcdebtda passed, it will show selectable statuses for this account
+2 NEW %,DIR,DIRUT,RCRJFLAG,RCSTAT,RCSTATSL,STATDA,STATLIST,X,Y
+3 ;
+4 ; get the status list for the user
+5 DO STATDEF
+6 ;
+7 ; build list of possible statuses for AR package (show statuses used)
+8 SET STATLIST=""
+9 SET STATDA=0
FOR
SET STATDA=$ORDER(^PRCA(430,"ASDT",STATDA))
if 'STATDA
QUIT
Begin DoDot:1
+10 SET RCSTAT(STATDA)=$PIECE($GET(^PRCA(430.3,STATDA,0)),"^")
+11 SET STATLIST=STATLIST_STATDA_":"_$EXTRACT(RCSTAT(STATDA),1,20)_";"
End DoDot:1
+12 SET STATLIST=STATLIST_"*:ALL statuses;-:NO statuses;"
+13 ;
+14 FOR
Begin DoDot:1
+15 DO SHOWSTAT(RCDEBTDA)
+16 SET DIR(0)="SOA^"_STATLIST
SET DIR("A")="Select STATUS of bills to display: "
+17 DO ^DIR
+18 IF $DATA(DIRUT)
SET RCRJFLAG=1
QUIT
+19 IF Y="*"
SET %=0
FOR
SET %=$ORDER(RCSTAT(%))
if '%
QUIT
SET RCSTATSL(%)=1
+20 IF Y="-"
KILL RCSTATSL
QUIT
+21 SET Y=+Y
+22 IF $DATA(RCSTAT(Y))
Begin DoDot:2
+23 IF $DATA(RCSTATSL(Y))
KILL RCSTATSL(Y)
WRITE " un-selected"
QUIT
+24 SET RCSTATSL(Y)=1
WRITE " selected"
End DoDot:2
End DoDot:1
if $GET(RCRJFLAG)
QUIT
+25 ;
+26 ; save as default for user
+27 SET STATLIST=""
+28 SET STATDA=0
FOR
SET STATDA=$ORDER(RCSTATSL(STATDA))
if 'STATDA
QUIT
SET STATLIST=STATLIST_STATDA_"^"
+29 SET ^DISV(DUZ,"RCDPAPLM","STATUS")=STATLIST
+30 QUIT
+31 ;
+32 ;
STATDEF ; get list of statuses for the user
+1 ; returns RCSTATSL(statda)
+2 NEW %,STATDA
+3 ; build default selected statuses
+4 KILL RCSTATSL
+5 FOR %=1:1
SET STATDA=$PIECE($GET(^DISV(DUZ,"RCDPAPLM","STATUS")),"^",%)
if 'STATDA
QUIT
SET RCSTATSL(STATDA)=1
+6 QUIT
+7 ;
+8 ;
DEFAULT ; set the default statuses
+1 WRITE !
+2 WRITE !,"When using this option, you have the option to select bills to display by"
+3 WRITE !,"status. You can select a list of statuses of the bills to display. After"
+4 WRITE !,"you select the list of statuses, the option will retain the list of selected"
+5 WRITE !,"statuses for the next time you enter this option. Since you currently do"
+6 WRITE !,"not have any statuses selected for your list, the default statuses of"
+7 WRITE !,"active, open, pending calm, and refund review will be automatically"
+8 WRITE !,"selected for your list now."
+9 ; active(16), open(42), pending calm(21), refund review(44)
+10 SET ^DISV(DUZ,"RCDPAPLM","STATUS")="16^42^21^44"
+11 QUIT
+12 ;
+13 ;
SHOWSTAT(RCDEBTDA) ; show list of statuses
+1 NEW OFFSET,STARS,STATDA
+2 WRITE !!?3,"The following is a list of available statuses for bills:"
+3 WRITE !?3,"--------------------------------------------------------"
+4 SET OFFSET=0
+5 SET STATDA=0
FOR
SET STATDA=$ORDER(RCSTAT(STATDA))
if 'STATDA
QUIT
Begin DoDot:1
+6 IF OFFSET=0
WRITE !
+7 WRITE ?(OFFSET)
+8 ; does account have bills under status, if yes show stars
+9 SET STARS=" "
+10 IF $GET(RCDEBTDA)
IF $DATA(^PRCA(430,"AS",RCDEBTDA,STATDA))
SET STARS="**"
+11 WRITE STARS," ",$EXTRACT(STATDA_" ",1,2)," ",$EXTRACT(RCSTAT(STATDA)_" ",1,16)
+12 ; user has status selected
+13 IF $GET(RCSTATSL(STATDA))
WRITE " selected"
+14 SET OFFSET=OFFSET+44
+15 IF OFFSET>44
SET OFFSET=0
End DoDot:1
+16 WRITE !,"** indicates account has bills under status **",!
+17 QUIT
+18 ;
+19 ;
GETBILLS(RCDEBTDA) ; bills for account
+1 ; returns a list of bills in ^tmp("rcdpapst",$j,actdate,status,bill)
+2 NEW BILLDA,DATE,STATDA
+3 KILL ^TMP("RCDPAPST",$JOB)
+4 ;
+5 SET STATDA=0
FOR
SET STATDA=$ORDER(^PRCA(430,"AS",RCDEBTDA,STATDA))
if 'STATDA
QUIT
Begin DoDot:1
+6 SET BILLDA=0
FOR
SET BILLDA=$ORDER(^PRCA(430,"AS",RCDEBTDA,STATDA,BILLDA))
if 'BILLDA
QUIT
Begin DoDot:2
+7 SET DATE=$PIECE($GET(^PRCA(430,BILLDA,6)),"^",21)
IF 'DATE
QUIT
+8 SET ^TMP("RCDPAPST",$JOB,$PIECE(DATE,"."),STATDA,BILLDA)=$$BILLBAL(BILLDA,0)
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
+11 ;
BILLBAL(BILLDA,EXTERNAL) ; return a bills current balance principal ^ interest ^ admin
+1 ; set the external flag if data is being reported to an external system
+2 ; like fms, ndb, ig, etc.
+3 NEW ADMIN,CATEG,DATA7,INTEREST,PRINCPAL,STATDA
+4 SET DATA7=$GET(^PRCA(430,BILLDA,7))
+5 SET PRINCPAL=$PIECE(DATA7,"^")
+6 SET INTEREST=$PIECE(DATA7,"^",2)
+7 SET ADMIN=$PIECE(DATA7,"^",3)+$PIECE(DATA7,"^",4)+$PIECE(DATA7,"^",5)
+8 ;
+9 SET CATEG=$PIECE(^PRCA(430,BILLDA,0),"^",2)
SET STATDA=$PIECE(^(0),"^",8)
+10 ;
+11 ; special case for prepayments (26)
+12 IF CATEG=26
Begin DoDot:1
+13 SET PRINCPAL=-PRINCPAL
SET (INTEREST,ADMIN)=0
+14 ; bill status not open, active, or in refund review
+15 IF STATDA'=42
IF STATDA'=16
IF STATDA'=44
SET PRINCPAL=0
End DoDot:1
+16 ;
+17 ; if the bill's status is write-off, balance and int = 0
+18 IF STATDA=23
SET (PRINCPAL,INTEREST,ADMIN)=0
+19 ; if the bill's status is suspended, balance and int = 0
+20 ; this would be for collecting payments only, external systems
+21 ; still would get the bills balance
+22 IF STATDA=40
IF '$GET(EXTERNAL)
SET (PRINCPAL,INTEREST,ADMIN)=0
+23 ;
+24 QUIT PRINCPAL_"^"_INTEREST_"^"_ADMIN
