source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPUDEP.m@ 1006

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

revised back to 6/30/08 version

File size: 3.8 KB
Line 
1RCDPUDEP ;WISC/RFJ-deposit utilities ;1 Jun 99
2 ;;4.5;Accounts Receivable;**114,173**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7ADDDEPT(DEPOSIT,DEPDATE) ; if the deposit is not entered, add it
8 ;
9 ; if deposit date is missing, do not add the deposit
10 I 'DEPDATE Q 0
11 ;
12 ; already in file, deposit number and deposit date match
13 N DA,RCDPFLAG
14 S DA=0 F S DA=$O(^RCY(344.1,"B",DEPOSIT,DA)) Q:'DA I $P($G(^RCY(344.1,DA,0)),"^",3)=DEPDATE S RCDPFLAG=1 Q
15 I $G(RCDPFLAG) Q DA
16 ;
17 ; add it
18 N %,%DT,D0,DA,DD,DI,DIC,DIE,DLAYGO,DO,DQ,DR,X,Y
19 S DIC="^RCY(344.1,",DIC(0)="L",DLAYGO=344.1
20 ; .03 = deposit date .06 = opened by
21 ; .07 = date/time opened .12 = status (set to 1:open)
22 S DIC("DR")=".03////"_DEPDATE_";.06////"_DUZ_";.07///NOW;.12////1;"
23 S X=DEPOSIT
24 D FILE^DICN
25 I Y>0 Q +Y
26 Q 0
27 ;
28 ;
29SELDEPT(ADDNEW) ; select a deposit
30 ; if $g(addnew) allow adding a new deposit
31 ; returns -1 for timeout or ^, 0 for no selection, or ien of deposit
32 N %,%T,%Y,C,D0,DA,DIC,DIE,DLAYGO,DQ,DR,DTOUT,DUOUT,RCDEFLUP,X,Y
33 S DIC="^RCY(344.1,",DIC(0)="QEAM",DIC("A")="Select DEPOSIT: "
34 S DIC("W")="D DICW^RCDPUDEP"
35 ; use special lookup on input
36 S RCDEFLUP=1
37 I $G(ADDNEW) S DIC(0)="QEALM",DLAYGO=344.1,DIC("DR")=".03///TODAY;.06////"_DUZ_";.07///NOW;.12////1;"
38 D ^DIC
39 I Y<0,'$G(DUOUT),'$G(DTOUT) S Y=0
40 Q +Y
41 ;
42 ;
43DICW ; write identifier code for receipt lookup
44 N DATA
45 S DATA=$G(^RCY(344.1,Y,0)) I DATA="" Q
46 ; opened by
47 W ?13,"by: ",$E($P($G(^VA(200,+$P(DATA,"^",6),0)),"^"),1,15)
48 ; date opened
49 I '$P(DATA,"^",7) S $P(DATA,"^",7)="???????"
50 W ?35," on: ",$E($P(DATA,"^",7),4,5),"/",$E($P(DATA,"^",7),6,7),"/",$E($P(DATA,"^",7),2,3)
51 ; total dollars
52 W ?50," amt: $",$J($P(DATA,"^",4),9,2)
53 ; status
54 W ?69," ",$P("N/A^OPEN^DEPOSITED^CONFIRMED^PROCESSED^VOID","^",+$P(DATA,"^",12)+1)
55 Q
56 ;
57 ;
58LOOKUP ; special lookup on deposits, called from ^dd(344.1,.01,7.5)
59 ; if rcdeflup flag not set, do not use special lookup
60 I '$D(RCDEFLUP) Q
61 ; 1:OPEN;3:CONFIRMED
62 ; user entered O.? for lookup on open deposits
63 I X["O."!(X["o.") S DIC("S")="I $P(^(0),U,12)=1" S X="?" Q
64 ; user entered C.? for lookup on confirmed deposits
65 I X["C."!(X["c.") S DIC("S")="I $P(^(0),U,12)=3" S X="?" Q
66 ; deposit ticket # manually entered is for electronic ticket only
67 I $G(DIC(0))["L",$$AUTODEP(X) D EN^DDIOL(" ** Deposit #'s starting with "_$E(X,1,3)_" can only be used by automatic deposits",,"!") S X=""
68 K DIC("S")
69 Q
70 ;
71 ;
72EDITDEP(DA,ASKDATE) ; edit the deposit
73 ; if $g(askdate) ask only the deposit date
74 N %,D,D0,DI,DIC,DIE,DQ,DR,J,X,Y
75 S (DIC,DIE)="^RCY(344.1,",DR=""
76 ; deposit date(.03), do not allow edit if closed or either lockbox
77 I $$CHECKDEP^RCDPDPLU(DA) S DR=".03BANK DEPOSIT DATE//TODAY;"
78 ; bank(.13)
79 S DR=DR_".13//"_$P($G(^RC(342.1,+$O(^RC(342.1,"AC",9,0)),0)),"^")_";"
80 ; bank trace(.05)
81 S DR=DR_".05;"
82 ; agency title(.17)
83 S DR=DR_".17//"_$P($G(^RC(342.1,+$O(^RC(342.1,"AC",10,0)),0)),"^")_";"
84 ; agency location code(.14), comments(1)
85 S DR=DR_".14//"_$P(^RC(342,1,0),"^",7)_";1;"
86 ;
87 ; only ask deposit date
88 I $G(ASKDATE) S DR=".03BANK DEPOSIT DATE//TODAY;"
89 D ^DIE
90 Q
91 ;
92 ;
93CONFIRM(DA) ; confirm the deposit
94 N %DT,D,D0,DI,DIC,DIE,DQ,DR,X,Y
95 S (DIC,DIE)="^RCY(344.1,"
96 S DR=".04///"_$$TOTAL(DA)_";.12////3;.1////"_DUZ_";.11///NOW;"
97 D ^DIE
98 Q
99 ;
100 ;
101TOTAL(RCDEPTDA) ; compute total dollars for all receipts on the deposit
102 N RCRECTDA,RCTRANDA,TOTAL
103 S RCRECTDA=0
104 F S RCRECTDA=$O(^RCY(344,"AD",RCDEPTDA,RCRECTDA)) Q:'RCRECTDA D
105 . S RCTRANDA=0
106 . F S RCTRANDA=$O(^RCY(344,RCRECTDA,1,RCTRANDA)) Q:'RCTRANDA D
107 . . S TOTAL=$G(TOTAL)+$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,0)),"^",4)
108 Q +$G(TOTAL)
109 ;
110AUTODEP(X) ; Function returns 1 if the deposit ticket # in X is in the auto
111 ; deposit number space 269xxx, 369xxx, 469xxx, 569xxx
112 N Y
113 S Y=0
114 I $L(X)=6,$E(X,2,3)="69","2345"[$E(X),'$D(^RCY(344.1,"B",X)) S Y=1
115 Q Y
116 ;
Note: See TracBrowser for help on using the repository browser.