RCDPDPL1 ;WISC/RFJ-deposit profile listmanager options ;1 Jun 99
;;4.5;Accounts Receivable;**114,148,172,173**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
EDITDEP ; option: edit the deposit
D FULL^VALM1
S VALMBCK="R"
;
I '$$LOCKDEP^RCDPDPLU(RCDEPTDA) Q
;
W !
D EDITDEP^RCDPUDEP(RCDEPTDA)
L -^RCY(344.1,RCDEPTDA)
;
; rebuild the header
D INIT^RCDPDPLM
D HDR^RCDPDPLM
Q
;
;
CONFIRM ; option: confirm deposit
D FULL^VALM1
S VALMBCK="R"
;
W !!,"This option will confirm a deposit. Once a deposit is confirmed, receipts"
W !,"can no longer be added or changed on the deposit. Before a deposit can be"
W !,"confirmed all receipts must be processed and the cash receipt code sheets"
W !,"accepted by FMS."
;
N DATA,ERROR,FMSDOC,RECTDA,STATUS,X
;
I '$$LOCKDEP^RCDPDPLU(RCDEPTDA) Q
;
; check bank data
S ERROR=$$CHEKBANK(RCDEPTDA)
I ERROR D Q:ERROR
. W ! D EDITDEP^RCDPUDEP(RCDEPTDA)
. S ERROR=$$CHEKBANK(RCDEPTDA)
. I 'ERROR Q
. S VALMSG="Deposit NOT Confirmed."
. W !,VALMSG,!,"Use the Edit Deposit option to enter missing bank data."
. W !!,"Press RETURN to continue: " R X:DTIME
. L -^RCY(344.1,RCDEPTDA)
. ; rebuild the screen
. D INIT^RCDPDPLM
. D HDR^RCDPDPLM
W " Done."
;
; check receipts
W !!,"Checking receipts on deposit ..."
S RECTDA=0 F S RECTDA=$O(^RCY(344,"AD",RCDEPTDA,RECTDA)) Q:'RECTDA D
. S DATA=$G(^RCY(344,RECTDA,0)) I DATA="" Q
. ; get status, error if receipt not closed
. S STATUS=$S($P(DATA,"^",14)'=0:"OPEN",1:"CLOSED")
. I STATUS'="CLOSED" S ERROR=1
. ; get fms cr doc number and status, error if doc not accepted
. ; returns fmsdocument ^ status ^ prelockbox flag
. S FMSDOC=$$FMSSTAT^RCDPUREC(RECTDA)
. ; if status is closed and the fms document not sent (no dollars), allow confirm
. I STATUS="CLOSED",$P(FMSDOC,"^",2)="NOT ENTERED" Q
. ;
. I $P(FMSDOC,"^",2)'["ON LINE ENTRY",$P(FMSDOC,"^",2)'["ACCEPTED" S ERROR=1
. W !?5,$P(DATA,"^"),?15,STATUS,?30,$P(FMSDOC,"^"),?45,$P(FMSDOC,"^",2)
;
I $G(ERROR) D Q
. W !!,"Cannot confirm deposit until all receipts are closed and the cash"
. W !,"receipt documents have been accepted in FMS."
. W !!,"Press RETURN to continue: " R X:DTIME
. L -^RCY(344.1,RCDEPTDA)
;
W !!,"All receipts are closed and accepted."
I $$ASKCONFI=1 D CONFIRM^RCDPUDEP(RCDEPTDA),HDR^RCDPDPLM
L -^RCY(344.1,RCDEPTDA)
;
; rebuild the header
D INIT^RCDPDPLM
D HDR^RCDPDPLM
Q
;
;
CHEKBANK(RCDEPTDA) ; check the bank data for a deposit
; return error of 1 if data is missing
N DATA,ERROR
W !!,"Checking the deposit bank data ..."
S DATA=^RCY(344.1,RCDEPTDA,0)
I $P(DATA,"^",13)="" S ERROR=1 W !?5,"BANK is missing."
;I $P(DATA,"^",5)="" S ERROR=1 W !?5,"BANK TRACE NUMBER is missing."
I $P(DATA,"^",14)="" S ERROR=1 W !?5,"AGENCY LOCATION CODE is missing."
I $P(DATA,"^",17)="" S ERROR=1 W !?5,"AGENCY TITLE is missing."
Q +$G(ERROR)
;
;
ADDREC ; add a new receipt
D FULL^VALM1
S VALMBCK="R"
;
N RCRECTDA
W !
S RCRECTDA=$$SELRECT^RCDPUREC(1,RCDEPTDA)
I RCRECTDA<1 Q
;
D EN^VALM("RCDP RECEIPT PROFILE")
;
D INIT^RCDPDPLM
S VALMBCK="R"
Q
;
;
DICW ; Write identifiers for ERA lookup
; Assumes Y = ien of entry file 344.4
N RC0
S RC0=$G(^RCY(344.4,Y,0))
W ?9,"From: ",$E($P(RC0,U,6),1,20)," Trace: ",$E($P(RC0,U,2),1,10)," Amt: ",$J(+$P(RC0,U,5),"",2)_" on ",$$FMTE^XLFDT($P(RC0,U,4),2)
Q
;
RECEIPTS ; option: receipt profile/processing
N INDEX,RCRECTDA,VALMBG,VALMLST,VALMY
S VALMBCK="R"
;
; if no receipts, quit
I '$O(^TMP("RCDPDPLM",$J,"IDX",0)) S VALMSG="There are NO receipts to profile." Q
;
; if only one receipt, select that one automatically
I '$O(^TMP("RCDPDPLM",$J,"IDX",1)) S INDEX=1
;
; select the entry from the list
I '$G(INDEX) D I 'INDEX Q
. ; 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("RCDPDPLM",$J,"IDX",999999999),-1)
. D EN^VALM2($G(XQORNOD(0)),"OS")
. S INDEX=$O(VALMY(0))
;
S RCRECTDA=+$G(^TMP("RCDPDPLM",$J,"IDX",INDEX,INDEX))
D EN^VALM("RCDP RECEIPT PROFILE")
;
D INIT^RCDPDPLM
S VALMBCK="R"
; fast exit
I $G(RCDPFXIT) S VALMBCK="Q"
Q
;
;
CUSTOMIZ ; option: customize display
D FULL^VALM1
S VALMBCK="R"
;
W !!,"This option will allow the user to customize the screen and options"
W !,"used for deposit processing."
;
; ask to show check/credit card data
I $$ASKFMS=-1 Q
;
D INIT^RCDPDPLM
Q
;
;
ASKFMS() ; ask if its okay to show fms cr documents
; 1 is yes, otherwise no
N DIR,DIQ2,DTOUT,DUOUT,X,Y
S DIR(0)="YO",DIR("B")="NO"
S DIR("A")=" Do you want to turn on the display of the FMS CR documents"
W ! D ^DIR
I $G(DTOUT)!($G(DUOUT)) S Y=-1
I Y'=-1 S ^DISV(DUZ,"RCDPDPLM","SHOWFMS")=Y
Q Y
;
ASKCONFI() ; ask if its okay to confirm the deposit
; 1 is yes, otherwise no
N DIR,DIQ2,DTOUT,DUOUT,X,Y
S DIR(0)="YO",DIR("B")="NO"
S DIR("A")=" Are you sure you want to CONFIRM this deposit"
D ^DIR
I $G(DTOUT)!($G(DUOUT)) S Y=-1
Q Y
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPDPL1 5288 printed Sep 23, 2025@19:20:02 Page 2
RCDPDPL1 ;WISC/RFJ-deposit profile listmanager options ;1 Jun 99
+1 ;;4.5;Accounts Receivable;**114,148,172,173**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
EDITDEP ; option: edit the deposit
+1 DO FULL^VALM1
+2 SET VALMBCK="R"
+3 ;
+4 IF '$$LOCKDEP^RCDPDPLU(RCDEPTDA)
QUIT
+5 ;
+6 WRITE !
+7 DO EDITDEP^RCDPUDEP(RCDEPTDA)
+8 LOCK -^RCY(344.1,RCDEPTDA)
+9 ;
+10 ; rebuild the header
+11 DO INIT^RCDPDPLM
+12 DO HDR^RCDPDPLM
+13 QUIT
+14 ;
+15 ;
CONFIRM ; option: confirm deposit
+1 DO FULL^VALM1
+2 SET VALMBCK="R"
+3 ;
+4 WRITE !!,"This option will confirm a deposit. Once a deposit is confirmed, receipts"
+5 WRITE !,"can no longer be added or changed on the deposit. Before a deposit can be"
+6 WRITE !,"confirmed all receipts must be processed and the cash receipt code sheets"
+7 WRITE !,"accepted by FMS."
+8 ;
+9 NEW DATA,ERROR,FMSDOC,RECTDA,STATUS,X
+10 ;
+11 IF '$$LOCKDEP^RCDPDPLU(RCDEPTDA)
QUIT
+12 ;
+13 ; check bank data
+14 SET ERROR=$$CHEKBANK(RCDEPTDA)
+15 IF ERROR
Begin DoDot:1
+16 WRITE !
DO EDITDEP^RCDPUDEP(RCDEPTDA)
+17 SET ERROR=$$CHEKBANK(RCDEPTDA)
+18 IF 'ERROR
QUIT
+19 SET VALMSG="Deposit NOT Confirmed."
+20 WRITE !,VALMSG,!,"Use the Edit Deposit option to enter missing bank data."
+21 WRITE !!,"Press RETURN to continue: "
READ X:DTIME
+22 LOCK -^RCY(344.1,RCDEPTDA)
+23 ; rebuild the screen
+24 DO INIT^RCDPDPLM
+25 DO HDR^RCDPDPLM
End DoDot:1
if ERROR
QUIT
+26 WRITE " Done."
+27 ;
+28 ; check receipts
+29 WRITE !!,"Checking receipts on deposit ..."
+30 SET RECTDA=0
FOR
SET RECTDA=$ORDER(^RCY(344,"AD",RCDEPTDA,RECTDA))
if 'RECTDA
QUIT
Begin DoDot:1
+31 SET DATA=$GET(^RCY(344,RECTDA,0))
IF DATA=""
QUIT
+32 ; get status, error if receipt not closed
+33 SET STATUS=$SELECT($PIECE(DATA,"^",14)'=0:"OPEN",1:"CLOSED")
+34 IF STATUS'="CLOSED"
SET ERROR=1
+35 ; get fms cr doc number and status, error if doc not accepted
+36 ; returns fmsdocument ^ status ^ prelockbox flag
+37 SET FMSDOC=$$FMSSTAT^RCDPUREC(RECTDA)
+38 ; if status is closed and the fms document not sent (no dollars), allow confirm
+39 IF STATUS="CLOSED"
IF $PIECE(FMSDOC,"^",2)="NOT ENTERED"
QUIT
+40 ;
+41 IF $PIECE(FMSDOC,"^",2)'["ON LINE ENTRY"
IF $PIECE(FMSDOC,"^",2)'["ACCEPTED"
SET ERROR=1
+42 WRITE !?5,$PIECE(DATA,"^"),?15,STATUS,?30,$PIECE(FMSDOC,"^"),?45,$PIECE(FMSDOC,"^",2)
End DoDot:1
+43 ;
+44 IF $GET(ERROR)
Begin DoDot:1
+45 WRITE !!,"Cannot confirm deposit until all receipts are closed and the cash"
+46 WRITE !,"receipt documents have been accepted in FMS."
+47 WRITE !!,"Press RETURN to continue: "
READ X:DTIME
+48 LOCK -^RCY(344.1,RCDEPTDA)
End DoDot:1
QUIT
+49 ;
+50 WRITE !!,"All receipts are closed and accepted."
+51 IF $$ASKCONFI=1
DO CONFIRM^RCDPUDEP(RCDEPTDA)
DO HDR^RCDPDPLM
+52 LOCK -^RCY(344.1,RCDEPTDA)
+53 ;
+54 ; rebuild the header
+55 DO INIT^RCDPDPLM
+56 DO HDR^RCDPDPLM
+57 QUIT
+58 ;
+59 ;
CHEKBANK(RCDEPTDA) ; check the bank data for a deposit
+1 ; return error of 1 if data is missing
+2 NEW DATA,ERROR
+3 WRITE !!,"Checking the deposit bank data ..."
+4 SET DATA=^RCY(344.1,RCDEPTDA,0)
+5 IF $PIECE(DATA,"^",13)=""
SET ERROR=1
WRITE !?5,"BANK is missing."
+6 ;I $P(DATA,"^",5)="" S ERROR=1 W !?5,"BANK TRACE NUMBER is missing."
+7 IF $PIECE(DATA,"^",14)=""
SET ERROR=1
WRITE !?5,"AGENCY LOCATION CODE is missing."
+8 IF $PIECE(DATA,"^",17)=""
SET ERROR=1
WRITE !?5,"AGENCY TITLE is missing."
+9 QUIT +$GET(ERROR)
+10 ;
+11 ;
ADDREC ; add a new receipt
+1 DO FULL^VALM1
+2 SET VALMBCK="R"
+3 ;
+4 NEW RCRECTDA
+5 WRITE !
+6 SET RCRECTDA=$$SELRECT^RCDPUREC(1,RCDEPTDA)
+7 IF RCRECTDA<1
QUIT
+8 ;
+9 DO EN^VALM("RCDP RECEIPT PROFILE")
+10 ;
+11 DO INIT^RCDPDPLM
+12 SET VALMBCK="R"
+13 QUIT
+14 ;
+15 ;
DICW ; Write identifiers for ERA lookup
+1 ; Assumes Y = ien of entry file 344.4
+2 NEW RC0
+3 SET RC0=$GET(^RCY(344.4,Y,0))
+4 WRITE ?9,"From: ",$EXTRACT($PIECE(RC0,U,6),1,20)," Trace: ",$EXTRACT($PIECE(RC0,U,2),1,10)," Amt: ",$JUSTIFY(+$PIECE(RC0,U,5),"",2)_" on ",$$FMTE^XLFDT($PIECE(RC0,U,4),2)
+5 QUIT
+6 ;
RECEIPTS ; option: receipt profile/processing
+1 NEW INDEX,RCRECTDA,VALMBG,VALMLST,VALMY
+2 SET VALMBCK="R"
+3 ;
+4 ; if no receipts, quit
+5 IF '$ORDER(^TMP("RCDPDPLM",$JOB,"IDX",0))
SET VALMSG="There are NO receipts to profile."
QUIT
+6 ;
+7 ; if only one receipt, select that one automatically
+8 IF '$ORDER(^TMP("RCDPDPLM",$JOB,"IDX",1))
SET INDEX=1
+9 ;
+10 ; select the entry from the list
+11 IF '$GET(INDEX)
Begin DoDot:1
+12 ; if not on first screen, make sure selection begins with 1
+13 SET VALMBG=1
+14 ; if not on last screen, make sure selection ends with last
+15 SET VALMLST=$ORDER(^TMP("RCDPDPLM",$JOB,"IDX",999999999),-1)
+16 DO EN^VALM2($GET(XQORNOD(0)),"OS")
+17 SET INDEX=$ORDER(VALMY(0))
End DoDot:1
IF 'INDEX
QUIT
+18 ;
+19 SET RCRECTDA=+$GET(^TMP("RCDPDPLM",$JOB,"IDX",INDEX,INDEX))
+20 DO EN^VALM("RCDP RECEIPT PROFILE")
+21 ;
+22 DO INIT^RCDPDPLM
+23 SET VALMBCK="R"
+24 ; fast exit
+25 IF $GET(RCDPFXIT)
SET VALMBCK="Q"
+26 QUIT
+27 ;
+28 ;
CUSTOMIZ ; option: customize display
+1 DO FULL^VALM1
+2 SET VALMBCK="R"
+3 ;
+4 WRITE !!,"This option will allow the user to customize the screen and options"
+5 WRITE !,"used for deposit processing."
+6 ;
+7 ; ask to show check/credit card data
+8 IF $$ASKFMS=-1
QUIT
+9 ;
+10 DO INIT^RCDPDPLM
+11 QUIT
+12 ;
+13 ;
ASKFMS() ; ask if its okay to show fms cr documents
+1 ; 1 is yes, otherwise no
+2 NEW DIR,DIQ2,DTOUT,DUOUT,X,Y
+3 SET DIR(0)="YO"
SET DIR("B")="NO"
+4 SET DIR("A")=" Do you want to turn on the display of the FMS CR documents"
+5 WRITE !
DO ^DIR
+6 IF $GET(DTOUT)!($GET(DUOUT))
SET Y=-1
+7 IF Y'=-1
SET ^DISV(DUZ,"RCDPDPLM","SHOWFMS")=Y
+8 QUIT Y
+9 ;
ASKCONFI() ; ask if its okay to confirm the deposit
+1 ; 1 is yes, otherwise no
+2 NEW DIR,DIQ2,DTOUT,DUOUT,X,Y
+3 SET DIR(0)="YO"
SET DIR("B")="NO"
+4 SET DIR("A")=" Are you sure you want to CONFIRM this deposit"
+5 DO ^DIR
+6 IF $GET(DTOUT)!($GET(DUOUT))
SET Y=-1
+7 QUIT Y
+8 ;
