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