- RCDPESR3 ;ALB/TMK/PJH - Server auto-update utilities - EDI Lockbox ;Jun 06, 2014@19:11:19
- ;;4.5;Accounts Receivable;**173,214,208,255,269,283,298,321,345,349,380**;Mar 20, 1995;Build 14
- ;Per VA Directive 6402, this routine should not be modified.
- Q
- ;
- EFTIN(RCTXN,RCD,XMZ,RCGBL,RCEFLG) ; Adds a new EFT record to AR file 344.3
- ; from Lockbox EFT msg
- ; Input: RCTXN - Data on the header record of the message text
- ; RCD - Array containing formatted mail message header data
- ; XMZ - Mail message number
- ; RCGBL - Name of the array or global where the message is stored
- ; Output: RCEFLG - Error flag returned if passed by reference
- ;
- N CT,DA,DIK,DLAYGO,RC,RC1,RCLAST,RCDEPAMT,RCEFT,RCMEFTS,RCTDA,RCERR,RCTYP1,RCZ,XX,Z,Z0
- ;
- ; Take data out of mail message
- S (RCEFLG,RCLAST)=0,CT=0,RCTYP1="835EFT"
- F X XMREC Q:XMER<0 D Q:RCLAST
- . I +XMRG=99,$P(XMRG,U,2)="$" S RCLAST=1 Q
- . S:XMRG'="" CT=CT+1,@RCGBL@(2,"D",CT)=XMRG
- ;
- ; PRCA*4.5*349 - Removed killing of RCGBL to ensure raw data gets sent in error message
- I 'RCLAST,'$G(RCERR) S RCERR=2 ; No $ as last character of msg
- ;
- I $G(RCERR)>0 D G EFTQ
- . D ERRUPD^RCDPESR1(RCGBL,.RCD,RCTYP1,.RCERR)
- . S RCEFLG=1
- ;
- ; Add top-level entry to file 344.3
- S RCEFT=$$ADDEFT(RCTXN,XMZ,RCGBL,.RCERR)
- ;
- I $G(RCERR) D G EFTQ ; 'BAD' EFT's
- . D ERRUPD^RCDPESR1(RCGBL,.RCD,RCTYP1,.RCERR)
- . S RCEFLG=1
- ;
- G:'RCEFT EFTQ
- ;
- ; PRCA*4.5*380 - No longer deleting EFT Details
- ;
- S (RC,RC1,RCZ)=0
- F S RCZ=$O(@RCGBL@(2,"D",RCZ)) Q:'RCZ S Z0=$G(^(RCZ)) I Z0'="" D Q:$G(RCERR)
- . I $P(Z0,U)="01" D ; Each payer's data
- . . N DA,DD,DIC,DIE,DO,DR,X,Y
- . . S X=RCEFT
- . . S DIC("DR")=".11////0;.04////"_$P(Z0,U,2)_";.08////0"
- . . S DIC("DR")=DIC("DR")_$S($P(Z0,U,5)'="":";.02////"_$P(Z0,U,5),1:"")
- . . S DIC("DR")=DIC("DR")_$S($P(Z0,U,6)'="":";.03////"_$P(Z0,U,6),1:"")
- . . S DIC("DR")=DIC("DR")_";.07////"_$J(+$P(Z0,U,4)/100,"",2)
- . . S DIC("DR")=DIC("DR")_";.06////"_$S($P(Z0,U,8)'="":1,1:0)
- . . S DIC("DR")=DIC("DR")_";.12///"_$$FDT^RCDPESR9($P(Z0,U,3))
- . . S DIC("DR")=DIC("DR")_";.13////"_DT_$S($P(Z0,U,7)'="":";.05////"_$P(Z0,U,7),1:"")
- . . S DIC("DR")=DIC("DR")_$S($P(Z0,U,9)'="":";.15////"_$P(Z0,U,9),1:"")
- . . S XX=$S($P(Z0,U,10)="D":"D",$P(Z0,U,10)="-":"D",1:"")
- . . S DIC("DR")=DIC("DR")_";3////"_XX ; PRCA*4.5*321 added filing of this field
- . . ;
- . . I $P(Z0,U,8)'="" D ; Tax id error
- . . . S XX=$P(Z0,U,5)_" Payer ID: "_$P(RCTXN,U,6)
- . . . D TAXERR^RCDPESR1("EFT",XX,$P(RCTXN,U,7),$P(RCTXN,U,8)) ; Send bad tax id bulletin
- . . ;
- . . S DIC(0)="L",DIC="^RCY(344.31,",DLAYGO=344.31
- . . D FILE^DICN
- . . K DIC,DLAYGO,DO,DD
- . . I Y'>0 D ; Error filing data
- . . . S DIK="^RCY(344.3,",DA=RCEFT D ^DIK
- . . . S Z=0 F S Z=$O(^RCY(344.31,"B",RCEFT,Z)) Q:'Z S DIK="^RCY(344.31,",DA=Z D ^DIK
- . . . S RCEFLG=1,RCERR=3
- . . . D ERRUPD^RCDPESR1(RCGBL,.RCD,RCTYP1,RCERR)
- ;
- I '$G(RCEFLG) D
- . S DIE="^RCY(344.3,",DA=RCEFT,DR=".09////"_$$CHKSUM(RCEFT) D ^DIE
- ;
- EFTQ ;
- D CLEAN^DILF
- Q
- ;
- ADDEFT(RCTXN,RCXMZ,RCGBL,RCERR) ; File EFT TOTAL record in file 344.3
- ; RCTXN = the data on the header record of the message text
- ; RCXMZ = the mail message number
- ; RCGBL = the name of the array or global where the message is stored
- ; Function returns the ien of the total record found/added
- ; and also returns RCERR if passed by reference
- ;
- N RCTDA,RCRCPT,RCDUP,RCHAC,Z,Z0
- S (RCERR,RCTDA)=""
- ;
- ;----- changed for PRCA*4.5*283
- ;I $E($P(RCTXN,U,6),1,3)'="469",$E($P(RCTXN,U,6),1,3)'="569",$E($P(RCTXN,U,6),1,3)'="HAC" D G ADDQ ; Invalid EFT deposit number
- ;. N RCDXM,RCCT
- ;. S RCCT=0
- ;. 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)=" "
- ;. S RCCT=RCCT+1,RCDXM(RCCT)=" ",RCCT=RCCT+1,RCDXM(RCCT)="Here are the contents of this message:"
- ;. D DISP("EDI LBOX INVALID EFT DEPOSIT #",RCCT,.RCDXM,RCXMZ)
- ;-----
- ;
- ; Make sure it's not already there or if so, it has no ptr to a deposit
- ; or if a deposit exists, that the deposit does not yet have a receipt
- S RCDUP=0,RCHAC=$E($P(RCTXN,U,6),1,3)="HAC" ; This is a HAC deposit
- I $P(RCTXN,U,6)'="" D
- . ;Format Deposit Date as FM date
- . N RCDDAT
- . S X=$$FDT^RCDPESR9($P(RCTXN,U,7))
- . S RCDDAT=0,%DT="X" D ^%DT S:Y>0 RCDDAT=Y
- . S Z=0 ; Lookup deposit by deposit #
- . ; PRCA*4.5*380 - Don't quit now until we've either gone through all the records or found a valid match, since we might be matching
- . ; a duplicate record now
- . F S Z=$O(^RCY(344.3,"ADEP",RCDDAT,$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:RCTDA
- .. ; Deposit found - find receipt
- .. I $O(^RCY(344,"AD",$P(Z0,U,3),0)) S RCDUP=Z Q
- .. S RCTDA=Z
- ;
- ;-----
- ; PRCA*4.5*298 - MailMan message disabled, logic retained - 14 Feb 2014
- ;I RCDUP D ; Send bulletin that duplicate EFT received
- ;. N RCDXM,RCCT
- ;. S RCCT=0
- ;. S RCCT=RCCT+1,RCDXM(RCCT)="This EFT appears to be a duplicate transaction and has been rejected.",RCCT=RCCT+1,RCDXM(RCCT)=" "
- ;. S RCCT=RCCT+1,RCDXM(RCCT)=" ",RCCT=RCCT+1,RCDXM(RCCT)="Here are the contents of this message:"
- ;. D DISP("EDI LBOX DUP EFT DEPOSIT RECEIVED",RCCT,.RCDXM,RCXMZ)
- ;-----
- ;
- ; PRCA*4.5*380 - Removed check for dup; will now just create new transaction, instead
- N %DT,DA,DD,DEPAMT,DIC,DIE,DINUM,DLAYGO,DO,DR,RCDTTM,RCX,X,Y
- ;
- S X=$$FDT^RCDPESR9($P(RCTXN,U,3))_"@"_$P(RCTXN,U,4)
- S %DT="XTS" D ^%DT S:Y>0 RCDTTM=Y
- ;
- ;PRCA*4.5*380 - If updating an existing deposit, add new deposit amount to existing total
- S DEPAMT=$S(RCTDA:+$$GET1^DIQ(344.3,RCTDA_",",.08),1:0)+$$ZERO^RCDPESR9($P(RCTXN,U,8),1)
- ;
- S DIC("DR")=""
- S DIC("DR")=$S(RCDTTM'="":".02////"_RCDTTM,1:"")
- S DIC("DR")=DIC("DR")_$S(DIC("DR")'="":";",1:"")_".06////"_$P(RCTXN,U,6)_";.07///"_$$FDT^RCDPESR9($P(RCTXN,U,7))
- ;PRCA*4.5*380 - If updating an existing deposit, add new deposit amount to existing total
- S DIC("DR")=DIC("DR")_";.08////"_DEPAMT_";.13////"_$$NOW^XLFDT()_$S('RCTDA:";.05////"_RCXMZ,1:"")_";.14////0;.12////0"
- ;
- I RCTDA D ; Update the data already there
- . L +^RCY(344.3,RCTDA):1 I '$T S RCTDA=-1 Q
- . S DIE="^RCY(344.3,",DA=RCTDA,DR=DIC("DR") K DIC D ^DIE
- . K DIE,DA,DR
- . ; PRCA*4.5*380 - Add an entry to the subsequent mail messages multiple
- . S DIC="^RCY(344.3,"_RCTDA_",3,",DIC(0)="L",DA(1)=RCTDA,X=RCXMZ
- . D FILE^DICN K DA,DIC
- . L -^RCY(344.3,RCTDA)
- ;
- I 'RCTDA D
- . S RCX=+$O(^RCY(344.3," "),-1)
- . 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
- . S DIC(0)="L",DIC="^RCY(344.3,",DLAYGO=344.3,DINUM=RCX
- . D FILE^DICN K DO,DD,DLAYGO,DIC,DINUM
- . L -^RCY(344.3,RCX,0)
- . S RCTDA=$S(Y<0:"",1:+Y)
- ;
- I 'RCTDA S RCERR=3 ; Error in add of EFT record to file 344.3
- ;
- ADDQ Q $S(RCTDA>0:RCTDA,1:"")
- ;
- CHKSUM(RCTDA) ; Calc the checksum for EFT record stored in RCTDA in 344.3
- ;
- N RCDPCSUM,RCDPDATA,X,Y,Z,Z0
- ;
- S (RCDPCSUM,X)=0,Z0=$G(^RCY(344.3,RCTDA,0))
- ; Use pcs 1-8, leaving out piece 3
- S RCDPDATA=$P(Z0,U,1,8),$P(RCDPDATA,U,3)=""
- S X=RCDPCSUM_RCDPDATA X $S($G(^%ZOSF("LPC"))'="":^("LPC"),1:"S Y=""""") S RCDPCSUM=Y
- ; Use detail iens and pieces 3,4,7 to complete the checksum
- 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
- Q RCDPCSUM
- ;
- DISP(RCTIT,RCCT,RCDXM,RCXMZ) ; Sends bulletin with formatted data from message
- ; RCTIT = title of bulletin
- ; RCCT = # of lines previously populated
- ; RCXDM = array containing the text of the bulletin
- N RC,Z
- K ^TMP("RC1",$J),^TMP("RC",$J),^TMP("RCTEMP",$J)
- S RC=1,^TMP("RCTEMP",$J,RC)=$G(^TMP("RCMSGH",$J,0))
- 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))
- D DISP^RCDPESR8("^TMP(""RCTEMP"",$J)","^TMP(""RC1"",$J)",1,"^TMP(""RC"",$J)",75)
- S Z=0 F S Z=$O(^TMP("RC",$J,Z)) Q:'Z S RCCT=RCCT+1,RCDXM(RCCT)=$G(^TMP("RC",$J,Z))
- D BULLEFT^RCDPESR0("",RCXMZ,RCTIT,.RCDXM)
- K ^TMP("RC1",$J),^TMP("RC",$J),^TMP("RCTEMP",$J)
- Q
- ;
- DUP(RCM,RCIFN,RCAMT,RCAMT1) ; EOB in mail message already stored in 361.1?
- ; RCM = msg # EOB was received in
- ; RCIFN = bill ien
- ; RCAMT = amt pd
- ; RCAMT1 = amt reported billed
- ; Returns 0 if none found, entry #^message checksum on file if found
- N Z,DUP,DUP1
- S (DUP,DUP1,Z)=0
- F S Z=$O(^IBM(361.1,"AC",RCM,Z)) Q:'Z I +$G(^IBM(361.1,Z,0))=RCIFN D Q:DUP
- . I '$P($G(^IBM(361.1,Z,100)),U,5) S DUP1=Z Q ; Partially filed before
- . 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
- I 'DUP,DUP1 S DUP=DUP1_"^0"
- Q DUP
- ;
- DUPERA(DUP,RCNOUPD) ; Msg for duplicate ERA
- ; RCNOUPD = # of message with duplicate data
- ; DUP = flag = -1 if duplicate message received in same mail msg #
- K ^TMP("RCERR1",$J)
- 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")
- Q
- ;
- BULLS(RCFILE,RCTDA,DUP,RCXMSG) ; Error bulletins for ERA
- ; PRCA*4.5*298 - DUPLICATE TRANSMISSION MSG AND EEOB - EXCEPTIONS message disabled - 14 Feb 2014
- ;I RCFILE=5 D BULL1^RCDPESR5(RCTDA,"^TMP(""RCERR1"",$J)",$S($G(DUP)>0:$G(DUP),1:""))
- I RCFILE=4 D BULL2^RCDPESR5(RCTDA,"^TMP(""RCERR1"",$J)",RCXMSG)
- Q
- ;
- ADJERR(RCERR) ; Set up adj error text in RCERR(n) - pass by ref
- ; Function returns # of lines for error text
- 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)=" "
- Q 4
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPESR3 9917 printed Feb 18, 2025@23:11:48 Page 2
- RCDPESR3 ;ALB/TMK/PJH - Server auto-update utilities - EDI Lockbox ;Jun 06, 2014@19:11:19
- +1 ;;4.5;Accounts Receivable;**173,214,208,255,269,283,298,321,345,349,380**;Mar 20, 1995;Build 14
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 QUIT
- +4 ;
- EFTIN(RCTXN,RCD,XMZ,RCGBL,RCEFLG) ; Adds a new EFT record to AR file 344.3
- +1 ; from Lockbox EFT msg
- +2 ; Input: RCTXN - Data on the header record of the message text
- +3 ; RCD - Array containing formatted mail message header data
- +4 ; XMZ - Mail message number
- +5 ; RCGBL - Name of the array or global where the message is stored
- +6 ; Output: RCEFLG - Error flag returned if passed by reference
- +7 ;
- +8 NEW CT,DA,DIK,DLAYGO,RC,RC1,RCLAST,RCDEPAMT,RCEFT,RCMEFTS,RCTDA,RCERR,RCTYP1,RCZ,XX,Z,Z0
- +9 ;
- +10 ; Take data out of mail message
- +11 SET (RCEFLG,RCLAST)=0
- SET CT=0
- SET RCTYP1="835EFT"
- +12 FOR
- XECUTE XMREC
- if XMER<0
- QUIT
- Begin DoDot:1
- +13 IF +XMRG=99
- IF $PIECE(XMRG,U,2)="$"
- SET RCLAST=1
- QUIT
- +14 if XMRG'=""
- SET CT=CT+1
- SET @RCGBL@(2,"D",CT)=XMRG
- End DoDot:1
- if RCLAST
- QUIT
- +15 ;
- +16 ; PRCA*4.5*349 - Removed killing of RCGBL to ensure raw data gets sent in error message
- +17 ; No $ as last character of msg
- IF 'RCLAST
- IF '$GET(RCERR)
- SET RCERR=2
- +18 ;
- +19 IF $GET(RCERR)>0
- Begin DoDot:1
- +20 DO ERRUPD^RCDPESR1(RCGBL,.RCD,RCTYP1,.RCERR)
- +21 SET RCEFLG=1
- End DoDot:1
- GOTO EFTQ
- +22 ;
- +23 ; Add top-level entry to file 344.3
- +24 SET RCEFT=$$ADDEFT(RCTXN,XMZ,RCGBL,.RCERR)
- +25 ;
- +26 ; 'BAD' EFT's
- IF $GET(RCERR)
- Begin DoDot:1
- +27 DO ERRUPD^RCDPESR1(RCGBL,.RCD,RCTYP1,.RCERR)
- +28 SET RCEFLG=1
- End DoDot:1
- GOTO EFTQ
- +29 ;
- +30 if 'RCEFT
- GOTO EFTQ
- +31 ;
- +32 ; PRCA*4.5*380 - No longer deleting EFT Details
- +33 ;
- +34 SET (RC,RC1,RCZ)=0
- +35 FOR
- SET RCZ=$ORDER(@RCGBL@(2,"D",RCZ))
- if 'RCZ
- QUIT
- SET Z0=$GET(^(RCZ))
- IF Z0'=""
- Begin DoDot:1
- +36 ; Each payer's data
- IF $PIECE(Z0,U)="01"
- Begin DoDot:2
- +37 NEW DA,DD,DIC,DIE,DO,DR,X,Y
- +38 SET X=RCEFT
- +39 SET DIC("DR")=".11////0;.04////"_$PIECE(Z0,U,2)_";.08////0"
- +40 SET DIC("DR")=DIC("DR")_$SELECT($PIECE(Z0,U,5)'="":";.02////"_$PIECE(Z0,U,5),1:"")
- +41 SET DIC("DR")=DIC("DR")_$SELECT($PIECE(Z0,U,6)'="":";.03////"_$PIECE(Z0,U,6),1:"")
- +42 SET DIC("DR")=DIC("DR")_";.07////"_$JUSTIFY(+$PIECE(Z0,U,4)/100,"",2)
- +43 SET DIC("DR")=DIC("DR")_";.06////"_$SELECT($PIECE(Z0,U,8)'="":1,1:0)
- +44 SET DIC("DR")=DIC("DR")_";.12///"_$$FDT^RCDPESR9($PIECE(Z0,U,3))
- +45 SET DIC("DR")=DIC("DR")_";.13////"_DT_$SELECT($PIECE(Z0,U,7)'="":";.05////"_$PIECE(Z0,U,7),1:"")
- +46 SET DIC("DR")=DIC("DR")_$SELECT($PIECE(Z0,U,9)'="":";.15////"_$PIECE(Z0,U,9),1:"")
- +47 SET XX=$SELECT($PIECE(Z0,U,10)="D":"D",$PIECE(Z0,U,10)="-":"D",1:"")
- +48 ; PRCA*4.5*321 added filing of this field
- SET DIC("DR")=DIC("DR")_";3////"_XX
- +49 ;
- +50 ; Tax id error
- IF $PIECE(Z0,U,8)'=""
- Begin DoDot:3
- +51 SET XX=$PIECE(Z0,U,5)_" Payer ID: "_$PIECE(RCTXN,U,6)
- +52 ; Send bad tax id bulletin
- DO TAXERR^RCDPESR1("EFT",XX,$PIECE(RCTXN,U,7),$PIECE(RCTXN,U,8))
- End DoDot:3
- +53 ;
- +54 SET DIC(0)="L"
- SET DIC="^RCY(344.31,"
- SET DLAYGO=344.31
- +55 DO FILE^DICN
- +56 KILL DIC,DLAYGO,DO,DD
- +57 ; Error filing data
- IF Y'>0
- Begin DoDot:3
- +58 SET DIK="^RCY(344.3,"
- SET DA=RCEFT
- DO ^DIK
- +59 SET Z=0
- FOR
- SET Z=$ORDER(^RCY(344.31,"B",RCEFT,Z))
- if 'Z
- QUIT
- SET DIK="^RCY(344.31,"
- SET DA=Z
- DO ^DIK
- +60 SET RCEFLG=1
- SET RCERR=3
- +61 DO ERRUPD^RCDPESR1(RCGBL,.RCD,RCTYP1,RCERR)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- if $GET(RCERR)
- QUIT
- +62 ;
- +63 IF '$GET(RCEFLG)
- Begin DoDot:1
- +64 SET DIE="^RCY(344.3,"
- SET DA=RCEFT
- SET DR=".09////"_$$CHKSUM(RCEFT)
- DO ^DIE
- End DoDot:1
- +65 ;
- EFTQ ;
- +1 DO CLEAN^DILF
- +2 QUIT
- +3 ;
- ADDEFT(RCTXN,RCXMZ,RCGBL,RCERR) ; File EFT TOTAL record in file 344.3
- +1 ; RCTXN = the data on the header record of the message text
- +2 ; RCXMZ = the mail message number
- +3 ; RCGBL = the name of the array or global where the message is stored
- +4 ; Function returns the ien of the total record found/added
- +5 ; and also returns RCERR if passed by reference
- +6 ;
- +7 NEW RCTDA,RCRCPT,RCDUP,RCHAC,Z,Z0
- +8 SET (RCERR,RCTDA)=""
- +9 ;
- +10 ;----- changed for PRCA*4.5*283
- +11 ;I $E($P(RCTXN,U,6),1,3)'="469",$E($P(RCTXN,U,6),1,3)'="569",$E($P(RCTXN,U,6),1,3)'="HAC" D G ADDQ ; Invalid EFT deposit number
- +12 ;. N RCDXM,RCCT
- +13 ;. S RCCT=0
- +14 ;. 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)=" "
- +15 ;. S RCCT=RCCT+1,RCDXM(RCCT)=" ",RCCT=RCCT+1,RCDXM(RCCT)="Here are the contents of this message:"
- +16 ;. D DISP("EDI LBOX INVALID EFT DEPOSIT #",RCCT,.RCDXM,RCXMZ)
- +17 ;-----
- +18 ;
- +19 ; Make sure it's not already there or if so, it has no ptr to a deposit
- +20 ; or if a deposit exists, that the deposit does not yet have a receipt
- +21 ; This is a HAC deposit
- SET RCDUP=0
- SET RCHAC=$EXTRACT($PIECE(RCTXN,U,6),1,3)="HAC"
- +22 IF $PIECE(RCTXN,U,6)'=""
- Begin DoDot:1
- +23 ;Format Deposit Date as FM date
- +24 NEW RCDDAT
- +25 SET X=$$FDT^RCDPESR9($PIECE(RCTXN,U,7))
- +26 SET RCDDAT=0
- SET %DT="X"
- DO ^%DT
- if Y>0
- SET RCDDAT=Y
- +27 ; Lookup deposit by deposit #
- SET Z=0
- +28 ; PRCA*4.5*380 - Don't quit now until we've either gone through all the records or found a valid match, since we might be matching
- +29 ; a duplicate record now
- +30 FOR
- SET Z=$ORDER(^RCY(344.3,"ADEP",RCDDAT,$PIECE(RCTXN,U,6),Z))
- if 'Z
- QUIT
- SET Z0=$GET(^RCY(344.3,Z,0))
- if '$PIECE(Z0,U,3)
- SET RCTDA=Z
- if RCTDA
- QUIT
- Begin DoDot:2
- +31 ; Deposit found - find receipt
- +32 IF $ORDER(^RCY(344,"AD",$PIECE(Z0,U,3),0))
- SET RCDUP=Z
- QUIT
- +33 SET RCTDA=Z
- End DoDot:2
- if RCTDA
- QUIT
- End DoDot:1
- +34 ;
- +35 ;-----
- +36 ; PRCA*4.5*298 - MailMan message disabled, logic retained - 14 Feb 2014
- +37 ;I RCDUP D ; Send bulletin that duplicate EFT received
- +38 ;. N RCDXM,RCCT
- +39 ;. S RCCT=0
- +40 ;. S RCCT=RCCT+1,RCDXM(RCCT)="This EFT appears to be a duplicate transaction and has been rejected.",RCCT=RCCT+1,RCDXM(RCCT)=" "
- +41 ;. S RCCT=RCCT+1,RCDXM(RCCT)=" ",RCCT=RCCT+1,RCDXM(RCCT)="Here are the contents of this message:"
- +42 ;. D DISP("EDI LBOX DUP EFT DEPOSIT RECEIVED",RCCT,.RCDXM,RCXMZ)
- +43 ;-----
- +44 ;
- +45 ; PRCA*4.5*380 - Removed check for dup; will now just create new transaction, instead
- +46 NEW %DT,DA,DD,DEPAMT,DIC,DIE,DINUM,DLAYGO,DO,DR,RCDTTM,RCX,X,Y
- +47 ;
- +48 SET X=$$FDT^RCDPESR9($PIECE(RCTXN,U,3))_"@"_$PIECE(RCTXN,U,4)
- +49 SET %DT="XTS"
- DO ^%DT
- if Y>0
- SET RCDTTM=Y
- +50 ;
- +51 ;PRCA*4.5*380 - If updating an existing deposit, add new deposit amount to existing total
- +52 SET DEPAMT=$SELECT(RCTDA:+$$GET1^DIQ(344.3,RCTDA_",",.08),1:0)+$$ZERO^RCDPESR9($PIECE(RCTXN,U,8),1)
- +53 ;
- +54 SET DIC("DR")=""
- +55 SET DIC("DR")=$SELECT(RCDTTM'="":".02////"_RCDTTM,1:"")
- +56 SET DIC("DR")=DIC("DR")_$SELECT(DIC("DR")'="":";",1:"")_".06////"_$PIECE(RCTXN,U,6)_";.07///"_$$FDT^RCDPESR9($PIECE(RCTXN,U,7))
- +57 ;PRCA*4.5*380 - If updating an existing deposit, add new deposit amount to existing total
- +58 SET DIC("DR")=DIC("DR")_";.08////"_DEPAMT_";.13////"_$$NOW^XLFDT()_$SELECT('RCTDA:";.05////"_RCXMZ,1:"")_";.14////0;.12////0"
- +59 ;
- +60 ; Update the data already there
- IF RCTDA
- Begin DoDot:1
- +61 LOCK +^RCY(344.3,RCTDA):1
- IF '$TEST
- SET RCTDA=-1
- QUIT
- +62 SET DIE="^RCY(344.3,"
- SET DA=RCTDA
- SET DR=DIC("DR")
- KILL DIC
- DO ^DIE
- +63 KILL DIE,DA,DR
- +64 ; PRCA*4.5*380 - Add an entry to the subsequent mail messages multiple
- +65 SET DIC="^RCY(344.3,"_RCTDA_",3,"
- SET DIC(0)="L"
- SET DA(1)=RCTDA
- SET X=RCXMZ
- +66 DO FILE^DICN
- KILL DA,DIC
- +67 LOCK -^RCY(344.3,RCTDA)
- End DoDot:1
- +68 ;
- +69 IF 'RCTDA
- Begin DoDot:1
- +70 SET RCX=+$ORDER(^RCY(344.3," "),-1)
- +71 FOR RCX=RCX+1:1
- IF '$DATA(^RCY(344.3,RCX,0))
- LOCK +^RCY(344.3,RCX,0):1
- IF $TEST
- SET X=RCX
- QUIT
- +72 SET DIC(0)="L"
- SET DIC="^RCY(344.3,"
- SET DLAYGO=344.3
- SET DINUM=RCX
- +73 DO FILE^DICN
- KILL DO,DD,DLAYGO,DIC,DINUM
- +74 LOCK -^RCY(344.3,RCX,0)
- +75 SET RCTDA=$SELECT(Y<0:"",1:+Y)
- End DoDot:1
- +76 ;
- +77 ; Error in add of EFT record to file 344.3
- IF 'RCTDA
- SET RCERR=3
- +78 ;
- ADDQ QUIT $SELECT(RCTDA>0:RCTDA,1:"")
- +1 ;
- CHKSUM(RCTDA) ; Calc the checksum for EFT record stored in RCTDA in 344.3
- +1 ;
- +2 NEW RCDPCSUM,RCDPDATA,X,Y,Z,Z0
- +3 ;
- +4 SET (RCDPCSUM,X)=0
- SET Z0=$GET(^RCY(344.3,RCTDA,0))
- +5 ; Use pcs 1-8, leaving out piece 3
- +6 SET RCDPDATA=$PIECE(Z0,U,1,8)
- SET $PIECE(RCDPDATA,U,3)=""
- +7 SET X=RCDPCSUM_RCDPDATA
- XECUTE $SELECT($GET(^%ZOSF("LPC"))'="":^("LPC"),1:"S Y=""""")
- SET RCDPCSUM=Y
- +8 ; Use detail iens and pieces 3,4,7 to complete the checksum
- +9 SET Z=0
- FOR
- SET Z=$ORDER(^RCY(344.31,"B",RCTDA,Z))
- if 'Z
- QUIT
- SET Z0=$GET(^RCY(344.31,Z,0))
- SET RCDPDATA=Z_U_$PIECE(Z0,U,3,4)_U_$PIECE(Z0,U,7)
- SET X=RCDPCSUM_RCDPDATA
- XECUTE $SELECT($GET(^%ZOSF("LPC"))'="":^("LPC"),1:"S Y=""""")
- SET RCDPCSUM=Y
- +10 QUIT RCDPCSUM
- +11 ;
- DISP(RCTIT,RCCT,RCDXM,RCXMZ) ; Sends bulletin with formatted data from message
- +1 ; RCTIT = title of bulletin
- +2 ; RCCT = # of lines previously populated
- +3 ; RCXDM = array containing the text of the bulletin
- +4 NEW RC,Z
- +5 KILL ^TMP("RC1",$JOB),^TMP("RC",$JOB),^TMP("RCTEMP",$JOB)
- +6 SET RC=1
- SET ^TMP("RCTEMP",$JOB,RC)=$GET(^TMP("RCMSGH",$JOB,0))
- +7 SET Z=0
- FOR
- SET Z=$ORDER(^TMP("RCMSG",$JOB,2,"D",Z))
- if 'Z
- QUIT
- SET RC=RC+1
- SET ^TMP("RCTEMP",$JOB,RC)=$GET(^TMP("RCMSG",$JOB,2,"D",Z))
- +8 DO DISP^RCDPESR8("^TMP(""RCTEMP"",$J)","^TMP(""RC1"",$J)",1,"^TMP(""RC"",$J)",75)
- +9 SET Z=0
- FOR
- SET Z=$ORDER(^TMP("RC",$JOB,Z))
- if 'Z
- QUIT
- SET RCCT=RCCT+1
- SET RCDXM(RCCT)=$GET(^TMP("RC",$JOB,Z))
- +10 DO BULLEFT^RCDPESR0("",RCXMZ,RCTIT,.RCDXM)
- +11 KILL ^TMP("RC1",$JOB),^TMP("RC",$JOB),^TMP("RCTEMP",$JOB)
- +12 QUIT
- +13 ;
- DUP(RCM,RCIFN,RCAMT,RCAMT1) ; EOB in mail message already stored in 361.1?
- +1 ; RCM = msg # EOB was received in
- +2 ; RCIFN = bill ien
- +3 ; RCAMT = amt pd
- +4 ; RCAMT1 = amt reported billed
- +5 ; Returns 0 if none found, entry #^message checksum on file if found
- +6 NEW Z,DUP,DUP1
- +7 SET (DUP,DUP1,Z)=0
- +8 FOR
- SET Z=$ORDER(^IBM(361.1,"AC",RCM,Z))
- if 'Z
- QUIT
- IF +$GET(^IBM(361.1,Z,0))=RCIFN
- Begin DoDot:1
- +9 ; Partially filed before
- IF '$PIECE($GET(^IBM(361.1,Z,100)),U,5)
- SET DUP1=Z
- QUIT
- +10 IF +$GET(^IBM(361.1,Z,1))=+RCAMT
- IF +$PIECE($GET(^IBM(361.1,1,Z,2)),U,4)=+RCAMT1
- SET DUP=Z_U_+$PIECE($GET(^IBM(361.1,Z,100)),U,5)
- QUIT
- End DoDot:1
- if DUP
- QUIT
- +11 IF 'DUP
- IF DUP1
- SET DUP=DUP1_"^0"
- +12 QUIT DUP
- +13 ;
- DUPERA(DUP,RCNOUPD) ; Msg for duplicate ERA
- +1 ; RCNOUPD = # of message with duplicate data
- +2 ; DUP = flag = -1 if duplicate message received in same mail msg #
- +3 KILL ^TMP("RCERR1",$JOB)
- +4 SET ^TMP("RCERR1",$JOB,1)=$SELECT(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")
- +5 QUIT
- +6 ;
- BULLS(RCFILE,RCTDA,DUP,RCXMSG) ; Error bulletins for ERA
- +1 ; PRCA*4.5*298 - DUPLICATE TRANSMISSION MSG AND EEOB - EXCEPTIONS message disabled - 14 Feb 2014
- +2 ;I RCFILE=5 D BULL1^RCDPESR5(RCTDA,"^TMP(""RCERR1"",$J)",$S($G(DUP)>0:$G(DUP),1:""))
- +3 IF RCFILE=4
- DO BULL2^RCDPESR5(RCTDA,"^TMP(""RCERR1"",$J)",RCXMSG)
- +4 QUIT
- +5 ;
- ADJERR(RCERR) ; Set up adj error text in RCERR(n) - pass by ref
- +1 ; Function returns # of lines for error text
- +2 SET RCERR(1)="At least 1 adjustment transaction has been found on this ERA. Before the"
- SET RCERR(2)=" receipt for this ERA can be processed, the appropriate adjustments"
- SET RCERR(3)=" must be made using the EEOB Worklist"
- SET RCERR(4)=" "
- +3 QUIT 4
- +4 ;