- RCDPESR4 ;ALB/TMK/PJH - Server interface 835ERA processing ;Jun 06, 2014@19:11:19
- ;;4.5;Accounts Receivable;**173,216,208,230,269,271,298,321,424**;Mar 20, 1995;Build 11
- ;Per VA Directive 6402, this routine should not be modified.
- ;
- ;Reference to $$VALECME^BPSUTIL2 supported by IA# 6139
- ;
- ERAEOBIN(RCTXN,RCD,RCGBL,RCEFLG) ; Store/process 835ERA or 835XFR
- ; transaction coming into the site
- ; RCTXN = data on the hdr record of the msg text
- ; RCD = array with formatted hdr data
- ; RCGBL = name of the array or global where the msg is stored
- ; RCEFLG = error flag returned if passed by REF
- ;
- N RCLAST,RCBILL,RCTDA,RCMSG,RCERR
- S (RCTDA,RCEFLG)=0
- ;
- ;
- F L +^RCY(344.5,"AMSEQ",+$P(RCTXN,U,13)):30 Q:$T
- S RCMSG=$$EXTERA(RCTXN,.RCLAST,.RCBILL) ; Extract from mail msg
- ;
- ; If full msg received (99^$ record exists), file it
- I 'RCLAST,'$G(RCERR) D ;No $ as last character of msg
- . S RCERR=2
- ;
- I RCLAST S RCTDA=+$$ADD(RCGBL,RCD("MSG#"),RCMSG,.RCBILL,.RCERR,.RCD)
- ;
- I $G(RCERR)>0 D
- . D ERRUPD^RCDPESR1(RCGBL,.RCD,$P(RCTXN,U),.RCERR)
- . I RCTDA D ; Store exception msgs in file 344.5
- .. N A,C,Z
- .. S C=1,A(1)="Date: "_$$FMTE^XLFDT($$NOW^XLFDT(),2)
- .. I $G(^TMP("RCERR",$J,"TEXT"))'="" S C=C+1,A(C)=^TMP("RCERR",$J,"TEXT"),C=C+1,A(C)=" "
- .. S Z=0 F S Z=$O(^TMP("RCERR",$J,"MSG",Z)) Q:'Z S C=C+1,A(C)=^(Z)
- .. I $O(A(0)) D WP^DIE(344.5,RCTDA_",",5,"A","A")
- . S RCEFLG=1
- ;
- L -^RCY(344.5,"AMSEQ",+$P(RCTXN,U,13))
- 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
- ;
- Q
- ;
- EXTERA(RCTXN,RCLAST,RCBILL) ;Extract 835ERA or 835XFR transaction
- ;INPUT:
- ; RCTXN = data on 835ERA/835XFR hdr record
- ; RCLAST = passed by REF and returned=1 if entire record exists
- ;
- ;OUTPUT:
- ; ^TMP("RCMSG",$J,1,"D",line #)=formatted hdr data
- ; ^TMP("RCMSG",$J,2,"D",line #)=raw msg data
- ; if passed by ref, RCLAST = 1 if '99' record found
- ; if passed by ref, RCBILL(AR bill number) is returned
- ; with a 'list' of bills included in the ERA. If an
- ; entry = 1, 3rd party bill was found in file 430.
- ; If the entry = 2, the 3rd party bill found was not active
- ; Function returns existing ien in file 344.5 for multi part ERAs
- ;
- ;N CT,CT1,LINE,HCT,RCH,RCMSG,RCREFORM,RCINS,RCSTAT,B,RCSD,C5
- N B,C5,CT,CT1,HCT,LINE,RCH,RCINS,RCMSG,RCREFORM,RCSD,RCSRV,RCSTAT ;PRCA*4.5*424 removed RCSTART added RCSRV
- S (HCT,RCH)=0
- ;
- ;
- ; Check if sequence control # already exists or if a new record needed
- S RCMSG=+$O(^RCY(344.5,"AMSEQ",+$P(RCTXN,U,13),0))
- S CT=0
- I 'RCMSG D ; Build display data for the first sequence only
- . S HCT=HCT+1 S LINE(HCT)="Payer Name: "_$P(RCTXN,U,6)
- . S HCT=HCT+1 S LINE(HCT)="Payer ID: "_$P(RCTXN,U,7)
- . S HCT=HCT+1,LINE(HCT)="Trace #: "_$P(RCTXN,U,8)
- . 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)
- . I $P(RCTXN,U)["XFR",$P(RCTXN,U,19)'="" S HCT=HCT+1,LINE(HCT)="Contact Info: "_$P(RCTXN,U,19)
- . M ^TMP("RCMSG",$J,1,"D")=LINE
- . S CT=CT+1,^TMP("RCMSG",$J,2,"D",CT)=RCTXN
- ;
- S CT1=CT
- S ^TMP("RCMSG",$J,0)=RCTXN
- ;
- S RCSD=$NA(^TMP($J,"RCSRVDT")) K @RCSD ;service dates
- S C5=0
- S RCLAST=0,RCSRV=0 ; PRCA*4.5*321
- F X XMREC Q:XMER<0 D Q:RCLAST
- . Q:XMRG=""
- . I +XMRG=99,$P(XMRG,U,2)="$" S RCLAST=1 Q
- . S CT=CT+1
- . ;Statement Start Date - 05 Record is mandatory
- . I +XMRG=5,$P(XMRG,U,2)'="" D ;
- . . S C5=CT
- . . S @RCSD@(C5)=+$P(XMRG,U,9) ; PRCA*4.5*424
- . . S RCSRV=0
- . ; save the service date for possible ECME# look up
- . ;PRCA*4.5*321 BEGIN
- . I +XMRG=40,$$VALECME^BPSUTIL2($P(XMRG,U,2)),C5,'RCSRV D
- . . I $P(XMRG,U,19) S @RCSD@(C5)=+$P(XMRG,U,19),RCSRV=1
- . S ^TMP("RCMSG",$J,2,"D",CT)=XMRG
- ;
- ; reformat bill# if needed
- S RCREFORM=""
- S CT=CT1
- F S CT=$O(^TMP("RCMSG",$J,2,"D",CT)) Q:'CT S XMRG=$G(^(CT)) D
- . Q:XMRG=""
- . I +XMRG=5,$P(XMRG,U,2)'="" D
- .. S RCREFORM="",RCSTAT=1
- .. ; Check if bill is in AR & is a 3rd party bill
- .. S RCBILL=$$BILL^RCDPESR1($P(XMRG,U,2),$G(@RCSD@(CT)),.RCINS) ; look up claim ien by claim# or ECME#
- .. I '$G(RCINS)!(RCBILL<0) S (RCBILL,RCSTAT)=0
- .. 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
- .. I RCBILL,$P(^PRCA(430.3,+$P($G(^PRCA(430,+RCBILL,0)),U,8),0),U,3)'=102 S RCSTAT=2
- .. S RCBILL($P(XMRG,U,2))=RCSTAT
- . I RCREFORM'="",+XMRG>5 S $P(XMRG,U,2)=RCREFORM,^TMP("RCMSG",$J,2,"D",CT)=XMRG
- ;
- K @RCSD
- Q RCMSG
- ;
- ADD(RCGBL,RCDMSG,RCMSG,RCBILL,RCERR,RCD) ; Add msg(s) in @RCGBL to
- ; file 344.5
- ; RCGBL = name of the global used to store the msg data
- ; RCDMSG = Mailman msg number the ERA arrived in.
- ; RCMSG = ien of the existing entry in file 344.5 for multipart ERAs
- ; RCBILL(AR bill number) = list of bills included, pass by REF
- ; RCD = array with formatted hdr data
- ;
- ; Errors returned in RCERR and RCERR(n)
- ; Function returns entry # of msg added or "" if none added
- ;
- ;
- N RCHDR,RCTYP,RCIEN
- S RCHDR=$G(^TMP("RCMSGH",$J,0))
- S RCTYP=$P(RCHDR,U)
- S RCIEN=$S($G(RCMSG):RCMSG,1:$$ADDTXN(RCHDR,RCDMSG)) ;File msg hdr
- I RCIEN'>0 S RCERR=3 ;msg hdr can't be filed
- I '$G(RCERR) D LOADDET(RCIEN,RCGBL,RCHDR,.RCBILL,.RCD,.RCERR)
- 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
- ;
- Q $S($G(RCIEN)>0&'$G(RCERR):RCIEN,1:"")
- ;
- ADDTXN(RCDATA,RCDMSG) ; Add a trxn for msg in RCDATA to file 344.5
- ; RCDATA = data on the msg hdr record
- ; RCDMSG = Mailman msg number the ERA arrived in
- ;Function returns ien of the new entry in file 344.5 or "" if an error
- ;
- N A,RCY,DLAYGO,DIC,DD,DO,DA,X,Y,Z
- ;
- ;
- S (X,A)=RCDMSG ;Use msg ID as basis for the .01 field
- F Z=1:1 Q:'$D(^RCY(344.5,"B",A)) S A=X_"."_Z
- S X=A
- S DIC(0)="L",DIC="^RCY(344.5,",DLAYGO=344.5
- 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
- I $P(RCDATA,U,6)'="" S DIC("DR")=DIC("DR")_";3.01////"_$P(RCDATA,U,6)
- D FILE^DICN K DO,DD,DLAYGO,DA,DIC
- S RCY=+Y
- ;
- ;
- Q $S(RCY>0:+RCY,1:"")
- ;
- LOADDET(RCTDA,RCGBL,RCHDR,RCBILL,RCD,RCERR) ; Load the rest of the text
- ; into the msg
- ; RCTDA = ien in file 344.5
- ; RCGBL = name of the array holding the detail msg text to be loaded
- ; RCHDR = data on ERA hdr record
- ; RCBILL(AR bill number) = list of bills included, pass by REF
- ; RCD = array with formatted hdr data
- ;
- ; OUTPUT: RCERR if any errors found, pass by REF
- ;
- ;
- N RCE,RCDATA,RCMSG,RCFROM,Z,Z0
- K ^TMP("RCTEXT",$J),^TMP("RCRAW",$J)
- M ^TMP("RCTEXT",$J)=@RCGBL@(1,"D")
- M ^TMP("RCRAW",$J)=@RCGBL@(2,"D")
- ;
- S RCDATA=$G(^RCY(344.5,RCTDA,0)),RCMSG=$G(RCD("MSG#")),RCFROM=$G(RCD("FROM"))
- ;
- ; For multi-part ERA, don't update if sequence already filed
- ; Add seq # if not already there
- I $P(RCHDR,U)'["XFR",$P(RCHDR,U,13) Q:$D(^RCY(344.5,RCTDA,"S","B",+$P(RCHDR,U,14)))
- ;
- D STOREM(+$G(RCTDA),"^TMP(""RCTEXT"",$J)","^TMP(""RCRAW"",$J)",.RCE)
- ;
- I $D(RCE("DIERR")) D ; Extract error
- . N DIE,DA,DR,X,Y
- . D EXTERR^RCDPESR1(.RCERR,.RCE)
- . S:$L($G(RCE)) RCERR(+$O(RCERR(""),-1)+1)=RCE
- . I $D(^RCY(344.5,RCTDA,0)) S DIE="^RCY(344.5,",DR=".1////4",DA=RCTDA D ^DIE
- E D ; No error - store rest of data
- . N Z,RCT,RCCT,RCX,RCB ; Add bills included in ERA
- . S RCT=0,RCCT=0,RCX=$J("",4)
- . S Z="" F S Z=$O(RCBILL(Z)) Q:Z="" D
- .. N DO,DD,DIC,DLAYGO,X,Y
- .. 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
- .. 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
- .. ;
- . I $L(RCX)>4 S RCCT=RCCT+1,RCB(RCCT)=RCX
- . ; Add list of bills to display data
- . I $O(RCB(0)) D WP^DIE(344.5,RCTDA_",",1,"A","RCB")
- . ; Add seq #
- . 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
- . D FILE^DICN K DO,DD,DLAYGO,DIC
- . ;
- . I $P(RCHDR,U)["835XFR" D XFR^RCDPESR5(RCTDA,RCFROM,RCMSG,.RCD) Q
- . ;
- . ; Proceed only if not a transfer record
- . I $P(RCDATA,U,9)'="" D ; Determine if all sequences received yet
- .. N RCOK,RCLAST
- .. S RCOK=1,RCLAST=0
- .. F Z=1:1 Q:'RCOK!RCLAST D
- ... I 'RCLAST,'$D(^RCY(344.5,RCTDA,"S","B",Z)) S RCOK=0 Q
- ... S Z0=+$O(^RCY(344.5,RCTDA,"S","B",Z,0)),Z0=$G(^RCY(344.5,RCTDA,"S",Z0,0))
- ... I Z0="" S RCOK=0 Q
- ... I $P(Z0,U,2) S RCLAST=1 ; Last sequence received and all before it
- .. ;
- .. I RCOK D
- ... N DA,DIE,DR,X,Y
- ... S DA=RCTDA,DR=".08////0;.1///@",DIE="^RCY(344.5," D ^DIE
- ... I '$O(^RCY(344.5,RCTDA,"B","AV",1,0)) D ; No valid bills found
- ....;-----
- ....; PRCA*4.5*298 - MailMan message disabled, logic retained - 14 Feb 2014
- ....;N RCE
- ....;S RCE(1)="No valid bills for this site were found in this ERA"
- ....;S RCE(2)="Review/correct the bill #'s on this ERA in your transmission exceptions"
- ....;S RCE(3)="Please contact the Implementation Manager group to report this situation",RCE(4)=" "
- ....;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)
- ....;-----
- .... S DA=RCTDA,DR=".08////1;.1////6",DIE="^RCY(344.5," D ^DIE
- ;
- ;
- K ^TMP("RCTEXT",$J),^TMP("RCRAW",$J)
- Q
- ;
- STOREM(RCTDA,RCDISP,RCTEXT,RCE) ;Store msg text in file 344.5
- ;INPUT:
- ; RCTDA = ien of the entry in file 344.5
- ; RCDISP = name of the array where display msg text is retrieved from
- ; or "@" to delete the text from the display text field
- ; RCTEXT = name of the array where raw msg text is retrieved from
- ; or "@" to delete the text from the raw msg field
- ;OUTPUT:
- ; RCE = array of errors (RCE("DIERR")) returned, pass by REF
- ;
- N RCZ,X,Y,DIE
- K RCE("DIERR")
- ;
- I $S($G(RCDISP)="@":1,1:$D(@RCDISP)'<10) D
- . 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
- ;
- I '$O(RCE("DIERR",0)),$S($G(RCTEXT)="@":1,1:$D(@RCTEXT)'<10) D
- . 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
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPESR4 10642 printed Feb 18, 2025@23:11:49 Page 2
- RCDPESR4 ;ALB/TMK/PJH - Server interface 835ERA processing ;Jun 06, 2014@19:11:19
- +1 ;;4.5;Accounts Receivable;**173,216,208,230,269,271,298,321,424**;Mar 20, 1995;Build 11
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ;Reference to $$VALECME^BPSUTIL2 supported by IA# 6139
- +5 ;
- ERAEOBIN(RCTXN,RCD,RCGBL,RCEFLG) ; Store/process 835ERA or 835XFR
- +1 ; transaction coming into the site
- +2 ; RCTXN = data on the hdr record of the msg text
- +3 ; RCD = array with formatted hdr data
- +4 ; RCGBL = name of the array or global where the msg is stored
- +5 ; RCEFLG = error flag returned if passed by REF
- +6 ;
- +7 NEW RCLAST,RCBILL,RCTDA,RCMSG,RCERR
- +8 SET (RCTDA,RCEFLG)=0
- +9 ;
- +10 ;
- +11 FOR
- LOCK +^RCY(344.5,"AMSEQ",+$PIECE(RCTXN,U,13)):30
- if $TEST
- QUIT
- +12 ; Extract from mail msg
- SET RCMSG=$$EXTERA(RCTXN,.RCLAST,.RCBILL)
- +13 ;
- +14 ; If full msg received (99^$ record exists), file it
- +15 ;No $ as last character of msg
- IF 'RCLAST
- IF '$GET(RCERR)
- Begin DoDot:1
- +16 SET RCERR=2
- End DoDot:1
- +17 ;
- +18 IF RCLAST
- SET RCTDA=+$$ADD(RCGBL,RCD("MSG#"),RCMSG,.RCBILL,.RCERR,.RCD)
- +19 ;
- +20 IF $GET(RCERR)>0
- Begin DoDot:1
- +21 DO ERRUPD^RCDPESR1(RCGBL,.RCD,$PIECE(RCTXN,U),.RCERR)
- +22 ; Store exception msgs in file 344.5
- IF RCTDA
- Begin DoDot:2
- +23 NEW A,C,Z
- +24 SET C=1
- SET A(1)="Date: "_$$FMTE^XLFDT($$NOW^XLFDT(),2)
- +25 IF $GET(^TMP("RCERR",$JOB,"TEXT"))'=""
- SET C=C+1
- SET A(C)=^TMP("RCERR",$JOB,"TEXT")
- SET C=C+1
- SET A(C)=" "
- +26 SET Z=0
- FOR
- SET Z=$ORDER(^TMP("RCERR",$JOB,"MSG",Z))
- if 'Z
- QUIT
- SET C=C+1
- SET A(C)=^(Z)
- +27 IF $ORDER(A(0))
- DO WP^DIE(344.5,RCTDA_",",5,"A","A")
- End DoDot:2
- +28 SET RCEFLG=1
- End DoDot:1
- +29 ;
- +30 LOCK -^RCY(344.5,"AMSEQ",+$PIECE(RCTXN,U,13))
- +31 ; Send bad tax id bulletin
- IF $PIECE(RCTXN,U)'["XFR"
- IF $PIECE(RCTXN,U,12)'=""
- DO TAXERR^RCDPESR1("ERA",$PIECE(RCTXN,U,6)_" Payer ID: "_$PIECE(RCTXN,U,7),$PIECE(RCTXN,U,11),$PIECE(RCTXN,U,12))
- +32 ;
- +33 QUIT
- +34 ;
- EXTERA(RCTXN,RCLAST,RCBILL) ;Extract 835ERA or 835XFR transaction
- +1 ;INPUT:
- +2 ; RCTXN = data on 835ERA/835XFR hdr record
- +3 ; RCLAST = passed by REF and returned=1 if entire record exists
- +4 ;
- +5 ;OUTPUT:
- +6 ; ^TMP("RCMSG",$J,1,"D",line #)=formatted hdr data
- +7 ; ^TMP("RCMSG",$J,2,"D",line #)=raw msg data
- +8 ; if passed by ref, RCLAST = 1 if '99' record found
- +9 ; if passed by ref, RCBILL(AR bill number) is returned
- +10 ; with a 'list' of bills included in the ERA. If an
- +11 ; entry = 1, 3rd party bill was found in file 430.
- +12 ; If the entry = 2, the 3rd party bill found was not active
- +13 ; Function returns existing ien in file 344.5 for multi part ERAs
- +14 ;
- +15 ;N CT,CT1,LINE,HCT,RCH,RCMSG,RCREFORM,RCINS,RCSTAT,B,RCSD,C5
- +16 ;PRCA*4.5*424 removed RCSTART added RCSRV
- NEW B,C5,CT,CT1,HCT,LINE,RCH,RCINS,RCMSG,RCREFORM,RCSD,RCSRV,RCSTAT
- +17 SET (HCT,RCH)=0
- +18 ;
- +19 ;
- +20 ; Check if sequence control # already exists or if a new record needed
- +21 SET RCMSG=+$ORDER(^RCY(344.5,"AMSEQ",+$PIECE(RCTXN,U,13),0))
- +22 SET CT=0
- +23 ; Build display data for the first sequence only
- IF 'RCMSG
- Begin DoDot:1
- +24 SET HCT=HCT+1
- SET LINE(HCT)="Payer Name: "_$PIECE(RCTXN,U,6)
- +25 SET HCT=HCT+1
- SET LINE(HCT)="Payer ID: "_$PIECE(RCTXN,U,7)
- +26 SET HCT=HCT+1
- SET LINE(HCT)="Trace #: "_$PIECE(RCTXN,U,8)
- +27 SET HCT=HCT+1
- SET LINE(HCT)="Date Paid: "_$$FDT^RCDPESR9($PIECE(RCTXN,U,9))_" Total Amt Paid: "_$JUSTIFY($PIECE(RCTXN,U,10)/100,0,2)
- +28 IF $PIECE(RCTXN,U)["XFR"
- IF $PIECE(RCTXN,U,19)'=""
- SET HCT=HCT+1
- SET LINE(HCT)="Contact Info: "_$PIECE(RCTXN,U,19)
- +29 MERGE ^TMP("RCMSG",$JOB,1,"D")=LINE
- +30 SET CT=CT+1
- SET ^TMP("RCMSG",$JOB,2,"D",CT)=RCTXN
- End DoDot:1
- +31 ;
- +32 SET CT1=CT
- +33 SET ^TMP("RCMSG",$JOB,0)=RCTXN
- +34 ;
- +35 ;service dates
- SET RCSD=$NAME(^TMP($JOB,"RCSRVDT"))
- KILL @RCSD
- +36 SET C5=0
- +37 ; PRCA*4.5*321
- SET RCLAST=0
- SET RCSRV=0
- +38 FOR
- XECUTE XMREC
- if XMER<0
- QUIT
- Begin DoDot:1
- +39 if XMRG=""
- QUIT
- +40 IF +XMRG=99
- IF $PIECE(XMRG,U,2)="$"
- SET RCLAST=1
- QUIT
- +41 SET CT=CT+1
- +42 ;Statement Start Date - 05 Record is mandatory
- +43 ;
- IF +XMRG=5
- IF $PIECE(XMRG,U,2)'=""
- Begin DoDot:2
- +44 SET C5=CT
- +45 ; PRCA*4.5*424
- SET @RCSD@(C5)=+$PIECE(XMRG,U,9)
- +46 SET RCSRV=0
- End DoDot:2
- +47 ; save the service date for possible ECME# look up
- +48 ;PRCA*4.5*321 BEGIN
- +49 IF +XMRG=40
- IF $$VALECME^BPSUTIL2($PIECE(XMRG,U,2))
- IF C5
- IF 'RCSRV
- Begin DoDot:2
- +50 IF $PIECE(XMRG,U,19)
- SET @RCSD@(C5)=+$PIECE(XMRG,U,19)
- SET RCSRV=1
- End DoDot:2
- +51 SET ^TMP("RCMSG",$JOB,2,"D",CT)=XMRG
- End DoDot:1
- if RCLAST
- QUIT
- +52 ;
- +53 ; reformat bill# if needed
- +54 SET RCREFORM=""
- +55 SET CT=CT1
- +56 FOR
- SET CT=$ORDER(^TMP("RCMSG",$JOB,2,"D",CT))
- if 'CT
- QUIT
- SET XMRG=$GET(^(CT))
- Begin DoDot:1
- +57 if XMRG=""
- QUIT
- +58 IF +XMRG=5
- IF $PIECE(XMRG,U,2)'=""
- Begin DoDot:2
- +59 SET RCREFORM=""
- SET RCSTAT=1
- +60 ; Check if bill is in AR & is a 3rd party bill
- +61 ; look up claim ien by claim# or ECME#
- SET RCBILL=$$BILL^RCDPESR1($PIECE(XMRG,U,2),$GET(@RCSD@(CT)),.RCINS)
- +62 IF '$GET(RCINS)!(RCBILL<0)
- SET (RCBILL,RCSTAT)=0
- +63 IF RCBILL
- SET B=$PIECE($GET(^PRCA(430,RCBILL,0)),U)
- IF B'=$PIECE(XMRG,U,2)
- SET $PIECE(XMRG,U,2)=B
- SET RCREFORM=B
- +64 IF RCBILL
- IF $PIECE(^PRCA(430.3,+$PIECE($GET(^PRCA(430,+RCBILL,0)),U,8),0),U,3)'=102
- SET RCSTAT=2
- +65 SET RCBILL($PIECE(XMRG,U,2))=RCSTAT
- End DoDot:2
- +66 IF RCREFORM'=""
- IF +XMRG>5
- SET $PIECE(XMRG,U,2)=RCREFORM
- SET ^TMP("RCMSG",$JOB,2,"D",CT)=XMRG
- End DoDot:1
- +67 ;
- +68 KILL @RCSD
- +69 QUIT RCMSG
- +70 ;
- ADD(RCGBL,RCDMSG,RCMSG,RCBILL,RCERR,RCD) ; Add msg(s) in @RCGBL to
- +1 ; file 344.5
- +2 ; RCGBL = name of the global used to store the msg data
- +3 ; RCDMSG = Mailman msg number the ERA arrived in.
- +4 ; RCMSG = ien of the existing entry in file 344.5 for multipart ERAs
- +5 ; RCBILL(AR bill number) = list of bills included, pass by REF
- +6 ; RCD = array with formatted hdr data
- +7 ;
- +8 ; Errors returned in RCERR and RCERR(n)
- +9 ; Function returns entry # of msg added or "" if none added
- +10 ;
- +11 ;
- +12 NEW RCHDR,RCTYP,RCIEN
- +13 SET RCHDR=$GET(^TMP("RCMSGH",$JOB,0))
- +14 SET RCTYP=$PIECE(RCHDR,U)
- +15 ;File msg hdr
- SET RCIEN=$SELECT($GET(RCMSG):RCMSG,1:$$ADDTXN(RCHDR,RCDMSG))
- +16 ;msg hdr can't be filed
- IF RCIEN'>0
- SET RCERR=3
- +17 IF '$GET(RCERR)
- DO LOADDET(RCIEN,RCGBL,RCHDR,.RCBILL,.RCD,.RCERR)
- +18 ;Task to upd VistA for complete 835ERA only
- IF '$GET(RCERR)
- IF '$ORDER(RCERR(0))
- IF RCTYP["835ERA"
- IF '$PIECE($GET(^RCY(344.5,RCIEN,0)),U,8)
- DO TASKERA^RCDPESR2(RCIEN)
- +19 ;
- +20 QUIT $SELECT($GET(RCIEN)>0&'$GET(RCERR):RCIEN,1:"")
- +21 ;
- ADDTXN(RCDATA,RCDMSG) ; Add a trxn for msg in RCDATA to file 344.5
- +1 ; RCDATA = data on the msg hdr record
- +2 ; RCDMSG = Mailman msg number the ERA arrived in
- +3 ;Function returns ien of the new entry in file 344.5 or "" if an error
- +4 ;
- +5 NEW A,RCY,DLAYGO,DIC,DD,DO,DA,X,Y,Z
- +6 ;
- +7 ;
- +8 ;Use msg ID as basis for the .01 field
- SET (X,A)=RCDMSG
- +9 FOR Z=1:1
- if '$DATA(^RCY(344.5,"B",A))
- QUIT
- SET A=X_"."_Z
- +10 SET X=A
- +11 SET DIC(0)="L"
- SET DIC="^RCY(344.5,"
- SET DLAYGO=344.5
- +12 SET DIC("DR")=".02////"_$EXTRACT($PIECE(RCDATA,U),1,6)_";.03///^S X=""NOW"";.04////0;.06////"_$SELECT($PIECE(RCDATA,U)'["XFR":1,1:0)_$SELECT($PIECE(RCDATA,U,13)'="":";.09////"_+$PIECE(RCDATA,U,13)_";.08////1",1:"")_";.1////2;.11////"_RCDMSG
- +13 IF $PIECE(RCDATA,U,6)'=""
- SET DIC("DR")=DIC("DR")_";3.01////"_$PIECE(RCDATA,U,6)
- +14 DO FILE^DICN
- KILL DO,DD,DLAYGO,DA,DIC
- +15 SET RCY=+Y
- +16 ;
- +17 ;
- +18 QUIT $SELECT(RCY>0:+RCY,1:"")
- +19 ;
- LOADDET(RCTDA,RCGBL,RCHDR,RCBILL,RCD,RCERR) ; Load the rest of the text
- +1 ; into the msg
- +2 ; RCTDA = ien in file 344.5
- +3 ; RCGBL = name of the array holding the detail msg text to be loaded
- +4 ; RCHDR = data on ERA hdr record
- +5 ; RCBILL(AR bill number) = list of bills included, pass by REF
- +6 ; RCD = array with formatted hdr data
- +7 ;
- +8 ; OUTPUT: RCERR if any errors found, pass by REF
- +9 ;
- +10 ;
- +11 NEW RCE,RCDATA,RCMSG,RCFROM,Z,Z0
- +12 KILL ^TMP("RCTEXT",$JOB),^TMP("RCRAW",$JOB)
- +13 MERGE ^TMP("RCTEXT",$JOB)=@RCGBL@(1,"D")
- +14 MERGE ^TMP("RCRAW",$JOB)=@RCGBL@(2,"D")
- +15 ;
- +16 SET RCDATA=$GET(^RCY(344.5,RCTDA,0))
- SET RCMSG=$GET(RCD("MSG#"))
- SET RCFROM=$GET(RCD("FROM"))
- +17 ;
- +18 ; For multi-part ERA, don't update if sequence already filed
- +19 ; Add seq # if not already there
- +20 IF $PIECE(RCHDR,U)'["XFR"
- IF $PIECE(RCHDR,U,13)
- if $DATA(^RCY(344.5,RCTDA,"S","B",+$PIECE(RCHDR,U,14)))
- QUIT
- +21 ;
- +22 DO STOREM(+$GET(RCTDA),"^TMP(""RCTEXT"",$J)","^TMP(""RCRAW"",$J)",.RCE)
- +23 ;
- +24 ; Extract error
- IF $DATA(RCE("DIERR"))
- Begin DoDot:1
- +25 NEW DIE,DA,DR,X,Y
- +26 DO EXTERR^RCDPESR1(.RCERR,.RCE)
- +27 if $LENGTH($GET(RCE))
- SET RCERR(+$ORDER(RCERR(""),-1)+1)=RCE
- +28 IF $DATA(^RCY(344.5,RCTDA,0))
- SET DIE="^RCY(344.5,"
- SET DR=".1////4"
- SET DA=RCTDA
- DO ^DIE
- End DoDot:1
- +29 ; No error - store rest of data
- IF '$TEST
- Begin DoDot:1
- +30 ; Add bills included in ERA
- NEW Z,RCT,RCCT,RCX,RCB
- +31 SET RCT=0
- SET RCCT=0
- SET RCX=$JUSTIFY("",4)
- +32 SET Z=""
- FOR
- SET Z=$ORDER(RCBILL(Z))
- if Z=""
- QUIT
- Begin DoDot:2
- +33 NEW DO,DD,DIC,DLAYGO,X,Y
- +34 if RCT=4
- SET RCCT=RCCT+1
- SET RCB(RCCT)=RCX
- SET RCT=0
- SET RCX=$JUSTIFY("",4)
- SET RCX=RCX_$EXTRACT($SELECT(+RCBILL(Z):"",1:"*")_Z_$JUSTIFY("",15),1,15)
- SET RCT=RCT+1
- +35 SET DIC(0)="L"
- SET DIC("DR")=".02////"_$SELECT($GET(RCBILL(Z)):1,1:0)
- SET X=Z
- SET DA(1)=RCTDA
- SET DIC="^RCY(344.5,"_DA(1)_",""B"","
- SET DLAYGO=344.54
- DO FILE^DICN
- KILL DO,DD,DLAYGO,DIC
- +36 ;
- End DoDot:2
- +37 IF $LENGTH(RCX)>4
- SET RCCT=RCCT+1
- SET RCB(RCCT)=RCX
- +38 ; Add list of bills to display data
- +39 IF $ORDER(RCB(0))
- DO WP^DIE(344.5,RCTDA_",",1,"A","RCB")
- +40 ; Add seq #
- +41 SET DA(1)=RCTDA
- SET DIC="^RCY(344.5,"_DA(1)_",""S"","
- SET DIC(0)="L"
- SET X=$PIECE(RCHDR,U,14)
- SET DIC("DR")=".02////"_$SELECT($PIECE(RCHDR,U,15)="Y":1,1:0)_";.03///^S X=""NOW"";.04////"_RCMSG
- SET X=+$PIECE(RCHDR,U,14)
- SET DLAYGO=344.53
- +42 DO FILE^DICN
- KILL DO,DD,DLAYGO,DIC
- +43 ;
- +44 IF $PIECE(RCHDR,U)["835XFR"
- DO XFR^RCDPESR5(RCTDA,RCFROM,RCMSG,.RCD)
- QUIT
- +45 ;
- +46 ; Proceed only if not a transfer record
- +47 ; Determine if all sequences received yet
- IF $PIECE(RCDATA,U,9)'=""
- Begin DoDot:2
- +48 NEW RCOK,RCLAST
- +49 SET RCOK=1
- SET RCLAST=0
- +50 FOR Z=1:1
- if 'RCOK!RCLAST
- QUIT
- Begin DoDot:3
- +51 IF 'RCLAST
- IF '$DATA(^RCY(344.5,RCTDA,"S","B",Z))
- SET RCOK=0
- QUIT
- +52 SET Z0=+$ORDER(^RCY(344.5,RCTDA,"S","B",Z,0))
- SET Z0=$GET(^RCY(344.5,RCTDA,"S",Z0,0))
- +53 IF Z0=""
- SET RCOK=0
- QUIT
- +54 ; Last sequence received and all before it
- IF $PIECE(Z0,U,2)
- SET RCLAST=1
- End DoDot:3
- +55 ;
- +56 IF RCOK
- Begin DoDot:3
- +57 NEW DA,DIE,DR,X,Y
- +58 SET DA=RCTDA
- SET DR=".08////0;.1///@"
- SET DIE="^RCY(344.5,"
- DO ^DIE
- +59 ; No valid bills found
- IF '$ORDER(^RCY(344.5,RCTDA,"B","AV",1,0))
- Begin DoDot:4
- +60 ;-----
- +61 ; PRCA*4.5*298 - MailMan message disabled, logic retained - 14 Feb 2014
- +62 ;N RCE
- +63 ;S RCE(1)="No valid bills for this site were found in this ERA"
- +64 ;S RCE(2)="Review/correct the bill #'s on this ERA in your transmission exceptions"
- +65 ;S RCE(3)="Please contact the Implementation Manager group to report this situation",RCE(4)=" "
- +66 ;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)
- +67 ;-----
- +68 SET DA=RCTDA
- SET DR=".08////1;.1////6"
- SET DIE="^RCY(344.5,"
- DO ^DIE
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +69 ;
- +70 ;
- +71 KILL ^TMP("RCTEXT",$JOB),^TMP("RCRAW",$JOB)
- +72 QUIT
- +73 ;
- STOREM(RCTDA,RCDISP,RCTEXT,RCE) ;Store msg text in file 344.5
- +1 ;INPUT:
- +2 ; RCTDA = ien of the entry in file 344.5
- +3 ; RCDISP = name of the array where display msg text is retrieved from
- +4 ; or "@" to delete the text from the display text field
- +5 ; RCTEXT = name of the array where raw msg text is retrieved from
- +6 ; or "@" to delete the text from the raw msg field
- +7 ;OUTPUT:
- +8 ; RCE = array of errors (RCE("DIERR")) returned, pass by REF
- +9 ;
- +10 NEW RCZ,X,Y,DIE
- +11 KILL RCE("DIERR")
- +12 ;
- +13 IF $SELECT($GET(RCDISP)="@":1,1:$DATA(@RCDISP)'<10)
- Begin DoDot:1
- +14 ; On lock error, retry up to 20 times
- FOR RCZ=1:1:20
- DO WP^DIE(344.5,RCTDA_",",1,"AK",""_RCDISP_"","RCE")
- if $SELECT('$DATA(RCE("DIERR"))
- QUIT
- if RCZ<20
- KILL RCE("DIERR")
- End DoDot:1
- +15 ;
- +16 IF '$ORDER(RCE("DIERR",0))
- IF $SELECT($GET(RCTEXT)="@":1,1:$DATA(@RCTEXT)'<10)
- Begin DoDot:1
- +17 ; On lock error, retry up to 20 times
- FOR RCZ=1:1:20
- DO WP^DIE(344.5,RCTDA_",",2,"AK",""_RCTEXT_"","RCE")
- if $SELECT('$DATA(RCE("DIERR"))
- QUIT
- if RCZ<20
- KILL RCE("DIERR")
- End DoDot:1
- +18 QUIT