1 | RCDPDPL1 ;WISC/RFJ-deposit profile listmanager options ;1 Jun 99
|
---|
2 | ;;4.5;Accounts Receivable;**114,148,172,173**;Mar 20, 1995
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | Q
|
---|
5 | ;
|
---|
6 | ;
|
---|
7 | EDITDEP ; option: edit the deposit
|
---|
8 | D FULL^VALM1
|
---|
9 | S VALMBCK="R"
|
---|
10 | ;
|
---|
11 | I '$$LOCKDEP^RCDPDPLU(RCDEPTDA) Q
|
---|
12 | ;
|
---|
13 | W !
|
---|
14 | D EDITDEP^RCDPUDEP(RCDEPTDA)
|
---|
15 | L -^RCY(344.1,RCDEPTDA)
|
---|
16 | ;
|
---|
17 | ; rebuild the header
|
---|
18 | D INIT^RCDPDPLM
|
---|
19 | D HDR^RCDPDPLM
|
---|
20 | Q
|
---|
21 | ;
|
---|
22 | ;
|
---|
23 | CONFIRM ; option: confirm deposit
|
---|
24 | D FULL^VALM1
|
---|
25 | S VALMBCK="R"
|
---|
26 | ;
|
---|
27 | W !!,"This option will confirm a deposit. Once a deposit is confirmed, receipts"
|
---|
28 | W !,"can no longer be added or changed on the deposit. Before a deposit can be"
|
---|
29 | W !,"confirmed all receipts must be processed and the cash receipt code sheets"
|
---|
30 | W !,"accepted by FMS."
|
---|
31 | ;
|
---|
32 | N DATA,ERROR,FMSDOC,RECTDA,STATUS,X
|
---|
33 | ;
|
---|
34 | I '$$LOCKDEP^RCDPDPLU(RCDEPTDA) Q
|
---|
35 | ;
|
---|
36 | ; check bank data
|
---|
37 | S ERROR=$$CHEKBANK(RCDEPTDA)
|
---|
38 | I ERROR D Q:ERROR
|
---|
39 | . W ! D EDITDEP^RCDPUDEP(RCDEPTDA)
|
---|
40 | . S ERROR=$$CHEKBANK(RCDEPTDA)
|
---|
41 | . I 'ERROR Q
|
---|
42 | . S VALMSG="Deposit NOT Confirmed."
|
---|
43 | . W !,VALMSG,!,"Use the Edit Deposit option to enter missing bank data."
|
---|
44 | . W !!,"Press RETURN to continue: " R X:DTIME
|
---|
45 | . L -^RCY(344.1,RCDEPTDA)
|
---|
46 | . ; rebuild the screen
|
---|
47 | . D INIT^RCDPDPLM
|
---|
48 | . D HDR^RCDPDPLM
|
---|
49 | W " Done."
|
---|
50 | ;
|
---|
51 | ; check receipts
|
---|
52 | W !!,"Checking receipts on deposit ..."
|
---|
53 | S RECTDA=0 F S RECTDA=$O(^RCY(344,"AD",RCDEPTDA,RECTDA)) Q:'RECTDA D
|
---|
54 | . S DATA=$G(^RCY(344,RECTDA,0)) I DATA="" Q
|
---|
55 | . ; get status, error if receipt not closed
|
---|
56 | . S STATUS=$S($P(DATA,"^",14)'=0:"OPEN",1:"CLOSED")
|
---|
57 | . I STATUS'="CLOSED" S ERROR=1
|
---|
58 | . ; get fms cr doc number and status, error if doc not accepted
|
---|
59 | . ; returns fmsdocument ^ status ^ prelockbox flag
|
---|
60 | . S FMSDOC=$$FMSSTAT^RCDPUREC(RECTDA)
|
---|
61 | . ; if status is closed and the fms document not sent (no dollars), allow confirm
|
---|
62 | . I STATUS="CLOSED",$P(FMSDOC,"^",2)="NOT ENTERED" Q
|
---|
63 | . ;
|
---|
64 | . I $P(FMSDOC,"^",2)'["ON LINE ENTRY",$P(FMSDOC,"^",2)'["ACCEPTED" S ERROR=1
|
---|
65 | . W !?5,$P(DATA,"^"),?15,STATUS,?30,$P(FMSDOC,"^"),?45,$P(FMSDOC,"^",2)
|
---|
66 | ;
|
---|
67 | I $G(ERROR) D Q
|
---|
68 | . W !!,"Cannot confirm deposit until all receipts are closed and the cash"
|
---|
69 | . W !,"receipt documents have been accepted in FMS."
|
---|
70 | . W !!,"Press RETURN to continue: " R X:DTIME
|
---|
71 | . L -^RCY(344.1,RCDEPTDA)
|
---|
72 | ;
|
---|
73 | W !!,"All receipts are closed and accepted."
|
---|
74 | I $$ASKCONFI=1 D CONFIRM^RCDPUDEP(RCDEPTDA),HDR^RCDPDPLM
|
---|
75 | L -^RCY(344.1,RCDEPTDA)
|
---|
76 | ;
|
---|
77 | ; rebuild the header
|
---|
78 | D INIT^RCDPDPLM
|
---|
79 | D HDR^RCDPDPLM
|
---|
80 | Q
|
---|
81 | ;
|
---|
82 | ;
|
---|
83 | CHEKBANK(RCDEPTDA) ; check the bank data for a deposit
|
---|
84 | ; return error of 1 if data is missing
|
---|
85 | N DATA,ERROR
|
---|
86 | W !!,"Checking the deposit bank data ..."
|
---|
87 | S DATA=^RCY(344.1,RCDEPTDA,0)
|
---|
88 | I $P(DATA,"^",13)="" S ERROR=1 W !?5,"BANK is missing."
|
---|
89 | ;I $P(DATA,"^",5)="" S ERROR=1 W !?5,"BANK TRACE NUMBER is missing."
|
---|
90 | I $P(DATA,"^",14)="" S ERROR=1 W !?5,"AGENCY LOCATION CODE is missing."
|
---|
91 | I $P(DATA,"^",17)="" S ERROR=1 W !?5,"AGENCY TITLE is missing."
|
---|
92 | Q +$G(ERROR)
|
---|
93 | ;
|
---|
94 | ;
|
---|
95 | ADDREC ; add a new receipt
|
---|
96 | D FULL^VALM1
|
---|
97 | S VALMBCK="R"
|
---|
98 | ;
|
---|
99 | N RCRECTDA
|
---|
100 | W !
|
---|
101 | S RCRECTDA=$$SELRECT^RCDPUREC(1,RCDEPTDA)
|
---|
102 | I RCRECTDA<1 Q
|
---|
103 | ;
|
---|
104 | D EN^VALM("RCDP RECEIPT PROFILE")
|
---|
105 | ;
|
---|
106 | D INIT^RCDPDPLM
|
---|
107 | S VALMBCK="R"
|
---|
108 | Q
|
---|
109 | ;
|
---|
110 | ;
|
---|
111 | DICW ; Write identifiers for ERA lookup
|
---|
112 | ; Assumes Y = ien of entry file 344.4
|
---|
113 | N RC0
|
---|
114 | S RC0=$G(^RCY(344.4,Y,0))
|
---|
115 | 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)
|
---|
116 | Q
|
---|
117 | ;
|
---|
118 | RECEIPTS ; option: receipt profile/processing
|
---|
119 | N INDEX,RCRECTDA,VALMBG,VALMLST,VALMY
|
---|
120 | S VALMBCK="R"
|
---|
121 | ;
|
---|
122 | ; if no receipts, quit
|
---|
123 | I '$O(^TMP("RCDPDPLM",$J,"IDX",0)) S VALMSG="There are NO receipts to profile." Q
|
---|
124 | ;
|
---|
125 | ; if only one receipt, select that one automatically
|
---|
126 | I '$O(^TMP("RCDPDPLM",$J,"IDX",1)) S INDEX=1
|
---|
127 | ;
|
---|
128 | ; select the entry from the list
|
---|
129 | I '$G(INDEX) D I 'INDEX Q
|
---|
130 | . ; if not on first screen, make sure selection begins with 1
|
---|
131 | . S VALMBG=1
|
---|
132 | . ; if not on last screen, make sure selection ends with last
|
---|
133 | . S VALMLST=$O(^TMP("RCDPDPLM",$J,"IDX",999999999),-1)
|
---|
134 | . D EN^VALM2($G(XQORNOD(0)),"OS")
|
---|
135 | . S INDEX=$O(VALMY(0))
|
---|
136 | ;
|
---|
137 | S RCRECTDA=+$G(^TMP("RCDPDPLM",$J,"IDX",INDEX,INDEX))
|
---|
138 | D EN^VALM("RCDP RECEIPT PROFILE")
|
---|
139 | ;
|
---|
140 | D INIT^RCDPDPLM
|
---|
141 | S VALMBCK="R"
|
---|
142 | ; fast exit
|
---|
143 | I $G(RCDPFXIT) S VALMBCK="Q"
|
---|
144 | Q
|
---|
145 | ;
|
---|
146 | ;
|
---|
147 | CUSTOMIZ ; option: customize display
|
---|
148 | D FULL^VALM1
|
---|
149 | S VALMBCK="R"
|
---|
150 | ;
|
---|
151 | W !!,"This option will allow the user to customize the screen and options"
|
---|
152 | W !,"used for deposit processing."
|
---|
153 | ;
|
---|
154 | ; ask to show check/credit card data
|
---|
155 | I $$ASKFMS=-1 Q
|
---|
156 | ;
|
---|
157 | D INIT^RCDPDPLM
|
---|
158 | Q
|
---|
159 | ;
|
---|
160 | ;
|
---|
161 | ASKFMS() ; ask if its okay to show fms cr documents
|
---|
162 | ; 1 is yes, otherwise no
|
---|
163 | N DIR,DIQ2,DTOUT,DUOUT,X,Y
|
---|
164 | S DIR(0)="YO",DIR("B")="NO"
|
---|
165 | S DIR("A")=" Do you want to turn on the display of the FMS CR documents"
|
---|
166 | W ! D ^DIR
|
---|
167 | I $G(DTOUT)!($G(DUOUT)) S Y=-1
|
---|
168 | I Y'=-1 S ^DISV(DUZ,"RCDPDPLM","SHOWFMS")=Y
|
---|
169 | Q Y
|
---|
170 | ;
|
---|
171 | ASKCONFI() ; ask if its okay to confirm the deposit
|
---|
172 | ; 1 is yes, otherwise no
|
---|
173 | N DIR,DIQ2,DTOUT,DUOUT,X,Y
|
---|
174 | S DIR(0)="YO",DIR("B")="NO"
|
---|
175 | S DIR("A")=" Are you sure you want to CONFIRM this deposit"
|
---|
176 | D ^DIR
|
---|
177 | I $G(DTOUT)!($G(DUOUT)) S Y=-1
|
---|
178 | Q Y
|
---|
179 | ;
|
---|