RCDPAPL1 ;WISC/RFJ-account profile listmanager options ;1 Jun 99
;;4.5;Accounts Receivable;**114,315**;Mar 20, 1995;Build 67
;;Per VA Directive 6402, this routine should not be modified.
Q
;
ACCOUNT ; select a new account
D FULL^VALM1
S VALMBCK="R"
;
W !!,"This option will allow you to select a new account."
W ! S %=$$SELACCT^RCDPAPLM
I %<1 Q
S RCDEBTDA=%
;
D INIT^RCDPAPLM
Q
;
BILLTRAN ; show transactions for a bill
N RCBILLDA
S VALMBCK="R"
;
S RCBILLDA=$$SELBILL I 'RCBILLDA Q
D EN^VALM("RCDP TRANSACTIONS LIST")
;
D INIT^RCDPAPLM
S VALMBCK="R"
; fast exit
I $G(RCDPFXIT) S VALMBCK="Q"
Q
;
BILLPROF ; bill profile
N RCBILLDA
S VALMBCK="R"
;
S RCBILLDA=$$SELBILL I 'RCBILLDA Q
D EN^VALM("RCDP BILL PROFILE")
;
D INIT^RCDPAPLM
S VALMBCK="R"
; fast exit
I $G(RCDPFXIT) S VALMBCK="Q"
Q
;
SELBILL() ; select bill from list
N VALMBG,VALMLST,VALMY
; if no bills, quit
I '$O(^TMP("RCDPAPLM",$J,"IDX",0)) S VALMSG="There are NO bills to profile." Q 0
;
; if only one bill, select that one automatically
I '$O(^TMP("RCDPAPLM",$J,"IDX",1)) Q +$G(^TMP("RCDPAPLM",$J,"IDX",1,1))
;
; select the entry from the list
; if not on first screen, make sure selection begins with 1
S VALMBG=1
; if not on last screen, make sure selection ends with last
S VALMLST=$O(^TMP("RCDPAPLM",$J,"IDX",999999999),-1)
D EN^VALM2($G(XQORNOD(0)),"OS")
Q +$G(^TMP("RCDPAPLM",$J,"IDX",+$O(VALMY(0)),+$O(VALMY(0))))
;
SELMULT(VALMY) ; select 0, 1, or more bills from the list
; Output VALMY array, pass by reference. Return format is VALMY(#)=""
; The calling routine must then process any of the entries found in the VALMY array, one at a time.
;
N VALMBG,VALMLST
K VALMY
;
; if no bills in list, then update screen message and exit
I '$O(@VALMAR@("IDX",0)) S VALMSG="There are no bills to select." G SELMX
;
; if there is only 1 bill in list then add that one into the VALMY array and quit
I '$O(@VALMAR@("IDX",1)) S VALMY(1)="" G SELMX
;
; Multiple bills in list. Ask user to select 1 or more of them
S VALMBG=1 ; first possible entry
S VALMLST=$O(@VALMAR@("IDX",999999999),-1) ; last possible entry
;
; call the selector API
D EN^VALM2($G(XQORNOD(0)),"O")
;
SELMX ;
Q
;
SUSPEND ;Suspend a Bill PRCA*4.5*315
N GOTBILL,VALMY,RCBILLDA,RCDPGN,RCDPGC,RCDPGT,RCDPGQ,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
D FULL^VALM1
D SELMULT(.VALMY) I '$O(VALMY(0)) G SUSPX
;
; count the number of selected entries and put into RCDPGT
S RCDPGN=0 F RCDPGT=0:1 S RCDPGN=$O(VALMY(RCDPGN)) Q:'RCDPGN
;
W !
S (RCDPGN,RCDPGC)=0 F S RCDPGN=$O(VALMY(RCDPGN)) Q:'RCDPGN D Q:$G(RCDPFXIT)!$G(RCDPGQ)
. S RCBILLDA=$G(@VALMAR@("IDX",RCDPGN,RCDPGN)) Q:'RCBILLDA
. S RCDPGC=RCDPGC+1
. W !," ======== Bill# ",$P($P($G(^PRCA(430,RCBILLDA,0)),U,1),"-",2)," (",RCDPGC," of ",RCDPGT," selected) ========",!
. S GOTBILL=1
. D 47^RCWROFF ; Call into existing write-off routine for each bill selected
. I $G(RCDPGQ) W " ... exiting Bill# loop" Q
. ;
. ; special break in between each bill
. W ! S DIR(0)="E" S DIR("A")="Type <Enter> to continue"
. I (RCDPGT-RCDPGC)>0 S DIR("A")=DIR("A")_" or '^' to exit this Bill# loop" ; if there are still more bills in loop
. D ^DIR K DIR W !
. I $D(DIRUT) S RCDPGQ=1
. Q
;
D INIT^RCDPAPLM ; refresh the account profile list of bills
;
SUSPX ;
S VALMBCK="R"
I $G(RCDPFXIT) S VALMBCK="Q"
Q
;
REESTAB ; Re-Establish a Bill - PRCA*4.5*315
N GOTBILL,VALMY,RCBILLDA,RCDPGN,RCDPGC,RCDPGT,RCDPGQ,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
D FULL^VALM1
D SELMULT(.VALMY) I '$O(VALMY(0)) G REESTX
;
; count the number of selected entries and put into RCDPGT
S RCDPGN=0 F RCDPGT=0:1 S RCDPGN=$O(VALMY(RCDPGN)) Q:'RCDPGN
;
W !
S (RCDPGN,RCDPGC)=0 F S RCDPGN=$O(VALMY(RCDPGN)) Q:'RCDPGN D Q:$G(RCDPFXIT)!$G(RCDPGQ)
. S RCBILLDA=$G(@VALMAR@("IDX",RCDPGN,RCDPGN)) Q:'RCBILLDA
. S RCDPGC=RCDPGC+1
. W !," ======== Bill# ",$P($P($G(^PRCA(430,RCBILLDA,0)),U,1),"-",2)," (",RCDPGC," of ",RCDPGT," selected) ========",!
. S GOTBILL=1
. D ENAP^PRCAWREA(RCBILLDA) ; Call into existing Re-Establish bill routine for each bill selected
. ;
. ; special break in between each bill
. W ! S DIR(0)="E" S DIR("A")="Type <Enter> to continue"
. I (RCDPGT-RCDPGC)>0 S DIR("A")=DIR("A")_" or '^' to exit this Bill# loop" ; if there are still more bills in loop
. D ^DIR K DIR W !
. I $D(DIRUT) S RCDPGQ=1
. Q
;
D INIT^RCDPAPLM ; refresh the account profile list of bills
;
REESTX ;
S VALMBCK="R"
I $G(RCDPFXIT) S VALMBCK="Q"
Q
;
STOP ;Stop a Bill in Cross-servicing (Debtor) PRCA*4.5*315
N GOTBILL,VALMY,RCBILLDA,RCDPGN,RCDPGC,RCDPGT,RCDPGQ,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
D FULL^VALM1
D SELMULT(.VALMY) I '$O(VALMY(0)) G STOPX
;
; count the number of selected entries and put into RCDPGT
S RCDPGN=0 F RCDPGT=0:1 S RCDPGN=$O(VALMY(RCDPGN)) Q:'RCDPGN
;
W !
S (RCDPGN,RCDPGC)=0 F S RCDPGN=$O(VALMY(RCDPGN)) Q:'RCDPGN D Q:$G(RCDPFXIT)!$G(RCDPGQ)
. S RCBILLDA=$G(@VALMAR@("IDX",RCDPGN,RCDPGN)) Q:'RCBILLDA
. S RCDPGC=RCDPGC+1
. W !," ======== Bill# ",$P($P($G(^PRCA(430,RCBILLDA,0)),U,1),"-",2)," (",RCDPGC," of ",RCDPGT," selected) ========",!
. S GOTBILL=1
. D STOP^RCTCSPU ;Call into existing TOP routine for each bill selected
. I $G(RCDPGQ) W " ... exiting Bill# loop" Q
. ;
. ; special break in between each bill
. W ! S DIR(0)="E" S DIR("A")="Type <Enter> to continue"
. I (RCDPGT-RCDPGC)>0 S DIR("A")=DIR("A")_" or '^' to exit this Bill# loop" ; if there are still more bills in loop
. D ^DIR K DIR W !
. I $D(DIRUT) S RCDPGQ=1
. Q
;
D INIT^RCDPAPLM ; refresh the account profile list of bills
;
STOPX ;
S VALMBCK="R"
I $G(RCDPFXIT) S VALMBCK="Q"
Q
;
TERM ;Fiscal Officer Terminated PRCA*4.5*315
N GOTBILL,VALMY,RCBILLDA,RCDPGN,RCDPGC,RCDPGT,RCDPGQ,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
D FULL^VALM1
D SELMULT(.VALMY) I '$O(VALMY(0)) G TERMX
;
; count the number of selected entries and put into RCDPGT
S RCDPGN=0 F RCDPGT=0:1 S RCDPGN=$O(VALMY(RCDPGN)) Q:'RCDPGN
;
W !
S (RCDPGN,RCDPGC)=0 F S RCDPGN=$O(VALMY(RCDPGN)) Q:'RCDPGN D Q:$G(RCDPFXIT)!$G(RCDPGQ)
. S RCBILLDA=$G(@VALMAR@("IDX",RCDPGN,RCDPGN)) Q:'RCBILLDA
. S RCDPGC=RCDPGC+1
. W !," ======== Bill# ",$P($P($G(^PRCA(430,RCBILLDA,0)),U,1),"-",2)," (",RCDPGC," of ",RCDPGT," selected) ========",!
. S GOTBILL=1
. D 8^RCWROFF ; Call into existing write-off routine for each bill selected
. I $G(RCDPGQ) W " ... exiting Bill# loop" Q
. ;
. ; special break in between each bill
. W ! S DIR(0)="E" S DIR("A")="Type <Enter> to continue"
. I (RCDPGT-RCDPGC)>0 S DIR("A")=DIR("A")_" or '^' to exit this Bill# loop" ; if there are still more bills in loop
. D ^DIR K DIR W !
. I $D(DIRUT) S RCDPGQ=1
. Q
;
D INIT^RCDPAPLM ; refresh the account profile list of bills
;
TERMX ;
S VALMBCK="R"
I $G(RCDPFXIT) S VALMBCK="Q"
Q
;
RECALLB ;Recall a Bill PRCA*4.5*315
N GOTBILL,VALMY,RCBILLDA,RCDPGN,RCDPGC,RCDPGT,RCDPGQ,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
D FULL^VALM1
D SELMULT(.VALMY) I '$O(VALMY(0)) G RECALBX
;
; count the number of selected entries and put into RCDPGT
S RCDPGN=0 F RCDPGT=0:1 S RCDPGN=$O(VALMY(RCDPGN)) Q:'RCDPGN
;
W !
S (RCDPGN,RCDPGC)=0 F S RCDPGN=$O(VALMY(RCDPGN)) Q:'RCDPGN D Q:$G(RCDPFXIT)!$G(RCDPGQ)
. S RCBILLDA=$G(@VALMAR@("IDX",RCDPGN,RCDPGN)) Q:'RCBILLDA
. S RCDPGC=RCDPGC+1
. W !," ======== Bill# ",$P($P($G(^PRCA(430,RCBILLDA,0)),U,1),"-",2)," (",RCDPGC," of ",RCDPGT," selected) ========",!
. S GOTBILL=1
. D RCLLSETB^RCTCSPU ; Call into existing recall code
. I $G(RCDPGQ) W " ... exiting Bill# loop" Q
. ;
. ; special break in between each bill
. W ! S DIR(0)="E" S DIR("A")="Type <Enter> to continue"
. I (RCDPGT-RCDPGC)>0 S DIR("A")=DIR("A")_" or '^' to exit this Bill# loop" ; if there are still more bills in loop
. D ^DIR K DIR W !
. I $D(DIRUT) S RCDPGQ=1
. Q
;
D INIT^RCDPAPLM ; refresh the account profile list of bills
;
RECALBX ;
S VALMBCK="R"
I $G(RCDPFXIT) S VALMBCK="Q"
Q
;
RECALLD ;Recall a Debtor PRCA*4.5*315
N GOTDEBT,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
D FULL^VALM1
S RCDEBTDA=+$G(RCDEBTDA) ; RCDEBTDA is set by the ACCTPR^RCTCSWL - Account Profile action protocol
I 'RCDEBTDA G RECALDX
;
S GOTDEBT=1
D RCLLSETD^RCTCSPU ; Call into existing recall code for debtors
D PAUSE^VALM1
D INIT^RCDPAPLM ; refresh the account profile list of bills
RECALDX ;
S VALMBCK="R"
I $G(RCDPFXIT) S VALMBCK="Q"
Q
;
INC ;Increase Transaction PRCA*4.5*315
N GOTBILL,VALMY,RCBILLDA,RCDPGN,RCDPGC,RCDPGT,RCDPGQ,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
D FULL^VALM1
;
; check on security key - same one used in the menu system for AR option PRCAC TR ADJUSTMENT
I '$D(^XUSEC("PRCADJ",DUZ)) D G INCX
. W *7,!!?3,"You must hold the PRCADJ security key in order to access this option.",!
. D PAUSE^VALM1
. Q
;
D SELMULT(.VALMY) I '$O(VALMY(0)) G INCX
;
; count the number of selected entries and put into RCDPGT
S RCDPGN=0 F RCDPGT=0:1 S RCDPGN=$O(VALMY(RCDPGN)) Q:'RCDPGN
;
W !
S (RCDPGN,RCDPGC)=0 F S RCDPGN=$O(VALMY(RCDPGN)) Q:'RCDPGN D Q:$G(RCDPFXIT)!$G(RCDPGQ)
. S RCBILLDA=$G(@VALMAR@("IDX",RCDPGN,RCDPGN)) Q:'RCBILLDA
. S RCDPGC=RCDPGC+1
. W !," ======== Bill# ",$P($P($G(^PRCA(430,RCBILLDA,0)),U,1),"-",2)," (",RCDPGC," of ",RCDPGT," selected) ========",!
. S GOTBILL=1
. D INCREASE^RCBEADJ ; Call into existing increase code
. I $G(RCDPGQ) W " ... exiting Bill# loop" Q
. ;
. ; special break in between each bill
. W ! S DIR(0)="E" S DIR("A")="Type <Enter> to continue"
. I (RCDPGT-RCDPGC)>0 S DIR("A")=DIR("A")_" or '^' to exit this Bill# loop" ; if there are still more bills in loop
. D ^DIR K DIR W !
. I $D(DIRUT) S RCDPGQ=1
. Q
;
D INIT^RCDPAPLM ; refresh the account profile list of bills
;
INCX ;
S VALMBCK="R"
I $G(RCDPFXIT) S VALMBCK="Q"
Q
;
DEC ;Decrease Transaction PRCA*4.5*315
N GOTBILL,VALMY,RCBILLDA,RCDPGN,RCDPGC,RCDPGT,RCDPGQ,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
D FULL^VALM1
;
; check on security key - same one used in the menu system for AR option PRCAC TR ADJUSTMENT
I '$D(^XUSEC("PRCADJ",DUZ)) D G DECX
. W *7,!!?3,"You must hold the PRCADJ security key in order to access this option.",!
. D PAUSE^VALM1
. Q
;
D SELMULT(.VALMY) I '$O(VALMY(0)) G DECX
;
; count the number of selected entries and put into RCDPGT
S RCDPGN=0 F RCDPGT=0:1 S RCDPGN=$O(VALMY(RCDPGN)) Q:'RCDPGN
;
W !
S (RCDPGN,RCDPGC)=0 F S RCDPGN=$O(VALMY(RCDPGN)) Q:'RCDPGN D Q:$G(RCDPFXIT)!$G(RCDPGQ)
. S RCBILLDA=$G(@VALMAR@("IDX",RCDPGN,RCDPGN)) Q:'RCBILLDA
. S RCDPGC=RCDPGC+1
. W !," ======== Bill# ",$P($P($G(^PRCA(430,RCBILLDA,0)),U,1),"-",2)," (",RCDPGC," of ",RCDPGT," selected) ========",!
. S GOTBILL=1
. D DECREASE^RCBEADJ ; Call into existing decrease code
. I $G(RCDPGQ) W " ... exiting Bill# loop" Q
. ;
. ; special break in between each bill
. W ! S DIR(0)="E" S DIR("A")="Type <Enter> to continue"
. I (RCDPGT-RCDPGC)>0 S DIR("A")=DIR("A")_" or '^' to exit this Bill# loop" ; if there are still more bills in loop
. D ^DIR K DIR W !
. I $D(DIRUT) S RCDPGQ=1
. Q
;
D INIT^RCDPAPLM ; refresh the account profile list of bills
;
DECX ;
S VALMBCK="R"
I $G(RCDPFXIT) S VALMBCK="Q"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPAPL1 11545 printed Sep 23, 2025@19:19:49 Page 2
RCDPAPL1 ;WISC/RFJ-account profile listmanager options ;1 Jun 99
+1 ;;4.5;Accounts Receivable;**114,315**;Mar 20, 1995;Build 67
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
ACCOUNT ; select a new account
+1 DO FULL^VALM1
+2 SET VALMBCK="R"
+3 ;
+4 WRITE !!,"This option will allow you to select a new account."
+5 WRITE !
SET %=$$SELACCT^RCDPAPLM
+6 IF %<1
QUIT
+7 SET RCDEBTDA=%
+8 ;
+9 DO INIT^RCDPAPLM
+10 QUIT
+11 ;
BILLTRAN ; show transactions for a bill
+1 NEW RCBILLDA
+2 SET VALMBCK="R"
+3 ;
+4 SET RCBILLDA=$$SELBILL
IF 'RCBILLDA
QUIT
+5 DO EN^VALM("RCDP TRANSACTIONS LIST")
+6 ;
+7 DO INIT^RCDPAPLM
+8 SET VALMBCK="R"
+9 ; fast exit
+10 IF $GET(RCDPFXIT)
SET VALMBCK="Q"
+11 QUIT
+12 ;
BILLPROF ; bill profile
+1 NEW RCBILLDA
+2 SET VALMBCK="R"
+3 ;
+4 SET RCBILLDA=$$SELBILL
IF 'RCBILLDA
QUIT
+5 DO EN^VALM("RCDP BILL PROFILE")
+6 ;
+7 DO INIT^RCDPAPLM
+8 SET VALMBCK="R"
+9 ; fast exit
+10 IF $GET(RCDPFXIT)
SET VALMBCK="Q"
+11 QUIT
+12 ;
SELBILL() ; select bill from list
+1 NEW VALMBG,VALMLST,VALMY
+2 ; if no bills, quit
+3 IF '$ORDER(^TMP("RCDPAPLM",$JOB,"IDX",0))
SET VALMSG="There are NO bills to profile."
QUIT 0
+4 ;
+5 ; if only one bill, select that one automatically
+6 IF '$ORDER(^TMP("RCDPAPLM",$JOB,"IDX",1))
QUIT +$GET(^TMP("RCDPAPLM",$JOB,"IDX",1,1))
+7 ;
+8 ; select the entry from the list
+9 ; if not on first screen, make sure selection begins with 1
+10 SET VALMBG=1
+11 ; if not on last screen, make sure selection ends with last
+12 SET VALMLST=$ORDER(^TMP("RCDPAPLM",$JOB,"IDX",999999999),-1)
+13 DO EN^VALM2($GET(XQORNOD(0)),"OS")
+14 QUIT +$GET(^TMP("RCDPAPLM",$JOB,"IDX",+$ORDER(VALMY(0)),+$ORDER(VALMY(0))))
+15 ;
SELMULT(VALMY) ; select 0, 1, or more bills from the list
+1 ; Output VALMY array, pass by reference. Return format is VALMY(#)=""
+2 ; The calling routine must then process any of the entries found in the VALMY array, one at a time.
+3 ;
+4 NEW VALMBG,VALMLST
+5 KILL VALMY
+6 ;
+7 ; if no bills in list, then update screen message and exit
+8 IF '$ORDER(@VALMAR@("IDX",0))
SET VALMSG="There are no bills to select."
GOTO SELMX
+9 ;
+10 ; if there is only 1 bill in list then add that one into the VALMY array and quit
+11 IF '$ORDER(@VALMAR@("IDX",1))
SET VALMY(1)=""
GOTO SELMX
+12 ;
+13 ; Multiple bills in list. Ask user to select 1 or more of them
+14 ; first possible entry
SET VALMBG=1
+15 ; last possible entry
SET VALMLST=$ORDER(@VALMAR@("IDX",999999999),-1)
+16 ;
+17 ; call the selector API
+18 DO EN^VALM2($GET(XQORNOD(0)),"O")
+19 ;
SELMX ;
+1 QUIT
+2 ;
SUSPEND ;Suspend a Bill PRCA*4.5*315
+1 NEW GOTBILL,VALMY,RCBILLDA,RCDPGN,RCDPGC,RCDPGT,RCDPGQ,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
+2 DO FULL^VALM1
+3 DO SELMULT(.VALMY)
IF '$ORDER(VALMY(0))
GOTO SUSPX
+4 ;
+5 ; count the number of selected entries and put into RCDPGT
+6 SET RCDPGN=0
FOR RCDPGT=0:1
SET RCDPGN=$ORDER(VALMY(RCDPGN))
if 'RCDPGN
QUIT
+7 ;
+8 WRITE !
+9 SET (RCDPGN,RCDPGC)=0
FOR
SET RCDPGN=$ORDER(VALMY(RCDPGN))
if 'RCDPGN
QUIT
Begin DoDot:1
+10 SET RCBILLDA=$GET(@VALMAR@("IDX",RCDPGN,RCDPGN))
if 'RCBILLDA
QUIT
+11 SET RCDPGC=RCDPGC+1
+12 WRITE !," ======== Bill# ",$PIECE($PIECE($GET(^PRCA(430,RCBILLDA,0)),U,1),"-",2)," (",RCDPGC," of ",RCDPGT," selected) ========",!
+13 SET GOTBILL=1
+14 ; Call into existing write-off routine for each bill selected
DO 47^RCWROFF
+15 IF $GET(RCDPGQ)
WRITE " ... exiting Bill# loop"
QUIT
+16 ;
+17 ; special break in between each bill
+18 WRITE !
SET DIR(0)="E"
SET DIR("A")="Type <Enter> to continue"
+19 ; if there are still more bills in loop
IF (RCDPGT-RCDPGC)>0
SET DIR("A")=DIR("A")_" or '^' to exit this Bill# loop"
+20 DO ^DIR
KILL DIR
WRITE !
+21 IF $DATA(DIRUT)
SET RCDPGQ=1
+22 QUIT
End DoDot:1
if $GET(RCDPFXIT)!$GET(RCDPGQ)
QUIT
+23 ;
+24 ; refresh the account profile list of bills
DO INIT^RCDPAPLM
+25 ;
SUSPX ;
+1 SET VALMBCK="R"
+2 IF $GET(RCDPFXIT)
SET VALMBCK="Q"
+3 QUIT
+4 ;
REESTAB ; Re-Establish a Bill - PRCA*4.5*315
+1 NEW GOTBILL,VALMY,RCBILLDA,RCDPGN,RCDPGC,RCDPGT,RCDPGQ,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
+2 DO FULL^VALM1
+3 DO SELMULT(.VALMY)
IF '$ORDER(VALMY(0))
GOTO REESTX
+4 ;
+5 ; count the number of selected entries and put into RCDPGT
+6 SET RCDPGN=0
FOR RCDPGT=0:1
SET RCDPGN=$ORDER(VALMY(RCDPGN))
if 'RCDPGN
QUIT
+7 ;
+8 WRITE !
+9 SET (RCDPGN,RCDPGC)=0
FOR
SET RCDPGN=$ORDER(VALMY(RCDPGN))
if 'RCDPGN
QUIT
Begin DoDot:1
+10 SET RCBILLDA=$GET(@VALMAR@("IDX",RCDPGN,RCDPGN))
if 'RCBILLDA
QUIT
+11 SET RCDPGC=RCDPGC+1
+12 WRITE !," ======== Bill# ",$PIECE($PIECE($GET(^PRCA(430,RCBILLDA,0)),U,1),"-",2)," (",RCDPGC," of ",RCDPGT," selected) ========",!
+13 SET GOTBILL=1
+14 ; Call into existing Re-Establish bill routine for each bill selected
DO ENAP^PRCAWREA(RCBILLDA)
+15 ;
+16 ; special break in between each bill
+17 WRITE !
SET DIR(0)="E"
SET DIR("A")="Type <Enter> to continue"
+18 ; if there are still more bills in loop
IF (RCDPGT-RCDPGC)>0
SET DIR("A")=DIR("A")_" or '^' to exit this Bill# loop"
+19 DO ^DIR
KILL DIR
WRITE !
+20 IF $DATA(DIRUT)
SET RCDPGQ=1
+21 QUIT
End DoDot:1
if $GET(RCDPFXIT)!$GET(RCDPGQ)
QUIT
+22 ;
+23 ; refresh the account profile list of bills
DO INIT^RCDPAPLM
+24 ;
REESTX ;
+1 SET VALMBCK="R"
+2 IF $GET(RCDPFXIT)
SET VALMBCK="Q"
+3 QUIT
+4 ;
STOP ;Stop a Bill in Cross-servicing (Debtor) PRCA*4.5*315
+1 NEW GOTBILL,VALMY,RCBILLDA,RCDPGN,RCDPGC,RCDPGT,RCDPGQ,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
+2 DO FULL^VALM1
+3 DO SELMULT(.VALMY)
IF '$ORDER(VALMY(0))
GOTO STOPX
+4 ;
+5 ; count the number of selected entries and put into RCDPGT
+6 SET RCDPGN=0
FOR RCDPGT=0:1
SET RCDPGN=$ORDER(VALMY(RCDPGN))
if 'RCDPGN
QUIT
+7 ;
+8 WRITE !
+9 SET (RCDPGN,RCDPGC)=0
FOR
SET RCDPGN=$ORDER(VALMY(RCDPGN))
if 'RCDPGN
QUIT
Begin DoDot:1
+10 SET RCBILLDA=$GET(@VALMAR@("IDX",RCDPGN,RCDPGN))
if 'RCBILLDA
QUIT
+11 SET RCDPGC=RCDPGC+1
+12 WRITE !," ======== Bill# ",$PIECE($PIECE($GET(^PRCA(430,RCBILLDA,0)),U,1),"-",2)," (",RCDPGC," of ",RCDPGT," selected) ========",!
+13 SET GOTBILL=1
+14 ;Call into existing TOP routine for each bill selected
DO STOP^RCTCSPU
+15 IF $GET(RCDPGQ)
WRITE " ... exiting Bill# loop"
QUIT
+16 ;
+17 ; special break in between each bill
+18 WRITE !
SET DIR(0)="E"
SET DIR("A")="Type <Enter> to continue"
+19 ; if there are still more bills in loop
IF (RCDPGT-RCDPGC)>0
SET DIR("A")=DIR("A")_" or '^' to exit this Bill# loop"
+20 DO ^DIR
KILL DIR
WRITE !
+21 IF $DATA(DIRUT)
SET RCDPGQ=1
+22 QUIT
End DoDot:1
if $GET(RCDPFXIT)!$GET(RCDPGQ)
QUIT
+23 ;
+24 ; refresh the account profile list of bills
DO INIT^RCDPAPLM
+25 ;
STOPX ;
+1 SET VALMBCK="R"
+2 IF $GET(RCDPFXIT)
SET VALMBCK="Q"
+3 QUIT
+4 ;
TERM ;Fiscal Officer Terminated PRCA*4.5*315
+1 NEW GOTBILL,VALMY,RCBILLDA,RCDPGN,RCDPGC,RCDPGT,RCDPGQ,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
+2 DO FULL^VALM1
+3 DO SELMULT(.VALMY)
IF '$ORDER(VALMY(0))
GOTO TERMX
+4 ;
+5 ; count the number of selected entries and put into RCDPGT
+6 SET RCDPGN=0
FOR RCDPGT=0:1
SET RCDPGN=$ORDER(VALMY(RCDPGN))
if 'RCDPGN
QUIT
+7 ;
+8 WRITE !
+9 SET (RCDPGN,RCDPGC)=0
FOR
SET RCDPGN=$ORDER(VALMY(RCDPGN))
if 'RCDPGN
QUIT
Begin DoDot:1
+10 SET RCBILLDA=$GET(@VALMAR@("IDX",RCDPGN,RCDPGN))
if 'RCBILLDA
QUIT
+11 SET RCDPGC=RCDPGC+1
+12 WRITE !," ======== Bill# ",$PIECE($PIECE($GET(^PRCA(430,RCBILLDA,0)),U,1),"-",2)," (",RCDPGC," of ",RCDPGT," selected) ========",!
+13 SET GOTBILL=1
+14 ; Call into existing write-off routine for each bill selected
DO 8^RCWROFF
+15 IF $GET(RCDPGQ)
WRITE " ... exiting Bill# loop"
QUIT
+16 ;
+17 ; special break in between each bill
+18 WRITE !
SET DIR(0)="E"
SET DIR("A")="Type <Enter> to continue"
+19 ; if there are still more bills in loop
IF (RCDPGT-RCDPGC)>0
SET DIR("A")=DIR("A")_" or '^' to exit this Bill# loop"
+20 DO ^DIR
KILL DIR
WRITE !
+21 IF $DATA(DIRUT)
SET RCDPGQ=1
+22 QUIT
End DoDot:1
if $GET(RCDPFXIT)!$GET(RCDPGQ)
QUIT
+23 ;
+24 ; refresh the account profile list of bills
DO INIT^RCDPAPLM
+25 ;
TERMX ;
+1 SET VALMBCK="R"
+2 IF $GET(RCDPFXIT)
SET VALMBCK="Q"
+3 QUIT
+4 ;
RECALLB ;Recall a Bill PRCA*4.5*315
+1 NEW GOTBILL,VALMY,RCBILLDA,RCDPGN,RCDPGC,RCDPGT,RCDPGQ,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
+2 DO FULL^VALM1
+3 DO SELMULT(.VALMY)
IF '$ORDER(VALMY(0))
GOTO RECALBX
+4 ;
+5 ; count the number of selected entries and put into RCDPGT
+6 SET RCDPGN=0
FOR RCDPGT=0:1
SET RCDPGN=$ORDER(VALMY(RCDPGN))
if 'RCDPGN
QUIT
+7 ;
+8 WRITE !
+9 SET (RCDPGN,RCDPGC)=0
FOR
SET RCDPGN=$ORDER(VALMY(RCDPGN))
if 'RCDPGN
QUIT
Begin DoDot:1
+10 SET RCBILLDA=$GET(@VALMAR@("IDX",RCDPGN,RCDPGN))
if 'RCBILLDA
QUIT
+11 SET RCDPGC=RCDPGC+1
+12 WRITE !," ======== Bill# ",$PIECE($PIECE($GET(^PRCA(430,RCBILLDA,0)),U,1),"-",2)," (",RCDPGC," of ",RCDPGT," selected) ========",!
+13 SET GOTBILL=1
+14 ; Call into existing recall code
DO RCLLSETB^RCTCSPU
+15 IF $GET(RCDPGQ)
WRITE " ... exiting Bill# loop"
QUIT
+16 ;
+17 ; special break in between each bill
+18 WRITE !
SET DIR(0)="E"
SET DIR("A")="Type <Enter> to continue"
+19 ; if there are still more bills in loop
IF (RCDPGT-RCDPGC)>0
SET DIR("A")=DIR("A")_" or '^' to exit this Bill# loop"
+20 DO ^DIR
KILL DIR
WRITE !
+21 IF $DATA(DIRUT)
SET RCDPGQ=1
+22 QUIT
End DoDot:1
if $GET(RCDPFXIT)!$GET(RCDPGQ)
QUIT
+23 ;
+24 ; refresh the account profile list of bills
DO INIT^RCDPAPLM
+25 ;
RECALBX ;
+1 SET VALMBCK="R"
+2 IF $GET(RCDPFXIT)
SET VALMBCK="Q"
+3 QUIT
+4 ;
RECALLD ;Recall a Debtor PRCA*4.5*315
+1 NEW GOTDEBT,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
+2 DO FULL^VALM1
+3 ; RCDEBTDA is set by the ACCTPR^RCTCSWL - Account Profile action protocol
SET RCDEBTDA=+$GET(RCDEBTDA)
+4 IF 'RCDEBTDA
GOTO RECALDX
+5 ;
+6 SET GOTDEBT=1
+7 ; Call into existing recall code for debtors
DO RCLLSETD^RCTCSPU
+8 DO PAUSE^VALM1
+9 ; refresh the account profile list of bills
DO INIT^RCDPAPLM
RECALDX ;
+1 SET VALMBCK="R"
+2 IF $GET(RCDPFXIT)
SET VALMBCK="Q"
+3 QUIT
+4 ;
INC ;Increase Transaction PRCA*4.5*315
+1 NEW GOTBILL,VALMY,RCBILLDA,RCDPGN,RCDPGC,RCDPGT,RCDPGQ,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
+2 DO FULL^VALM1
+3 ;
+4 ; check on security key - same one used in the menu system for AR option PRCAC TR ADJUSTMENT
+5 IF '$DATA(^XUSEC("PRCADJ",DUZ))
Begin DoDot:1
+6 WRITE *7,!!?3,"You must hold the PRCADJ security key in order to access this option.",!
+7 DO PAUSE^VALM1
+8 QUIT
End DoDot:1
GOTO INCX
+9 ;
+10 DO SELMULT(.VALMY)
IF '$ORDER(VALMY(0))
GOTO INCX
+11 ;
+12 ; count the number of selected entries and put into RCDPGT
+13 SET RCDPGN=0
FOR RCDPGT=0:1
SET RCDPGN=$ORDER(VALMY(RCDPGN))
if 'RCDPGN
QUIT
+14 ;
+15 WRITE !
+16 SET (RCDPGN,RCDPGC)=0
FOR
SET RCDPGN=$ORDER(VALMY(RCDPGN))
if 'RCDPGN
QUIT
Begin DoDot:1
+17 SET RCBILLDA=$GET(@VALMAR@("IDX",RCDPGN,RCDPGN))
if 'RCBILLDA
QUIT
+18 SET RCDPGC=RCDPGC+1
+19 WRITE !," ======== Bill# ",$PIECE($PIECE($GET(^PRCA(430,RCBILLDA,0)),U,1),"-",2)," (",RCDPGC," of ",RCDPGT," selected) ========",!
+20 SET GOTBILL=1
+21 ; Call into existing increase code
DO INCREASE^RCBEADJ
+22 IF $GET(RCDPGQ)
WRITE " ... exiting Bill# loop"
QUIT
+23 ;
+24 ; special break in between each bill
+25 WRITE !
SET DIR(0)="E"
SET DIR("A")="Type <Enter> to continue"
+26 ; if there are still more bills in loop
IF (RCDPGT-RCDPGC)>0
SET DIR("A")=DIR("A")_" or '^' to exit this Bill# loop"
+27 DO ^DIR
KILL DIR
WRITE !
+28 IF $DATA(DIRUT)
SET RCDPGQ=1
+29 QUIT
End DoDot:1
if $GET(RCDPFXIT)!$GET(RCDPGQ)
QUIT
+30 ;
+31 ; refresh the account profile list of bills
DO INIT^RCDPAPLM
+32 ;
INCX ;
+1 SET VALMBCK="R"
+2 IF $GET(RCDPFXIT)
SET VALMBCK="Q"
+3 QUIT
+4 ;
DEC ;Decrease Transaction PRCA*4.5*315
+1 NEW GOTBILL,VALMY,RCBILLDA,RCDPGN,RCDPGC,RCDPGT,RCDPGQ,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
+2 DO FULL^VALM1
+3 ;
+4 ; check on security key - same one used in the menu system for AR option PRCAC TR ADJUSTMENT
+5 IF '$DATA(^XUSEC("PRCADJ",DUZ))
Begin DoDot:1
+6 WRITE *7,!!?3,"You must hold the PRCADJ security key in order to access this option.",!
+7 DO PAUSE^VALM1
+8 QUIT
End DoDot:1
GOTO DECX
+9 ;
+10 DO SELMULT(.VALMY)
IF '$ORDER(VALMY(0))
GOTO DECX
+11 ;
+12 ; count the number of selected entries and put into RCDPGT
+13 SET RCDPGN=0
FOR RCDPGT=0:1
SET RCDPGN=$ORDER(VALMY(RCDPGN))
if 'RCDPGN
QUIT
+14 ;
+15 WRITE !
+16 SET (RCDPGN,RCDPGC)=0
FOR
SET RCDPGN=$ORDER(VALMY(RCDPGN))
if 'RCDPGN
QUIT
Begin DoDot:1
+17 SET RCBILLDA=$GET(@VALMAR@("IDX",RCDPGN,RCDPGN))
if 'RCBILLDA
QUIT
+18 SET RCDPGC=RCDPGC+1
+19 WRITE !," ======== Bill# ",$PIECE($PIECE($GET(^PRCA(430,RCBILLDA,0)),U,1),"-",2)," (",RCDPGC," of ",RCDPGT," selected) ========",!
+20 SET GOTBILL=1
+21 ; Call into existing decrease code
DO DECREASE^RCBEADJ
+22 IF $GET(RCDPGQ)
WRITE " ... exiting Bill# loop"
QUIT
+23 ;
+24 ; special break in between each bill
+25 WRITE !
SET DIR(0)="E"
SET DIR("A")="Type <Enter> to continue"
+26 ; if there are still more bills in loop
IF (RCDPGT-RCDPGC)>0
SET DIR("A")=DIR("A")_" or '^' to exit this Bill# loop"
+27 DO ^DIR
KILL DIR
WRITE !
+28 IF $DATA(DIRUT)
SET RCDPGQ=1
+29 QUIT
End DoDot:1
if $GET(RCDPFXIT)!$GET(RCDPGQ)
QUIT
+30 ;
+31 ; refresh the account profile list of bills
DO INIT^RCDPAPLM
+32 ;
DECX ;
+1 SET VALMBCK="R"
+2 IF $GET(RCDPFXIT)
SET VALMBCK="Q"
+3 QUIT
+4 ;
