- 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 Feb 18, 2025@23:10:13 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