source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPESR1.m@ 794

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

initial load of FOIAVistA 6/30/08 version
File size: 7.2 KB
Line 
1RCDPESR1 ;ALB/TMP - Server interface to AR from Austin ;06/03/02
2 ;;4.5;Accounts Receivable;**173,214,208,202**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6PERROR(RCERR,RCEMG,RCXMZ) ; Process Errors - Send bulletin to mail group
7 ; RCERR = Error text array
8 ; RCEMG = name of the mail group to which these errors should be sent
9 ; RCXMZ = internal entry # of the mailman msg
10 ; RCTYPE = msg type, if known
11 N CT,XMDUZ,XMSUBJ,XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,RCXM,XMZ,XMERR,Z
12 ;
13 S CT=0
14 ;
15 I $G(RCEMG)="" S CT=CT+1,RCXM(CT)=$P($T(ERROR+2),";;",2),XMTO(.5)=""
16 ;
17 I $D(RCEMG) D
18 . S:RCEMG="" RCEMG="RCDPE PAYMENTS EXCEPTIONS"
19 . S:$E(RCEMG,1,2)'="G." RCEMG="G."_RCEMG
20 . S XMTO("I:"_RCEMG)=""
21 ;
22 S Z=$O(XMTO("")) I Z=.5,'$O(XMTO(.5)) S XMTO("I:G.RCDPE PAYMENTS EXCEPTIONS")=""
23 D EMFORM(CT,.RCERR,.RCXM,RCXMZ)
24 ;
25 S XMDUZ=""
26 S XMSUBJ="EDI LBOX SERVER OPTION ERROR",XMBODY="RCXM"
27 D
28 . N DUZ S DUZ=.5,DUZ(0)="@"
29 . D SENDMSG^XMXAPI(.5,XMSUBJ,XMBODY,.XMTO,,.XMZ)
30 K ^TMP("RCRAW",$J)
31 Q
32 ;
33EMFORM(CT,RCERR,RCXM,RCXMZ) ; Format error msgs
34 ; INPUT:
35 ; CT = # of lines previously populated in error msg
36 ; RCERR = array of errors
37 ; RCXMZ = internal entry # of mailman msg
38 ;
39 ; OUTPUT:
40 ; RCXM = array containing the complete error msg text
41 ;
42 N TTYPE,TDATE,TTIME,Z
43 ;
44 S TDATE=$G(^TMP("RCERR",$J,"DATE")),TTIME=$P(TDATE,".",2)_"000000",TDATE=$$FMTE^XLFDT($P(TDATE,"."),"2D")
45 S TTYPE=$G(^TMP("RCMSG",$J))
46 ;
47 S CT=CT+1
48 S RCXM(CT)="** AN EXCEPTION HAS BEEN DETECTED FOR AN EDI LOCKBOX RETURN MESSAGE **",CT=CT+1,RCXM(CT)=" "
49 S CT=CT+1
50 S RCXM(CT)=" Return Message Code: "_$S(TTYPE="":$S($G(^TMP("RCERR",$J,"TYPE"))'="":^("TYPE"),1:"Cannot be determined"),1:TTYPE)
51 ;
52 S CT=CT+2
53 S RCXM(CT-1)=" ",RCXM(CT)=$J("",13)_"Return Message Date: "_TDATE_" Message Time: "_$E(TTIME,1,2)_":"_$E(TTIME,3,4)_":"_$E(TTIME,5,6),CT=CT+1
54 ;
55 S CT=CT+2,RCXM(CT-1)=" ",RCXM(CT)=$J("",15)_"Mailman Message #: "_$G(RCXMZ)
56 ;
57 I $G(RCERR)'="",RCERR?1A.E S CT=CT+2,RCXM(CT-1)=" ",RCXM(CT)=RCERR
58 I $G(^TMP("RCERR",$J,"TEXT"))'="" S CT=CT+2,RCXM(CT)=^("TEXT"),RCXM(CT-1)=" "
59 ;
60 S Z="" F S Z=$O(RCERR(Z)) Q:Z="" S:$G(^TMP("RCERR",$J,"TEXT"))="" CT=CT+1,RCXM(CT)=" " I $G(RCERR(Z))'="",RCERR(Z)'=" " S CT=CT+1,RCXM(CT)=RCERR(Z)
61 S Z=0 F S Z=$O(^TMP("RCERR",$J,"MSG",Z)) Q:'Z S CT=CT+1,RCXM(CT)=^(Z)
62 ;
63 Q
64 ;
65EXTERR(RCERR,RCE) ; Put error into error array
66 ; Returns: (must be passed by reference)
67 ; RCERR = specific error encountered, returned as 4
68 ; RCE = error text from the word processing field update error global
69 N RCZ,Q
70 S RCE="",RCERR=4 ; error reported as 'record was partially stored'
71 S RCZ=0 F S RCZ=$O(RCE("DIERR",RCZ)) Q:'RCZ S Q=$G(RCE("DIERR",RCZ,"TEXT",1)) I $L(Q),$L(Q)+$L(RCE)<99 S RCE=RCE_Q_";;"
72 Q
73 ;
74ERRUPD(RCGBL,RCD,RCTYPE,RCERR) ; Set up global array to hold msg data
75 ; RCGBL = name of the global or array where msg data is found
76 ; RCD = array containing mail header data for the msg
77 ; RCTYPE = type of msg (835ERA/835XFR/etc)
78 ; RCERR = error array - text or reference to error tables below
79 ;
80 ; Returns ^TMP("RCERR",$J,"MSG" array with formatted error text
81 ;
82 N Z,Z0,Z1,Z2,CT,RCE
83 ;
84 Q:$G(RCERR)<0
85 K ^TMP("RCERR",$J)
86 S CT=0
87 ;
88 S ^TMP("RCERR",$J,"DATE")=$G(RCD("DATE"))
89 S ^TMP("RCERR",$J,"TYPE")=$G(RCTYPE)
90 S ^TMP("RCERR",$J,"SUBJ")=$G(RCD("SUBJ"))
91 ;
92 I $G(RCERR)>0,RCERR<20 D
93 . S Z="ERROR2+"_RCERR
94 . S RCE=$P($T(@Z),";;",2)
95 . I RCE'="" S ^TMP("RCERR",$J,"TEXT")=RCE
96 ;
97 S Z="" F S Z=$O(RCERR(Z)) Q:Z="" S Z0="" F S Z0=$O(RCERR(Z,Z0)) Q:Z0="" S RCE=$G(RCERR(Z,Z0)) D
98 . I $L(RCE) S CT=CT+1,^TMP("RCERR",$J,"MSG",CT)=$S(RCE:$P($T(ERROR+RCE),";;",2),1:RCE)
99 . S RCTYPE=$P($G(@RCGBL@(0)),U)
100 . S:$G(^TMP("RCERR",$J,"TYPE"))="" ^("TYPE")=RCTYPE
101 . S Z1=""
102 . F S Z1=$O(@RCGBL@(1,"D",Z1)) Q:Z1="" S CT=CT+1,^TMP("RCERR",$J,"MSG",CT)=$G(@RCGBL@(1,"D",Z1))
103 ;
104 I $D(@RCGBL@(2,"D")) D
105 . S CT=CT+2,^TMP("RCERR",$J,"MSG",CT-1)=" ",^TMP("RCERR",$J,"MSG",CT)="**** RAW MESSAGE DATA ****:"
106 . I $G(^TMP("RCMSGH",$J,0))'="" S CT=CT+1,^TMP("RCERR",$J,"MSG",CT)=^TMP("RCMSGH",$J,0)
107 . S Z2="" F S Z2=$O(@RCGBL@(2,"D",Z2)) Q:Z2="" S CT=CT+1,^TMP("RCERR",$J,"MSG",CT)=$G(@RCGBL@(2,"D",Z2))
108 E D
109 . Q:'$D(^TMP("RCRAW",$J))
110 . S CT=CT+2,^TMP("RCERR",$J,"MSG",CT-1)=" ",^TMP("RCERR",$J,"MSG",CT)="**** RAW MESSAGE DATA ****:"
111 . I $G(^TMP("RCMSGH",$J,0))'="" S CT=CT+1,^TMP("RCERR",$J,"MSG",CT)=^TMP("RCMSGH",$J,0)
112 . S Z2="" F S Z2=$O(^TMP("RCRAW",$J,Z2)) Q:Z2="" S CT=CT+1,^TMP("RCERR",$J,"MSG",CT)=$G(^TMP("RCRAW",$J,Z2))
113 ;
114 Q
115 ;
116DKILL(RCXMZ) ; Delete server mail msg from postmaster mailbox
117 ; RCXMZ = ien of mailman msg
118 ;
119 D ZAPSERV^XMXAPI("S.RCDPE EDI LOCKBOX SERVER",RCXMZ)
120 Q
121 ;
122TEMPDEL(DA) ; Delete msg from temporary msg file
123 ; DA = ien of the entry in file 344.5
124 ;
125 N DIK,Y,X
126 S DIK="^RCY(344.5," D ^DIK
127 L -^RCY(344.5,DA,0)
128 Q
129 ;
130RESTMSG(RCD,RCARRAY,XMZ) ; Read rest of msg, store in array
131 ; RCD = last line # already in the msg
132 ; RCARRAY = name of the array to store the data in
133 ; XMZ = ien of the mailman msg
134 ;
135 F X XMREC Q:XMER<0 S RCD=RCD+1,@RCARRAY@(RCD)=XMRG
136 Q
137 ;
138TAXERR(RCTYPE,RCINS,RCTID,RCCHG) ; Send a bulletin for a bad tax id
139 ; RCTYPE = "ERA" for an ERA record, "EFT" for an EFT record
140 ; RCINS = name and id to identify the ins co
141 ; RCTID = tax id sent in error
142 ; RCCHG = code describing how correction was made
143 ; 'E'=EPHRA, 'C'=Changed by looking at claim #'s
144 ;
145 N XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,RCDXM,XMZ,XMERR,RCCT,RCDXM,RCCT
146 S RCCT=0
147 S RCCT=RCCT+1,RCDXM(RCCT)="An "_RCTYPE_" was received at your site "_$$FMTE^XLFDT($$NOW^XLFDT(),2)_" with an invalid tax id.",RCCT=RCCT+1,RCDXM(RCCT)=" From: "_RCINS
148 S RCCT=RCCT+1,RCDXM(RCCT)=" The tax id sent was: "_RCTID_" and it was corrected by: "
149 S RCCT=RCCT+1,RCDXM(RCCT)=" "_$S(RCCHG="E":"EPHRA",1:"Extracting it based on bill numbers in the ERA")
150 S RCCT=RCCT+2,RCDXM(RCCT-1)=" ",RCDXM(RCCT)="If your site continues to receive these bulletins for this payer,",RCCT=RCCT+1,RCDXM(RCCT)="contact the payer and request they correct their tax id for your site"
151 ;
152 S XMTO("I:G.RCDPE PAYMENTS")="",XMBODY="RCDXM"
153 D
154 . N DUZ S DUZ=.5,DUZ(0)="@"
155 . D SENDMSG^XMXAPI(.5,"EDI LBOX ERRONEOUS TAX ID ON "_RCTYPE,XMBODY,.XMTO,,.XMZ)
156 Q
157 ;
158BILL(X,RCDT,RCIB) ; Returns ien of bill in X or -1 if not valid
159 ; RCDT = the Statement from date (used for Rx bills)
160 ; and, if passed by reference, RCIB = 1 if an insurance bill
161 N DIC,Y
162 S RCIB=0
163 S X=$TR(X," "),X=$TR(X,"O","0") ; Remove spaces, change ohs to zeroes
164 I X'["-",$E(X,1,3)?3N,$L(X)>7 S X=$E(X,1,3)_"-"_$E(X,4,$L(X))
165 S DIC="^PRCA(430,",DIC(0)="MZ" D ^DIC
166 I Y<0,X?1.7N D ; Rx lookup
167 . N ARRAY
168 . S ARRAY("ECME")=X,ARRAY("FILLDT")=$G(RCDT)
169 . S Y=$$RXBIL^IBNCPDPU(.ARRAY)
170 . I Y>0 S Y(0)=$G(^PRCA(430,+Y,0))
171 I Y>0 S RCIB=($P($G(^RCD(340,+$P(Y(0),U,9),0)),U)["DIC(36,")
172 Q +Y
173 ;
174FMDT(X) ; Format date (X) in YYYYMMDD to Fileman format
175 I $L(X)=8 D
176 . S X=$E(X,1,4)-1700_$E(X,5,8)
177 Q X
178 ;
179ERROR ; Top level error msgs for msgs
180 ;;Invalid mailgroup designated for EDI Lockbox errors
181 ;;Message header error
182 ;
183ERROR2 ; Error condition msgs for msgs
184 ;;Message code is invalid for EDI Lockbox.
185 ;;This message has no ending $ or 99 record.
186 ;;Message file problem - no message stored.
187 ;;Message file problem - message partially stored.
188 ;;No valid claims for the site found on the ERA.
189 ;
Note: See TracBrowser for help on using the repository browser.