| [613] | 1 | RCDPESR4 ;ALB/TMK - Server interface 835ERA processing ;06/03/02
|
|---|
| 2 | ;;4.5;Accounts Receivable;**173,216,208,230**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ERAEOBIN(RCTXN,RCD,RCGBL,RCEFLG) ; Store/process 835ERA or 835XFR
|
|---|
| 6 | ; transaction coming into the site
|
|---|
| 7 | ; RCTXN = data on the hdr record of the msg text
|
|---|
| 8 | ; RCD = array with formatted hdr data
|
|---|
| 9 | ; RCGBL = name of the array or global where the msg is stored
|
|---|
| 10 | ; RCEFLG = error flag returned if passed by REF
|
|---|
| 11 | ;
|
|---|
| 12 | N RCLAST,RCBILL,RCTDA,RCMSG,RCERR
|
|---|
| 13 | S (RCTDA,RCEFLG)=0
|
|---|
| 14 | ;
|
|---|
| 15 | L +^RCY(344.5,"AMSEQ",+$P(RCTXN,U,13))
|
|---|
| 16 | S RCMSG=$$EXTERA(RCTXN,.RCLAST,.RCBILL) ; Extract from mail msg
|
|---|
| 17 | ;
|
|---|
| 18 | ; If full msg received (99^$ record exists), file it
|
|---|
| 19 | I 'RCLAST,'$G(RCERR) D ;No $ as last character of msg
|
|---|
| 20 | . S RCERR=2
|
|---|
| 21 | ;
|
|---|
| 22 | I RCLAST S RCTDA=+$$ADD(RCGBL,RCD("MSG#"),RCMSG,.RCBILL,.RCERR,.RCD)
|
|---|
| 23 | ;
|
|---|
| 24 | I $G(RCERR)>0 D
|
|---|
| 25 | . D ERRUPD^RCDPESR1(RCGBL,.RCD,$P(RCTXN,U),.RCERR)
|
|---|
| 26 | . I RCTDA D ; Store exception msgs in file 344.5
|
|---|
| 27 | .. N A,C,Z
|
|---|
| 28 | .. S C=1,A(1)="Date: "_$$FMTE^XLFDT($$NOW^XLFDT(),2)
|
|---|
| 29 | .. I $G(^TMP("RCERR",$J,"TEXT"))'="" S C=C+1,A(C)=^TMP("RCERR",$J,"TEXT"),C=C+1,A(C)=" "
|
|---|
| 30 | .. S Z=0 F S Z=$O(^TMP("RCERR",$J,"MSG",Z)) Q:'Z S C=C+1,A(C)=^(Z)
|
|---|
| 31 | .. I $O(A(0)) D WP^DIE(344.5,RCTDA_",",5,"A","A")
|
|---|
| 32 | . S RCEFLG=1
|
|---|
| 33 | ;
|
|---|
| 34 | L -^RCY(344.5,"AMSEQ",+$P(RCTXN,U,13))
|
|---|
| 35 | I $P(RCTXN,U)'["XFR",$P(RCTXN,U,12)'="" D TAXERR^RCDPESR1("ERA",$P(RCTXN,U,6)_" Payer ID: "_$P(RCTXN,U,7),$P(RCTXN,U,11),$P(RCTXN,U,12)) ; Send bad tax id bulletin
|
|---|
| 36 | ;
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | EXTERA(RCTXN,RCLAST,RCBILL) ;Extract 835ERA or 835XFR transaction
|
|---|
| 40 | ;INPUT:
|
|---|
| 41 | ; RCTXN = data on 835ERA/835XFR hdr record
|
|---|
| 42 | ; RCLAST = passed by REF and returned=1 if entire record exists
|
|---|
| 43 | ;
|
|---|
| 44 | ;OUTPUT:
|
|---|
| 45 | ; ^TMP("RCMSG",$J,1,"D",line #)=formatted hdr data
|
|---|
| 46 | ; ^TMP("RCMSG",$J,2,"D",line #)=raw msg data
|
|---|
| 47 | ; if passed by ref, RCLAST = 1 if '99' record found
|
|---|
| 48 | ; if passed by ref, RCBILL(AR bill number) is returned
|
|---|
| 49 | ; with a 'list' of bills included in the ERA. If an
|
|---|
| 50 | ; entry = 1, 3rd party bill was found in file 430.
|
|---|
| 51 | ; If the entry = 2, the 3rd party bill found was not active
|
|---|
| 52 | ; Function returns existing ien in file 344.5 for multi part ERAs
|
|---|
| 53 | ;
|
|---|
| 54 | N CT,CT1,LINE,HCT,RCH,RCMSG,RCREFORM,RCINS,RCSTAT,B,RCSD,C5
|
|---|
| 55 | S (HCT,RCH)=0
|
|---|
| 56 | ;
|
|---|
| 57 | ; Check if sequence control # already exists or if a new record needed
|
|---|
| 58 | S RCMSG=+$O(^RCY(344.5,"AMSEQ",+$P(RCTXN,U,13),0))
|
|---|
| 59 | S CT=0
|
|---|
| 60 | I 'RCMSG D ; Build display data for the first sequence only
|
|---|
| 61 | . S HCT=HCT+1 S LINE(HCT)="Payer Name: "_$P(RCTXN,U,6)_" Payer ID: "_$P(RCTXN,U,7)
|
|---|
| 62 | . S HCT=HCT+1,LINE(HCT)="Trace #: "_$P(RCTXN,U,8)
|
|---|
| 63 | . S HCT=HCT+1,LINE(HCT)="Date Paid: "_$$FDT^RCDPESR9($P(RCTXN,U,9))_" Total Amt Paid: "_$J($P(RCTXN,U,10)/100,0,2)
|
|---|
| 64 | . I $P(RCTXN,U)["XFR",$P(RCTXN,U,16)'="" S HCT=HCT+1,LINE(HCT)="Contact Info: "_$P(RCTXN,U,16)
|
|---|
| 65 | . M ^TMP("RCMSG",$J,1,"D")=LINE
|
|---|
| 66 | . S CT=CT+1,^TMP("RCMSG",$J,2,"D",CT)=RCTXN
|
|---|
| 67 | ;
|
|---|
| 68 | S CT1=CT
|
|---|
| 69 | S ^TMP("RCMSG",$J,0)=RCTXN
|
|---|
| 70 | ;
|
|---|
| 71 | S RCSD=$NA(^TMP($J,"RCSRVDT")) K @RCSD ;service dates
|
|---|
| 72 | S C5=0
|
|---|
| 73 | S RCLAST=0
|
|---|
| 74 | F X XMREC Q:XMER<0 D Q:RCLAST
|
|---|
| 75 | . Q:XMRG=""
|
|---|
| 76 | . I +XMRG=99,$P(XMRG,U,2)="$" S RCLAST=1 Q
|
|---|
| 77 | . S CT=CT+1
|
|---|
| 78 | . I +XMRG=5,$P(XMRG,U,2)'="" S C5=CT
|
|---|
| 79 | . I +XMRG=40,$P(XMRG,U,2)?1.7N,C5,$P(XMRG,U,19),'$D(@RCSD@(C5)) S ^(C5)=+$P(XMRG,U,19)
|
|---|
| 80 | . S ^TMP("RCMSG",$J,2,"D",CT)=XMRG
|
|---|
| 81 | ;
|
|---|
| 82 | ; reformat bill# if needed
|
|---|
| 83 | S RCREFORM=""
|
|---|
| 84 | S CT=CT1
|
|---|
| 85 | F S CT=$O(^TMP("RCMSG",$J,2,"D",CT)) Q:'CT S XMRG=$G(^(CT)) D
|
|---|
| 86 | . Q:XMRG=""
|
|---|
| 87 | . I +XMRG=5,$P(XMRG,U,2)'="" D
|
|---|
| 88 | .. S RCREFORM="",RCSTAT=1
|
|---|
| 89 | .. ; Check if bill is in AR & is a 3rd party bill
|
|---|
| 90 | .. S RCBILL=$$BILL^RCDPESR1($P(XMRG,U,2),$G(@RCSD@(CT)),.RCINS)
|
|---|
| 91 | .. I '$G(RCINS)!(RCBILL<0) S (RCBILL,RCSTAT)=0
|
|---|
| 92 | .. I RCBILL S B=$P($G(^PRCA(430,RCBILL,0)),U) I B'=$P(XMRG,U,2) S $P(XMRG,U,2)=B,RCREFORM=B
|
|---|
| 93 | .. I RCBILL,$P(^PRCA(430.3,+$P($G(^PRCA(430,+RCBILL,0)),U,8),0),U,3)'=102 S RCSTAT=2
|
|---|
| 94 | .. S RCBILL($P(XMRG,U,2))=RCSTAT
|
|---|
| 95 | . I RCREFORM'="",+XMRG>5 S $P(XMRG,U,2)=RCREFORM,^TMP("RCMSG",$J,2,"D",CT)=XMRG
|
|---|
| 96 | ;
|
|---|
| 97 | K @RCSD
|
|---|
| 98 | Q RCMSG
|
|---|
| 99 | ;
|
|---|
| 100 | ADD(RCGBL,RCDMSG,RCMSG,RCBILL,RCERR,RCD) ; Add msg(s) in @RCGBL to
|
|---|
| 101 | ; file 344.5
|
|---|
| 102 | ; RCGBL = name of the global used to store the msg data
|
|---|
| 103 | ; RCDMSG = Mailman msg number the ERA arrived in.
|
|---|
| 104 | ; RCMSG = ien of the existing entry in file 344.5 for multipart ERAs
|
|---|
| 105 | ; RCBILL(AR bill number) = list of bills included, pass by REF
|
|---|
| 106 | ; RCD = array with formatted hdr data
|
|---|
| 107 | ;
|
|---|
| 108 | ; Errors returned in RCERR and RCERR(n)
|
|---|
| 109 | ; Function returns entry # of msg added or "" if none added
|
|---|
| 110 | ;
|
|---|
| 111 | N RCHDR,RCTYP,RCIEN
|
|---|
| 112 | S RCHDR=$G(^TMP("RCMSGH",$J,0))
|
|---|
| 113 | S RCTYP=$P(RCHDR,U)
|
|---|
| 114 | S RCIEN=$S($G(RCMSG):RCMSG,1:$$ADDTXN(RCHDR,RCDMSG)) ;File msg hdr
|
|---|
| 115 | I RCIEN'>0 S RCERR=3 ;msg hdr can't be filed
|
|---|
| 116 | I '$G(RCERR) D LOADDET(RCIEN,RCGBL,RCHDR,.RCBILL,.RCD,.RCERR)
|
|---|
| 117 | I '$G(RCERR),'$O(RCERR(0)),RCTYP["835ERA",'$P($G(^RCY(344.5,RCIEN,0)),U,8) D TASKERA^RCDPESR2(RCIEN) ;Task to upd VistA for complete 835ERA only
|
|---|
| 118 | ;
|
|---|
| 119 | Q $S($G(RCIEN)>0&'$G(RCERR):RCIEN,1:"")
|
|---|
| 120 | ;
|
|---|
| 121 | ADDTXN(RCDATA,RCDMSG) ; Add a trxn for msg in RCDATA to file 344.5
|
|---|
| 122 | ; RCDATA = data on the msg hdr record
|
|---|
| 123 | ; RCDMSG = Mailman msg number the ERA arrived in
|
|---|
| 124 | ;Function returns ien of the new entry in file 344.5 or "" if an error
|
|---|
| 125 | ;
|
|---|
| 126 | N A,RCY,DLAYGO,DIC,DD,DO,DA,X,Y,Z
|
|---|
| 127 | ;
|
|---|
| 128 | S (X,A)=RCDMSG ;Use msg ID as basis for the .01 field
|
|---|
| 129 | F Z=1:1 Q:'$D(^RCY(344.5,"B",A)) S A=X_"."_Z
|
|---|
| 130 | S X=A
|
|---|
| 131 | S DIC(0)="L",DIC="^RCY(344.5,",DLAYGO=344.5
|
|---|
| 132 | S DIC("DR")=".02////"_$E($P(RCDATA,U),1,6)_";.03///^S X=""NOW"";.04////0;.06////"_$S($P(RCDATA,U)'["XFR":1,1:0)_$S($P(RCDATA,U,13)'="":";.09////"_+$P(RCDATA,U,13)_";.08////1",1:"")_";.1////2;.11////"_RCDMSG
|
|---|
| 133 | I $P(RCDATA,U,6)'="" S DIC("DR")=DIC("DR")_";3.01////"_$P(RCDATA,U,6)
|
|---|
| 134 | D FILE^DICN K DO,DD,DLAYGO,DA,DIC
|
|---|
| 135 | S RCY=+Y
|
|---|
| 136 | Q $S(RCY>0:+RCY,1:"")
|
|---|
| 137 | ;
|
|---|
| 138 | LOADDET(RCTDA,RCGBL,RCHDR,RCBILL,RCD,RCERR) ; Load the rest of the text
|
|---|
| 139 | ; into the msg
|
|---|
| 140 | ; RCTDA = ien in file 344.5
|
|---|
| 141 | ; RCGBL = name of the array holding the detail msg text to be loaded
|
|---|
| 142 | ; RCHDR = data on ERA hdr record
|
|---|
| 143 | ; RCBILL(AR bill number) = list of bills included, pass by REF
|
|---|
| 144 | ; RCD = array with formatted hdr data
|
|---|
| 145 | ;
|
|---|
| 146 | ; OUTPUT: RCERR if any errors found, pass by REF
|
|---|
| 147 | ;
|
|---|
| 148 | N RCE,RCDATA,RCMSG,RCFROM,Z,Z0
|
|---|
| 149 | K ^TMP("RCTEXT",$J),^TMP("RCRAW",$J)
|
|---|
| 150 | M ^TMP("RCTEXT",$J)=@RCGBL@(1,"D")
|
|---|
| 151 | M ^TMP("RCRAW",$J)=@RCGBL@(2,"D")
|
|---|
| 152 | ;
|
|---|
| 153 | S RCDATA=$G(^RCY(344.5,RCTDA,0)),RCMSG=$G(RCD("MSG#")),RCFROM=$G(RCD("FROM"))
|
|---|
| 154 | ;
|
|---|
| 155 | ; For multi-part ERA, don't update if sequence already filed
|
|---|
| 156 | ; Add seq # if not already there
|
|---|
| 157 | I $P(RCHDR,U)'["XFR",$P(RCHDR,U,13) Q:$D(^RCY(344.5,RCTDA,"S","B",+$P(RCHDR,U,14)))
|
|---|
| 158 | ;
|
|---|
| 159 | D STOREM(+$G(RCTDA),"^TMP(""RCTEXT"",$J)","^TMP(""RCRAW"",$J)",.RCE)
|
|---|
| 160 | ;
|
|---|
| 161 | I $D(RCE("DIERR")) D ; Extract error
|
|---|
| 162 | . N DIE,DA,DR,X,Y
|
|---|
| 163 | . D EXTERR^RCDPESR1(.RCERR,.RCE)
|
|---|
| 164 | . S:$L($G(RCE)) RCERR(+$O(RCERR(""),-1)+1)=RCE
|
|---|
| 165 | . I $D(^RCY(344.5,RCTDA,0)) S DIE="^RCY(344.5,",DR=".1////4",DA=RCTDA D ^DIE
|
|---|
| 166 | E D ; No error - store rest of data
|
|---|
| 167 | . N Z,RCT,RCCT,RCX,RCB ; Add bills included in ERA
|
|---|
| 168 | . S RCT=0,RCCT=0,RCX=$J("",4)
|
|---|
| 169 | . S Z="" F S Z=$O(RCBILL(Z)) Q:Z="" D
|
|---|
| 170 | .. N DO,DD,DIC,DLAYGO,X,Y
|
|---|
| 171 | .. S:RCT=4 RCCT=RCCT+1,RCB(RCCT)=RCX,RCT=0,RCX=$J("",4) S RCX=RCX_$E($S(+RCBILL(Z):"",1:"*")_Z_$J("",15),1,15),RCT=RCT+1
|
|---|
| 172 | .. S DIC(0)="L",DIC("DR")=".02////"_$S($G(RCBILL(Z)):1,1:0),X=Z,DA(1)=RCTDA,DIC="^RCY(344.5,"_DA(1)_",""B"",",DLAYGO=344.54 D FILE^DICN K DO,DD,DLAYGO,DIC
|
|---|
| 173 | .. ;
|
|---|
| 174 | . I $L(RCX)>4 S RCCT=RCCT+1,RCB(RCCT)=RCX
|
|---|
| 175 | . ; Add list of bills to display data
|
|---|
| 176 | . I $O(RCB(0)) D WP^DIE(344.5,RCTDA_",",1,"A","RCB")
|
|---|
| 177 | . ; Add seq #
|
|---|
| 178 | . S DA(1)=RCTDA,DIC="^RCY(344.5,"_DA(1)_",""S"",",DIC(0)="L",X=$P(RCHDR,U,14),DIC("DR")=".02////"_$S($P(RCHDR,U,15)="Y":1,1:0)_";.03///^S X=""NOW"";.04////"_RCMSG,X=+$P(RCHDR,U,14),DLAYGO=344.53
|
|---|
| 179 | . D FILE^DICN K DO,DD,DLAYGO,DIC
|
|---|
| 180 | . ;
|
|---|
| 181 | . I $P(RCHDR,U)["835XFR" D XFR^RCDPESR5(RCTDA,RCFROM,RCMSG,.RCD) Q
|
|---|
| 182 | . ;
|
|---|
| 183 | . ; Proceed only if not a transfer record
|
|---|
| 184 | . I $P(RCDATA,U,9)'="" D ; Determine if all sequences received yet
|
|---|
| 185 | .. N RCOK,RCLAST
|
|---|
| 186 | .. S RCOK=1,RCLAST=0
|
|---|
| 187 | .. F Z=1:1 Q:'RCOK!RCLAST D
|
|---|
| 188 | ... I 'RCLAST,'$D(^RCY(344.5,RCTDA,"S","B",Z)) S RCOK=0 Q
|
|---|
| 189 | ... S Z0=+$O(^RCY(344.5,RCTDA,"S","B",Z,0)),Z0=$G(^RCY(344.5,RCTDA,"S",Z0,0))
|
|---|
| 190 | ... I Z0="" S RCOK=0 Q
|
|---|
| 191 | ... I $P(Z0,U,2) S RCLAST=1 ; Last sequence received and all before it
|
|---|
| 192 | .. ;
|
|---|
| 193 | .. I RCOK D
|
|---|
| 194 | ... N DA,DIE,DR,X,Y
|
|---|
| 195 | ... S DA=RCTDA,DR=".08////0;.1///@",DIE="^RCY(344.5," D ^DIE
|
|---|
| 196 | ... I '$O(^RCY(344.5,RCTDA,"B","AV",1,0)) D ; No valid bills found
|
|---|
| 197 | .... N RCE
|
|---|
| 198 | .... S RCE(1)="No valid bills for this site were found in this ERA"
|
|---|
| 199 | .... S RCE(2)="Review/correct the bill #'s on this ERA in your transmission exceptions"
|
|---|
| 200 | .... S RCE(3)="Please contact the Implementation Manager group to report this situation",RCE(4)=" "
|
|---|
| 201 | .... D BULLERA^RCDPESR0("D"_$S($O(^RCY(344.5,RCTDA,2,0)):"F",1:""),RCTDA,$G(RCD("MSG#")),"EDI LBOX - NO VALID BILLS ON ERA "_$E($G(RCD("PAYFROM")),1,20),.RCE,0)
|
|---|
| 202 | .... S DA=RCTDA,DR=".08////1;.1////6",DIE="^RCY(344.5," D ^DIE
|
|---|
| 203 | ;
|
|---|
| 204 | K ^TMP("RCTEXT",$J),^TMP("RCRAW",$J)
|
|---|
| 205 | Q
|
|---|
| 206 | ;
|
|---|
| 207 | STOREM(RCTDA,RCDISP,RCTEXT,RCE) ;Store msg text in file 344.5
|
|---|
| 208 | ;INPUT:
|
|---|
| 209 | ; RCTDA = ien of the entry in file 344.5
|
|---|
| 210 | ; RCDISP = name of the array where display msg text is retrieved from
|
|---|
| 211 | ; or "@" to delete the text from the display text field
|
|---|
| 212 | ; RCTEXT = name of the array where raw msg text is retrieved from
|
|---|
| 213 | ; or "@" to delete the text from the raw msg field
|
|---|
| 214 | ;OUTPUT:
|
|---|
| 215 | ; RCE = array of errors (RCE("DIERR")) returned, pass by REF
|
|---|
| 216 | ;
|
|---|
| 217 | N RCZ,X,Y,DIE
|
|---|
| 218 | K RCE("DIERR")
|
|---|
| 219 | ;
|
|---|
| 220 | I $S($G(RCDISP)="@":1,1:$D(@RCDISP)'<10) D
|
|---|
| 221 | . F RCZ=1:1:20 D WP^DIE(344.5,RCTDA_",",1,"AK",""_RCDISP_"","RCE") Q:$S('$D(RCE("DIERR")):1,+RCE("DIERR")=1:$G(RCE("DIERR",1))'=110,1:1) K:RCZ<20 RCE("DIERR") ; On lock error, retry up to 20 times
|
|---|
| 222 | ;
|
|---|
| 223 | I '$O(RCE("DIERR",0)),$S($G(RCTEXT)="@":1,1:$D(@RCTEXT)'<10) D
|
|---|
| 224 | . F RCZ=1:1:20 D WP^DIE(344.5,RCTDA_",",2,"AK",""_RCTEXT_"","RCE") Q:$S('$D(RCE("DIERR")):1,+RCE("DIERR")=1:$G(RCE("DIERR",1))'=110,1:1) K:RCZ<20 RCE("DIERR") ; On lock error, retry up to 20 times
|
|---|
| 225 | Q
|
|---|
