RCDPESR1 ;ALB/TMP - Server interface to AR from Austin ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**173,214,208,202,271,298,321,345,349**;Mar 20, 1995;Build 44
;Per VA Directive 6402, this routine should not be modified.
;
;Reference to $$RXBIL^IBNCPDPU supported by DBIA 4435
;Reference to $$VALECME^BPSUTIL2 supported by IA# 6139
;
Q
;
PERROR(RCERR,RCEMG,RCXMZ) ; Process Errors - Send bulletin to mail group
; RCERR = Error text array
; RCEMG = name of the mail group to which these errors should be sent
; RCXMZ = internal entry # of the mailman msg
; RCTYPE = msg type, if known
N CT,XMDUZ,XMSUBJ,XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,RCXM,XMZ,XMERR,Z
;
S CT=0
;
I $G(RCEMG)="" S CT=CT+1,RCXM(CT)=$P($T(ERROR+2),";;",2),XMTO(.5)=""
;
I $D(RCEMG) D
. S:RCEMG="" RCEMG="RCDPE PAYMENTS EXCEPTIONS"
. S:$E(RCEMG,1,2)'="G." RCEMG="G."_RCEMG
. S XMTO("I:"_RCEMG)=""
;
S Z=$O(XMTO("")) I Z=.5,'$O(XMTO(.5)) S XMTO("I:G.RCDPE PAYMENTS EXCEPTIONS")=""
D EMFORM(CT,.RCERR,.RCXM,RCXMZ)
;
S XMDUZ=""
S XMSUBJ="EDI LBOX SERVER OPTION ERROR",XMBODY="RCXM"
D
. N DUZ S DUZ=.5,DUZ(0)="@"
. D SENDMSG^XMXAPI(.5,XMSUBJ,XMBODY,.XMTO,,.XMZ)
;
; PRCA*4.5*349 - Send a new message to an Outlook email group notifying of error
D OUTMSG(.RCERR,RCXMZ)
K ^TMP("RCRAW",$J)
Q
;
OUTMSG(RCERR,RCXMZ) ; Build message to send to Outlook address
; PRCA*4.5*349 - New subroutine
; RCERR = Error text array
; RCXMZ = internal entry # of the mailman msg
N CT,RCMTXT,RCXM,TDATE,TTYPE,XMBODY,XMDUZ,XMSUBJ,XMTO,XMZ
S TDATE=$G(^TMP("RCERR",$J,"DATE")),TDATE=$$FMTE^XLFDT(TDATE)
S TTYPE=$G(^TMP("RCMSG",$J))
S XMBODY="RCXM"
;
S CT=1
S RCXM(CT)="** AN EXCEPTION HAS BEEN DETECTED FOR AN EDI LOCKBOX MESSAGE **",CT=CT+1,RCXM(CT)=" "
S CT=CT+1
S RCXM(CT)="Message Type: "_$S(TTYPE="":$S($G(^TMP("RCERR",$J,"TYPE"))'="":^("TYPE"),1:"Cannot be determined"),1:TTYPE)
;
S CT=CT+2
S RCXM(CT-1)=" ",RCXM(CT)="Message Date: "_TDATE
;
S CT=CT+1,RCXM(CT)="Mailman Message #: "_$G(RCXMZ)
S CT=CT+1,RCXM(CT)=" "
S CT=CT+1,RCXM(CT)="Error: "_$S($D(^TMP("RCERR",$J,"TEXT")):^TMP("RCERR",$J,"TEXT"),1:"Unknown error")
I TTYPE["EFT" D
. D OUTEFT($NA(^TMP("RCERR",$J,"MSG")),.CT,"RCXM")
; To be safe, try to parse unknown message types as ERAs for the purpose of
; masking PII
I TTYPE'["EFT" D
. D OUTERA($NA(^TMP("RCERR",$J,"MSG")),.CT,"RCXM")
;
S XMDUZ="",XMSUBJ="EDI LBOX-STA# "_$P($$SITE^VASITE,"^",3)_"-TRANSMISSION ERROR"
S XMTO("vha835payerinquiry@domain.ext")=""
D
. N DUZ S DUZ=.5,DUZ(0)="@"
. D SENDMSG^XMXAPI(.5,XMSUBJ,XMBODY,.XMTO,,.XMZ)
Q
OUTERA(RAW,CT,RCMTXT) ; Format ERA/EEOB for Outlook message
; PRCA*4.5*349 - New Subroutine
; RAW - Points to raw data from the message
; CT - (Passed by Reference) Current message text line count
; RCMTXT - Pointer to message text array
N I,J,LN,RC,RCDAT,RCREF,OUTXFRM,X,Y,Z
Q:RCMTXT=""!(RAW="")
S J="" F S J=$O(@RAW@(J)) Q:J="" I +$G(@RAW@(J))=835 D Q
. S LN=$G(@RAW@(J))
. F I=8,10,6,7 D
. . S RCDAT=$P(LN,U,I)
. . S RCREF="835+"_I_"^RCDPESR9",RC=$P($T(@RCREF),";;",2)
. . S OUTXFRM=$P(RC,U,4,99)
. . I OUTXFRM'="" S X=RCDAT X OUTXFRM S RCDAT=Y
. . S CT=CT+1,@RCMTXT@(CT)=$P(RC,U,3)_": "_RCDAT
S Z=0 F S Z=$O(@RAW@(Z)) Q:Z="" D
. S CT=CT+1,@RCMTXT@(CT)=$$MASKPII(@RAW@(Z))
Q
OUTEFT(RAW,CT,RCMTXT) ; Format EFT for Outlook message
; PRCA*4.5*349 - New Subroutine
; RAW - Points to raw data from the message
; CT - (Passed by Reference) Current message text line count
; RCMTXT - Pointer to message text array
N DATA,I,Z
Q:RCMTXT=""!(RAW="")
S I="" F S I=$O(@RAW@(I)) Q:'I D
. S DATA($P(@RAW@(I),U))=$G(@RAW@(I))
S CT=CT+1,@RCMTXT@(CT)="Trace Number: "_$P($G(DATA("01")),U,2)
S CT=CT+1,@RCMTXT@(CT)="Dollar Amt: "_$$ZERO^RCDPESR9($P($G(DATA("01")),U,4),1)
S CT=CT+1,@RCMTXT@(CT)="Payer Name: "_$P($G(DATA("01")),U,5)
S CT=CT+1,@RCMTXT@(CT)="Payer ID: "_$P($G(DATA("01")),U,6)
S Z=0 F S Z=$O(@RAW@(Z)) Q:'Z D
. S CT=CT+1,@RCMTXT@(CT)=$G(@RAW@(Z))
Q
EMFORM(CT,RCERR,RCXM,RCXMZ) ; Format error msgs
; INPUT:
; CT = # of lines previously populated in error msg
; RCERR = array of errors
; RCXMZ = internal entry # of mailman msg
;
; OUTPUT:
; RCXM = array containing the complete error msg text
;
N TTYPE,TDATE,TTIME,Z
;
S TDATE=$G(^TMP("RCERR",$J,"DATE")),TTIME=$P(TDATE,".",2)_"000000",TDATE=$$FMTE^XLFDT($P(TDATE,"."),"2D")
S TTYPE=$G(^TMP("RCMSG",$J))
;
S CT=CT+1
S RCXM(CT)="** AN EXCEPTION HAS BEEN DETECTED FOR AN EDI LOCKBOX RETURN MESSAGE **",CT=CT+1,RCXM(CT)=" "
S CT=CT+1
S RCXM(CT)=" Return Message Code: "_$S(TTYPE="":$S($G(^TMP("RCERR",$J,"TYPE"))'="":^("TYPE"),1:"Cannot be determined"),1:TTYPE)
;
S CT=CT+2
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
;
S CT=CT+2,RCXM(CT-1)=" ",RCXM(CT)=$J("",15)_"Mailman Message #: "_$G(RCXMZ)
;
I $G(RCERR)'="",RCERR?1A.E S CT=CT+2,RCXM(CT-1)=" ",RCXM(CT)=RCERR
I $G(^TMP("RCERR",$J,"TEXT"))'="" S CT=CT+2,RCXM(CT)=^("TEXT"),RCXM(CT-1)=" "
;
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)
S Z=0 F S Z=$O(^TMP("RCERR",$J,"MSG",Z)) Q:'Z S CT=CT+1,RCXM(CT)=^(Z)
;
Q
;
MASKPII(X) ; Return a "05" field with PII masked for sending errors
; PRCA*4.5*349 - Subroutine added
N I
I +X,+X'="835" D
. S $P(X,U,2)="**REDACTED**"
I $P(X,U)="05" D
. F I=3:1:6 D
. . S $P(X,U,I)="**REDACTED**"
Q X
;
EXTERR(RCERR,RCE) ; Put error into error array
; Returns: (must be passed by reference)
; RCERR = specific error encountered, returned as 4
; RCE = error text from the word processing field update error global
N RCZ,Q
S RCE="",RCERR=4 ; error reported as 'record was partially stored'
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_";;"
Q
;
ERRUPD(RCGBL,RCD,RCTYPE,RCERR) ; Set up global array to hold msg data
; RCGBL = name of the global or array where msg data is found
; RCD = array containing mail header data for the msg
; RCTYPE = type of msg (835ERA/835XFR/etc)
; RCERR = error array - text or reference to error tables below
;
; Returns ^TMP("RCERR",$J,"MSG" array with formatted error text
;
N Z,Z0,Z1,Z2,CT,RCE
;
Q:$G(RCERR)<0
K ^TMP("RCERR",$J)
S CT=0
;
S ^TMP("RCERR",$J,"DATE")=$G(RCD("DATE"))
S ^TMP("RCERR",$J,"TYPE")=$G(RCTYPE)
S ^TMP("RCERR",$J,"SUBJ")=$G(RCD("SUBJ"))
;
I $G(RCERR)>0,RCERR<20 D
. S Z="ERROR2+"_RCERR
. S RCE=$P($T(@Z),";;",2)
. I RCE'="" S ^TMP("RCERR",$J,"TEXT")=RCE
;
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
. I $L(RCE) S CT=CT+1,^TMP("RCERR",$J,"MSG",CT)=$S(RCE:$P($T(ERROR+RCE),";;",2),1:RCE)
. S RCTYPE=$P($G(@RCGBL@(0)),U)
. S:$G(^TMP("RCERR",$J,"TYPE"))="" ^("TYPE")=RCTYPE
. S Z1=""
. F S Z1=$O(@RCGBL@(1,"D",Z1)) Q:Z1="" S CT=CT+1,^TMP("RCERR",$J,"MSG",CT)=$G(@RCGBL@(1,"D",Z1))
;
I $D(@RCGBL@(2,"D")) D
. S CT=CT+2,^TMP("RCERR",$J,"MSG",CT-1)=" ",^TMP("RCERR",$J,"MSG",CT)="**** RAW MESSAGE DATA ****:"
. I $G(^TMP("RCMSGH",$J,0))'="" S CT=CT+1,^TMP("RCERR",$J,"MSG",CT)=^TMP("RCMSGH",$J,0)
. 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))
E D
. Q:'$D(^TMP("RCRAW",$J))
. S CT=CT+2,^TMP("RCERR",$J,"MSG",CT-1)=" ",^TMP("RCERR",$J,"MSG",CT)="**** RAW MESSAGE DATA ****:"
. I $G(^TMP("RCMSGH",$J,0))'="" S CT=CT+1,^TMP("RCERR",$J,"MSG",CT)=^TMP("RCMSGH",$J,0)
. 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))
;
Q
;
DKILL(RCXMZ) ; Delete server mail msg from postmaster mailbox
; RCXMZ = ien of mailman msg
;
D ZAPSERV^XMXAPI("S.RCDPE EDI LOCKBOX SERVER",RCXMZ)
Q
;
TEMPDEL(DA) ; Delete msg from temporary msg file
; DA = ien of the entry in file 344.5
;
N DIK,Y,X
S DIK="^RCY(344.5," D ^DIK
L -^RCY(344.5,DA,0)
Q
;
RESTMSG(RCD,RCARRAY,XMZ) ; Read rest of msg, store in array
; RCD = last line # already in the msg
; RCARRAY = name of the array to store the data in
; XMZ = ien of the mailman msg
;
F X XMREC Q:XMER<0 S RCD=RCD+1,@RCARRAY@(RCD)=XMRG
Q
;
TAXERR(RCTYPE,RCINS,RCTID,RCCHG) ; Send a bulletin for a bad tax id
; RCTYPE = "ERA" for an ERA record, "EFT" for an EFT record
; RCINS = name and id to identify the ins co
; RCTID = tax id sent in error
; RCCHG = code describing how correction was made
; 'E'=EPHRA, 'C'=Changed by looking at claim #'s
;
N XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,RCDXM,XMZ,XMERR,RCCT,RCDXM,RCCT
S RCCT=0
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
S RCCT=RCCT+1,RCDXM(RCCT)=" The tax id sent was: "_RCTID_" and it was corrected by: "
S RCCT=RCCT+1,RCDXM(RCCT)=" "_$S(RCCHG="E":"EPHRA",1:"Extracting it based on bill numbers in the ERA")
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"
;
S XMTO("I:G.RCDPE PAYMENTS")="",XMBODY="RCDXM"
D
. N DUZ S DUZ=.5,DUZ(0)="@"
. D SENDMSG^XMXAPI(.5,"EDI LBOX ERRONEOUS TAX ID ON "_RCTYPE,XMBODY,.XMTO,,.XMZ)
Q
;
BILL(X,RCDT,RCIB) ; Returns ien of bill in X or -1 if not valid
; RCDT = the Statement from date (used for Rx bills)
; and, if passed by reference, RCIB = 1 if an insurance bill
N ARRAY,DIC,Y,Z
S RCIB=0
S X=$TR(X," "),(X,Z)=$TR(X,"O","0") ; Remove spaces, change ohs to zeroes
I X'["-",$E(X,1,3)?3N,+$E(X,1,3),$L(X)>7,$L(X)<12 S X=$E(X,1,3)_"-"_$E(X,4,$L(X))
S DIC="^PRCA(430,",DIC(0)="MZ" D ^DIC
; Checks if the ECME# is valid
I Y<0,$$VALECME^BPSUTIL2(Z) D
. S ARRAY("ECME")=Z,ARRAY("FILLDT")=$G(RCDT)
. S Y=$$RXBIL^IBNCPDPU(.ARRAY) ; DBIA 4435
. I Y>0 S Y(0)=$G(^PRCA(430,+Y,0))
I Y>0 S RCIB=($P($G(^RCD(340,+$P(Y(0),U,9),0)),U)["DIC(36,")
Q +Y
;
FMDT(X) ; Format date (X) in YYYYMMDD to Fileman format
I $L(X)=8 D
. S X=$E(X,1,4)-1700_$E(X,5,8)
Q X
;
ERROR ; Top level error msgs for msgs
;;Invalid mailgroup designated for EDI Lockbox errors
;;Message header error
;
ERROR2 ; Error condition msgs for msgs
;;Message code is invalid for EDI Lockbox.
;;This message has no ending $ or 99 record.
;;Message file problem - no message stored.
;;Message file problem - message partially stored.
;;No valid claims for the site found on the ERA.
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPESR1 10827 printed Dec 13, 2024@01:45:22 Page 2
RCDPESR1 ;ALB/TMP - Server interface to AR from Austin ;Jun 06, 2014@19:11:19
+1 ;;4.5;Accounts Receivable;**173,214,208,202,271,298,321,345,349**;Mar 20, 1995;Build 44
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;Reference to $$RXBIL^IBNCPDPU supported by DBIA 4435
+5 ;Reference to $$VALECME^BPSUTIL2 supported by IA# 6139
+6 ;
+7 QUIT
+8 ;
PERROR(RCERR,RCEMG,RCXMZ) ; Process Errors - Send bulletin to mail group
+1 ; RCERR = Error text array
+2 ; RCEMG = name of the mail group to which these errors should be sent
+3 ; RCXMZ = internal entry # of the mailman msg
+4 ; RCTYPE = msg type, if known
+5 NEW CT,XMDUZ,XMSUBJ,XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,RCXM,XMZ,XMERR,Z
+6 ;
+7 SET CT=0
+8 ;
+9 IF $GET(RCEMG)=""
SET CT=CT+1
SET RCXM(CT)=$PIECE($TEXT(ERROR+2),";;",2)
SET XMTO(.5)=""
+10 ;
+11 IF $DATA(RCEMG)
Begin DoDot:1
+12 if RCEMG=""
SET RCEMG="RCDPE PAYMENTS EXCEPTIONS"
+13 if $EXTRACT(RCEMG,1,2)'="G."
SET RCEMG="G."_RCEMG
+14 SET XMTO("I:"_RCEMG)=""
End DoDot:1
+15 ;
+16 SET Z=$ORDER(XMTO(""))
IF Z=.5
IF '$ORDER(XMTO(.5))
SET XMTO("I:G.RCDPE PAYMENTS EXCEPTIONS")=""
+17 DO EMFORM(CT,.RCERR,.RCXM,RCXMZ)
+18 ;
+19 SET XMDUZ=""
+20 SET XMSUBJ="EDI LBOX SERVER OPTION ERROR"
SET XMBODY="RCXM"
+21 Begin DoDot:1
+22 NEW DUZ
SET DUZ=.5
SET DUZ(0)="@"
+23 DO SENDMSG^XMXAPI(.5,XMSUBJ,XMBODY,.XMTO,,.XMZ)
End DoDot:1
+24 ;
+25 ; PRCA*4.5*349 - Send a new message to an Outlook email group notifying of error
+26 DO OUTMSG(.RCERR,RCXMZ)
+27 KILL ^TMP("RCRAW",$JOB)
+28 QUIT
+29 ;
OUTMSG(RCERR,RCXMZ) ; Build message to send to Outlook address
+1 ; PRCA*4.5*349 - New subroutine
+2 ; RCERR = Error text array
+3 ; RCXMZ = internal entry # of the mailman msg
+4 NEW CT,RCMTXT,RCXM,TDATE,TTYPE,XMBODY,XMDUZ,XMSUBJ,XMTO,XMZ
+5 SET TDATE=$GET(^TMP("RCERR",$JOB,"DATE"))
SET TDATE=$$FMTE^XLFDT(TDATE)
+6 SET TTYPE=$GET(^TMP("RCMSG",$JOB))
+7 SET XMBODY="RCXM"
+8 ;
+9 SET CT=1
+10 SET RCXM(CT)="** AN EXCEPTION HAS BEEN DETECTED FOR AN EDI LOCKBOX MESSAGE **"
SET CT=CT+1
SET RCXM(CT)=" "
+11 SET CT=CT+1
+12 SET RCXM(CT)="Message Type: "_$SELECT(TTYPE="":$SELECT($GET(^TMP("RCERR",$JOB,"TYPE"))'="":^("TYPE"),1:"Cannot be determined"),1:TTYPE)
+13 ;
+14 SET CT=CT+2
+15 SET RCXM(CT-1)=" "
SET RCXM(CT)="Message Date: "_TDATE
+16 ;
+17 SET CT=CT+1
SET RCXM(CT)="Mailman Message #: "_$GET(RCXMZ)
+18 SET CT=CT+1
SET RCXM(CT)=" "
+19 SET CT=CT+1
SET RCXM(CT)="Error: "_$SELECT($DATA(^TMP("RCERR",$JOB,"TEXT")):^TMP("RCERR",$JOB,"TEXT"),1:"Unknown error")
+20 IF TTYPE["EFT"
Begin DoDot:1
+21 DO OUTEFT($NAME(^TMP("RCERR",$JOB,"MSG")),.CT,"RCXM")
End DoDot:1
+22 ; To be safe, try to parse unknown message types as ERAs for the purpose of
+23 ; masking PII
+24 IF TTYPE'["EFT"
Begin DoDot:1
+25 DO OUTERA($NAME(^TMP("RCERR",$JOB,"MSG")),.CT,"RCXM")
End DoDot:1
+26 ;
+27 SET XMDUZ=""
SET XMSUBJ="EDI LBOX-STA# "_$PIECE($$SITE^VASITE,"^",3)_"-TRANSMISSION ERROR"
+28 SET XMTO("vha835payerinquiry@domain.ext")=""
+29 Begin DoDot:1
+30 NEW DUZ
SET DUZ=.5
SET DUZ(0)="@"
+31 DO SENDMSG^XMXAPI(.5,XMSUBJ,XMBODY,.XMTO,,.XMZ)
End DoDot:1
+32 QUIT
OUTERA(RAW,CT,RCMTXT) ; Format ERA/EEOB for Outlook message
+1 ; PRCA*4.5*349 - New Subroutine
+2 ; RAW - Points to raw data from the message
+3 ; CT - (Passed by Reference) Current message text line count
+4 ; RCMTXT - Pointer to message text array
+5 NEW I,J,LN,RC,RCDAT,RCREF,OUTXFRM,X,Y,Z
+6 if RCMTXT=""!(RAW="")
QUIT
+7 SET J=""
FOR
SET J=$ORDER(@RAW@(J))
if J=""
QUIT
IF +$GET(@RAW@(J))=835
Begin DoDot:1
+8 SET LN=$GET(@RAW@(J))
+9 FOR I=8,10,6,7
Begin DoDot:2
+10 SET RCDAT=$PIECE(LN,U,I)
+11 SET RCREF="835+"_I_"^RCDPESR9"
SET RC=$PIECE($TEXT(@RCREF),";;",2)
+12 SET OUTXFRM=$PIECE(RC,U,4,99)
+13 IF OUTXFRM'=""
SET X=RCDAT
XECUTE OUTXFRM
SET RCDAT=Y
+14 SET CT=CT+1
SET @RCMTXT@(CT)=$PIECE(RC,U,3)_": "_RCDAT
End DoDot:2
End DoDot:1
QUIT
+15 SET Z=0
FOR
SET Z=$ORDER(@RAW@(Z))
if Z=""
QUIT
Begin DoDot:1
+16 SET CT=CT+1
SET @RCMTXT@(CT)=$$MASKPII(@RAW@(Z))
End DoDot:1
+17 QUIT
OUTEFT(RAW,CT,RCMTXT) ; Format EFT for Outlook message
+1 ; PRCA*4.5*349 - New Subroutine
+2 ; RAW - Points to raw data from the message
+3 ; CT - (Passed by Reference) Current message text line count
+4 ; RCMTXT - Pointer to message text array
+5 NEW DATA,I,Z
+6 if RCMTXT=""!(RAW="")
QUIT
+7 SET I=""
FOR
SET I=$ORDER(@RAW@(I))
if 'I
QUIT
Begin DoDot:1
+8 SET DATA($PIECE(@RAW@(I),U))=$GET(@RAW@(I))
End DoDot:1
+9 SET CT=CT+1
SET @RCMTXT@(CT)="Trace Number: "_$PIECE($GET(DATA("01")),U,2)
+10 SET CT=CT+1
SET @RCMTXT@(CT)="Dollar Amt: "_$$ZERO^RCDPESR9($PIECE($GET(DATA("01")),U,4),1)
+11 SET CT=CT+1
SET @RCMTXT@(CT)="Payer Name: "_$PIECE($GET(DATA("01")),U,5)
+12 SET CT=CT+1
SET @RCMTXT@(CT)="Payer ID: "_$PIECE($GET(DATA("01")),U,6)
+13 SET Z=0
FOR
SET Z=$ORDER(@RAW@(Z))
if 'Z
QUIT
Begin DoDot:1
+14 SET CT=CT+1
SET @RCMTXT@(CT)=$GET(@RAW@(Z))
End DoDot:1
+15 QUIT
EMFORM(CT,RCERR,RCXM,RCXMZ) ; Format error msgs
+1 ; INPUT:
+2 ; CT = # of lines previously populated in error msg
+3 ; RCERR = array of errors
+4 ; RCXMZ = internal entry # of mailman msg
+5 ;
+6 ; OUTPUT:
+7 ; RCXM = array containing the complete error msg text
+8 ;
+9 NEW TTYPE,TDATE,TTIME,Z
+10 ;
+11 SET TDATE=$GET(^TMP("RCERR",$JOB,"DATE"))
SET TTIME=$PIECE(TDATE,".",2)_"000000"
SET TDATE=$$FMTE^XLFDT($PIECE(TDATE,"."),"2D")
+12 SET TTYPE=$GET(^TMP("RCMSG",$JOB))
+13 ;
+14 SET CT=CT+1
+15 SET RCXM(CT)="** AN EXCEPTION HAS BEEN DETECTED FOR AN EDI LOCKBOX RETURN MESSAGE **"
SET CT=CT+1
SET RCXM(CT)=" "
+16 SET CT=CT+1
+17 SET RCXM(CT)=" Return Message Code: "_$SELECT(TTYPE="":$SELECT($GET(^TMP("RCERR",$JOB,"TYPE"))'="":^("TYPE"),1:"Cannot be determined"),1:TTYPE)
+18 ;
+19 SET CT=CT+2
+20 SET RCXM(CT-1)=" "
SET RCXM(CT)=$JUSTIFY("",13)_"Return Message Date: "_TDATE_" Message Time: "_$EXTRACT(TTIME,1,2)_":"_$EXTRACT(TTIME,3,4)_":"_$EXTRACT(TTIME,5,6)
SET CT=CT+1
+21 ;
+22 SET CT=CT+2
SET RCXM(CT-1)=" "
SET RCXM(CT)=$JUSTIFY("",15)_"Mailman Message #: "_$GET(RCXMZ)
+23 ;
+24 IF $GET(RCERR)'=""
IF RCERR?1A.E
SET CT=CT+2
SET RCXM(CT-1)=" "
SET RCXM(CT)=RCERR
+25 IF $GET(^TMP("RCERR",$JOB,"TEXT"))'=""
SET CT=CT+2
SET RCXM(CT)=^("TEXT")
SET RCXM(CT-1)=" "
+26 ;
+27 SET Z=""
FOR
SET Z=$ORDER(RCERR(Z))
if Z=""
QUIT
if $GET(^TMP("RCERR",$JOB,"TEXT"))=""
SET CT=CT+1
SET RCXM(CT)=" "
IF $GET(RCERR(Z))'=""
IF RCERR(Z)'=" "
SET CT=CT+1
SET RCXM(CT)=RCERR(Z)
+28 SET Z=0
FOR
SET Z=$ORDER(^TMP("RCERR",$JOB,"MSG",Z))
if 'Z
QUIT
SET CT=CT+1
SET RCXM(CT)=^(Z)
+29 ;
+30 QUIT
+31 ;
MASKPII(X) ; Return a "05" field with PII masked for sending errors
+1 ; PRCA*4.5*349 - Subroutine added
+2 NEW I
+3 IF +X
IF +X'="835"
Begin DoDot:1
+4 SET $PIECE(X,U,2)="**REDACTED**"
End DoDot:1
+5 IF $PIECE(X,U)="05"
Begin DoDot:1
+6 FOR I=3:1:6
Begin DoDot:2
+7 SET $PIECE(X,U,I)="**REDACTED**"
End DoDot:2
End DoDot:1
+8 QUIT X
+9 ;
EXTERR(RCERR,RCE) ; Put error into error array
+1 ; Returns: (must be passed by reference)
+2 ; RCERR = specific error encountered, returned as 4
+3 ; RCE = error text from the word processing field update error global
+4 NEW RCZ,Q
+5 ; error reported as 'record was partially stored'
SET RCE=""
SET RCERR=4
+6 SET RCZ=0
FOR
SET RCZ=$ORDER(RCE("DIERR",RCZ))
if 'RCZ
QUIT
SET Q=$GET(RCE("DIERR",RCZ,"TEXT",1))
IF $LENGTH(Q)
IF $LENGTH(Q)+$LENGTH(RCE)<99
SET RCE=RCE_Q_";;"
+7 QUIT
+8 ;
ERRUPD(RCGBL,RCD,RCTYPE,RCERR) ; Set up global array to hold msg data
+1 ; RCGBL = name of the global or array where msg data is found
+2 ; RCD = array containing mail header data for the msg
+3 ; RCTYPE = type of msg (835ERA/835XFR/etc)
+4 ; RCERR = error array - text or reference to error tables below
+5 ;
+6 ; Returns ^TMP("RCERR",$J,"MSG" array with formatted error text
+7 ;
+8 NEW Z,Z0,Z1,Z2,CT,RCE
+9 ;
+10 if $GET(RCERR)<0
QUIT
+11 KILL ^TMP("RCERR",$JOB)
+12 SET CT=0
+13 ;
+14 SET ^TMP("RCERR",$JOB,"DATE")=$GET(RCD("DATE"))
+15 SET ^TMP("RCERR",$JOB,"TYPE")=$GET(RCTYPE)
+16 SET ^TMP("RCERR",$JOB,"SUBJ")=$GET(RCD("SUBJ"))
+17 ;
+18 IF $GET(RCERR)>0
IF RCERR<20
Begin DoDot:1
+19 SET Z="ERROR2+"_RCERR
+20 SET RCE=$PIECE($TEXT(@Z),";;",2)
+21 IF RCE'=""
SET ^TMP("RCERR",$JOB,"TEXT")=RCE
End DoDot:1
+22 ;
+23 SET Z=""
FOR
SET Z=$ORDER(RCERR(Z))
if Z=""
QUIT
SET Z0=""
FOR
SET Z0=$ORDER(RCERR(Z,Z0))
if Z0=""
QUIT
SET RCE=$GET(RCERR(Z,Z0))
Begin DoDot:1
+24 IF $LENGTH(RCE)
SET CT=CT+1
SET ^TMP("RCERR",$JOB,"MSG",CT)=$SELECT(RCE:$PIECE($TEXT(ERROR+RCE),";;",2),1:RCE)
+25 SET RCTYPE=$PIECE($GET(@RCGBL@(0)),U)
+26 if $GET(^TMP("RCERR",$JOB,"TYPE"))=""
SET ^("TYPE")=RCTYPE
+27 SET Z1=""
+28 FOR
SET Z1=$ORDER(@RCGBL@(1,"D",Z1))
if Z1=""
QUIT
SET CT=CT+1
SET ^TMP("RCERR",$JOB,"MSG",CT)=$GET(@RCGBL@(1,"D",Z1))
End DoDot:1
+29 ;
+30 IF $DATA(@RCGBL@(2,"D"))
Begin DoDot:1
+31 SET CT=CT+2
SET ^TMP("RCERR",$JOB,"MSG",CT-1)=" "
SET ^TMP("RCERR",$JOB,"MSG",CT)="**** RAW MESSAGE DATA ****:"
+32 IF $GET(^TMP("RCMSGH",$JOB,0))'=""
SET CT=CT+1
SET ^TMP("RCERR",$JOB,"MSG",CT)=^TMP("RCMSGH",$JOB,0)
+33 SET Z2=""
FOR
SET Z2=$ORDER(@RCGBL@(2,"D",Z2))
if Z2=""
QUIT
SET CT=CT+1
SET ^TMP("RCERR",$JOB,"MSG",CT)=$GET(@RCGBL@(2,"D",Z2))
End DoDot:1
+34 IF '$TEST
Begin DoDot:1
+35 if '$DATA(^TMP("RCRAW",$JOB))
QUIT
+36 SET CT=CT+2
SET ^TMP("RCERR",$JOB,"MSG",CT-1)=" "
SET ^TMP("RCERR",$JOB,"MSG",CT)="**** RAW MESSAGE DATA ****:"
+37 IF $GET(^TMP("RCMSGH",$JOB,0))'=""
SET CT=CT+1
SET ^TMP("RCERR",$JOB,"MSG",CT)=^TMP("RCMSGH",$JOB,0)
+38 SET Z2=""
FOR
SET Z2=$ORDER(^TMP("RCRAW",$JOB,Z2))
if Z2=""
QUIT
SET CT=CT+1
SET ^TMP("RCERR",$JOB,"MSG",CT)=$GET(^TMP("RCRAW",$JOB,Z2))
End DoDot:1
+39 ;
+40 QUIT
+41 ;
DKILL(RCXMZ) ; Delete server mail msg from postmaster mailbox
+1 ; RCXMZ = ien of mailman msg
+2 ;
+3 DO ZAPSERV^XMXAPI("S.RCDPE EDI LOCKBOX SERVER",RCXMZ)
+4 QUIT
+5 ;
TEMPDEL(DA) ; Delete msg from temporary msg file
+1 ; DA = ien of the entry in file 344.5
+2 ;
+3 NEW DIK,Y,X
+4 SET DIK="^RCY(344.5,"
DO ^DIK
+5 LOCK -^RCY(344.5,DA,0)
+6 QUIT
+7 ;
RESTMSG(RCD,RCARRAY,XMZ) ; Read rest of msg, store in array
+1 ; RCD = last line # already in the msg
+2 ; RCARRAY = name of the array to store the data in
+3 ; XMZ = ien of the mailman msg
+4 ;
+5 FOR
XECUTE XMREC
if XMER<0
QUIT
SET RCD=RCD+1
SET @RCARRAY@(RCD)=XMRG
+6 QUIT
+7 ;
TAXERR(RCTYPE,RCINS,RCTID,RCCHG) ; Send a bulletin for a bad tax id
+1 ; RCTYPE = "ERA" for an ERA record, "EFT" for an EFT record
+2 ; RCINS = name and id to identify the ins co
+3 ; RCTID = tax id sent in error
+4 ; RCCHG = code describing how correction was made
+5 ; 'E'=EPHRA, 'C'=Changed by looking at claim #'s
+6 ;
+7 NEW XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,RCDXM,XMZ,XMERR,RCCT,RCDXM,RCCT
+8 SET RCCT=0
+9 SET RCCT=RCCT+1
SET RCDXM(RCCT)="An "_RCTYPE_" was received at your site "_$$FMTE^XLFDT($$NOW^XLFDT(),2)_" with an invalid tax id."
SET RCCT=RCCT+1
SET RCDXM(RCCT)=" From: "_RCINS
+10 SET RCCT=RCCT+1
SET RCDXM(RCCT)=" The tax id sent was: "_RCTID_" and it was corrected by: "
+11 SET RCCT=RCCT+1
SET RCDXM(RCCT)=" "_$SELECT(RCCHG="E":"EPHRA",1:"Extracting it based on bill numbers in the ERA")
+12 SET RCCT=RCCT+2
SET RCDXM(RCCT-1)=" "
SET RCDXM(RCCT)="If your site continues to receive these bulletins for this payer,"
SET RCCT=RCCT+1
SET RCDXM(RCCT)="contact the payer and request they correct their tax id for your site"
+13 ;
+14 SET XMTO("I:G.RCDPE PAYMENTS")=""
SET XMBODY="RCDXM"
+15 Begin DoDot:1
+16 NEW DUZ
SET DUZ=.5
SET DUZ(0)="@"
+17 DO SENDMSG^XMXAPI(.5,"EDI LBOX ERRONEOUS TAX ID ON "_RCTYPE,XMBODY,.XMTO,,.XMZ)
End DoDot:1
+18 QUIT
+19 ;
BILL(X,RCDT,RCIB) ; Returns ien of bill in X or -1 if not valid
+1 ; RCDT = the Statement from date (used for Rx bills)
+2 ; and, if passed by reference, RCIB = 1 if an insurance bill
+3 NEW ARRAY,DIC,Y,Z
+4 SET RCIB=0
+5 ; Remove spaces, change ohs to zeroes
SET X=$TRANSLATE(X," ")
SET (X,Z)=$TRANSLATE(X,"O","0")
+6 IF X'["-"
IF $EXTRACT(X,1,3)?3N
IF +$EXTRACT(X,1,3)
IF $LENGTH(X)>7
IF $LENGTH(X)<12
SET X=$EXTRACT(X,1,3)_"-"_$EXTRACT(X,4,$LENGTH(X))
+7 SET DIC="^PRCA(430,"
SET DIC(0)="MZ"
DO ^DIC
+8 ; Checks if the ECME# is valid
+9 IF Y<0
IF $$VALECME^BPSUTIL2(Z)
Begin DoDot:1
+10 SET ARRAY("ECME")=Z
SET ARRAY("FILLDT")=$GET(RCDT)
+11 ; DBIA 4435
SET Y=$$RXBIL^IBNCPDPU(.ARRAY)
+12 IF Y>0
SET Y(0)=$GET(^PRCA(430,+Y,0))
End DoDot:1
+13 IF Y>0
SET RCIB=($PIECE($GET(^RCD(340,+$PIECE(Y(0),U,9),0)),U)["DIC(36,")
+14 QUIT +Y
+15 ;
FMDT(X) ; Format date (X) in YYYYMMDD to Fileman format
+1 IF $LENGTH(X)=8
Begin DoDot:1
+2 SET X=$EXTRACT(X,1,4)-1700_$EXTRACT(X,5,8)
End DoDot:1
+3 QUIT X
+4 ;
ERROR ; Top level error msgs for msgs
+1 ;;Invalid mailgroup designated for EDI Lockbox errors
+2 ;;Message header error
+3 ;
ERROR2 ; Error condition msgs for msgs
+1 ;;Message code is invalid for EDI Lockbox.
+2 ;;This message has no ending $ or 99 record.
+3 ;;Message file problem - no message stored.
+4 ;;Message file problem - message partially stored.
+5 ;;No valid claims for the site found on the ERA.
+6 ;
