| 1 | RCDPESR3 ;ALB/TMK - Server auto-update utilities - EDI Lockbox ;06/06/02
|
|---|
| 2 | ;;4.5;Accounts Receivable;**173,214,208**;Mar 20, 1995
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | EFTIN(RCTXN,RCD,XMZ,RCGBL,RCEFLG) ; Adds a new EFT record to AR file 344.3
|
|---|
| 6 | ; from Lockbox EFT msg
|
|---|
| 7 | ; RCTXN = the data on the header record of the message text
|
|---|
| 8 | ; RCD = array containing formatted mail message header data
|
|---|
| 9 | ; XMZ = the mail message number
|
|---|
| 10 | ; RCGBL = the name of the array or global where the message is stored
|
|---|
| 11 | ; RCEFLG = error flag returned if passed by reference
|
|---|
| 12 | ;
|
|---|
| 13 | N CT,RC,RC1,RCLAST,RCEFT,RCTDA,RCERR,RCTYP1,DA,DIK,RCZ,Z,Z0,DLAYGO
|
|---|
| 14 | ;
|
|---|
| 15 | ; Take data out of mail message
|
|---|
| 16 | S (RCEFLG,RCLAST)=0,CT=0,RCTYP1="835EFT"
|
|---|
| 17 | F X XMREC Q:XMER<0 D Q:RCLAST
|
|---|
| 18 | . I +XMRG=99,$P(XMRG,U,2)="$" S RCLAST=1 Q
|
|---|
| 19 | . S:XMRG'="" CT=CT+1,@RCGBL@(2,"D",CT)=XMRG
|
|---|
| 20 | ;
|
|---|
| 21 | I 'RCLAST,'$G(RCERR) K @RCGBL S RCERR=2 ;No $ as last character of msg
|
|---|
| 22 | ;
|
|---|
| 23 | I $G(RCERR)>0 D G EFTQ
|
|---|
| 24 | . D ERRUPD^RCDPESR1(RCGBL,.RCD,RCTYP1,.RCERR)
|
|---|
| 25 | . S RCEFLG=1
|
|---|
| 26 | ;
|
|---|
| 27 | ; Add top-level entry to file 344.3
|
|---|
| 28 | S RCEFT=$$ADDEFT(RCTXN,XMZ,RCGBL,.RCERR)
|
|---|
| 29 | ;
|
|---|
| 30 | I $G(RCERR) D G EFTQ ; 'BAD' EFT's
|
|---|
| 31 | . D ERRUPD^RCDPESR1(RCGBL,.RCD,RCTYP1,.RCERR)
|
|---|
| 32 | . S RCEFLG=1
|
|---|
| 33 | ;
|
|---|
| 34 | G:'RCEFT EFTQ
|
|---|
| 35 | ;
|
|---|
| 36 | ; Add the detail data to file 344.31 for this EFT record
|
|---|
| 37 | S Z=0 F S Z=$O(^RCY(344.31,"B",RCEFT,Z)) Q:'Z S DA=Z,DIK="^RCY(344.31," D ^DIK ; Delete any detail data already there
|
|---|
| 38 | ;
|
|---|
| 39 | S (RC,RC1,RCZ)=0
|
|---|
| 40 | F S RCZ=$O(@RCGBL@(2,"D",RCZ)) Q:'RCZ S Z0=$G(^(RCZ)) I Z0'="" D Q:$G(RCERR)
|
|---|
| 41 | . I $P(Z0,U)="01" D ; Each payer's data
|
|---|
| 42 | .. N DA,DIE,DR,X,Y,DO,DD,DIC
|
|---|
| 43 | .. S X=RCEFT
|
|---|
| 44 | .. S DIC("DR")=".11////0;.04////"_$P(Z0,U,2)_";.08////0"_$S($P(Z0,U,5)'="":";.02////"_$P(Z0,U,5),1:"")_$S($P(Z0,U,6)'="":";.03////"_$P(Z0,U,6),1:"")_";.07////"_$J(+$P(Z0,U,4)/100,"",2)_";.06////"_$S($P(Z0,U,8)'="":1,1:0)
|
|---|
| 45 | .. S DIC("DR")=DIC("DR")_";.12///"_$$FDT^RCDPESR9($P(Z0,U,3))_";.13////"_DT_$S($P(Z0,U,7)'="":";.05////"_$P(Z0,U,7),1:"")_$S($P(Z0,U,9)'="":";.15////"_$P(Z0,U,9),1:"")
|
|---|
| 46 | .. ;
|
|---|
| 47 | .. I $P(Z0,U,8)'="" D ; tax id error
|
|---|
| 48 | ... D TAXERR^RCDPESR1("EFT",$P(Z0,U,5)_" Payer ID: "_$P(RCTXN,U,6),$P(RCTXN,U,7),$P(RCTXN,U,8)) ; Send bad tax id bulletin
|
|---|
| 49 | .. ;
|
|---|
| 50 | .. S DIC(0)="L",DIC="^RCY(344.31,",DLAYGO=344.31 D FILE^DICN K DIC,DLAYGO,DO,DD
|
|---|
| 51 | .. I Y'>0 D ; Error filing data
|
|---|
| 52 | ... S DIK="^RCY(344.3,",DA=RCEFT D ^DIK
|
|---|
| 53 | ... S Z=0 F S Z=$O(^RCY(344.31,"B",RCEFT,Z)) Q:'Z S DIK="^RCY(344.31,",DA=Z D ^DIK
|
|---|
| 54 | ... S RCEFLG=1,RCERR=3
|
|---|
| 55 | ... D ERRUPD^RCDPESR1(RCGBL,.RCD,RCTYP1,RCERR)
|
|---|
| 56 | ;
|
|---|
| 57 | I '$G(RCEFLG) D
|
|---|
| 58 | . S DIE="^RCY(344.3,",DA=RCEFT,DR=".09////"_$$CHKSUM(RCEFT) D ^DIE
|
|---|
| 59 | ;
|
|---|
| 60 | EFTQ ;
|
|---|
| 61 | D CLEAN^DILF
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
| 64 | ADDEFT(RCTXN,RCXMZ,RCGBL,RCERR) ; File EFT TOTAL record in file 344.3
|
|---|
| 65 | ; RCTXN = the data on the header record of the message text
|
|---|
| 66 | ; RCXMZ = the mail message number
|
|---|
| 67 | ; RCGBL = the name of the array or global where the message is stored
|
|---|
| 68 | ; Function returns the ien of the total record found/added
|
|---|
| 69 | ; and also returns RCERR if passed by reference
|
|---|
| 70 | ;
|
|---|
| 71 | N RCTDA,RCRCPT,RCDUP,RCHAC,Z,Z0
|
|---|
| 72 | S (RCERR,RCTDA)=""
|
|---|
| 73 | ;
|
|---|
| 74 | I $E($P(RCTXN,U,6),1,3)'="469",$E($P(RCTXN,U,6),1,3)'="HAC" D G ADDQ ; Invalid EFT deposit number
|
|---|
| 75 | . N RCDXM,RCCT
|
|---|
| 76 | . S RCCT=0
|
|---|
| 77 | . S RCCT=RCCT+1,RCDXM(RCCT)="This EFT has an invalid deposit number for EDI Lockbox and has been rejected.",RCCT=RCCT+1,RCDXM(RCCT)=" "
|
|---|
| 78 | . S RCCT=RCCT+1,RCDXM(RCCT)=" ",RCCT=RCCT+1,RCDXM(RCCT)="Here are the contents of this message:"
|
|---|
| 79 | . D DISP("EDI LBOX INVALID EFT DEPOSIT #",RCCT,.RCDXM,RCXMZ)
|
|---|
| 80 | ;
|
|---|
| 81 | ; Make sure it's not already there or if so, it has no ptr to a deposit
|
|---|
| 82 | ; or if a deposit exists, that the deposit does not yet have a receipt
|
|---|
| 83 | S RCDUP=0,RCHAC=$E($P(RCTXN,U,6),1,3)="HAC" ; This is a HAC deposit
|
|---|
| 84 | I $P(RCTXN,U,6)'="" D
|
|---|
| 85 | . S Z=0 ; Lookup deposit by deposit #
|
|---|
| 86 | . F S Z=$O(^RCY(344.3,"C",$P(RCTXN,U,6),Z)) Q:'Z S Z0=$G(^RCY(344.3,Z,0)) S:'$P(Z0,U,3) RCTDA=Z Q:RCTDA D Q
|
|---|
| 87 | .. ; Deposit found - find receipt
|
|---|
| 88 | .. I $O(^RCY(344,"AD",$P(Z0,U,3),0)) S RCDUP=Z Q
|
|---|
| 89 | .. S RCTDA=Z
|
|---|
| 90 | ;
|
|---|
| 91 | I RCDUP D ; Send bulletin that duplicate EFT received
|
|---|
| 92 | . N RCDXM,RCCT
|
|---|
| 93 | . S RCCT=0
|
|---|
| 94 | . S RCCT=RCCT+1,RCDXM(RCCT)="This EFT appears to be a duplicate transaction and has been rejected.",RCCT=RCCT+1,RCDXM(RCCT)=" "
|
|---|
| 95 | . S RCCT=RCCT+1,RCDXM(RCCT)=" ",RCCT=RCCT+1,RCDXM(RCCT)="Here are the contents of this message:"
|
|---|
| 96 | . D DISP("EDI LBOX DUP EFT DEPOSIT RECEIVED",RCCT,.RCDXM,RCXMZ)
|
|---|
| 97 | ;
|
|---|
| 98 | I 'RCDUP D ; Add or update the record
|
|---|
| 99 | . N RCX,RCDTTM,DIE,DIC,DLAYGO,DD,DA,DO,DR,X,Y,%DT,DINUM
|
|---|
| 100 | . ;
|
|---|
| 101 | . S X=$$FDT^RCDPESR9($P(RCTXN,U,3))_"@"_$P(RCTXN,U,4)
|
|---|
| 102 | . S %DT="XTS" D ^%DT S:Y>0 RCDTTM=Y
|
|---|
| 103 | . ;
|
|---|
| 104 | . S DIC("DR")=""
|
|---|
| 105 | . S DIC("DR")=$S(RCDTTM'="":".02////"_RCDTTM,1:"")
|
|---|
| 106 | . S DIC("DR")=DIC("DR")_$S(DIC("DR")'="":";",1:"")_".06////"_$P(RCTXN,U,6)_";.07///"_$$FDT^RCDPESR9($P(RCTXN,U,7))
|
|---|
| 107 | . S DIC("DR")=DIC("DR")_";.08////"_$$ZERO^RCDPESR9($P(RCTXN,U,8),1)_";.13////"_$$NOW^XLFDT()_";.05////"_RCXMZ_";.14////0;.12////0"
|
|---|
| 108 | . ;
|
|---|
| 109 | . I RCTDA D ; Overwrite the data already there
|
|---|
| 110 | .. L +^RCY(344.3,RCTDA):1 I '$T S RCTDA=-1 Q
|
|---|
| 111 | .. S DIE="^RCY(344.3,",DA=RCTDA,DR=DIC("DR") K DIC D ^DIE
|
|---|
| 112 | .. L -^RCY(344.3,RCTDA)
|
|---|
| 113 | . ;
|
|---|
| 114 | . I 'RCTDA D
|
|---|
| 115 | .. S RCX=+$O(^RCY(344.3," "),-1)
|
|---|
| 116 | .. F RCX=RCX+1:1 I '$D(^RCY(344.3,RCX,0)) L +^RCY(344.3,RCX,0):1 I $T S X=RCX Q
|
|---|
| 117 | .. S DIC(0)="L",DIC="^RCY(344.3,",DLAYGO=344.3,DINUM=RCX
|
|---|
| 118 | .. D FILE^DICN K DO,DD,DLAYGO,DIC,DINUM
|
|---|
| 119 | .. L -^RCY(344.3,RCX,0)
|
|---|
| 120 | .. S RCTDA=$S(Y<0:"",1:+Y)
|
|---|
| 121 | . ;
|
|---|
| 122 | . I 'RCTDA S RCERR=3 ; Error in add of EFT record to file 344.3
|
|---|
| 123 | ;
|
|---|
| 124 | ADDQ Q $S(RCTDA>0:RCTDA,1:"")
|
|---|
| 125 | ;
|
|---|
| 126 | CHKSUM(RCTDA) ; Calc the checksum for EFT record stored in RCTDA in 344.3
|
|---|
| 127 | ;
|
|---|
| 128 | N RCDPCSUM,RCDPDATA,X,Y,Z,Z0
|
|---|
| 129 | ;
|
|---|
| 130 | S (RCDPCSUM,X)=0,Z0=$G(^RCY(344.3,RCTDA,0))
|
|---|
| 131 | ; Use pcs 1-8, leaving out piece 3
|
|---|
| 132 | S RCDPDATA=$P(Z0,U,1,8),$P(RCDPDATA,U,3)=""
|
|---|
| 133 | S X=RCDPCSUM_RCDPDATA X $S($G(^%ZOSF("LPC"))'="":^("LPC"),1:"S Y=""""") S RCDPCSUM=Y
|
|---|
| 134 | ; Use detail iens and pieces 3,4,7 to complete the checksum
|
|---|
| 135 | S Z=0 F S Z=$O(^RCY(344.31,"B",RCTDA,Z)) Q:'Z S Z0=$G(^RCY(344.31,Z,0)),RCDPDATA=Z_U_$P(Z0,U,3,4)_U_$P(Z0,U,7),X=RCDPCSUM_RCDPDATA X $S($G(^%ZOSF("LPC"))'="":^("LPC"),1:"S Y=""""") S RCDPCSUM=Y
|
|---|
| 136 | Q RCDPCSUM
|
|---|
| 137 | ;
|
|---|
| 138 | DISP(RCTIT,RCCT,RCDXM,RCXMZ) ; Sends bulletin with formatted data from message
|
|---|
| 139 | ; RCTIT = title of bulletin
|
|---|
| 140 | ; RCCT = # of lines previously populated
|
|---|
| 141 | ; RCXDM = array containing the text of the bulletin
|
|---|
| 142 | N RC,Z
|
|---|
| 143 | K ^TMP("RC1",$J),^TMP("RC",$J),^TMP("RCTEMP",$J)
|
|---|
| 144 | S RC=1,^TMP("RCTEMP",$J,RC)=$G(^TMP("RCMSGH",$J,0))
|
|---|
| 145 | S Z=0 F S Z=$O(^TMP("RCMSG",$J,2,"D",Z)) Q:'Z S RC=RC+1,^TMP("RCTEMP",$J,RC)=$G(^TMP("RCMSG",$J,2,"D",Z))
|
|---|
| 146 | D DISP^RCDPESR8("^TMP(""RCTEMP"",$J)","^TMP(""RC1"",$J)",1,"^TMP(""RC"",$J)",75)
|
|---|
| 147 | S Z=0 F S Z=$O(^TMP("RC",$J,Z)) Q:'Z S RCCT=RCCT+1,RCDXM(RCCT)=$G(^TMP("RC",$J,Z))
|
|---|
| 148 | D BULLEFT^RCDPESR0("",RCXMZ,RCTIT,.RCDXM)
|
|---|
| 149 | K ^TMP("RC1",$J),^TMP("RC",$J),^TMP("RCTEMP",$J)
|
|---|
| 150 | Q
|
|---|
| 151 | ;
|
|---|
| 152 | DUP(RCM,RCIFN,RCAMT,RCAMT1) ; EOB in mail message already stored in 361.1?
|
|---|
| 153 | ; RCM = msg # EOB was received in
|
|---|
| 154 | ; RCIFN = bill ien
|
|---|
| 155 | ; RCAMT = amt pd
|
|---|
| 156 | ; RCAMT1 = amt reported billed
|
|---|
| 157 | ; Returns 0 if none found, entry #^message checksum on file if found
|
|---|
| 158 | N Z,DUP,DUP1
|
|---|
| 159 | S (DUP,DUP1,Z)=0
|
|---|
| 160 | F S Z=$O(^IBM(361.1,"AC",RCM,Z)) Q:'Z I +$G(^IBM(361.1,Z,0))=RCIFN D Q:DUP
|
|---|
| 161 | . I '$P($G(^IBM(361.1,Z,100)),U,5) S DUP1=Z Q ; Partially filed before
|
|---|
| 162 | . I +$G(^IBM(361.1,Z,1))=+RCAMT,+$P($G(^IBM(361.1,1,Z,2)),U,4)=+RCAMT1 S DUP=Z_U_+$P($G(^IBM(361.1,Z,100)),U,5) Q
|
|---|
| 163 | I 'DUP,DUP1 S DUP=DUP1_"^0"
|
|---|
| 164 | Q DUP
|
|---|
| 165 | ;
|
|---|
| 166 | DUPERA(DUP,RCNOUPD) ; Msg for duplicate ERA
|
|---|
| 167 | ; RCNOUPD = # of message with duplicate data
|
|---|
| 168 | ; DUP = flag = -1 if duplicate message received in same mail msg #
|
|---|
| 169 | K ^TMP("RCERR1",$J)
|
|---|
| 170 | S ^TMP("RCERR1",$J,1)=$S(DUP>0:"This an exact duplicate of an ERA received previously in mail msg "_RCNOUPD,1:"This ERA message was already fully processed - message was ignored")
|
|---|
| 171 | Q
|
|---|
| 172 | ;
|
|---|
| 173 | BULLS(RCFILE,RCTDA,DUP,RCXMSG) ; Error bulletins for ERA
|
|---|
| 174 | I RCFILE=5 D BULL1^RCDPESR5(RCTDA,"^TMP(""RCERR1"",$J)",$S($G(DUP)>0:$G(DUP),1:""))
|
|---|
| 175 | I RCFILE=4 D BULL2^RCDPESR5(RCTDA,"^TMP(""RCERR1"",$J)",RCXMSG)
|
|---|
| 176 | Q
|
|---|
| 177 | ;
|
|---|
| 178 | ADJERR(RCERR) ; Set up adj error text in RCERR(n) - pass by ref
|
|---|
| 179 | ; Function returns # of lines for error text
|
|---|
| 180 | S RCERR(1)="At least 1 adjustment transaction has been found on this ERA. Before the",RCERR(2)=" receipt for this ERA can be processed, the appropriate adjustments",RCERR(3)=" must be made using the EEOB Worklist",RCERR(4)=" "
|
|---|
| 181 | Q 4
|
|---|
| 182 | ;
|
|---|
