source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPDPL1.m@ 1608

Last change on this file since 1608 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.0 KB
RevLine 
[613]1RCDPDPL1 ;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 ;
7EDITDEP ; 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 ;
23CONFIRM ; 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 ;
83CHEKBANK(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 ;
95ADDREC ; 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 ;
111DICW ; 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 ;
118RECEIPTS ; 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 ;
147CUSTOMIZ ; 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 ;
161ASKFMS() ; 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 ;
171ASKCONFI() ; 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 ;
Note: See TracBrowser for help on using the repository browser.