- 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 Feb 18, 2025@23:11:46 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 ;