source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPUREC.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 9.0 KB
Line 
1RCDPUREC ;WISC/RFJ-receipt utilities ;1 Jun 99
2 ;;4.5;Accounts Receivable;**114,148,169,173,208,222**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7ADDRECT(TRANDATE,RCDEPTDA,PAYTYPDA) ; add a receipt
8 ;
9 ; if deposit or payment type is missing, do not add the receipt
10 I 'RCDEPTDA!('PAYTYPDA) Q 0
11 ;
12 N DA,DATA,RCDPFLAG,RECEIPT,TYPE
13 ; if a receipt has already been added for this transmission date
14 ; and deposit number, do not add a new one
15 S DA=0 F S DA=$O(^RCY(344,"AD",+RCDEPTDA,DA)) Q:'DA S DATA=$G(^RCY(344,DA,0)) I $P($P(DATA,"^",3),".")=TRANDATE,$P(DATA,"^",4)=PAYTYPDA S RCDPFLAG=1 Q
16 I $G(RCDPFLAG) Q DA
17 ;
18 Q $$BLDRCPT(TRANDATE,RCDEPTDA,PAYTYPDA)
19 ;
20BLDRCPT(TRANDATE,RCDEPTDA,PAYTYPDA) ; Build a receipt with/without deposit
21 ;
22 N TYPE,RECEIPT
23 ; build unique receipt number for date
24 S TYPE=$E($G(^RC(341.1,PAYTYPDA,0))) I TYPE="" S TYPE="Z"
25 I TYPE="C",$G(RCDEPTDA)["ERACHK" S RCDEPTDA=+RCDEPTDA,TYPE="E" ; ERA plus paper check EDI Lockbox receipt
26 ; lockbox receipt in the form of L980901A0, do not include century
27 F D Q:RECEIPT'=""
28 . S RECEIPT=$$NEXT(TYPE_$E(TRANDATE,2,7)) ;get last two digits from 00 to ZZ
29 . L +^RCY(344,"B",RECEIPT):2 I '$T S RECEIPT=""
30 ;
31 ; add it
32 N %,%DT,D0,DA,DD,DI,DIC,DIE,DLAYGO,DO,DQ,DR,X,Y
33 S DIC="^RCY(344,",DIC(0)="L",DLAYGO=344
34 ; .02 = opened by .03 = date opened = transmission dt
35 ; .04 = type of payment .06 = deposit ticket
36 ; .14 = status (set to 1:open)
37 S DIC("DR")=".02////"_DUZ_";.03///"_TRANDATE_";.04////"_PAYTYPDA_$S(RCDEPTDA:";.06////"_RCDEPTDA,1:"")_";.14////1;"
38 S X=RECEIPT
39 D FILE^DICN
40 L -^RCY(344,"B",RECEIPT)
41 I Y>0 Q +Y
42 Q 0
43 ;
44 ;
45NEXT(RECEIPT) ; get next 2 digits in sequence 00 to ZZ for receipt
46 ;
47 ; start with 00
48 I '$D(^RCY(344,"B",RECEIPT_"00")) Q RECEIPT_"00"
49 ;
50 N DIGIT1,DIGIT2,LAST
51 ; get the last one used and increment by 1
52 S LAST=$O(^RCY(344,"B",RECEIPT_"ZZ"),-1) ;example L2980901ZZ
53 S DIGIT1=$A($E(LAST,8)),DIGIT2=$A($E(LAST,9))
54 ; increment the ascii value of last digit
55 S DIGIT2=DIGIT2+1
56 ; ascii 48=0, 57=9, 65=A, 90=Z
57 I DIGIT2>57,DIGIT2<65 S DIGIT2=65 ;an A
58 ; digit2 above a Z, set digit2 to a 0 and increment digit 1
59 I DIGIT2>90 S DIGIT2=48,DIGIT1=DIGIT1+1
60 I DIGIT1>57,DIGIT1<65 S DIGIT1=65 ;an A
61 ; digit 1 is above a Z, reset and reuse the Z
62 I DIGIT1>90 S DIGIT1=90,DIGIT2=90
63 ;
64 Q RECEIPT_$C(DIGIT1)_$C(DIGIT2)
65 ;
66 ;
67SELRECT(ADDNEW,RCDEPTDA) ; select a receipt
68 ; if $g(addnew) allow adding a new receipt
69 ; if $g(rcdeptda) allow selection of receipts for the deposit only
70 ; if $g(addnew) and $g(rcdeptda) deposit number auto set for new receipt
71 ; returns -1 for timeout or ^, 0 for no selection, or ien of receipt
72 N %,%Y,C,D0,DA,DI,DIC,DIE,DIK,DG,DLAYGO,DQ,DR,DTOUT,DUOUT,RCREFLUP,X,Y,RCDE,RCLB,RC1,RC2,RCREQ,RCY
73 S DIC="^RCY(344,",DIC(0)="QEAM",DIC("A")="Select RECEIPT: "
74 S DIC("W")="D DICW^RCDPUREC"
75 ; set screen to select receipts linked to deposit and to screen out
76 ; selection of EDI Lockbox-type receipts unless an EFT is associated
77 ; with the deposit and the receipt is not associated with an ERA
78 S RCDE=+$O(^RCY(344.3,"ARDEP",+$G(RCDEPTDA),0))
79 I $G(RCDEPTDA) D
80 . S DIC("S")="N Z S Z=$G(^(0)) I $S('$$EDILBEV^RCDPEU($P(Z,U,4)):'RCDE,1:RCDE&'$P(Z,U,18)),($P(Z,U,6)=""""!($P(Z,U,6)=RCDEPTDA))"
81 . S DIC("A")="Select RECEIPT (for deposit "_$P(^RCY(344.1,RCDEPTDA,0),"^")_"): "
82 ; use special lookup on input
83 I '$G(RCDEPTDA) S RCREFLUP=1
84 ; add new entries
85 S RC1="TYPE NOT VALID FOR THIS RECEIPT",RC2=">>AN EFT REFERENCE IS REQUIRED"
86 I $G(ADDNEW) D
87 . S DIC("A")="Select RECEIPT (or add a new one): "
88 . S DIC(0)="QEALM",DLAYGO=344
89 . S DIC("DR")="S RCREQ=0;.02////"_DUZ_";.03///NOW;.14////1;@4;.04"_$S(RCDE:"////"_$$LBEVENT^RCDPEU(),1:"")
90 . S DIC("DR")=DIC("DR")_";S RCLB=$$EDILBEV^RCDPEU(+X) S:'RCLB Y=""@6"";I $G(RCDEPTDA) S Y=$S('RCDE:""@8"",1:""@6"");W !,RC2 S RCREQ=1;.17;S Y=""@99"""
91 . S DIC("DR")=DIC("DR")_";@6;.06"_$S($G(RCDEPTDA):"////"_RCDEPTDA,1:"")_";S:'RCDE Y=""@99"";.17////"_+RCDE_";S Y=""@99"";@8;W *7,!,RC1 S Y=""@4"";@99"
92 . S DIC("DR")=DIC("DR")_";"
93 D ^DIC
94 S RCY=Y
95 I RCY<0,'$G(DUOUT),'$G(DTOUT) S RCY=0
96 I $P(RCY,U,3),$G(RCREQ) D
97 . I '$P($G(^RCY(344,+RCY,0)),U,17) D Q
98 .. W !,*7,"NO EFT REFERENCED - RECEIPT NOT ADDED"
99 .. S DA=+RCY,DIK="^RCY(344," D ^DIK
100 .. S RCY=0
101 . S DIE="^RCY(344.31,",DA=$P(^RCY(344,+RCY,0),U,17),DR=".08////2" D ^DIE
102 Q +RCY
103 ;
104 ;
105DICW ; write identifier code for receipt lookup
106 N DATA
107 S DATA=$G(^RCY(344,Y,0)) I DATA="" Q
108 ; opened by
109 W ?13,"by: ",$E($P($G(^VA(200,+$P(DATA,"^",2),0)),"^"),1,15)
110 ; date opened
111 I '$P(DATA,"^",3) S $P(DATA,"^",3)="???????"
112 W ?35," on: ",$E($P(DATA,"^",3),4,5),"/",$E($P(DATA,"^",3),6,7),"/",$E($P(DATA,"^",3),2,3)
113 ; type of payment
114 W ?50," ",$E($P($G(^RC(341.1,+$P(DATA,"^",4),0)),"^"),1,18)
115 ; status
116 W ?70," ",$S($P(DATA,"^",14):"OPEN",1:"CLOSED")
117 Q
118 ;
119 ;
120LOOKUP ; special lookup on receipts, called from ^dd(344,.01,7.5)
121 ; if rcreflup flag not set, do not use special lookup
122 I '$D(RCREFLUP) Q
123 ; user entered O.? for lookup on open receipts
124 I X["O."!(X["o.") S DIC("S")="I $P(^(0),U,14)" S X="?" Q
125 ; user entered C.? for lookup on closed receipts
126 I X["C."!(X["c.") S DIC("S")="I '$P(^(0),U,14)" S X="?" Q
127 K DIC("S")
128 Q
129 ;
130 ;
131EDITREC(DA,DR) ; edit the receipt (dr = string of fields to ask)
132 N D,D0,DI,DIC,DIE,DQ,X,Y,RCDR1,RCDR2,RCDR3,DIPA,RCDA
133 S (DIC,DIE)="^RCY(344,",RCDA=DA
134 I $G(DR)="" N DR D
135 . S DR=".01;.04;"_$S($P($G(^RCY(344,RCDA,0)),U,17):"",1:"I $P($G(^RCY(344,DA,0)),U,17) S Y=""@1001"";.06;@1001;")_"D LBT^RCDPUREC(.Y);.18;@99"
136 ;
137 I $G(DR)[".04;" D ; Add a check to DR string for type of payment edit
138 . D EDIT4^RCDPURE1(RCDA,DR,.RCDR1,.RCDR2,.RCDR3)
139 . S DR=$S($E(RCDR1,$L(RCDR1))'=";":RCDR1,1:$E(RCDR1,1,$L(RCDR1)-1)),DR(1,344,1)=RCDR2,DR(1,344,2)=RCDR3
140 ;
141 D ^DIE
142 I $P($G(^RCY(344,RCDA,0)),U,6),$P(^(0),U,17),$$EDILBEV^RCDPEU(+$P(^(0),U,4)) S DIE="^RCY(344,",DR=".06///@" D ^DIE ; Delete deposit if EDI LB event and EFT referenced
143 I $D(^RCY(344,RCDA,0)) D LASTEDIT(RCDA)
144 Q
145 ;
146LBT(Y) ; Determine if Y should be set to @99 ; DR string too long
147 ; Assume DA,RCM3 is set
148 N Z,Z0
149 S Z0=$G(^RCY(344,DA,0)),Z=($P(Z0,U,4)=$$LBEVENT^RCDPEU())
150 ; Don't allow to edit ERA reference if worklist created it
151 I $P($G(^RCY(344.49,+$P(Z0,U,18),0)),U,2)=DA S Y="@99" Q
152 ; only ask for ERA if not EDI lockbox and deposit # exists
153 I $S(Z:1,1:'$P($G(^RCY(344,DA,0)),U,6)) S Y="@99" Q
154 W !,RCM3
155 Q
156 ;
157TYP(Y) ; Determine where to jump to in the 'type' edit of the template
158 ; DR string too long
159 ; Assumes RCP,RCNO,RCN4,RCO4,DA defined
160 N RCCHANGE
161 I $S(RCN4=RCO4&(RCN4'=14):1,RCN4'=14&(RCO4'=14):1,1:0) S Y=RCP+2 G TYPQ
162 ; To get here, the type was changed and it either was 14 or is now 14
163 S RCCHANGE=(RCN4'=RCO4)
164 I RCCHANGE D G:Y TYPQ
165 . ; Type can't be changed if the old type was EDI Lockbox and there is
166 . ; an ERA detail record associated with it
167 . I RCO4=14,$P($G(^RCY(344,DA,0)),U,18) S Y=RCP+1 Q
168 . ; Type can't be changed to EDI Lockbox if rcpt detail already exists
169 . I RCN4=14,$O(^RCY(344,DA,1,0)) S Y=RCP+1 Q
170 . ; If type changed to EDI LOCKBOX, must have an EFT reference
171 I RCN4'=14 S Y=RCP+2 G TYPQ
172TYPQ I '$G(Y) D
173 . ; If ERA is matched to EFT, don't allow to edit EFT
174 . I $P($G(^RCY(344,DA,0)),U,17),$P($G(^(0)),U,18),$D(^RCY(344.31,"AERA",+$P($G(^RCY(344,DA,0)),U,18),+$P($G(^RCY(344,DA,0)),U,17))) S Y=RCP+2 Q
175 . S RCNE=$$ASK17^RCDPUREC(DA) I 'RCNE S RCNO=1,Y=RCP+1
176 I $G(Y) S Y="@"_Y
177 Q
178 ;
179LASTEDIT(DA) ; set when receipt last edit
180 N %DT,D,D0,DI,DIC,DIE,DQ,DR,X,Y
181 S (DIC,DIE)="^RCY(344,"
182 S DR=".11////"_DUZ_";.12///NOW;"
183 D ^DIE
184 Q
185 ;
186 ;
187MARKPROC(DA,FMSDOCNO) ; mark receipt as processed, set receipt as closed,
188 ; store fms document number if passed
189 N %DT,D,D0,DI,DIC,DIE,DQ,DR,X,Y
190 S (DIC,DIE)="^RCY(344,"
191 S DR=".07////"_DUZ_";.08///NOW;.14////0;"
192 I $G(FMSDOCNO)'="" S DR=DR_"200////"_FMSDOCNO_";"
193 D ^DIE
194 Q
195 ;
196 ;
197FMSSTAT(RCRECTDA) ; return the fms cr document ^ status ^ if sent before lockbox
198 N FMSDOCNO,PRELOCK,STATUS
199 ; get the fms document from the receipt
200 S FMSDOCNO=$P($G(^RCY(344,RCRECTDA,2)),"^")
201 ; if not on receipt, it may be earlier than lockbox and on deposit
202 I FMSDOCNO="" S FMSDOCNO=$P($G(^RCY(344.1,+$P($G(^RCY(344,RCRECTDA,0)),"^",6),2)),"^") I FMSDOCNO'="" S PRELOCK=1
203 S STATUS=$$STATUS^GECSSGET(FMSDOCNO)
204 I STATUS=-1 S STATUS="NOT ENTERED"
205 ;
206 ; if the cr document is entered, check to see if entered on line
207 I FMSDOCNO'="",$P($G(^RCY(344,RCRECTDA,2)),"^",2) S STATUS="ON LINE ENTRY"
208 ;
209 ; if the cr document is missing, set status to not sent
210 I FMSDOCNO="" S FMSDOCNO="NOT SENT"
211 ;
212 Q FMSDOCNO_"^"_STATUS_"^"_$G(PRELOCK)
213 ;
214ASK17(DA) ; Ask,return the EFT detail record for a receipt
215 ; DA = the ien of the RECEIPT (file 344)
216 N DIR,X,Y
217 S DIR(0)="PAO^RCY(344.31,:AEMQ",DIR("?",1)="Select the EFT that contained the deposited money that this receipt details",DIR("?",2)="An EFT detail record can only be associated with one receipt"
218 S DIR("?")="This is required if the type of payment is EDI LOCKBOX"
219 S DIR("A")=" EFT DETAIL RECORD: ",DIR("S")="I $S('$O(^RCY(344,""AEFT"",+Y,0)):1,1:$O(^(0))=DA)"
220 S:$P($G(^RCY(344,DA,0)),U,17) DIR("B")=$P(^(0),U,17)
221 D ^DIR K DIR
222 I $D(DUOUT)!$D(DTOUT)!Y=""!(Y<0) Q 0
223 Q +Y
224 ;
Note: See TracBrowser for help on using the repository browser.