source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPEM2.m

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

initial load of FOIAVistA 6/30/08 version

File size: 8.2 KB
Line 
1RCDPEM2 ;ALB/TMK - MANUAL ERA AND EFT MATCHING ;05-NOV-02
2 ;;4.5;Accounts Receivable;**173,208**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5MATCH1 ; Manually 'match' an ERA to an EFT
6 N DA,DR,DIE,DIC,DIR,X,Y,RCEFT,RCERA,RCNAME,RCMATCH,RCQUIT,DUOUT,DTOUT
7 W !,"THIS OPTION WILL ALLOW YOU TO MANUALLY MATCH AN EFT DETAIL RECORD",!,"WITH AN ERA RECORD"
8M1 S DIR("A")="SELECT THE UNMATCHED EFT TO MATCH TO AN ERA: "
9 S DIR(0)="PAO^RCY(344.31,:AEMQ",DIR("S")="I '$P(^(0),U,8)"
10 W ! D ^DIR K DIR
11 I $D(DUOUT)!$D(DTOUT)!(Y<0) G M1Q
12 S RCEFT=+Y,RCEFT(0)=$G(^RCY(344.31,+Y,0))
13 W !
14 S DIC="^RCY(344.31,",DR="0",DA=RCEFT D EN^DIQ
15 W !
16 S DIR("A")="ARE YOU SURE THIS IS THE EFT YOU WANT TO MATCH?: ",DIR(0)="YA",DIR("B")="YES" D ^DIR K DIR
17 I $D(DUOUT)!$D(DTOUT) G M1Q
18 I Y'=1 G M1
19M12 S DIR("A")="SELECT THE UNMATCHED ERA TO MATCH TO EFT #"_RCEFT_": "
20 S DIR(0)="PAO^RCY(344.4,:AEMQ",DIR("S")="I '$P(^(0),U,9),'$P(^(0),U,8)"
21 W ! D ^DIR K DIR
22 I $D(DUOUT)!$D(DTOUT)!(Y<0) G M1Q
23 S RCERA=+Y,RCERA(0)=$G(^RCY(344.4,+Y,0))
24 W !
25 S DIC="^RCY(344.4,",DR="0",DA=RCERA D EN^DIQ
26 W !
27 S DIR("A")="ARE YOU SURE THIS IS THE CORRECT ERA TO MATCH TO?: ",DIR(0)="YA",DIR("B")="YES" D ^DIR K DIR
28 I $D(DUOUT)!$D(DTOUT) G M1Q
29 I Y'=1 G M12
30 S RCMATCH=(+$P(RCERA(0),U,5)=+$P(RCEFT(0),U,7))
31 S RCNAME=($P(RCERA(0),U,6)=$P(RCEFT(0),U,2))
32 I 'RCMATCH!'RCNAME D G:RCQUIT M1Q
33 . N Z
34 . S RCQUIT=0,Z=1
35 . S DIR("A",1)="***WARNING***"
36 . I 'RCNAME S Z=Z+1,DIR("A",Z)=$J("",3)_"> The payer names on these two records do not agree"
37 . I 'RCMATCH S Z=Z+1,DIR("A",Z)=$J("",3)_"> The amount of payment on these two records do not agree"
38 . S DIR(0)="YA",DIR("B")="NO",DIR("A")="ARE YOU SURE YOU WANT TO MATCH THESE 2 RECORDS?: " W ! D ^DIR K DIR
39 . I $S($D(DUOUT)!$D(DTOUT):1,Y'=1:1,1:0) S RCQUIT=1 Q
40 S DIE="^RCY(344.4,",DR=".09////1",DA=RCERA D ^DIE
41 I '$D(Y) S DIE="^RCY(344.31,",DR=".08////1;.1////"_RCERA,DA=RCEFT D ^DIE
42 S DIR(0)="EA",DIR("A",1)="EFT #"_RCEFT_" WAS "_$S('$D(Y):"SUCCESSFULLY",1:"NOT")_" MATCHED TO ERA #"_RCERA,DIR("A")="PRESS RETURN TO CONTINUE: " D ^DIR K DIR
43M1Q Q
44 ;
45MATCH2 ; Manually 'match' a 0-balance EFT to a paper EOB
46 N DUOUT,DTOUT,DA,DR,DIE,DIC,DIR,X,Y,RCEFT,RCRCPT
47 W !,"THIS OPTION WILL ALLOW YOU TO MANUALLY MARK A 0-BALANCE EFT DETAIL RECORD",!,"AS MATCHED TO A PAPER EOB"
48M2 S DIR("A")="SELECT THE UNMATCHED 0-BALANCE EFT TO MARK AS MATCHED TO PAPER EOB: "
49 S DIR(0)="PAO^RCY(344.31,:AEMQ",DIR("S")="I '$P(^(0),U,8),'$P(^(0),U,7)"
50 W ! D ^DIR K DIR
51 I $D(DUOUT)!$D(DTOUT)!(Y'>0) G M2Q
52 S RCEFT=+Y
53 W !
54 S DIC="^RCY(344.31,",DR="0",DA=RCEFT D EN^DIQ
55 W !
56 S DIR("A")="ARE YOU SURE THIS IS THE EFT YOU WANT TO MARK AS MATCHED?: ",DIR(0)="YA",DIR("B")="YES" D ^DIR K DIR
57 I $D(DUOUT)!$D(DTOUT) G M2Q
58 I Y'=1 G M2
59 S DIE="^RCY(344.31,",DR=".08////2",DA=RCEFT D ^DIE
60 S DIR(0)="EA",DIR("A")="EFT #"_RCEFT_" WAS "_$S('$D(Y):"SUCCESSFULLY",1:"NOT")_" MARKED AS MATCHED TO PAPER EOB" D ^DIR K DIR
61M2Q Q
62 ;
63MANTR ; Mark an EFT detail record as 'TR' posted manually
64 N DA,DR,DIC,DIE,DIR,X,Y,RCEFT,DUOUT,DTOUT,RCZ0,RCTR,RCHOW
65 ; EFT detail cannot be associated with a receipt or TR document
66 ;
67 W !,"*****",!," YOU SHOULD ONLY USE THIS OPTION IF YOU HAVE AN EFT DETAIL RECORD ON YOUR",!," UNAPPLIED DEPOSIT REPORT WHOSE DETAIL WAS ENTERED ON LINE VIA A TR DOCUMENT",!,"*****",!
68 S DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,16)="""",$P(^(0),U,11)",DIC("A")="SELECT THE EFT DETAIL WHOSE 'TR' DOC WAS MANUALLY ENTERED ON LINE: ",DIC="^RCY(344.31,"
69 W ! D ^DIC K DIC
70 I Y'>0 G MANTRQ
71 S RCEFT=+Y,RCZ0=$G(^RCY(344.31,RCEFT,0))
72 S DIR(0)="FA^2:30^K:X'?1""TR"".E X",DIR("A")="ENTER THE TR DOC # THAT WAS ENTERED ON-LINE FOR THE EFT DETAIL: "
73 W ! D ^DIR K DIR
74 I $D(DTOUT)!$D(DUOUT) G MANTRQ
75 S RCTR=Y,DR=""
76 ;
77 I '$P(RCZ0,U,8) D G:RCQUIT MANTRQ ;Unmatched
78 . S DIR(0)="SA^E:ELECTRONIC ERA;P:PAPER EOB",DIR("A")="WAS THE EFT DETAIL RECEIVED BY (E)RA or (P)APER EOB?: " W ! D ^DIR K DIR
79 . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
80 . S RCHOW=Y,DR=""
81 . I RCHOW="E" D
82 .. S DR=";.09R;.08////1"
83 . I RCHOW="P" D
84 .. S DR=";.08////2"
85 ;
86 S DIR(0)="YA",DIR("B")="NO",DIR("A",1)="THIS WILL MARK EFT DETAIL #: "_RCEFT_" AS MANUALLY POSTED",DIR("A",2)=" USING TR DOC: "_RCTR
87 S DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE?: " W ! D ^DIR K DIR
88 I Y'=1 D G MANTRQ
89 . S DIR(0)="EA",DIR("A")="EFT NOT UPDATED - PRESS RETURN TO CONTINUE: " W ! D ^DIR K DIR
90 S DIE="^RCY(344.31,",DA=RCEFT,DR=".16R"_DR D ^DIE
91 I $D(Y) D
92 . S DIE="^RCY(344.31,",DA=RCEFT,DR=".16///@;.08///"_$S($P(RCZ0,U,8)'="":$P(RCZ0,U,8),1:"@") D ^DIE
93 . S DIR("A")="EFT NOT UPDATED - PRESS RETURN TO CONTINUE"
94 E D
95 . S DIR("A")="STATUS UPDATED FOR EFT DETAIL #: "_RCEFT_" - PRESS RETURN TO CONTINUE: "
96 S DIR(0)="EA"
97 W ! D ^DIR K DIR
98 ;
99MANTRQ Q
100 ;
101CHK() ; Function returns the ien of CHECK/MO payment type
102 Q +$O(^RC(341.1,"AC",4,0))
103 ;
104POSTED ; Mark an ERA as posted when the data was previously posted using
105 ; paper EOB information
106 N DIC,DIE,DIR,DA,DR,X,Y
107 ; Must be unmatched or matched to paper check, must not already have a receipt, must not be posted yet
108 W !!,"THIS OPTION IS USED WHEN YOU HAVE POSTED AN ERA PAID WITH A PAPER CHECK",!,"BY USING THE PAPER EOB AND YOU DID NOT REFERENCE THE ERA IN THE RECEIPT",!!
109 S DIC("S")="I ""02""[+$P(^(0),U,9),$S('$P(^(0),U,8):1,1:'$P(^(0),U,5)),$P(^(0),U,14)=0",DIC="^RCY(344.4,",DIC(0)="AEMQ"
110 D ^DIC K DIC
111 ;
112 I Y'>0 G POSTEDQ
113 ;
114 S DIE="^RCY(344.4,",DR=".08R;.09////2;.14////2;20.03////1",DA=+Y D ^DIE
115 I '$D(Y) D
116 . S DIR(0)="EA",DIR("A",1)="ERA HAS BEEN MARKED AS POSTED USING PAPER EOB",DIR("A")="PRESS RETURN TO CONTINUE " D ^DIR K DIR
117 ;
118POSTEDQ Q
119 ;
120MATCH3 ; Manually 'match' a 0-balance ERA that has no check or EFT
121 N DUOUT,DTOUT,DA,DR,DIE,DIC,DIR,X,Y,RCERA,RCRCPT
122 W !,"THIS OPTION WILL ALLOW YOU TO MANUALLY MARK A 0-BALANCE ERA WITH NO",!,"CHECK OR EFT AS 'MATCH-0 PAYMENT' TO REMOVE IT FROM THE ERA AGING REPORT"
123M3 S DIR("A")="SELECT THE UNMATCHED 0-BALANCE ERA TO MARK AS MATCHED: "
124 S DIR(0)="PAO^RCY(344.4,:AEMQ",DIR("S")="I '$P(^(0),U,9),'$P(^(0),U,5)"
125 W ! D ^DIR K DIR
126 I $D(DUOUT)!$D(DTOUT)!(Y'>0) G M3Q
127 S RCERA=+Y
128 W !
129 S DIC="^RCY(344.4,",DR="0",DA=RCERA D EN^DIQ
130 W !
131 S DIR("A")="ARE YOU SURE THIS IS THE ERA YOU WANT TO MARK AS MATCH-0 PAYMENT?: ",DIR(0)="YA",DIR("B")="YES" D ^DIR K DIR
132 I $D(DUOUT)!$D(DTOUT) G M3Q
133 I Y'=1 G M3
134 S DIE="^RCY(344.4,",DR=".09////3",DA=RCERA D ^DIE
135 S DIR(0)="EA",DIR("A")="ERA #"_RCERA_" WAS "_$S('$D(Y):"SUCCESSFULLY",1:"NOT")_" MARKED AS MATCH-0 PAYMENT" D ^DIR K DIR
136M3Q Q
137 ;
138UNMATCH ; Used to 'unmatch' an ERA matched in error
139 N X,Y,DIR,DIC,DIE,DIK,DA,DR,RCWL,RCEFT,RCQUIT
140 S DIC(0)="AEMQ",DIC="^RCY(344.4,",DIC("S")="I '$P(^(0),U,8),$S('$P(^(0),U,14):1,1:$P(^(0),U,9)=3),$P(^(0),U,9)" D ^DIC K DIC
141 Q:Y'>0
142 S RCWL=+Y,RCQUIT=0
143 I $D(^RCY(344.49,RCWL,0)) D Q:RCQUIT
144 . S DIR(0)="YA",DIR("A",1)="THIS ERA ALREADY HAS A WORKLIST ENTRY AND MUST BE DELETED BEFORE IT CAN BE UNMATCHED",DIR("A")="DO YOU WANT TO DELETE THE WORKLIST ENTRY FOR THIS ERA NOW?: "
145 . W ! D ^DIR K DIR
146 . I Y'=1 S RCQUIT=1 Q
147 . S DIK="^RCY(344.49,",DA=RCWL D ^DIK
148 I $O(^RCY(344.31,"AERA",RCWL,0)) S RCEFT=+$O(^(0)) D Q:RCQUIT
149 . S DIR("A",1)="THIS ERA IS MATCHED TO EFT #"_RCEFT,DIR("A")="ARE YOU SURE YOU WANT TO UNMATCH THEM?: ",DIR(0)="YA"
150 . W ! D ^DIR K DIR
151 . I Y'=1 S RCQUIT=1 Q
152 . S DIE="^RCY(344.31,",DR=".1///@;.08////0",DA=RCEFT D ^DIE
153 . W !,"EFT #"_RCEFT_" IS NOW UNMATCHED",!
154 S DIE="^RCY(344.4,",DR=".09////0;.13///@;.14////0",DA=RCWL D ^DIE
155 S DIR("A")="ERA HAS BEEN SUCCESSFULLY UNMATCHED - PRESS RETURN TO CONTINUE "
156 S DIR(0)="EA" W ! D ^DIR K DIR
157 Q
158 ;
159RETN ; Entrypoint for returned ERA
160 N DIR,X,Y,DTOUT,DUOUT,DIC,RCY,DIE,DA,DR
161 W !!,"USE THIS OPTION ONLY IF YOU HAVE A PAPER CHECK THAT HAS BEEN RETURNED TO",!,"THE PAYER WITHOUT BEING DEPOSITED AND YOU WANT TO MARK THE CORRESPONDING",!,"ERA AS NOT POSTED/RETURNED TO PAYER",!
162 S DIC="^RCY(344.4,",DIC(0)="AEMQ",DIC("S")="I $S($P(^(0),U,9)=0!($P(^(0),U,9)=2):1,1:0),'$P(^(0),U,14)" D ^DIC
163 Q:Y'>0
164 S RCY=+Y
165 S DIR(0)="YA",DIR("A",1)="THIS WILL MARK THE ERA # "_+Y_" AS RETURNED TO PAYER/NOT POSTED",DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE?: " W ! D ^DIR K DIR
166 I $D(DTOUT)!$D(DUOUT)!Y=0 D
167 . S DIR("A",1)="NO CHANGES MADE TO ERA # "_RCY
168 E D
169 . S DIR("A",1)="ERA # "_RCY_" HAS BEEN MARKED AS RETURNED TO PAYER/NOT POSTED"
170 . S DIE="^RCY(344.4,",DR=".14////4;.09////2",DA=RCY D ^DIE
171 S DIR(0)="EA",DIR("A")="PRESS RETURN TO CONTINUE: "
172 W ! D ^DIR K DIR
173 Q
174 ;
Note: See TracBrowser for help on using the repository browser.