Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDPESR1

RCDPESR1.m

Go to the documentation of this file.
  1. 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
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;Reference to $$RXBIL^IBNCPDPU supported by DBIA 4435
  1. ;Reference to $$VALECME^BPSUTIL2 supported by IA# 6139
  1. ;
  1. Q
  1. ;
  1. PERROR(RCERR,RCEMG,RCXMZ) ; Process Errors - Send bulletin to mail group
  1. ; RCERR = Error text array
  1. ; RCEMG = name of the mail group to which these errors should be sent
  1. ; RCXMZ = internal entry # of the mailman msg
  1. ; RCTYPE = msg type, if known
  1. N CT,XMDUZ,XMSUBJ,XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,RCXM,XMZ,XMERR,Z
  1. ;
  1. S CT=0
  1. ;
  1. I $G(RCEMG)="" S CT=CT+1,RCXM(CT)=$P($T(ERROR+2),";;",2),XMTO(.5)=""
  1. ;
  1. I $D(RCEMG) D
  1. . S:RCEMG="" RCEMG="RCDPE PAYMENTS EXCEPTIONS"
  1. . S:$E(RCEMG,1,2)'="G." RCEMG="G."_RCEMG
  1. . S XMTO("I:"_RCEMG)=""
  1. ;
  1. S Z=$O(XMTO("")) I Z=.5,'$O(XMTO(.5)) S XMTO("I:G.RCDPE PAYMENTS EXCEPTIONS")=""
  1. D EMFORM(CT,.RCERR,.RCXM,RCXMZ)
  1. ;
  1. S XMDUZ=""
  1. S XMSUBJ="EDI LBOX SERVER OPTION ERROR",XMBODY="RCXM"
  1. D
  1. . N DUZ S DUZ=.5,DUZ(0)="@"
  1. . D SENDMSG^XMXAPI(.5,XMSUBJ,XMBODY,.XMTO,,.XMZ)
  1. ;
  1. ; PRCA*4.5*349 - Send a new message to an Outlook email group notifying of error
  1. D OUTMSG(.RCERR,RCXMZ)
  1. K ^TMP("RCRAW",$J)
  1. Q
  1. ;
  1. OUTMSG(RCERR,RCXMZ) ; Build message to send to Outlook address
  1. ; PRCA*4.5*349 - New subroutine
  1. ; RCERR = Error text array
  1. ; RCXMZ = internal entry # of the mailman msg
  1. N CT,RCMTXT,RCXM,TDATE,TTYPE,XMBODY,XMDUZ,XMSUBJ,XMTO,XMZ
  1. S TDATE=$G(^TMP("RCERR",$J,"DATE")),TDATE=$$FMTE^XLFDT(TDATE)
  1. S TTYPE=$G(^TMP("RCMSG",$J))
  1. S XMBODY="RCXM"
  1. ;
  1. S CT=1
  1. S RCXM(CT)="** AN EXCEPTION HAS BEEN DETECTED FOR AN EDI LOCKBOX MESSAGE **",CT=CT+1,RCXM(CT)=" "
  1. S CT=CT+1
  1. S RCXM(CT)="Message Type: "_$S(TTYPE="":$S($G(^TMP("RCERR",$J,"TYPE"))'="":^("TYPE"),1:"Cannot be determined"),1:TTYPE)
  1. ;
  1. S CT=CT+2
  1. S RCXM(CT-1)=" ",RCXM(CT)="Message Date: "_TDATE
  1. ;
  1. S CT=CT+1,RCXM(CT)="Mailman Message #: "_$G(RCXMZ)
  1. S CT=CT+1,RCXM(CT)=" "
  1. S CT=CT+1,RCXM(CT)="Error: "_$S($D(^TMP("RCERR",$J,"TEXT")):^TMP("RCERR",$J,"TEXT"),1:"Unknown error")
  1. I TTYPE["EFT" D
  1. . D OUTEFT($NA(^TMP("RCERR",$J,"MSG")),.CT,"RCXM")
  1. ; To be safe, try to parse unknown message types as ERAs for the purpose of
  1. ; masking PII
  1. I TTYPE'["EFT" D
  1. . D OUTERA($NA(^TMP("RCERR",$J,"MSG")),.CT,"RCXM")
  1. ;
  1. S XMDUZ="",XMSUBJ="EDI LBOX-STA# "_$P($$SITE^VASITE,"^",3)_"-TRANSMISSION ERROR"
  1. S XMTO("vha835payerinquiry@domain.ext")=""
  1. D
  1. . N DUZ S DUZ=.5,DUZ(0)="@"
  1. . D SENDMSG^XMXAPI(.5,XMSUBJ,XMBODY,.XMTO,,.XMZ)
  1. Q
  1. OUTERA(RAW,CT,RCMTXT) ; Format ERA/EEOB for Outlook message
  1. ; PRCA*4.5*349 - New Subroutine
  1. ; RAW - Points to raw data from the message
  1. ; CT - (Passed by Reference) Current message text line count
  1. ; RCMTXT - Pointer to message text array
  1. N I,J,LN,RC,RCDAT,RCREF,OUTXFRM,X,Y,Z
  1. Q:RCMTXT=""!(RAW="")
  1. S J="" F S J=$O(@RAW@(J)) Q:J="" I +$G(@RAW@(J))=835 D Q
  1. . S LN=$G(@RAW@(J))
  1. . F I=8,10,6,7 D
  1. . . S RCDAT=$P(LN,U,I)
  1. . . S RCREF="835+"_I_"^RCDPESR9",RC=$P($T(@RCREF),";;",2)
  1. . . S OUTXFRM=$P(RC,U,4,99)
  1. . . I OUTXFRM'="" S X=RCDAT X OUTXFRM S RCDAT=Y
  1. . . S CT=CT+1,@RCMTXT@(CT)=$P(RC,U,3)_": "_RCDAT
  1. S Z=0 F S Z=$O(@RAW@(Z)) Q:Z="" D
  1. . S CT=CT+1,@RCMTXT@(CT)=$$MASKPII(@RAW@(Z))
  1. Q
  1. OUTEFT(RAW,CT,RCMTXT) ; Format EFT for Outlook message
  1. ; PRCA*4.5*349 - New Subroutine
  1. ; RAW - Points to raw data from the message
  1. ; CT - (Passed by Reference) Current message text line count
  1. ; RCMTXT - Pointer to message text array
  1. N DATA,I,Z
  1. Q:RCMTXT=""!(RAW="")
  1. S I="" F S I=$O(@RAW@(I)) Q:'I D
  1. . S DATA($P(@RAW@(I),U))=$G(@RAW@(I))
  1. S CT=CT+1,@RCMTXT@(CT)="Trace Number: "_$P($G(DATA("01")),U,2)
  1. S CT=CT+1,@RCMTXT@(CT)="Dollar Amt: "_$$ZERO^RCDPESR9($P($G(DATA("01")),U,4),1)
  1. S CT=CT+1,@RCMTXT@(CT)="Payer Name: "_$P($G(DATA("01")),U,5)
  1. S CT=CT+1,@RCMTXT@(CT)="Payer ID: "_$P($G(DATA("01")),U,6)
  1. S Z=0 F S Z=$O(@RAW@(Z)) Q:'Z D
  1. . S CT=CT+1,@RCMTXT@(CT)=$G(@RAW@(Z))
  1. Q
  1. EMFORM(CT,RCERR,RCXM,RCXMZ) ; Format error msgs
  1. ; INPUT:
  1. ; CT = # of lines previously populated in error msg
  1. ; RCERR = array of errors
  1. ; RCXMZ = internal entry # of mailman msg
  1. ;
  1. ; OUTPUT:
  1. ; RCXM = array containing the complete error msg text
  1. ;
  1. N TTYPE,TDATE,TTIME,Z
  1. ;
  1. S TDATE=$G(^TMP("RCERR",$J,"DATE")),TTIME=$P(TDATE,".",2)_"000000",TDATE=$$FMTE^XLFDT($P(TDATE,"."),"2D")
  1. S TTYPE=$G(^TMP("RCMSG",$J))
  1. ;
  1. S CT=CT+1
  1. S RCXM(CT)="** AN EXCEPTION HAS BEEN DETECTED FOR AN EDI LOCKBOX RETURN MESSAGE **",CT=CT+1,RCXM(CT)=" "
  1. S CT=CT+1
  1. S RCXM(CT)=" Return Message Code: "_$S(TTYPE="":$S($G(^TMP("RCERR",$J,"TYPE"))'="":^("TYPE"),1:"Cannot be determined"),1:TTYPE)
  1. ;
  1. S CT=CT+2
  1. 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
  1. ;
  1. S CT=CT+2,RCXM(CT-1)=" ",RCXM(CT)=$J("",15)_"Mailman Message #: "_$G(RCXMZ)
  1. ;
  1. I $G(RCERR)'="",RCERR?1A.E S CT=CT+2,RCXM(CT-1)=" ",RCXM(CT)=RCERR
  1. I $G(^TMP("RCERR",$J,"TEXT"))'="" S CT=CT+2,RCXM(CT)=^("TEXT"),RCXM(CT-1)=" "
  1. ;
  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)
  1. S Z=0 F S Z=$O(^TMP("RCERR",$J,"MSG",Z)) Q:'Z S CT=CT+1,RCXM(CT)=^(Z)
  1. ;
  1. Q
  1. ;
  1. MASKPII(X) ; Return a "05" field with PII masked for sending errors
  1. ; PRCA*4.5*349 - Subroutine added
  1. N I
  1. I +X,+X'="835" D
  1. . S $P(X,U,2)="**REDACTED**"
  1. I $P(X,U)="05" D
  1. . F I=3:1:6 D
  1. . . S $P(X,U,I)="**REDACTED**"
  1. Q X
  1. ;
  1. EXTERR(RCERR,RCE) ; Put error into error array
  1. ; Returns: (must be passed by reference)
  1. ; RCERR = specific error encountered, returned as 4
  1. ; RCE = error text from the word processing field update error global
  1. N RCZ,Q
  1. S RCE="",RCERR=4 ; error reported as 'record was partially stored'
  1. 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_";;"
  1. Q
  1. ;
  1. 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
  1. ; RCD = array containing mail header data for the msg
  1. ; RCTYPE = type of msg (835ERA/835XFR/etc)
  1. ; RCERR = error array - text or reference to error tables below
  1. ;
  1. ; Returns ^TMP("RCERR",$J,"MSG" array with formatted error text
  1. ;
  1. N Z,Z0,Z1,Z2,CT,RCE
  1. ;
  1. Q:$G(RCERR)<0
  1. K ^TMP("RCERR",$J)
  1. S CT=0
  1. ;
  1. S ^TMP("RCERR",$J,"DATE")=$G(RCD("DATE"))
  1. S ^TMP("RCERR",$J,"TYPE")=$G(RCTYPE)
  1. S ^TMP("RCERR",$J,"SUBJ")=$G(RCD("SUBJ"))
  1. ;
  1. I $G(RCERR)>0,RCERR<20 D
  1. . S Z="ERROR2+"_RCERR
  1. . S RCE=$P($T(@Z),";;",2)
  1. . I RCE'="" S ^TMP("RCERR",$J,"TEXT")=RCE
  1. ;
  1. 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
  1. . I $L(RCE) S CT=CT+1,^TMP("RCERR",$J,"MSG",CT)=$S(RCE:$P($T(ERROR+RCE),";;",2),1:RCE)
  1. . S RCTYPE=$P($G(@RCGBL@(0)),U)
  1. . S:$G(^TMP("RCERR",$J,"TYPE"))="" ^("TYPE")=RCTYPE
  1. . S Z1=""
  1. . F S Z1=$O(@RCGBL@(1,"D",Z1)) Q:Z1="" S CT=CT+1,^TMP("RCERR",$J,"MSG",CT)=$G(@RCGBL@(1,"D",Z1))
  1. ;
  1. I $D(@RCGBL@(2,"D")) D
  1. . S CT=CT+2,^TMP("RCERR",$J,"MSG",CT-1)=" ",^TMP("RCERR",$J,"MSG",CT)="**** RAW MESSAGE DATA ****:"
  1. . I $G(^TMP("RCMSGH",$J,0))'="" S CT=CT+1,^TMP("RCERR",$J,"MSG",CT)=^TMP("RCMSGH",$J,0)
  1. . 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))
  1. E D
  1. . Q:'$D(^TMP("RCRAW",$J))
  1. . S CT=CT+2,^TMP("RCERR",$J,"MSG",CT-1)=" ",^TMP("RCERR",$J,"MSG",CT)="**** RAW MESSAGE DATA ****:"
  1. . I $G(^TMP("RCMSGH",$J,0))'="" S CT=CT+1,^TMP("RCERR",$J,"MSG",CT)=^TMP("RCMSGH",$J,0)
  1. . 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))
  1. ;
  1. Q
  1. ;
  1. DKILL(RCXMZ) ; Delete server mail msg from postmaster mailbox
  1. ; RCXMZ = ien of mailman msg
  1. ;
  1. D ZAPSERV^XMXAPI("S.RCDPE EDI LOCKBOX SERVER",RCXMZ)
  1. Q
  1. ;
  1. TEMPDEL(DA) ; Delete msg from temporary msg file
  1. ; DA = ien of the entry in file 344.5
  1. ;
  1. N DIK,Y,X
  1. S DIK="^RCY(344.5," D ^DIK
  1. L -^RCY(344.5,DA,0)
  1. Q
  1. ;
  1. RESTMSG(RCD,RCARRAY,XMZ) ; Read rest of msg, store in array
  1. ; RCD = last line # already in the msg
  1. ; RCARRAY = name of the array to store the data in
  1. ; XMZ = ien of the mailman msg
  1. ;
  1. F X XMREC Q:XMER<0 S RCD=RCD+1,@RCARRAY@(RCD)=XMRG
  1. Q
  1. ;
  1. 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
  1. ; RCINS = name and id to identify the ins co
  1. ; RCTID = tax id sent in error
  1. ; RCCHG = code describing how correction was made
  1. ; 'E'=EPHRA, 'C'=Changed by looking at claim #'s
  1. ;
  1. N XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,RCDXM,XMZ,XMERR,RCCT,RCDXM,RCCT
  1. S RCCT=0
  1. 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
  1. S RCCT=RCCT+1,RCDXM(RCCT)=" The tax id sent was: "_RCTID_" and it was corrected by: "
  1. S RCCT=RCCT+1,RCDXM(RCCT)=" "_$S(RCCHG="E":"EPHRA",1:"Extracting it based on bill numbers in the ERA")
  1. 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"
  1. ;
  1. S XMTO("I:G.RCDPE PAYMENTS")="",XMBODY="RCDXM"
  1. D
  1. . N DUZ S DUZ=.5,DUZ(0)="@"
  1. . D SENDMSG^XMXAPI(.5,"EDI LBOX ERRONEOUS TAX ID ON "_RCTYPE,XMBODY,.XMTO,,.XMZ)
  1. Q
  1. ;
  1. 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)
  1. ; and, if passed by reference, RCIB = 1 if an insurance bill
  1. N ARRAY,DIC,Y,Z
  1. S RCIB=0
  1. S X=$TR(X," "),(X,Z)=$TR(X,"O","0") ; Remove spaces, change ohs to zeroes
  1. 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))
  1. S DIC="^PRCA(430,",DIC(0)="MZ" D ^DIC
  1. ; Checks if the ECME# is valid
  1. I Y<0,$$VALECME^BPSUTIL2(Z) D
  1. . S ARRAY("ECME")=Z,ARRAY("FILLDT")=$G(RCDT)
  1. . S Y=$$RXBIL^IBNCPDPU(.ARRAY) ; DBIA 4435
  1. . I Y>0 S Y(0)=$G(^PRCA(430,+Y,0))
  1. I Y>0 S RCIB=($P($G(^RCD(340,+$P(Y(0),U,9),0)),U)["DIC(36,")
  1. Q +Y
  1. ;
  1. FMDT(X) ; Format date (X) in YYYYMMDD to Fileman format
  1. I $L(X)=8 D
  1. . S X=$E(X,1,4)-1700_$E(X,5,8)
  1. Q X
  1. ;
  1. ERROR ; Top level error msgs for msgs
  1. ;;Invalid mailgroup designated for EDI Lockbox errors
  1. ;;Message header error
  1. ;
  1. ERROR2 ; Error condition msgs for msgs
  1. ;;Message code is invalid for EDI Lockbox.
  1. ;;This message has no ending $ or 99 record.
  1. ;;Message file problem - no message stored.
  1. ;;Message file problem - message partially stored.
  1. ;;No valid claims for the site found on the ERA.
  1. ;