Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDPDPL1

RCDPDPL1.m

Go to the documentation of this file.
  1. RCDPDPL1 ;WISC/RFJ-deposit profile listmanager options ;1 Jun 99
  1. ;;4.5;Accounts Receivable;**114,148,172,173**;Mar 20, 1995
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. Q
  1. ;
  1. ;
  1. EDITDEP ; option: edit the deposit
  1. D FULL^VALM1
  1. S VALMBCK="R"
  1. ;
  1. I '$$LOCKDEP^RCDPDPLU(RCDEPTDA) Q
  1. ;
  1. W !
  1. D EDITDEP^RCDPUDEP(RCDEPTDA)
  1. L -^RCY(344.1,RCDEPTDA)
  1. ;
  1. ; rebuild the header
  1. D INIT^RCDPDPLM
  1. D HDR^RCDPDPLM
  1. Q
  1. ;
  1. ;
  1. CONFIRM ; option: confirm deposit
  1. D FULL^VALM1
  1. S VALMBCK="R"
  1. ;
  1. W !!,"This option will confirm a deposit. Once a deposit is confirmed, receipts"
  1. W !,"can no longer be added or changed on the deposit. Before a deposit can be"
  1. W !,"confirmed all receipts must be processed and the cash receipt code sheets"
  1. W !,"accepted by FMS."
  1. ;
  1. N DATA,ERROR,FMSDOC,RECTDA,STATUS,X
  1. ;
  1. I '$$LOCKDEP^RCDPDPLU(RCDEPTDA) Q
  1. ;
  1. ; check bank data
  1. S ERROR=$$CHEKBANK(RCDEPTDA)
  1. I ERROR D Q:ERROR
  1. . W ! D EDITDEP^RCDPUDEP(RCDEPTDA)
  1. . S ERROR=$$CHEKBANK(RCDEPTDA)
  1. . I 'ERROR Q
  1. . S VALMSG="Deposit NOT Confirmed."
  1. . W !,VALMSG,!,"Use the Edit Deposit option to enter missing bank data."
  1. . W !!,"Press RETURN to continue: " R X:DTIME
  1. . L -^RCY(344.1,RCDEPTDA)
  1. . ; rebuild the screen
  1. . D INIT^RCDPDPLM
  1. . D HDR^RCDPDPLM
  1. W " Done."
  1. ;
  1. ; check receipts
  1. W !!,"Checking receipts on deposit ..."
  1. S RECTDA=0 F S RECTDA=$O(^RCY(344,"AD",RCDEPTDA,RECTDA)) Q:'RECTDA D
  1. . S DATA=$G(^RCY(344,RECTDA,0)) I DATA="" Q
  1. . ; get status, error if receipt not closed
  1. . S STATUS=$S($P(DATA,"^",14)'=0:"OPEN",1:"CLOSED")
  1. . I STATUS'="CLOSED" S ERROR=1
  1. . ; get fms cr doc number and status, error if doc not accepted
  1. . ; returns fmsdocument ^ status ^ prelockbox flag
  1. . S FMSDOC=$$FMSSTAT^RCDPUREC(RECTDA)
  1. . ; if status is closed and the fms document not sent (no dollars), allow confirm
  1. . I STATUS="CLOSED",$P(FMSDOC,"^",2)="NOT ENTERED" Q
  1. . ;
  1. . I $P(FMSDOC,"^",2)'["ON LINE ENTRY",$P(FMSDOC,"^",2)'["ACCEPTED" S ERROR=1
  1. . W !?5,$P(DATA,"^"),?15,STATUS,?30,$P(FMSDOC,"^"),?45,$P(FMSDOC,"^",2)
  1. ;
  1. I $G(ERROR) D Q
  1. . W !!,"Cannot confirm deposit until all receipts are closed and the cash"
  1. . W !,"receipt documents have been accepted in FMS."
  1. . W !!,"Press RETURN to continue: " R X:DTIME
  1. . L -^RCY(344.1,RCDEPTDA)
  1. ;
  1. W !!,"All receipts are closed and accepted."
  1. I $$ASKCONFI=1 D CONFIRM^RCDPUDEP(RCDEPTDA),HDR^RCDPDPLM
  1. L -^RCY(344.1,RCDEPTDA)
  1. ;
  1. ; rebuild the header
  1. D INIT^RCDPDPLM
  1. D HDR^RCDPDPLM
  1. Q
  1. ;
  1. ;
  1. CHEKBANK(RCDEPTDA) ; check the bank data for a deposit
  1. ; return error of 1 if data is missing
  1. N DATA,ERROR
  1. W !!,"Checking the deposit bank data ..."
  1. S DATA=^RCY(344.1,RCDEPTDA,0)
  1. I $P(DATA,"^",13)="" S ERROR=1 W !?5,"BANK is missing."
  1. ;I $P(DATA,"^",5)="" S ERROR=1 W !?5,"BANK TRACE NUMBER is missing."
  1. I $P(DATA,"^",14)="" S ERROR=1 W !?5,"AGENCY LOCATION CODE is missing."
  1. I $P(DATA,"^",17)="" S ERROR=1 W !?5,"AGENCY TITLE is missing."
  1. Q +$G(ERROR)
  1. ;
  1. ;
  1. ADDREC ; add a new receipt
  1. D FULL^VALM1
  1. S VALMBCK="R"
  1. ;
  1. N RCRECTDA
  1. W !
  1. S RCRECTDA=$$SELRECT^RCDPUREC(1,RCDEPTDA)
  1. I RCRECTDA<1 Q
  1. ;
  1. D EN^VALM("RCDP RECEIPT PROFILE")
  1. ;
  1. D INIT^RCDPDPLM
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ;
  1. DICW ; Write identifiers for ERA lookup
  1. ; Assumes Y = ien of entry file 344.4
  1. N RC0
  1. S RC0=$G(^RCY(344.4,Y,0))
  1. 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)
  1. Q
  1. ;
  1. RECEIPTS ; option: receipt profile/processing
  1. N INDEX,RCRECTDA,VALMBG,VALMLST,VALMY
  1. S VALMBCK="R"
  1. ;
  1. ; if no receipts, quit
  1. I '$O(^TMP("RCDPDPLM",$J,"IDX",0)) S VALMSG="There are NO receipts to profile." Q
  1. ;
  1. ; if only one receipt, select that one automatically
  1. I '$O(^TMP("RCDPDPLM",$J,"IDX",1)) S INDEX=1
  1. ;
  1. ; select the entry from the list
  1. I '$G(INDEX) D I 'INDEX Q
  1. . ; if not on first screen, make sure selection begins with 1
  1. . S VALMBG=1
  1. . ; if not on last screen, make sure selection ends with last
  1. . S VALMLST=$O(^TMP("RCDPDPLM",$J,"IDX",999999999),-1)
  1. . D EN^VALM2($G(XQORNOD(0)),"OS")
  1. . S INDEX=$O(VALMY(0))
  1. ;
  1. S RCRECTDA=+$G(^TMP("RCDPDPLM",$J,"IDX",INDEX,INDEX))
  1. D EN^VALM("RCDP RECEIPT PROFILE")
  1. ;
  1. D INIT^RCDPDPLM
  1. S VALMBCK="R"
  1. ; fast exit
  1. I $G(RCDPFXIT) S VALMBCK="Q"
  1. Q
  1. ;
  1. ;
  1. CUSTOMIZ ; option: customize display
  1. D FULL^VALM1
  1. S VALMBCK="R"
  1. ;
  1. W !!,"This option will allow the user to customize the screen and options"
  1. W !,"used for deposit processing."
  1. ;
  1. ; ask to show check/credit card data
  1. I $$ASKFMS=-1 Q
  1. ;
  1. D INIT^RCDPDPLM
  1. Q
  1. ;
  1. ;
  1. ASKFMS() ; ask if its okay to show fms cr documents
  1. ; 1 is yes, otherwise no
  1. N DIR,DIQ2,DTOUT,DUOUT,X,Y
  1. S DIR(0)="YO",DIR("B")="NO"
  1. S DIR("A")=" Do you want to turn on the display of the FMS CR documents"
  1. W ! D ^DIR
  1. I $G(DTOUT)!($G(DUOUT)) S Y=-1
  1. I Y'=-1 S ^DISV(DUZ,"RCDPDPLM","SHOWFMS")=Y
  1. Q Y
  1. ;
  1. ASKCONFI() ; ask if its okay to confirm the deposit
  1. ; 1 is yes, otherwise no
  1. N DIR,DIQ2,DTOUT,DUOUT,X,Y
  1. S DIR(0)="YO",DIR("B")="NO"
  1. S DIR("A")=" Are you sure you want to CONFIRM this deposit"
  1. D ^DIR
  1. I $G(DTOUT)!($G(DUOUT)) S Y=-1
  1. Q Y
  1. ;