RCDPESR0 ;ALB/TMK/DWA - Server auto-update utilities - EDI Lockbox ; 9/30/10 6:05pm
;;4.5;Accounts Receivable;**173,208,269**;Mar 20, 1995;Build 113
;;Per VHA Directive 10-93-142, this routine should not be modified.
; IA for read access to ^IBM(361.1 = 4051
;
DISP(RCMIN,RCMOUT,RCFMT,RCFULL,RCW,RC3444) ; Format the 835 return msg
; RCMIN = the name of the array that contains the raw message data
; The data is contained at the next level and the subscript is
; numeric and greater than 0 or the data can be at the
; 0-node subsequent to the final subscript.
; If the message array is a global ^TMP($J,"MSG",n), RCMIN
; will equal "^TMP($J,""MSG"")" and the message text will be
; in ^TMP($J,"MSG",1), ^TMP($J,"MSG",2), etc. OR
; the message text can be defined at TMP($J,"MSG",1,0) ^...,2,0)
; etc.
; RCMOUT = the name of the array that should be returned. This array
; will follow the same convention as the input array. The
; array will be returned with a numeric final subscript. If
; RCMOUT is passed as "^TMP($J,""MSG1"")", then the display
; lines will be returned in ^TMP($J,"MSG1",1),
; ^TMP($J,"MSG1",2), etc. Note the array RCMOUT is killed
; on entry to this call
; RCFMT = 0 or null if call should return raw data, 1 to execute the
; transforms attached to the fields
; RCFULL = the name of an array if the data should be returned in
; this array, formatted into lines for display. If not sent,
; only the display data by element is returned in RCMOUT. If
; RCFULL is sent, the array is killed before populating it
; RCW = max # of characters per line to return in array RCFULL
; RC3444 = flag that indicates only return bill data, not header data
;
N Z,Z0,Z1,RC,RCCT,RCREF,RCDATA,RCQ,R
S RCCT=0,RCREF="" K @RCMOUT
S Z=0 F S Z=$O(@RCMIN@(Z)) Q:'Z S Z0=$S($G(@RCMIN@(Z))'="":@RCMIN@(Z),1:$G(@RCMIN@(Z,0))) I Z0'="" S RCQ=0 D
. I '$G(RCV5),+$P(Z0,U)=835,+$P(Z0,U,16)>0 S RCV5=1
. F Z1=1:1:$L(Z0,U) I $P(Z0,U,Z1)'="" D Q:RCQ
.. S RCDATA=$P(Z0,U,Z1)
.. I Z1=1 D Q:RCQ
... S RC=""
... I RCDATA'="",RCDATA?.N.A,$G(RCV5) D
.... S RCREF=$S($E(RCDATA,1,3)'="835":$E(RCDATA,1,8),1:"835"),R=RCREF_"^RCDPES10",RC=$P($T(@R),";;",2)
... I RCDATA'="",RCDATA?.N.A,'$G(RCV5) D
.... S RCREF=$S($E(RCDATA,1,3)'="835":$E(RCDATA,1,8),1:"835"),R=RCREF_"^RCDPESR9",RC=$P($T(@R),";;",2)
... I RC="" S RCCT=RCCT+1,@RCMOUT@(RCCT)="<<<INVALID LINE TYPE - RAW DATA IS:",RCCT=RCCT+1,@RCMOUT@(RCCT)=Z0,RCDATA=""
.. Q:RCDATA=""!(RCREF="")!$S(RCREF="835":$G(RC3444),1:0)
.. S RC=""
.. I RCREF?.A.N,$G(RCV5) D
... S R=RCREF_"+"_Z1_"^RCDPES10",RC=$P($T(@R),";;",2)
.. I RCREF?.A.N,'$G(RCV5) D
... S R=RCREF_"+"_Z1_"^RCDPESR9",RC=$P($T(@R),";;",2)
.. I RC=""!($P(RC,U)'=RCREF) S:$S(RCDATA'="":1,1:'$P(RC,U,2)) RCCT=RCCT+1,@RCMOUT@(RCCT)="NO DATA DEFINITION PC "_Z1_": "_RCDATA Q
.. I RC'="" D
... N X,X1,Y
... S X1=$P(RC,U,4,99)
... I $G(RCFMT),X1'="" S X=RCDATA X X1 S RCDATA=Y ; Output transform
... Q:RCDATA=""&($P(RC,U,2)) ; Don't output if null data
... S RC=$P(RC,U,3)
... S RCCT=RCCT+1,@RCMOUT@(RCCT)=$S(Z1=1:"<<<",1:"")_RC_": "_RCDATA_$S(Z1=1:">>>",1:"")
I $G(RCFULL)'="" D FMTDSP(RCMOUT,RCFULL,$G(RCW),$G(RC3444))
Q
;
FMTDSP(RCMUN,RCMFO,RCW,RCNOH05) ; Format the display data in array named in
; RCMUN into lines up to RCW characters wide RCMUN must be set up the
; same as the output of the DISP call above
; Returns array named in RCMFO with the last subscript being the line #
; Note @RCMFO is killed on entry to this call
; Default is 80 if RCW=0 or null
; RCNOH05 = flag that if =1, suppresses the '05' header
;
N Z,RCLINE,RCCT,RCCT1,RCMID,RCD,RCSTART,RCLINE,RCDASH
K @RCMFO
S:'$G(RCW) RCW=80
S RCDASH=" "_$TR($J("",RCW-2)," ","-")
S (RCCT,RCCT1)=0,RCLINE="",RCMID=RCW\2-1
S Z=0 F S Z=$O(@RCMUN@(Z)) Q:'Z S RCD=$G(@RCMUN@(Z)) D
. I $E(RCD,1,3)="<<<" D Q ; New line needed ... record start
.. I $L(RCLINE)>0 S RCCT=RCCT+1,@RCMFO@(RCCT)=RCLINE,RCLINE=""
.. I $L(RCLINE)=0 D
... I Z>1 S RCCT=RCCT+1,@RCMFO@(RCCT)=" "
... I RCD["<<<Line Type: 05 ",'$G(RCNOH05) S RCCT1=RCCT1+1,RCCT=RCCT+1,@RCMFO@(RCCT)=RCDASH,RCCT=RCCT+1,@RCMFO@(RCCT)="****** ERA DETAIL START ******",RCCT=RCCT+1,@RCMFO@(RCCT)=RCDASH
... I $L(RCD)>RCW D Q
.... S RCSTART=1
.... F S RCCT=RCCT+1,@RCMFO@(RCCT)=$E(RCD,RCSTART,RCSTART+RCW-1),RCSTART=RCSTART+RCW Q:RCSTART>$L(RCD)
... S RCCT=RCCT+1,@RCMFO@(RCCT)=RCD
. ;
. I $L(RCD)>RCW D Q ; Split line if greater than width given
.. I $L(RCLINE) S RCCT=RCCT+1,@RCMFO@(RCCT)=RCLINE
.. S RCSTART=1
.. F S RCCT=RCCT+1,@RCMFO@(RCCT)=$E(RCD,RCSTART,RCSTART+RCW-1),RCSTART=RCSTART+RCW Q:RCSTART>$L(RCD)
.. S RCLINE=""
. I $L(RCLINE)=0 D Q ; Format left side of line
.. S RCLINE=RCD
.. ;
.. I $L(RCLINE)>RCMID S RCCT=RCCT+1,@RCMFO@(RCCT)=RCLINE,RCLINE=""
. ;
. I (RCMID+$L(RCD)+1)>RCW D Q ; data too long for right side of line
.. S RCCT=RCCT+1,@RCMFO@(RCCT)=RCLINE,RCCT=RCCT+1,@RCMFO@(RCCT)=RCD,RCLINE=""
. S RCLINE=$E(RCLINE_$J("",RCMID),1,RCMID)_" "_RCD,RCCT=RCCT+1,@RCMFO@(RCCT)=RCLINE,RCLINE=""
I $L(RCLINE) S RCCT=RCCT+1,@RCMFO@(RCCT)=RCLINE
Q
;
BULLERA(RC,RCTDA,RCXMG,RCSUBJ,RCERR,RCTYP) ; Send a bulletin for entries in 344.5
; RC = flags for data to include (one or more can can be used)
; 'D': display text 'R': raw data 'F': formatted data from raw
; data in file 344.5
; RCTDA = ien of the entry in file 344.5
; RCXMG = mail msg # for the ERA
; RCSUBJ = subject of the bulletin
; RCERR = error text in array or name of error global
; RCTYP = if 0:ERA 1:EEOB
;
N XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,XMZ,XMERR,Z,Z0,CT,RCXM,RCVAR
K ^TMP("RCXM_344.5",$J)
S RCERR=$G(RCERR)
S RCVAR=$S($E(RCERR,1,5)="^TMP(":RCERR,1:"RCERR")
S XMTO("I:G.RCDPE PAYMENTS EXCEPTIONS")="",CT=0,RCTYP=$S('$G(RCTYP):"ERA",1:"EEOB")
S CT=CT+1,^TMP("RCXM_344.5",$J,CT)="The following electronic "_RCTYP_" was received at your site.",CT=CT+1,^TMP("RCXM_344.5",$J,CT)="It was received on: "_$$FMTE^XLFDT($$NOW^XLFDT(),2)_" in mail msg # "_RCXMG_"."
S CT=CT+1,^TMP("RCXM_344.5",$J,CT)="This message is sent to alert you to conditions regarding this "_RCTYP_".",CT=CT+1,^TMP("RCXM_344.5",$J,CT)=" "
I RC["D" D DTXT(RCTDA,.RCXM,.CT) M ^TMP("RCXM_344.5",$J)=RCXM K RCXM
S Z=0 F S Z=$O(@RCVAR@(Z)) Q:'Z I $D(@RCVAR@(Z,"*")) S CT=CT+1,^TMP("RCXM_344.5",$J,CT)=@RCVAR@(Z,"*")
I $G(RCERR)'="",RCVAR="RCERR" S CT=CT+1,^TMP("RCXM_344.5",$J,CT)=RCERR,CT=CT+1,^TMP("RCXM_344.5",$J,CT)=" "
I $O(@RCVAR@(""))'="" D
. S Z="" F S Z=$O(@RCVAR@(Z)) Q:Z="" D
.. I $G(@RCVAR@(Z))'="" S CT=CT+1,^TMP("RCXM_344.5",$J,CT)=@RCVAR@(Z)
.. I $O(@RCVAR@(Z,0)) S Z0="" F S Z0=$O(@RCVAR@(Z,Z0)) Q:Z0="" I Z0'="*" S CT=CT+1,^TMP("RCXM_344.5",$J,CT)=@RCVAR@(Z,Z0)
I RC["F" D
. N RCCT1
. S RCCT1=0
. K ^TMP($J,"PRCAZ_RAW"),^TMP($J,"PRCAZ_FMT1"),^TMP($J,"PRCAZ_FMT")
. D DISP("^RCY(344.5,"_RCTDA_",2)","^TMP($J,""PRCAZ_FMT1"")",1,"^TMP($J,""PRCAZ_FMT"")",75)
. S CT=CT+1,^TMP("RCXM_344.5",$J,CT)="FORMATTED DATA: "
. S Z=0 F S Z=$O(^TMP($J,"PRCAZ_FMT",Z)) Q:'Z S CT=CT+1,^TMP("RCXM_344.5",$J,CT)=^TMP($J,"PRCAZ_FMT",Z)
. S:RC["R" CT=CT+1,^TMP("RCXM_344.5",$J,CT)=" "
I RC["R" D
. S CT=CT+1,^TMP("RCXM_344.5",$J,CT)="RAW DATA: "
. S Z=0 F S Z=$O(^RCY(344.5,RCTDA,2,Z)) Q:'Z S CT=CT+1,^TMP("RCXM_344.5",$J,CT)=$G(^RCY(344.5,RCTDA,2,Z,0))
S XMBODY="^TMP(""RCXM_344.5"",$J)"
D
. N DUZ S DUZ=.5,DUZ(0)="@"
. D SENDMSG^XMXAPI(.5,$E(RCSUBJ,1,65),XMBODY,.XMTO,,.XMZ)
K ^TMP($J,"PRCAZ_RAW"),^TMP($J,"PRCAZ_FMT1"),^TMP($J,"PRCAZ_FMT"),^TMP("RCXM_344.5",$J)
Q
;
BULLEFT(RCTDA,RCXMG,RCSUBJ,RCERR) ; Send a bulletin for 'bad' EFT entries
; RCTDA = ien of the entry in file 344.3
; RCXMG = mail msg # for the EFT
; RCSUBJ = subject of the bulletin
; RCERR = error text in array
N XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,RCXM,XMZ,XMERR,Z,Z0,CT
S XMTO("I:G.RCDPE PAYMENTS EXCEPTIONS")="",CT=0
S CT=CT+1,RCXM(CT)="The following electronic EFT deposit was received at your site.",CT=CT+1,RCXM(CT)="It was received on: "_$$FMTE^XLFDT($$NOW^XLFDT(),2)_" in mail msg # "_RCXMG_"."
S CT=CT+1,RCXM(CT)="This message is sent to alert you to conditions regarding this EFT.",CT=CT+1,RCXM(CT)=" "
I $G(RCERR)'="" S CT=CT+1,RCXM(CT)=RCERR,CT=CT+1,RCXM(CT)=" "
I $O(RCERR(""))'="" D
. S Z="" F S Z=$O(RCERR(Z)) Q:Z="" D
.. I $G(RCERR(Z))'="" S CT=CT+1,RCXM(CT)=RCERR(Z)
.. I $O(RCERR(Z,0)) S Z0="" F S Z0=$O(RCERR(Z,Z0)) Q:Z0="" S CT=CT+1,RCXM(CT)=RCERR(Z,Z0)
S XMBODY="RCXM"
D
. N DUZ S DUZ=.5,DUZ(0)="@"
. D SENDMSG^XMXAPI(.5,$E(RCSUBJ,1,65),XMBODY,.XMTO,,.XMZ)
Q
;
DTXT(RCTDA,RCXM,RCNT) ; Add display text to array RCXM(CT)
; RCTDA = ien of entry in file 344.5
; Send RCNT and RCXM by reference for return values
N RCDIQ
D GETS^DIQ(344.5,RCTDA_",",1,"EN","RCDIQ")
D TXTDE^RCDPEX(RCTDA,.RCDIQ,1,.RCXM,.RCNT)
Q
;
BILLREF(RC3444,RC34441) ; Returns the bill # for the EOB in file 344.4, entry
; number RC3444 and subfile entry RC34441
N RCARR
D DIQ34441^RCDPEDS(RC3444,RC34441,99,"RCARR")
Q $G(RCARR(344.41,RC34441,99,"E"))
;
GETBILL(DA) ; Called from computed field to find bill reference
; Assumes DA(1)= ien of file 344.4, DA = ien of file 344.41
N Z,VAL
S Z=$G(^RCY(344.4,DA(1),1,DA,0))
I $P(Z,U,2) S VAL=$$BN1^PRCAFN(+$G(^IBM(361.1,+$P(Z,U,2),0))) ; IA 4051
I $G(VAL)="" S VAL=$P(Z,U,5)
Q VAL
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPESR0 9588 printed Dec 13, 2024@01:45:22 Page 2
RCDPESR0 ;ALB/TMK/DWA - Server auto-update utilities - EDI Lockbox ; 9/30/10 6:05pm
+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 ; IA for read access to ^IBM(361.1 = 4051
+4 ;
DISP(RCMIN,RCMOUT,RCFMT,RCFULL,RCW,RC3444) ; Format the 835 return msg
+1 ; RCMIN = the name of the array that contains the raw message data
+2 ; The data is contained at the next level and the subscript is
+3 ; numeric and greater than 0 or the data can be at the
+4 ; 0-node subsequent to the final subscript.
+5 ; If the message array is a global ^TMP($J,"MSG",n), RCMIN
+6 ; will equal "^TMP($J,""MSG"")" and the message text will be
+7 ; in ^TMP($J,"MSG",1), ^TMP($J,"MSG",2), etc. OR
+8 ; the message text can be defined at TMP($J,"MSG",1,0) ^...,2,0)
+9 ; etc.
+10 ; RCMOUT = the name of the array that should be returned. This array
+11 ; will follow the same convention as the input array. The
+12 ; array will be returned with a numeric final subscript. If
+13 ; RCMOUT is passed as "^TMP($J,""MSG1"")", then the display
+14 ; lines will be returned in ^TMP($J,"MSG1",1),
+15 ; ^TMP($J,"MSG1",2), etc. Note the array RCMOUT is killed
+16 ; on entry to this call
+17 ; RCFMT = 0 or null if call should return raw data, 1 to execute the
+18 ; transforms attached to the fields
+19 ; RCFULL = the name of an array if the data should be returned in
+20 ; this array, formatted into lines for display. If not sent,
+21 ; only the display data by element is returned in RCMOUT. If
+22 ; RCFULL is sent, the array is killed before populating it
+23 ; RCW = max # of characters per line to return in array RCFULL
+24 ; RC3444 = flag that indicates only return bill data, not header data
+25 ;
+26 NEW Z,Z0,Z1,RC,RCCT,RCREF,RCDATA,RCQ,R
+27 SET RCCT=0
SET RCREF=""
KILL @RCMOUT
+28 SET Z=0
FOR
SET Z=$ORDER(@RCMIN@(Z))
if 'Z
QUIT
SET Z0=$SELECT($GET(@RCMIN@(Z))'="":@RCMIN@(Z),1:$GET(@RCMIN@(Z,0)))
IF Z0'=""
SET RCQ=0
Begin DoDot:1
+29 IF '$GET(RCV5)
IF +$PIECE(Z0,U)=835
IF +$PIECE(Z0,U,16)>0
SET RCV5=1
+30 FOR Z1=1:1:$LENGTH(Z0,U)
IF $PIECE(Z0,U,Z1)'=""
Begin DoDot:2
+31 SET RCDATA=$PIECE(Z0,U,Z1)
+32 IF Z1=1
Begin DoDot:3
+33 SET RC=""
+34 IF RCDATA'=""
IF RCDATA?.N.A
IF $GET(RCV5)
Begin DoDot:4
+35 SET RCREF=$SELECT($EXTRACT(RCDATA,1,3)'="835":$EXTRACT(RCDATA,1,8),1:"835")
SET R=RCREF_"^RCDPES10"
SET RC=$PIECE($TEXT(@R),";;",2)
End DoDot:4
+36 IF RCDATA'=""
IF RCDATA?.N.A
IF '$GET(RCV5)
Begin DoDot:4
+37 SET RCREF=$SELECT($EXTRACT(RCDATA,1,3)'="835":$EXTRACT(RCDATA,1,8),1:"835")
SET R=RCREF_"^RCDPESR9"
SET RC=$PIECE($TEXT(@R),";;",2)
End DoDot:4
+38 IF RC=""
SET RCCT=RCCT+1
SET @RCMOUT@(RCCT)="<<<INVALID LINE TYPE - RAW DATA IS:"
SET RCCT=RCCT+1
SET @RCMOUT@(RCCT)=Z0
SET RCDATA=""
End DoDot:3
if RCQ
QUIT
+39 if RCDATA=""!(RCREF="")!$SELECT(RCREF="835"
QUIT
+40 SET RC=""
+41 IF RCREF?.A.N
IF $GET(RCV5)
Begin DoDot:3
+42 SET R=RCREF_"+"_Z1_"^RCDPES10"
SET RC=$PIECE($TEXT(@R),";;",2)
End DoDot:3
+43 IF RCREF?.A.N
IF '$GET(RCV5)
Begin DoDot:3
+44 SET R=RCREF_"+"_Z1_"^RCDPESR9"
SET RC=$PIECE($TEXT(@R),";;",2)
End DoDot:3
+45 IF RC=""!($PIECE(RC,U)'=RCREF)
if $SELECT(RCDATA'=""
SET RCCT=RCCT+1
SET @RCMOUT@(RCCT)="NO DATA DEFINITION PC "_Z1_": "_RCDATA
QUIT
+46 IF RC'=""
Begin DoDot:3
+47 NEW X,X1,Y
+48 SET X1=$PIECE(RC,U,4,99)
+49 ; Output transform
IF $GET(RCFMT)
IF X1'=""
SET X=RCDATA
XECUTE X1
SET RCDATA=Y
+50 ; Don't output if null data
if RCDATA=""&($PIECE(RC,U,2))
QUIT
+51 SET RC=$PIECE(RC,U,3)
+52 SET RCCT=RCCT+1
SET @RCMOUT@(RCCT)=$SELECT(Z1=1:"<<<",1:"")_RC_": "_RCDATA_$SELECT(Z1=1:">>>",1:"")
End DoDot:3
End DoDot:2
if RCQ
QUIT
End DoDot:1
+53 IF $GET(RCFULL)'=""
DO FMTDSP(RCMOUT,RCFULL,$GET(RCW),$GET(RC3444))
+54 QUIT
+55 ;
FMTDSP(RCMUN,RCMFO,RCW,RCNOH05) ; Format the display data in array named in
+1 ; RCMUN into lines up to RCW characters wide RCMUN must be set up the
+2 ; same as the output of the DISP call above
+3 ; Returns array named in RCMFO with the last subscript being the line #
+4 ; Note @RCMFO is killed on entry to this call
+5 ; Default is 80 if RCW=0 or null
+6 ; RCNOH05 = flag that if =1, suppresses the '05' header
+7 ;
+8 NEW Z,RCLINE,RCCT,RCCT1,RCMID,RCD,RCSTART,RCLINE,RCDASH
+9 KILL @RCMFO
+10 if '$GET(RCW)
SET RCW=80
+11 SET RCDASH=" "_$TRANSLATE($JUSTIFY("",RCW-2)," ","-")
+12 SET (RCCT,RCCT1)=0
SET RCLINE=""
SET RCMID=RCW\2-1
+13 SET Z=0
FOR
SET Z=$ORDER(@RCMUN@(Z))
if 'Z
QUIT
SET RCD=$GET(@RCMUN@(Z))
Begin DoDot:1
+14 ; New line needed ... record start
IF $EXTRACT(RCD,1,3)="<<<"
Begin DoDot:2
+15 IF $LENGTH(RCLINE)>0
SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=RCLINE
SET RCLINE=""
+16 IF $LENGTH(RCLINE)=0
Begin DoDot:3
+17 IF Z>1
SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=" "
+18 IF RCD["<<<Line Type: 05 "
IF '$GET(RCNOH05)
SET RCCT1=RCCT1+1
SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=RCDASH
SET RCCT=RCCT+1
SET @RCMFO@(RCCT)="****** ERA DETAIL START ******"
SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=RCDASH
+19 IF $LENGTH(RCD)>RCW
Begin DoDot:4
+20 SET RCSTART=1
+21 FOR
SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=$EXTRACT(RCD,RCSTART,RCSTART+RCW-1)
SET RCSTART=RCSTART+RCW
if RCSTART>$LENGTH(RCD)
QUIT
End DoDot:4
QUIT
+22 SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=RCD
End DoDot:3
End DoDot:2
QUIT
+23 ;
+24 ; Split line if greater than width given
IF $LENGTH(RCD)>RCW
Begin DoDot:2
+25 IF $LENGTH(RCLINE)
SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=RCLINE
+26 SET RCSTART=1
+27 FOR
SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=$EXTRACT(RCD,RCSTART,RCSTART+RCW-1)
SET RCSTART=RCSTART+RCW
if RCSTART>$LENGTH(RCD)
QUIT
+28 SET RCLINE=""
End DoDot:2
QUIT
+29 ; Format left side of line
IF $LENGTH(RCLINE)=0
Begin DoDot:2
+30 SET RCLINE=RCD
+31 ;
+32 IF $LENGTH(RCLINE)>RCMID
SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=RCLINE
SET RCLINE=""
End DoDot:2
QUIT
+33 ;
+34 ; data too long for right side of line
IF (RCMID+$LENGTH(RCD)+1)>RCW
Begin DoDot:2
+35 SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=RCLINE
SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=RCD
SET RCLINE=""
End DoDot:2
QUIT
+36 SET RCLINE=$EXTRACT(RCLINE_$JUSTIFY("",RCMID),1,RCMID)_" "_RCD
SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=RCLINE
SET RCLINE=""
End DoDot:1
+37 IF $LENGTH(RCLINE)
SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=RCLINE
+38 QUIT
+39 ;
BULLERA(RC,RCTDA,RCXMG,RCSUBJ,RCERR,RCTYP) ; Send a bulletin for entries in 344.5
+1 ; RC = flags for data to include (one or more can can be used)
+2 ; 'D': display text 'R': raw data 'F': formatted data from raw
+3 ; data in file 344.5
+4 ; RCTDA = ien of the entry in file 344.5
+5 ; RCXMG = mail msg # for the ERA
+6 ; RCSUBJ = subject of the bulletin
+7 ; RCERR = error text in array or name of error global
+8 ; RCTYP = if 0:ERA 1:EEOB
+9 ;
+10 NEW XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,XMZ,XMERR,Z,Z0,CT,RCXM,RCVAR
+11 KILL ^TMP("RCXM_344.5",$JOB)
+12 SET RCERR=$GET(RCERR)
+13 SET RCVAR=$SELECT($EXTRACT(RCERR,1,5)="^TMP(":RCERR,1:"RCERR")
+14 SET XMTO("I:G.RCDPE PAYMENTS EXCEPTIONS")=""
SET CT=0
SET RCTYP=$SELECT('$GET(RCTYP):"ERA",1:"EEOB")
+15 SET CT=CT+1
SET ^TMP("RCXM_344.5",$JOB,CT)="The following electronic "_RCTYP_" was received at your site."
SET CT=CT+1
SET ^TMP("RCXM_344.5",$JOB,CT)="It was received on: "_$$FMTE^XLFDT($$NOW^XLFDT(),2)_" in mail msg # "_RCXMG_"."
+16 SET CT=CT+1
SET ^TMP("RCXM_344.5",$JOB,CT)="This message is sent to alert you to conditions regarding this "_RCTYP_"."
SET CT=CT+1
SET ^TMP("RCXM_344.5",$JOB,CT)=" "
+17 IF RC["D"
DO DTXT(RCTDA,.RCXM,.CT)
MERGE ^TMP("RCXM_344.5",$JOB)=RCXM
KILL RCXM
+18 SET Z=0
FOR
SET Z=$ORDER(@RCVAR@(Z))
if 'Z
QUIT
IF $DATA(@RCVAR@(Z,"*"))
SET CT=CT+1
SET ^TMP("RCXM_344.5",$JOB,CT)=@RCVAR@(Z,"*")
+19 IF $GET(RCERR)'=""
IF RCVAR="RCERR"
SET CT=CT+1
SET ^TMP("RCXM_344.5",$JOB,CT)=RCERR
SET CT=CT+1
SET ^TMP("RCXM_344.5",$JOB,CT)=" "
+20 IF $ORDER(@RCVAR@(""))'=""
Begin DoDot:1
+21 SET Z=""
FOR
SET Z=$ORDER(@RCVAR@(Z))
if Z=""
QUIT
Begin DoDot:2
+22 IF $GET(@RCVAR@(Z))'=""
SET CT=CT+1
SET ^TMP("RCXM_344.5",$JOB,CT)=@RCVAR@(Z)
+23 IF $ORDER(@RCVAR@(Z,0))
SET Z0=""
FOR
SET Z0=$ORDER(@RCVAR@(Z,Z0))
if Z0=""
QUIT
IF Z0'="*"
SET CT=CT+1
SET ^TMP("RCXM_344.5",$JOB,CT)=@RCVAR@(Z,Z0)
End DoDot:2
End DoDot:1
+24 IF RC["F"
Begin DoDot:1
+25 NEW RCCT1
+26 SET RCCT1=0
+27 KILL ^TMP($JOB,"PRCAZ_RAW"),^TMP($JOB,"PRCAZ_FMT1"),^TMP($JOB,"PRCAZ_FMT")
+28 DO DISP("^RCY(344.5,"_RCTDA_",2)","^TMP($J,""PRCAZ_FMT1"")",1,"^TMP($J,""PRCAZ_FMT"")",75)
+29 SET CT=CT+1
SET ^TMP("RCXM_344.5",$JOB,CT)="FORMATTED DATA: "
+30 SET Z=0
FOR
SET Z=$ORDER(^TMP($JOB,"PRCAZ_FMT",Z))
if 'Z
QUIT
SET CT=CT+1
SET ^TMP("RCXM_344.5",$JOB,CT)=^TMP($JOB,"PRCAZ_FMT",Z)
+31 if RC["R"
SET CT=CT+1
SET ^TMP("RCXM_344.5",$JOB,CT)=" "
End DoDot:1
+32 IF RC["R"
Begin DoDot:1
+33 SET CT=CT+1
SET ^TMP("RCXM_344.5",$JOB,CT)="RAW DATA: "
+34 SET Z=0
FOR
SET Z=$ORDER(^RCY(344.5,RCTDA,2,Z))
if 'Z
QUIT
SET CT=CT+1
SET ^TMP("RCXM_344.5",$JOB,CT)=$GET(^RCY(344.5,RCTDA,2,Z,0))
End DoDot:1
+35 SET XMBODY="^TMP(""RCXM_344.5"",$J)"
+36 Begin DoDot:1
+37 NEW DUZ
SET DUZ=.5
SET DUZ(0)="@"
+38 DO SENDMSG^XMXAPI(.5,$EXTRACT(RCSUBJ,1,65),XMBODY,.XMTO,,.XMZ)
End DoDot:1
+39 KILL ^TMP($JOB,"PRCAZ_RAW"),^TMP($JOB,"PRCAZ_FMT1"),^TMP($JOB,"PRCAZ_FMT"),^TMP("RCXM_344.5",$JOB)
+40 QUIT
+41 ;
BULLEFT(RCTDA,RCXMG,RCSUBJ,RCERR) ; Send a bulletin for 'bad' EFT entries
+1 ; RCTDA = ien of the entry in file 344.3
+2 ; RCXMG = mail msg # for the EFT
+3 ; RCSUBJ = subject of the bulletin
+4 ; RCERR = error text in array
+5 NEW XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,RCXM,XMZ,XMERR,Z,Z0,CT
+6 SET XMTO("I:G.RCDPE PAYMENTS EXCEPTIONS")=""
SET CT=0
+7 SET CT=CT+1
SET RCXM(CT)="The following electronic EFT deposit was received at your site."
SET CT=CT+1
SET RCXM(CT)="It was received on: "_$$FMTE^XLFDT($$NOW^XLFDT(),2)_" in mail msg # "_RCXMG_"."
+8 SET CT=CT+1
SET RCXM(CT)="This message is sent to alert you to conditions regarding this EFT."
SET CT=CT+1
SET RCXM(CT)=" "
+9 IF $GET(RCERR)'=""
SET CT=CT+1
SET RCXM(CT)=RCERR
SET CT=CT+1
SET RCXM(CT)=" "
+10 IF $ORDER(RCERR(""))'=""
Begin DoDot:1
+11 SET Z=""
FOR
SET Z=$ORDER(RCERR(Z))
if Z=""
QUIT
Begin DoDot:2
+12 IF $GET(RCERR(Z))'=""
SET CT=CT+1
SET RCXM(CT)=RCERR(Z)
+13 IF $ORDER(RCERR(Z,0))
SET Z0=""
FOR
SET Z0=$ORDER(RCERR(Z,Z0))
if Z0=""
QUIT
SET CT=CT+1
SET RCXM(CT)=RCERR(Z,Z0)
End DoDot:2
End DoDot:1
+14 SET XMBODY="RCXM"
+15 Begin DoDot:1
+16 NEW DUZ
SET DUZ=.5
SET DUZ(0)="@"
+17 DO SENDMSG^XMXAPI(.5,$EXTRACT(RCSUBJ,1,65),XMBODY,.XMTO,,.XMZ)
End DoDot:1
+18 QUIT
+19 ;
DTXT(RCTDA,RCXM,RCNT) ; Add display text to array RCXM(CT)
+1 ; RCTDA = ien of entry in file 344.5
+2 ; Send RCNT and RCXM by reference for return values
+3 NEW RCDIQ
+4 DO GETS^DIQ(344.5,RCTDA_",",1,"EN","RCDIQ")
+5 DO TXTDE^RCDPEX(RCTDA,.RCDIQ,1,.RCXM,.RCNT)
+6 QUIT
+7 ;
BILLREF(RC3444,RC34441) ; Returns the bill # for the EOB in file 344.4, entry
+1 ; number RC3444 and subfile entry RC34441
+2 NEW RCARR
+3 DO DIQ34441^RCDPEDS(RC3444,RC34441,99,"RCARR")
+4 QUIT $GET(RCARR(344.41,RC34441,99,"E"))
+5 ;
GETBILL(DA) ; Called from computed field to find bill reference
+1 ; Assumes DA(1)= ien of file 344.4, DA = ien of file 344.41
+2 NEW Z,VAL
+3 SET Z=$GET(^RCY(344.4,DA(1),1,DA,0))
+4 ; IA 4051
IF $PIECE(Z,U,2)
SET VAL=$$BN1^PRCAFN(+$GET(^IBM(361.1,+$PIECE(Z,U,2),0)))
+5 IF $GET(VAL)=""
SET VAL=$PIECE(Z,U,5)
+6 QUIT VAL
+7 ;
