RCDPESR5 ;ALB/TMK,DWA - Server interface 835XFR processing ;10/01/02
;;4.5;Accounts Receivable;**173,208,269**;Mar 20, 1995;Build 113
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
XFR(RCTDA,RCFROM,RCMSG,RCD) ; Send bulletin, update 344.5 for transfer EOB into site
; RCTDA = ien in file 344.5 being updated
; RCFROM = the sender's mail address from the mail message
; RCMSG = message # the data was received in
; RCD = array containing formatted header data
;
N RCCT,RCDXM,DA,DR,DIE,X,Y,Z,RCFROMNM
S Z=$P($P(RCD("SUBJ"),"REF #",2),"#"),RCFROMNM=$TR($P(RCFROM,"@",2),">")
I RCFROMNM="" S RCFROMNM=RCFROM
S DA=RCTDA,DR=".05///@;.08////1;.1///3"_$S($P(RCFROM,"@",2)'="":";.12////"_RCFROMNM,1:"")_";.13////^S X=("_+Z_"_$C(59)_"_$P(Z,";",2)_")"_$S($G(RCD("PAYFROM"))'="":";3.01////"_RCD("PAYFROM"),1:"")
S DIE="^RCY(344.5," D ^DIE
;
D SENDACK(RCTDA,"") ; acknowledge receipt of transferred EOB
;
S RCDXM(1)="An EEOB transmission has been received by the EDI Lockbox",RCDXM(2)=" system that was sent to you from another VistA site. Please review"
S RCDXM(3)=" it in EEOB exception processing and file the EEOB if it belongs to your",RCDXM(4)=" site or delete the message to return the EEOB to the site it was sent from."
S RCDXM(5)=" ",RCDXM(6)="The message was sent by "_RCFROM
S RCDXM(7)="The mail message number is "_RCMSG
S RCDXM(8)=" ",RCDXM(9)="EEOB DATA INCLUDED:"
S RCCT=9
K ^TMP($J)
D DISP^RCDPESR0("^RCY(344.5,"_RCTDA_",2)","^TMP($J,""PRCA_EXT"")",1,"^TMP($J,""PRCA_LINES"")",70)
S Z=0 F S Z=$O(^TMP($J,"PRCA_LINES",Z)) Q:'Z S RCCT=RCCT+1,RCDXM(RCCT)=$J("",3)_$G(^TMP($J,"PRCA_LINES",Z))
D BULLERA^RCDPESR0("",RCTDA,RCMSG,"EDI LBOX EEOB FROM "_$E(RCFROMNM,1,18)_" FOR "_$E($G(RCD("PAYFROM")),1,20),.RCDXM,1)
K ^TMP($J)
Q
;
SENDACK(RCTDA,RCSTAT) ; Send accept/reject msg to transf 'from' site
; RCTDA = ien of entry file 344.5
; RCSTAT = flag to indicate what happened
; values: "" = receipt 1 = accepted 0 = rejected
;
N RC,RC0,RCDOM,RCREF,XMTO,XMBODY,XMZ
; Send a mail message to sending site for accept/reject of EOB
S RC0=$G(^RCY(344.5,RCTDA,0)),RCREF=$P(RC0,U,13)
S RCDOM="@"_$S($P(RC0,U,12)'="":$P(RC0,U,12),1:$$KSP^XUPARAM("WHERE")) S:RCDOM="@" RCDOM=""
I RCREF,$P(RCREF,";",2) D
. ; 835ACK^accept/reject flag (""/0/1)^ien file 344_;_ien file 344.41
. S RC(1)="835XAK^"_RCSTAT_U_+$P(RCREF,";")_";"_+$P(RCREF,";",2)
. S XMBODY="RC",XMTO("S.RCDPE EDI LOCKBOX SERVER"_RCDOM)=""
. D
.. N DUZ S DUZ=.5,DUZ(0)="@"
.. D SENDMSG^XMXAPI(.5,"TRANSFER EEOB ACKNOWLEDGEMENT",XMBODY,.XMTO,,.XMZ)
Q
;
FILEEOB(RCTDA) ; Files trans-in EOB in IB
N DIE,DA,DR,X,Y,RCE
D UPDEOB^RCDPESR2(RCTDA,5)
I $D(^RCY(344.5,RCTDA,0)) D
. S DIE="^RCY(344.5,",DR=".04////0;.05///@;.1////5",DA=RCTDA D ^DIE
Q
;
BULL1(RCTDA,RCERR,DUP) ; Send bulletin for EDI Lockbox EOB exceptions
; RCTDA = ien of entry in file 344.5
; RCERR = the name of the error global
; DUP = ien of existing entry in file 344.4 if ERA is duplicate
;
N RCSUBJ
S RCSUBJ="EDI LBOX "_$S(DUP:"ERA - DUPLICATE TRANSMISSION MSG #"_DUP,1:" EEOB - EXCEPTIONS")_" "_$E($P($G(^RCY(344.5,RCTDA,3)),U),1,20)
S RCSUBJ=$E(RCSUBJ,1,65)
S DUP=+$G(DUP)
D BULLERA^RCDPESR0("D",RCTDA,$P($G(^RCY(344.5,RCTDA,0)),U,11),RCSUBJ,RCERR,0)
Q
;
BULL2(RCTDA,RCERR,RCXMG) ; Send bulletin for EOB transfer received at site
; RCTDA = ien of entry in file 344.5
; RCXMG = incoming message #
; RCERR = the name of the error global
;
N RCDIQ,RCXM,RCXM1,XMBODY,XMZ,XMTO,RC,Z,Q,RCSUBJ
S RCSUBJ="EDI LBOX EEOB DETAIL RE-FILE ATTEMPTED TO IB"
S XMTO("I:G.RCDPE PAYMENTS")="",RC=0
K ^TMP("RCERR_BULL2",$J)
S RC=RC+1,^TMP("RCERR_BULL2",$J,RC)="The following EEOB was received at your site.",RC=RC+1,^TMP("RCERR_BULL2",$J,RC)="It was received on: "_$$FMTE^XLFDT($$NOW^XLFDT(),2)_" in mail msg # "_RCXMG_"."
S RC=RC+1,^TMP("RCERR_BULL2",$J,RC)="The initial attempt to file this data in IB failed and this message",RC=RC+1,^TMP("RCERR_BULL2",$J,RC)="is the result of a subsequent attempt to file this EEOB detail data in IB"
S RC=RC+1,^TMP("RCERR_BULL2",$J,RC)=" "
D GETS^DIQ(344.4,+RCTDA_",","*","IEN","RCDIQ")
D TXT0^RCDPEX31(+RCTDA,.RCDIQ,.RCXM,0)
S Z=0 F S Z=$O(RCXM(Z)) Q:'Z S RC=RC+1,^TMP("RCERR_BULL2",$J,RC)=RCXM(Z)
I $G(RCERR)'="",$E(RCERR,1,5)'="^TMP(" S RC=RC+1,^TMP("RCERR_BULL2",$J,RC)=RCERR,RC=RC+1,^TMP("RCERR_BULL2",$J,RC)=" "
S RCERR=$S($E(RCERR,1,5)="^TMP(":RCERR,1:"RCERR")
I $O(@RCERR@(""))'="" D
. S Z="" F S Z=$O(@RCERR@(Z)) Q:Z="" D
.. I $G(@RCERR@(Z))'="" S RC=RC+1,^TMP("RCERR_BULL2",$J,RC)=@RCERR@(Z)
.. I $O(@RCERR@(Z,0)) S Q="" F S Q=$O(@RCERR@(Z,Q)) Q:Q="" S RC=RC+1,^TMP("RCERR_BULL2",$J,RC)=@RCERR@(Z,Q)
S XMBODY="^TMP(""RCERR_BULL2"","_$J_")"
D
. N DUZ S DUZ=.5,DUZ(0)="@"
. D SENDMSG^XMXAPI(.5,$E(RCSUBJ,1,65),XMBODY,.XMTO,,.XMZ)
K ^TMP("RCERR_BULL2",$J)
Q
;
DISP1(RCCT,RCNOH) ; Extract formatted EOB detail for bill
; RCCT = bill seq# within ERA transmission
; RCNOH = 1 if no header text needed on 05 rec
;
; Error array returned in ^TMP("RCERR1",$J)
;
N RC1,RC2,RCCT1,Z,RCV5
I +$P($G(^RCY(344.5,RCTDA,2,1,0)),U,16)>0 S RCV5=1
D DISP^RCDPESR0("^TMP($J,""RCDP-EOB"","_RCCT_")","RC1",1)
D FMTDSP^RCDPESR0("RC1","RC2",75,RCNOH)
S Z=0,RCCT1=$O(^TMP("RCERR1",$J,RCCT," "),-1)
F S Z=$O(RC2(Z)) Q:'Z S RCCT1=RCCT1+1,^TMP("RCERR1",$J,RCCT,RCCT1)=RC2(Z)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPESR5 5446 printed Oct 16, 2024@17:46:17 Page 2
RCDPESR5 ;ALB/TMK,DWA - Server interface 835XFR processing ;10/01/02
+1 ;;4.5;Accounts Receivable;**173,208,269**;Mar 20, 1995;Build 113
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
XFR(RCTDA,RCFROM,RCMSG,RCD) ; Send bulletin, update 344.5 for transfer EOB into site
+1 ; RCTDA = ien in file 344.5 being updated
+2 ; RCFROM = the sender's mail address from the mail message
+3 ; RCMSG = message # the data was received in
+4 ; RCD = array containing formatted header data
+5 ;
+6 NEW RCCT,RCDXM,DA,DR,DIE,X,Y,Z,RCFROMNM
+7 SET Z=$PIECE($PIECE(RCD("SUBJ"),"REF #",2),"#")
SET RCFROMNM=$TRANSLATE($PIECE(RCFROM,"@",2),">")
+8 IF RCFROMNM=""
SET RCFROMNM=RCFROM
+9 SET DA=RCTDA
SET DR=".05///@;.08////1;.1///3"_$SELECT($PIECE(RCFROM,"@",2)'="":";.12////"_RCFROMNM,1:"")_";.13////^S X=("_+Z_"_$C(59)_"_$PIECE(Z,";",2)_")"_$SELECT($GET(RCD("PAYFROM"))'="":";3.01////"_RCD("PAYFROM"),1:"")
+10 SET DIE="^RCY(344.5,"
DO ^DIE
+11 ;
+12 ; acknowledge receipt of transferred EOB
DO SENDACK(RCTDA,"")
+13 ;
+14 SET RCDXM(1)="An EEOB transmission has been received by the EDI Lockbox"
SET RCDXM(2)=" system that was sent to you from another VistA site. Please review"
+15 SET RCDXM(3)=" it in EEOB exception processing and file the EEOB if it belongs to your"
SET RCDXM(4)=" site or delete the message to return the EEOB to the site it was sent from."
+16 SET RCDXM(5)=" "
SET RCDXM(6)="The message was sent by "_RCFROM
+17 SET RCDXM(7)="The mail message number is "_RCMSG
+18 SET RCDXM(8)=" "
SET RCDXM(9)="EEOB DATA INCLUDED:"
+19 SET RCCT=9
+20 KILL ^TMP($JOB)
+21 DO DISP^RCDPESR0("^RCY(344.5,"_RCTDA_",2)","^TMP($J,""PRCA_EXT"")",1,"^TMP($J,""PRCA_LINES"")",70)
+22 SET Z=0
FOR
SET Z=$ORDER(^TMP($JOB,"PRCA_LINES",Z))
if 'Z
QUIT
SET RCCT=RCCT+1
SET RCDXM(RCCT)=$JUSTIFY("",3)_$GET(^TMP($JOB,"PRCA_LINES",Z))
+23 DO BULLERA^RCDPESR0("",RCTDA,RCMSG,"EDI LBOX EEOB FROM "_$EXTRACT(RCFROMNM,1,18)_" FOR "_$EXTRACT($GET(RCD("PAYFROM")),1,20),.RCDXM,1)
+24 KILL ^TMP($JOB)
+25 QUIT
+26 ;
SENDACK(RCTDA,RCSTAT) ; Send accept/reject msg to transf 'from' site
+1 ; RCTDA = ien of entry file 344.5
+2 ; RCSTAT = flag to indicate what happened
+3 ; values: "" = receipt 1 = accepted 0 = rejected
+4 ;
+5 NEW RC,RC0,RCDOM,RCREF,XMTO,XMBODY,XMZ
+6 ; Send a mail message to sending site for accept/reject of EOB
+7 SET RC0=$GET(^RCY(344.5,RCTDA,0))
SET RCREF=$PIECE(RC0,U,13)
+8 SET RCDOM="@"_$SELECT($PIECE(RC0,U,12)'="":$PIECE(RC0,U,12),1:$$KSP^XUPARAM("WHERE"))
if RCDOM="@"
SET RCDOM=""
+9 IF RCREF
IF $PIECE(RCREF,";",2)
Begin DoDot:1
+10 ; 835ACK^accept/reject flag (""/0/1)^ien file 344_;_ien file 344.41
+11 SET RC(1)="835XAK^"_RCSTAT_U_+$PIECE(RCREF,";")_";"_+$PIECE(RCREF,";",2)
+12 SET XMBODY="RC"
SET XMTO("S.RCDPE EDI LOCKBOX SERVER"_RCDOM)=""
+13 Begin DoDot:2
+14 NEW DUZ
SET DUZ=.5
SET DUZ(0)="@"
+15 DO SENDMSG^XMXAPI(.5,"TRANSFER EEOB ACKNOWLEDGEMENT",XMBODY,.XMTO,,.XMZ)
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
FILEEOB(RCTDA) ; Files trans-in EOB in IB
+1 NEW DIE,DA,DR,X,Y,RCE
+2 DO UPDEOB^RCDPESR2(RCTDA,5)
+3 IF $DATA(^RCY(344.5,RCTDA,0))
Begin DoDot:1
+4 SET DIE="^RCY(344.5,"
SET DR=".04////0;.05///@;.1////5"
SET DA=RCTDA
DO ^DIE
End DoDot:1
+5 QUIT
+6 ;
BULL1(RCTDA,RCERR,DUP) ; Send bulletin for EDI Lockbox EOB exceptions
+1 ; RCTDA = ien of entry in file 344.5
+2 ; RCERR = the name of the error global
+3 ; DUP = ien of existing entry in file 344.4 if ERA is duplicate
+4 ;
+5 NEW RCSUBJ
+6 SET RCSUBJ="EDI LBOX "_$SELECT(DUP:"ERA - DUPLICATE TRANSMISSION MSG #"_DUP,1:" EEOB - EXCEPTIONS")_" "_$EXTRACT($PIECE($GET(^RCY(344.5,RCTDA,3)),U),1,20)
+7 SET RCSUBJ=$EXTRACT(RCSUBJ,1,65)
+8 SET DUP=+$GET(DUP)
+9 DO BULLERA^RCDPESR0("D",RCTDA,$PIECE($GET(^RCY(344.5,RCTDA,0)),U,11),RCSUBJ,RCERR,0)
+10 QUIT
+11 ;
BULL2(RCTDA,RCERR,RCXMG) ; Send bulletin for EOB transfer received at site
+1 ; RCTDA = ien of entry in file 344.5
+2 ; RCXMG = incoming message #
+3 ; RCERR = the name of the error global
+4 ;
+5 NEW RCDIQ,RCXM,RCXM1,XMBODY,XMZ,XMTO,RC,Z,Q,RCSUBJ
+6 SET RCSUBJ="EDI LBOX EEOB DETAIL RE-FILE ATTEMPTED TO IB"
+7 SET XMTO("I:G.RCDPE PAYMENTS")=""
SET RC=0
+8 KILL ^TMP("RCERR_BULL2",$JOB)
+9 SET RC=RC+1
SET ^TMP("RCERR_BULL2",$JOB,RC)="The following EEOB was received at your site."
SET RC=RC+1
SET ^TMP("RCERR_BULL2",$JOB,RC)="It was received on: "_$$FMTE^XLFDT($$NOW^XLFDT(),2)_" in mail msg # "_RCXMG_"."
+10 SET RC=RC+1
SET ^TMP("RCERR_BULL2",$JOB,RC)="The initial attempt to file this data in IB failed and this message"
SET RC=RC+1
SET ^TMP("RCERR_BULL2",$JOB,RC)="is the result of a subsequent attempt to file this EEOB detail data in IB"
+11 SET RC=RC+1
SET ^TMP("RCERR_BULL2",$JOB,RC)=" "
+12 DO GETS^DIQ(344.4,+RCTDA_",","*","IEN","RCDIQ")
+13 DO TXT0^RCDPEX31(+RCTDA,.RCDIQ,.RCXM,0)
+14 SET Z=0
FOR
SET Z=$ORDER(RCXM(Z))
if 'Z
QUIT
SET RC=RC+1
SET ^TMP("RCERR_BULL2",$JOB,RC)=RCXM(Z)
+15 IF $GET(RCERR)'=""
IF $EXTRACT(RCERR,1,5)'="^TMP("
SET RC=RC+1
SET ^TMP("RCERR_BULL2",$JOB,RC)=RCERR
SET RC=RC+1
SET ^TMP("RCERR_BULL2",$JOB,RC)=" "
+16 SET RCERR=$SELECT($EXTRACT(RCERR,1,5)="^TMP(":RCERR,1:"RCERR")
+17 IF $ORDER(@RCERR@(""))'=""
Begin DoDot:1
+18 SET Z=""
FOR
SET Z=$ORDER(@RCERR@(Z))
if Z=""
QUIT
Begin DoDot:2
+19 IF $GET(@RCERR@(Z))'=""
SET RC=RC+1
SET ^TMP("RCERR_BULL2",$JOB,RC)=@RCERR@(Z)
+20 IF $ORDER(@RCERR@(Z,0))
SET Q=""
FOR
SET Q=$ORDER(@RCERR@(Z,Q))
if Q=""
QUIT
SET RC=RC+1
SET ^TMP("RCERR_BULL2",$JOB,RC)=@RCERR@(Z,Q)
End DoDot:2
End DoDot:1
+21 SET XMBODY="^TMP(""RCERR_BULL2"","_$JOB_")"
+22 Begin DoDot:1
+23 NEW DUZ
SET DUZ=.5
SET DUZ(0)="@"
+24 DO SENDMSG^XMXAPI(.5,$EXTRACT(RCSUBJ,1,65),XMBODY,.XMTO,,.XMZ)
End DoDot:1
+25 KILL ^TMP("RCERR_BULL2",$JOB)
+26 QUIT
+27 ;
DISP1(RCCT,RCNOH) ; Extract formatted EOB detail for bill
+1 ; RCCT = bill seq# within ERA transmission
+2 ; RCNOH = 1 if no header text needed on 05 rec
+3 ;
+4 ; Error array returned in ^TMP("RCERR1",$J)
+5 ;
+6 NEW RC1,RC2,RCCT1,Z,RCV5
+7 IF +$PIECE($GET(^RCY(344.5,RCTDA,2,1,0)),U,16)>0
SET RCV5=1
+8 DO DISP^RCDPESR0("^TMP($J,""RCDP-EOB"","_RCCT_")","RC1",1)
+9 DO FMTDSP^RCDPESR0("RC1","RC2",75,RCNOH)
+10 SET Z=0
SET RCCT1=$ORDER(^TMP("RCERR1",$JOB,RCCT," "),-1)
+11 FOR
SET Z=$ORDER(RC2(Z))
if 'Z
QUIT
SET RCCT1=RCCT1+1
SET ^TMP("RCERR1",$JOB,RCCT,RCCT1)=RC2(Z)
+12 QUIT
+13 ;
