source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPESR5.m@ 1756

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

initial load of WorldVistAEHR
File size: 5.1 KB
RevLine 
[613]1RCDPESR5 ;ALB/TMK - Server interface 835XFR processing ;10/01/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 ;
5XFR(RCTDA,RCFROM,RCMSG,RCD) ; Send bulletin, update 344.5 for transfer EOB into site
6 ; RCTDA = ien in file 344.5 being updated
7 ; RCFROM = the sender's mail address from the mail message
8 ; RCMSG = message # the data was received in
9 ; RCD = array containing formatted header data
10 ;
11 N RCCT,RCDXM,DA,DR,DIE,X,Y,Z,RCFROMNM
12 S Z=$P($P(RCD("SUBJ"),"REF #",2),"#"),RCFROMNM=$TR($P(RCFROM,"@",2),">")
13 I RCFROMNM="" S RCFROMNM=RCFROM
14 S DA=RCTDA,DR=".05///@;.08////1;.1///3"_$S($P(RCFROM,"@",2)'="":";.12////"_RCFROMNM,1:"")_";.13////^S X=("_+Z_"_$C(59)_"_$P(Z,";",2)_")"_$S($G(RCD("PAYFROM"))'="":";3.01////"_RCD("PAYFROM"),1:"")
15 S DIE="^RCY(344.5," D ^DIE
16 ;
17 D SENDACK(RCTDA,"") ; acknowledge receipt of transferred EOB
18 ;
19 S RCDXM(1)="An EEOB transmission has been received by the EDI Lockbox",RCDXM(2)=" system that was sent to you from another VistA site. Please review"
20 S RCDXM(3)=" it in EEOB exception processing and file the EEOB if it belongs to your",RCDXM(4)=" site or delete the message to return the EEOB to the site it was sent from."
21 S RCDXM(5)=" ",RCDXM(6)="The message was sent by "_RCFROM
22 S RCDXM(7)="The mail message number is "_RCMSG
23 S RCDXM(8)=" ",RCDXM(9)="EEOB DATA INCLUDED:"
24 S RCCT=9
25 K ^TMP($J)
26 D DISP^RCDPESR0("^RCY(344.5,"_RCTDA_",2)","^TMP($J,""PRCA_EXT"")",1,"^TMP($J,""PRCA_LINES"")",70)
27 S Z=0 F S Z=$O(^TMP($J,"PRCA_LINES",Z)) Q:'Z S RCCT=RCCT+1,RCDXM(RCCT)=$J("",3)_$G(^TMP($J,"PRCA_LINES",Z))
28 D BULLERA^RCDPESR0("",RCTDA,RCMSG,"EDI LBOX EEOB FROM "_$E(RCFROMNM,1,18)_" FOR "_$E($G(RCD("PAYFROM")),1,20),.RCDXM,1)
29 K ^TMP($J)
30 Q
31 ;
32SENDACK(RCTDA,RCSTAT) ; Send accept/reject msg to transf 'from' site
33 ; RCTDA = ien of entry file 344.5
34 ; RCSTAT = flag to indicate what happened
35 ; values: "" = receipt 1 = accepted 0 = rejected
36 ;
37 N RC,RC0,RCDOM,RCREF,XMTO,XMBODY,XMZ
38 ; Send a mail message to sending site for accept/reject of EOB
39 S RC0=$G(^RCY(344.5,RCTDA,0)),RCREF=$P(RC0,U,13)
40 S RCDOM="@"_$S($P(RC0,U,12)'="":$P(RC0,U,12),1:$$KSP^XUPARAM("WHERE")) S:RCDOM="@" RCDOM=""
41 I RCREF,$P(RCREF,";",2) D
42 . ; 835ACK^accept/reject flag (""/0/1)^ien file 344_;_ien file 344.41
43 . S RC(1)="835XAK^"_RCSTAT_U_+$P(RCREF,";")_";"_+$P(RCREF,";",2)
44 . S XMBODY="RC",XMTO("S.RCDPE EDI LOCKBOX SERVER"_RCDOM)=""
45 . D
46 .. N DUZ S DUZ=.5,DUZ(0)="@"
47 .. D SENDMSG^XMXAPI(.5,"TRANSFER EEOB ACKNOWLEDGEMENT",XMBODY,.XMTO,,.XMZ)
48 Q
49 ;
50FILEEOB(RCTDA) ; Files trans-in EOB in IB
51 N DIE,DA,DR,X,Y,RCE
52 D UPDEOB^RCDPESR2(RCTDA,5)
53 I $D(^RCY(344.5,RCTDA,0)) D
54 . S DIE="^RCY(344.5,",DR=".04////0;.05///@;.1////5",DA=RCTDA D ^DIE
55 Q
56 ;
57BULL1(RCTDA,RCERR,DUP) ; Send bulletin for EDI Lockbox EOB exceptions
58 ; RCTDA = ien of entry in file 344.5
59 ; RCERR = the name of the error global
60 ; DUP = ien of existing entry in file 344.4 if ERA is duplicate
61 ;
62 N RCSUBJ
63 S RCSUBJ="EDI LBOX "_$S(DUP:"ERA - DUPLICATE TRANSMISSION MSG #"_DUP,1:" EEOB - EXCEPTIONS")_" "_$E($P($G(^RCY(344.5,RCTDA,3)),U),1,20)
64 S RCSUBJ=$E(RCSUBJ,1,65)
65 S DUP=+$G(DUP)
66 D BULLERA^RCDPESR0("D",RCTDA,$P($G(^RCY(344.5,RCTDA,0)),U,11),RCSUBJ,RCERR,0)
67 Q
68 ;
69BULL2(RCTDA,RCERR,RCXMG) ; Send bulletin for EOB transfer received at site
70 ; RCTDA = ien of entry in file 344.5
71 ; RCXMG = incoming message #
72 ; RCERR = the name of the error global
73 ;
74 N RCDIQ,RCXM,RCXM1,XMBODY,XMZ,XMTO,RC,Z,Q,RCSUBJ
75 S RCSUBJ="EDI LBOX EEOB DETAIL RE-FILE ATTEMPTED TO IB"
76 S XMTO("I:G.RCDPE PAYMENTS")="",RC=0
77 K ^TMP("RCERR_BULL2",$J)
78 S RC=RC+1,^TMP("RCERR_BULL2",$J,RC)="The following EEOB was received at your site.",RC=RC+1,^TMP("RCERR_BULL2",$J,RC)="It was received on: "_$$FMTE^XLFDT($$NOW^XLFDT(),2)_" in mail msg # "_RCXMG_"."
79 S RC=RC+1,^TMP("RCERR_BULL2",$J,RC)="The initial attempt to file this data in IB failed and this message",RC=RC+1,^TMP("RCERR_BULL2",$J,RC)="is the result of a subsequent attempt to file this EEOB detail data in IB"
80 S RC=RC+1,^TMP("RCERR_BULL2",$J,RC)=" "
81 D GETS^DIQ(344.4,+RCTDA_",","*","IEN","RCDIQ")
82 D TXT0^RCDPEX31(+RCTDA,.RCDIQ,.RCXM,0)
83 S Z=0 F S Z=$O(RCXM(Z)) Q:'Z S RC=RC+1,^TMP("RCERR_BULL2",$J,RC)=RCXM(Z)
84 I $G(RCERR)'="",$E(RCERR,1,5)'="^TMP(" S RC=RC+1,^TMP("RCERR_BULL2",$J,RC)=RCERR,RC=RC+1,^TMP("RCERR_BULL2",$J,RC)=" "
85 S RCERR=$S($E(RCERR,1,5)="^TMP(":RCERR,1:"RCERR")
86 I $O(@RCERR@(""))'="" D
87 . S Z="" F S Z=$O(@RCERR@(Z)) Q:Z="" D
88 .. I $G(@RCERR@(Z))'="" S RC=RC+1,^TMP("RCERR_BULL2",$J,RC)=@RCERR@(Z)
89 .. I $O(@RCERR@(Z,0)) S Q="" F S Q=$O(@RCERR@(Z,Q)) Q:Q="" S RC=RC+1,^TMP("RCERR_BULL2",$J,RC)=@RCERR@(Z,Q)
90 S XMBODY="^TMP(""RCERR_BULL2"","_$J_")"
91 D
92 . N DUZ S DUZ=.5,DUZ(0)="@"
93 . D SENDMSG^XMXAPI(.5,$E(RCSUBJ,1,65),XMBODY,.XMTO,,.XMZ)
94 K ^TMP("RCERR_BULL2",$J)
95 Q
96 ;
97DISP1(RCCT,RCNOH) ; Extract formatted EOB detail for bill
98 ; RCCT = bill seq# within ERA transmission
99 ; RCNOH = 1 if no header text needed on 05 rec
100 ;
101 ; Error array returned in ^TMP("RCERR1",$J)
102 ;
103 N RC1,RC2,RCCT1,Z
104 D DISP^RCDPESR0("^TMP($J,""RCDP-EOB"","_RCCT_")","RC1",1)
105 D FMTDSP^RCDPESR0("RC1","RC2",75,RCNOH)
106 S Z=0,RCCT1=$O(^TMP("RCERR1",$J,RCCT," "),-1)
107 F S Z=$O(RC2(Z)) Q:'Z S RCCT1=RCCT1+1,^TMP("RCERR1",$J,RCCT,RCCT1)=RC2(Z)
108 Q
109 ;
Note: See TracBrowser for help on using the repository browser.