| 1 | RCDPESRV ;ALB/TMK - Server interface to AR from Austin ;06/03/02
|
|---|
| 2 | ;;4.5;Accounts Receivable;**173**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | SERVER ; Entry point for server option to process EDI Lockbox msgs received
|
|---|
| 6 | ; from Austin and redirected EOB transactions received from another
|
|---|
| 7 | ; VistA site
|
|---|
| 8 | ;
|
|---|
| 9 | N RCEFLG,RCERR,XMER,RCXMZ,RCTYPE
|
|---|
| 10 | K ^TMP("RCERR",$J),^TMP("RCMSG",$J),^TMP("RCMSGH",$J),^TMP($J)
|
|---|
| 11 | S RCXMZ=$G(XMZ)
|
|---|
| 12 | S RCEFLG=$$MSG(RCXMZ,.RCERR)
|
|---|
| 13 | D:$G(RCEFLG) PERROR^RCDPESR1(.RCERR,"G.RCDPE PAYMENTS EXCEPTIONS",RCXMZ)
|
|---|
| 14 | D DKILL^RCDPESR1(RCXMZ) S ZTREQ="@"
|
|---|
| 15 | K ^TMP("RCERR",$J),^TMP("RCMSG",$J),^TMP("RCMSGH",$J),^TMP($J)
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | MSG(RCXMZ,RCERR) ; Read/Store message lines
|
|---|
| 19 | ; RCERR = array of errors
|
|---|
| 20 | ; RCXMZ = the # of the Mailman message contianing this message
|
|---|
| 21 | ;
|
|---|
| 22 | ; OUTPUT:
|
|---|
| 23 | ; Function returns flag ... 0 = no errors 1 = errors
|
|---|
| 24 | ; and the standard Mailman error variable contents of XMER
|
|---|
| 25 | ;
|
|---|
| 26 | N RCTYP1,RCDATE,RCHD,RCTXN,XMDUZ,RCGBL,RCD,RCEFLG,RCCT,RCDXM,X,Y
|
|---|
| 27 | K ^TMP("RCERR",$J),^TMP("RCMSG",$J),^TMP("RCMSGH",$J)
|
|---|
| 28 | ;
|
|---|
| 29 | S (RCEFLG,RCERR,RCTXN)="",RCGBL="RCTXN"
|
|---|
| 30 | ; Set up formatted mailman header data in RCD
|
|---|
| 31 | S RCD("MSG#")=RCXMZ\1
|
|---|
| 32 | S RCHD=$$NET^XMRENT(RCXMZ)
|
|---|
| 33 | S RCD("FROM")=$P(RCHD,U,3)
|
|---|
| 34 | S RCD("SUBJ")=$P(RCHD,U,6)
|
|---|
| 35 | S (X,RCDATE)=$P(RCHD,U)
|
|---|
| 36 | I X'="" D ;Reformat date, if needed
|
|---|
| 37 | . N %DT
|
|---|
| 38 | . I X'["@" S X=$P(X," ",1,3)_"@"_$P(X," ",4)
|
|---|
| 39 | . S %DT="XTS" D ^%DT S:Y>0 RCDATE=Y\.0001*.0001
|
|---|
| 40 | ;
|
|---|
| 41 | S RCD("DATE")=RCDATE
|
|---|
| 42 | ; Read up to the header line of message
|
|---|
| 43 | S RCCT=1
|
|---|
| 44 | F X XMREC Q:$S(XMER<0:1,1:$E(XMRG,1,3)="835"&($E(XMRG,4,6)="ERA"!($E(XMRG,4,6)="EFT")!($E(XMRG,4,6)="XFR")!($E(XMRG,4,6)="XAK"))) S RCCT=RCCT+1,^TMP("RCERR",$J,"MSG",RCCT)=XMRG
|
|---|
| 45 | I XMER<0 D G MSGQ
|
|---|
| 46 | . S (RCEFLG,RCERR)=1
|
|---|
| 47 | . S ^TMP("RCERR",$J,"MSG",.5)=RCHD
|
|---|
| 48 | . S ^TMP("RCERR",$J,"DATE")=RCDATE
|
|---|
| 49 | ;
|
|---|
| 50 | K ^TMP("RCERR",$J,"MSG")
|
|---|
| 51 | S RCTXN=XMRG,RCD("PAYFROM")=$P(RCTXN,U,6)
|
|---|
| 52 | S RCTYP1=$P(RCTXN,U)
|
|---|
| 53 | ;
|
|---|
| 54 | I RCTYP1["835XAK" D G MSGQ ; Accept/reject of transferred EOB
|
|---|
| 55 | . N DA,DR,DIE,RCACC,RC0,RC00,XMZ,XMTO,XMBODY,RCXM,X,Y
|
|---|
| 56 | . S RCACC=$P(RCTXN,U,2)
|
|---|
| 57 | . S DR=$S(RCACC'="":".1////"_RCACC_";.13////"_RCACC,1:".16////1")
|
|---|
| 58 | . S DA(1)=+$P(RCTXN,U,3),DA=$P($P(RCTXN,U,3),";",2)
|
|---|
| 59 | . S RC0=$G(^RCY(344.4,DA(1),0))
|
|---|
| 60 | . S RC00=$G(^RCY(344.4,DA(1),1,DA,0))
|
|---|
| 61 | . I $P(RC00,U,10)'="" Q ; Already updated
|
|---|
| 62 | . S DIE="^RCY(344.4,"_DA(1)_",1,"
|
|---|
| 63 | . I DA(1),DA,RC00'="" D ^DIE
|
|---|
| 64 | . S RCXM(1)="An EEOB record for bill "_$P(RC00,U,5)_" was transferred to",RCXM(2)=$P($G(^DIC(4,+$P(RC00,U,11),0)),U)_" on "_$$FMTE^XLFDT($P(RC00,U,12),2)
|
|---|
| 65 | . S RCXM(3)=" ",RCXM(4)=" ERA TRACE #: "_$P(RC0,U,2)_" SEQ #:"_+RC00
|
|---|
| 66 | . S RCXM(5)=" ",RCXM(6)=" ",RCXM(7)=" This message is to inform you this transfer was **** "_$S(RCACC="":"RECEIVED",1:$P("REJECTED^ACCEPTED",U,RCACC+1))_" ****"
|
|---|
| 67 | . S RCXM(8)=" ",RCXM(9)=" "
|
|---|
| 68 | . I RCACC S RCXM(10)=" You must make the appropriate funds transfers manually"
|
|---|
| 69 | . I 'RCACC S RCXM(10)=$S(RCACC="":" Contact this site if the EEOB is not ACCEPTED or REJECTED in a timely manner",1:" Try another site or contact your IMPLEMENTATION MANAGER to reconcile this")
|
|---|
| 70 | . S XMBODY="RCXM"
|
|---|
| 71 | . S XMTO("I:G.RCDPE PAYMENTS"_$S(RCACC:" MGMNT",1:""))=""
|
|---|
| 72 | . D
|
|---|
| 73 | .. N DUZ S DUZ=.5,DUZ(0)="@"
|
|---|
| 74 | .. D SENDMSG^XMXAPI(.5,"EDI LBOX TRANSFERRED EEOB "_$S(RCACC="":"RECEIVED",RCACC:"ACCEPTED",1:"REJECTED"),XMBODY,.XMTO,,.XMZ)
|
|---|
| 75 | . ;
|
|---|
| 76 | ;
|
|---|
| 77 | I RCTYP1["835",$E(RCTYP1,1,4)'="835X",RCD("FROM")'["POSTMASTER@FOC-AUSTIN.VA.GOV" D G MSGQ
|
|---|
| 78 | . ;Send bulletin warning for non-Austin ERA/EFT message received
|
|---|
| 79 | . S RCDXM(1)="An electronic transmission ("_$E($P(RCTXN,U),4,6)_") has been received by the EDI Lockbox",RCDXM(2)=" system that did not originate from the Austin system. This message"
|
|---|
| 80 | . S RCDXM(3)=" WILL NOT be stored on your system and may be a breach of security.",RCDXM(4)=" "
|
|---|
| 81 | . S RCDXM(5)=" Please contact your IRM with the following information:",RCDXM(6)=" ",RCDXM(7)="The message was sent from "_RCD("FROM")
|
|---|
| 82 | . S RCDXM(8)="The mail message number is "_RCXMZ
|
|---|
| 83 | . S RCDXM(9)="The text received in the message is:",RCDXM(10)=" "
|
|---|
| 84 | . S RCDXM(11)=RCTXN
|
|---|
| 85 | . D RESTMSG^RCDPESR1(+$O(RCDXM(""),-1),"RCDXM",RCXMZ)
|
|---|
| 86 | . D BULLERA^RCDPESR0("","",RCXMZ,"EDI LBOX - ERA/EFT NOT FROM AUSTIN "_$G(RCD("PAYFROM")),.RCDXM,0)
|
|---|
| 87 | ;
|
|---|
| 88 | S RCGBL="^TMP(""RCMSG"","_$J_")"
|
|---|
| 89 | S @RCGBL=RCTYP1,^TMP("RCMSGH",$J,0)=RCTXN
|
|---|
| 90 | ;
|
|---|
| 91 | I RCTYP1["835ERA"!(RCTYP1["835XFR") D ERAEOBIN^RCDPESR4(RCTXN,.RCD,RCGBL,.RCEFLG)
|
|---|
| 92 | ;
|
|---|
| 93 | I RCTYP1["835EFT" D EFTIN^RCDPESR3(RCTXN,.RCD,XMZ,RCGBL,.RCEFLG)
|
|---|
| 94 | ;
|
|---|
| 95 | MSGQ Q RCEFLG
|
|---|
| 96 | ;
|
|---|
