source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPEX.m@ 1089

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

initial load of FOIAVistA 6/30/08 version
File size: 9.0 KB
Line 
1RCDPEX ;ALB/TMK - ELECTRONIC EOB EXCEPTION PROCESSING - FILE 344.5 ;10-OCT-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
5 ;
6UPD ; Update (File) ERA msgs manually from EOB exception list for file 344.5
7 N RCDA,RCOK,RCTDA,ZTSK,RCTSK,RCTYP,RCU,RC0
8 D FULL^VALM1
9 D SEL(.RCDA,1)
10 S RCDA=$O(RCDA(""))
11 I RCDA="" G UPDQ
12 S RCTDA=+RCDA(RCDA)
13 I '$$LOCK(RCTDA) G UPDQ
14 S RC0=$G(^RCY(344.5,RCTDA,0))
15 ;
16 I RC0="" D G UPDQ
17 . W !,*7,"ERA #",RCDA," is no longer in exception file" S RCOK=""
18 . D PAUSE^VALM1
19 I $P(RC0,U,5) S RCOK=1 D G:'RCOK UPDQ
20 . N ZTSK
21 . S ZTSK=$P(RC0,U,5) D STAT^%ZTLOAD Q:ZTSK(0)=0 ;Task not scheduled
22 . I "12"[ZTSK(1) W *7,!,"This record has already been scheduled for update. Task # is: ",$P(RC0,U,5) S RCOK="" D PAUSE^VALM1
23 ;
24 S RCTYP=$P(RC0,U,2)
25 S RCU=$S(RCTYP="835ERA":"NEWERA^RCDPESR2("_RCTDA_",1)",RCTYP="835XFR":"FILEEOB^RCDPESR5("_RCTDA_")",1:"")
26 I RCU="" W !,*7,"This message has an invalid 'type' - can't update" D PAUSE^VALM1 G UPDQ
27 S RCTSK=$$TASK(RCU,RCTDA)
28 I RCTSK W !,"File update has been tasked (#",RCTSK,")"
29 I 'RCTSK W !,*7,"File update could not be tasked. Please try again later!!!"
30 D PAUSE^VALM1
31 ;
32 D BLD^RCDPEX1
33UPDQ I $G(RCTDA) L -^RCY(344.5,RCTDA,0)
34 S VALMBCK="R"
35 Q
36 ;
37VP ; View/Print ERA Messages - File 344.5
38 N DHD,DIC,FLDS,BY,FR,TO,DIR,Y,L,RCDA,RCTDA,RCRAW,POP
39 D FULL^VALM1,SEL(.RCDA,1)
40 S RCDA=$O(RCDA(""))
41 G:'RCDA VPQ
42 S RCTDA=$G(RCDA(RCDA))
43 S DIR(0)="YA",DIR("A")="DO YOU WANT TO INCLUDE DATA THE WAY IT WAS RECEIVED (RAW DATA)?: ",DIR("B")="N" D ^DIR K DIR
44 I $D(DUOUT)!$D(DTOUT) G VPQ
45 S RCRAW=+Y
46 ; Ask device
47 N %ZIS,ZTRTN,ZTSAVE,ZTDESC
48 S %ZIS="QM" D ^%ZIS G:POP VPQ
49 I $D(IO("Q")) D G VPQ
50 . S ZTRTN="VPOUT^RCDPEX",ZTDESC="AR - Print EEOB Exception Message"
51 . S ZTSAVE("RCTDA")="",ZTSAVE("RCRAW")=""
52 . D ^%ZTLOAD
53 . W !!,$S($D(ZTSK):"Your task number"_ZTSK_" has been queued.",1:"Unable to queue this job.")
54 . K ZTSK,IO("Q") D HOME^%ZIS
55 U IO
56 ;
57VPOUT ; Entrypoint for queued job
58 N Z,Z0,RCSTOP,RCPG,RCXM,RCXM1,RC,RCZ,RCTDAC
59 K ^TMP($J,"RCRAW"),^TMP($J,"RCOUT")
60 S RCTDAC=RCTDA_","
61 ;
62 D GETS^DIQ(344.5,RCTDAC,"*","IEN","RCZ")
63 D TXTDE(RCTDA,.RCZ,1,.RCXM,.RC)
64 ;
65 I $O(^RCY(344.5,RCTDA,"EX",0)) D
66 . S RC=RC+1,RCXM(RC)="**EXCEPTION MESSAGES**"
67 . D TXTDE(RCTDA,.RCZ,5,.RCXM,.RC)
68 ;
69 K ^TMP("RCSAVE",$J)
70 M ^TMP("RCSAVE",$J)=^RCY(344.5,RCTDA,2)
71 S Z=0 F S Z=$O(^TMP("RCSAVE",$J,Z)) Q:'Z I $P($G(^(Z,0)),U)["835" K ^(0) Q ; Get rid of header node
72 D DISP^RCDPESR0("^TMP(""RCSAVE"",$J)","^TMP($J,""RCRAW"")",1,"^TMP($J,""RCOUT"")",75) ; Get formatted 'raw' data
73 K ^TMP("RCSAVE",$J)
74 I $G(RCRAW) D
75 . S RC=$O(^TMP($J,"RCOUT",""),-1)+1,^TMP($J,"RCOUT",RC)=" "
76 . S RC=RC+1,^TMP($J,"RCOUT",RC)="**RAW DATA**"
77 . S Z=0 F S Z=$O(^RCY(344.5,RCTDA,2,Z)) Q:'Z D
78 .. F Z0=1:80:$L($G(^RCY(344.5,RCTDA,2,Z,0))) S RC=RC+1,^TMP($J,"RCOUT",RC)=$E($G(^RCY(344.5,RCTDA,2,Z,0)),Z0,Z0+79)
79 ;
80 S (RCPG,RCSTOP,Z)=0
81 F S Z=$O(RCXM(Z)) Q:'Z S ^TMP($J,"RCOUT",Z-999)=RCXM(Z)
82 S Z=""
83 F S Z=$O(^TMP($J,"RCOUT",Z)) Q:'Z D Q:RCSTOP
84 . I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W !,"***TASK STOPPED BY USER***" Q
85 . I 'RCPG!(($Y+5)>IOSL) D I RCSTOP Q
86 .. D:RCPG ASK(.RCSTOP) I RCSTOP Q
87 .. D HDR(RCTDA,.RCPG)
88 . W !,$G(^TMP($J,"RCOUT",Z))
89 I 'RCSTOP,RCPG D ASK(.RCSTOP)
90 ;
91 I $D(ZTQUEUED) S ZTREQ="@"
92 I '$D(ZTQUEUED) D ^%ZISC
93 ;
94VPQ K ^TMP($J,"RCRAW"),^TMP($J,"RCOUT")
95 S VALMBCK="R"
96 Q
97 ;
98SEL(RCDA,ONE) ; Select entry(s) from list
99 ; RCDA = array returned if selections made
100 ; RCDA(n)=ien of bill selected in file 344.5
101 ; ONE = if set to 1, only one selection can be made at a time
102 N RC
103 K RCDA
104 D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S"))
105 S RCDA=0 F S RCDA=$O(VALMY(RCDA)) Q:'RCDA S RC=$G(^TMP("RCDPEX-EOBDX",$J,RCDA)),RCDA(RCDA)=+$P(RC,U,2)
106 Q
107 ;
108 ;
109DEL ; Delete messages from messages list - file 344.5
110 N RCDA,RCOK,RCTDA,RCTDAC,RCTYP,RCU,RC0,DIR,RCT,RCE,RCDIQ,RCX,Z,X,Y,XMSUBJ,XMTO,XMBODY,XMDUZ,XMZ
111 D FULL^VALM1
112 S RCTDA=0
113 D SEL(.RCDA,1)
114 S RCDA=$O(RCDA(""))
115 I RCDA="" G DELQ
116 W !
117 S DIR(0)="YA",DIR("A",1)="This action will PERMANENTLY delete an EDI Lockbox message from your system",DIR("A",2)="A bulletin will be sent to report the deletion",DIR("A",3)=" "
118 S DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE? ",DIR("B")="NO"
119 D ^DIR K DIR
120 G:Y'=1 DELQ
121 S RCTDA=+RCDA(RCDA),RCTDAC=RCTDA_","
122 I '$$LOCK(RCTDA) G DELQ
123 S RC0=$G(^RCY(344.5,RCTDA,0))
124 ;
125 I $P(RC0,U,5) S RCOK=1 D G:'RCOK DELQ
126 . N ZTSK
127 . S ZTSK=$P(RC0,U,5) D STAT^%ZTLOAD Q:ZTSK(0)=0 ;Task not scheduled
128 . I "12"[ZTSK(1) W *7,!,"This message is currently scheduled for update. Task # is: ",$P(RC0,U,11) S RCOK="" D PAUSE^VALM1
129 ;
130 S DIR(0)="YA",DIR("A",1)=" ",DIR("A",2)="",$P(DIR("A",2),"*",54)="",DIR("A",3)="* This EDI Lockbox message is about to be PERMANENTLY deleted!! *",DIR("A",4)=DIR("A",2),DIR("A",5)=" "
131 S DIR("A")="ARE YOU STILL SURE YOU WANT TO CONTINUE? ",DIR("B")="NO"
132 W ! D ^DIR W ! K DIR
133 I Y'=1 W !!,"Nothing deleted" D PAUSE^VALM1 G DELQ
134 ;
135 D GETS^DIQ(344.5,RCTDAC,"*","IEN","RCDIQ")
136 S RCE=0
137 D TXTDE(RCTDA,.RCDIQ,1,.RCX,.RCE)
138 S RCE=RCE+1,RCX(RCE)="RAW MESSAGE DATA:"
139 D TXTDE(RCTDA,.RCDIQ,2,.RCX,.RCE)
140 D DELMSG(RCTDA)
141 I $D(^RCY(344.5,RCTDA)) D G DELQ
142 . W !,"Message not deleted - problem with delete" D PAUSE^VALM1
143 ;
144 I $P(RC0,U,2)["XFR",'$P(RC0,U,14) D
145 . S DIR(0)="YA"
146 . S DIR("A")="ARE YOU DELETING THIS BECAUSE THE EEOB DOES NOT BELONG TO YOUR SITE?: ",DIR("B")="YES",DIR("?")="IF YOU RESPOND YES TO THIS QUESTION, A REJECT MESSAGE WILL BE SENT BACK TO",DIR("?",1)=" THE SENDING SITE FOR THIS EEOB"
147 . W ! D ^DIR K DIR
148 . Q:Y'=1
149 . D SENDACK^RCDPESR5(RCTDA,0) ; Send reject notice
150 S RCT(1)="Electronic EDI Lockbox message "_$P(RC0,U)_" has been deleted"
151 S RCT(2)=" "
152 S RCT(3)="DELETED BY: "_$P($G(^VA(200,+$G(DUZ),0)),U)_" "_$$FMTE^XLFDT($$NOW^XLFDT,2)
153 S RCT(4)=" ",RCE=+$O(RCT(""),-1)
154 S Z=0 F S Z=$O(RCX(Z)) Q:'Z S RCE=RCE+1,RCT(RCE)=RCX(Z)
155 S RCE=RCE+1,RCT(RCE)=" "
156 S XMSUBJ="EDI LBOX MESSAGE DELETED",XMBODY="RCT",XMDUZ="",XMTO("G.RCDPE PAYMENTS")=""
157 D SENDMSG^XMXAPI(.5,XMSUBJ,XMBODY,.XMTO,,.XMZ)
158 ;
159 W !,"A bulletin has been sent to report this deletion",!
160 D PAUSE^VALM1
161 ;
162 D BLD^RCDPEX1
163DELQ L -^RCY(344.5,RCTDA,0)
164 S VALMBCK="R"
165 Q
166 ;
167DELMSG(RCTDA) ; Delete message from temporary message holding file 344.5
168 ;
169 N DIK,DA,Y S DIK="^RCY(344.5,",DA=RCTDA D ^DIK
170 Q
171 ;
172TASK(RCRTN,RCTDA) ; Schedule the task to update data base from message
173 ; RCRTN = routine to task
174 ; RCTDA = internal entry of message in file 344.5
175 ;
176 N ZTSK,ZTDESC,ZTIO,ZTDTH,ZTSAVE,DA,DR,DIE
177 S ZTIO="",ZTDTH=$H,ZTDESC="UPDATE DATA BASE FROM EEOB EXCEPTION PROCESSING",ZTSAVE("RC*")="",ZTRTN=RCRTN
178 D ^%ZTLOAD
179 I $G(ZTSK),$G(^RCY(344.5,RCTDA,0)) D
180 . S DIE="^RCY(344.5,",DR=".05////"_ZTSK_";.04////1;.08////0",DA=RCTDA D ^DIE
181 Q $G(ZTSK)
182 ;
183LOCK(RCTDA) ; Attempt to lock message file entry RCTDA in file 344.5
184 ; Return 1 if successful, 0 if not able to lock
185 ;
186 N OK
187 S OK=1
188 L +^RCY(344.5,RCTDA,0):5
189 I '$T D
190 . I '$D(DIQUIET) W !,*7,"Another user is editing this entry ... please try again later" D PAUSE^VALM1
191 . S OK=0
192 Q OK
193 ;
194HDR(RCTDA,RCPG) ;Prints report heading
195 ; RCTDA = ien of file 344.5
196 ; RCPG = page # last printed
197 N Z
198 I RCPG!($E(IOST,1,2)="C-") W @IOF,*13
199 I 'RCPG D
200 . N RCX,RCZ
201 . D TXT0(RCTDA,.RCZ,.RCX,0) ; Get 0-node captioned fields
202 . S Z=0 F S Z=$O(RCX(Z)) Q:'Z S ^TMP($J,"RCHDR_EX",Z)=RCX(Z)
203 S RCPG=RCPG+1
204 W !,?15,"EDI LBOX - EEOB EXCEPTIONS - EEOB DETAIL",?55,$$FMTE^XLFDT(DT,2),?70,"Page: ",RCPG,!
205 S Z=0 F S Z=$O(^TMP($J,"RCHDR_EX",Z)) Q:'Z W !,$G(^(Z))
206 W !,$TR($J("",IOM)," ","=")
207 Q
208 ;
209ASK(RCSTOP) ; Ask to stop
210 ; RCSTOP: passed by ref, flag to stop processing
211 I $E(IOST,1,2)'["C-" Q
212 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
213 S DIR(0)="E" W ! D ^DIR
214 I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
215 Q
216 ; ***
217 ; *** Entrypoints TXT* assume these parameter definitions ***
218 ; ***
219 ; FUNCTIONs returns RCXM1 and RCCT if passed by reference
220 ; RCTDA = ien, file 344.5
221 ; RCXM1 = the array returned with text, captioned
222 ; RCCT = # of lines already in array (optional)
223 ; RCDIQ = the array returned from GETS^DIQ
224 ; ***
225 ;
226TXT0(RCTDA,RCDIQ,RCXM1,RCCT) ; Append 0-node captioned data to array RCXM1
227 ; See above for parameter definitions
228 ;
229 N RCZ,RCTDAC,LINE,DAT,Z,Z0
230 S LINE="",RCCT=+$G(RCCT),RCTDAC=RCTDA_","
231 S Z=0 F S Z=$O(RCDIQ(344.5,RCTDAC,Z)) Q:'Z!(Z'<1) D
232 . S Z0=$$GET1^DID(344.5,Z,,"LABEL")
233 . S DAT=Z0_": "_$G(RCDIQ(344.5,RCTDAC,Z,"E"))
234 . I $L(DAT)>39 S:$L(LINE) RCCT=RCCT+1,RCXM1(RCCT)=LINE S RCCT=RCCT+1,RCXM1(RCCT)=DAT,LINE="" Q
235 . I $L(LINE) D Q:LINE="" ; Left side exists
236 .. I $L(LINE)+$L(DAT)>75 S RCCT=RCCT+1,RCXM1(RCCT)=LINE,LINE=DAT Q
237 .. S LINE=LINE_" "_DAT,RCCT=RCCT+1,RCXM1(RCCT)=LINE,LINE=""
238 . S LINE=$E(DAT_$J("",39),1,39)
239 I $L(LINE) S RCCT=RCCT+1,RCXM1(RCCT)=LINE
240 S:RCCT RCCT=RCCT+1,RCXM1(RCCT)=" "
241 Q
242 ;
243TXTDE(RCTDA,RCDIQ,RCNODE,RCXM1,RCCT) ; Append display data to array RCXM1
244 ; See above for parameter definitions
245 ; RCNODE = the WP field # to return
246 ;
247 N RCCT1,LINE,Z,RCTDAC
248 S LINE="",RCCT=+$G(RCCT),RCCT1=RCCT
249 S RCTDAC=RCTDA_","
250 S Z=0 F S Z=$O(RCDIQ(344.5,RCTDAC,RCNODE,Z)) Q:'Z D
251 . S RCCT=RCCT+1,RCXM1(RCCT)=$G(RCDIQ(344.5,RCTDAC,RCNODE,Z))
252 S:RCCT'=RCCT1 RCCT=RCCT+1,RCXM1(RCCT)=" "
253 Q
254 ;
Note: See TracBrowser for help on using the repository browser.