RCDPESR8 ;ALB/TMK - EFT return file field captions ;09-SEP-2003
;;4.5;Accounts Receivable;**173**;Mar 20, 1995
;
; Note: if the 835 EFT flat file changes, make the corresponding changes
; in this routine.
DISP(RCMIN,RCMOUT,RCFMT,RCFULL,RCW) ; Format display for 835 EFT 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
;
N Z,Z0,Z1,R,RC,RCCT,RCREF,RCDATA,RCQ
S RCCT=0 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
. 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 RCREF=$S(RCDATA'["EFT":RCDATA,1:"EFT"),R=RCREF_"^RCDPESR8",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
.. Q:RCDATA=""
.. S R=RCREF_"+"_Z1_"^RCDPESR8",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
... S RC=$P(RC,U,3)
... Q:RC=""&(RCDATA="")
... 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))
Q
;
FMTDSP(RCMUN,RCMFO,RCW) ; 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
N Z,RCLINE,RCCT,RCCT1,RCMID,RCD,RCSTART,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: 01 " S RCCT1=RCCT1+1,RCCT=RCCT+1,@RCMFO@(RCCT)=RCDASH,RCCT=RCCT+1,@RCMFO@(RCCT)="*** EFT PAYMENT DETAIL START - PAYMENT SEQUENCE #"_RCCT1_"***",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,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
;
;
DISPADJ(RC3444,RCARRAY) ; Returns formatted lines of ERA level takeback data
; in array @RCARRAY@(n) where n=line #. Data is taken from entry
; # RC3444 in file 344.4, subfile 344.42
N RCT,Z,Z0
S RCT=0
S Z=0 F S Z=$O(^RCY(344.4,RC3444,2,Z)) Q:'Z S Z0=$G(^(Z,0)) D
. S RCT=RCT+1,@RCARRAY@(RCT)="REFERENCE #/BILL #: "_$P(Z0,U)
. S RCT=RCT+1,@RCARRAY@(RCT)=" "_$E("ADJUSTMENT CODE: "_$P(Z0,U,2)_$J("",30),1,30)_"AMOUNT: "_$J($P(Z0,U,3),0,2)
Q
;
EFT ;;HEADER DATA
;;EFT^^Return Message ID^S Y=X_" (EFT HEADER DATA)"
;;EFT^^^S Y=""
;;EFT^^File Date^S Y=$$FDT^RCDPESR9(X)
;;EFT^^File Time^S Y=$E(X,1,2)-$S($E(X,1,2)>12:12,1:0)_":"_$E(X,3,4)_$S($E(X,1,2)=24:" AM",$E(X,1,2)>11:" PM",1:" AM")
;;EFT^1^
;;EFT^^Deposit #
;;EFT^^Deposit Date^S Y=$$FDT^RCDPESR9(X)
;;EFT^^Total Deposit Amount^S Y=$$ZERO^RCDPESR9(X,1)
;
01 ;;EFT DETAIL RECORD
;;01^^Line Type^S Y=X_" (PAYMENT IDENTIFICATION)"
;;01^^Trace #
;;01^^Date Claims Paid^S Y=$$FDT^RCDPESR9(X)
;;01^^TOTAL AMOUNT PAID^S Y=$$ZERO^RCDPESR9(X,1)
;;01^^Payer Name
;;01^^Payer ID
;;01^^Provider Tax ID Sent
;;01^^Tax ID correction Flag^S Y=$S(X="E":"CHANGED BY EPHRA",X="C":"DETERMINED FROM CLAIM DATA",X="":"NO CHANGE MADE",1:X)
;;01^^ACH Trace #
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPESR8 5872 printed Apr 09, 2024@20:52:39 Page 2
RCDPESR8 ;ALB/TMK - EFT return file field captions ;09-SEP-2003
+1 ;;4.5;Accounts Receivable;**173**;Mar 20, 1995
+2 ;
+3 ; Note: if the 835 EFT flat file changes, make the corresponding changes
+4 ; in this routine.
DISP(RCMIN,RCMOUT,RCFMT,RCFULL,RCW) ; Format display for 835 EFT 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 ;
+25 NEW Z,Z0,Z1,R,RC,RCCT,RCREF,RCDATA,RCQ
+26 SET RCCT=0
KILL @RCMOUT
+27 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
+28 FOR Z1=1:1:$LENGTH(Z0,U)
IF $PIECE(Z0,U,Z1)'=""
Begin DoDot:2
+29 SET RCDATA=$PIECE(Z0,U,Z1)
+30 IF Z1=1
Begin DoDot:3
+31 SET RCREF=$SELECT(RCDATA'["EFT":RCDATA,1:"EFT")
SET R=RCREF_"^RCDPESR8"
SET RC=$PIECE($TEXT(@R),";;",2)
+32 IF RC=""
SET RCCT=RCCT+1
SET @RCMOUT@(RCCT)="<<<INVALID LINE TYPE - RAW DATA IS:"
SET RCCT=RCCT+1
SET @RCMOUT@(RCCT)=Z0
End DoDot:3
if RCQ
QUIT
+33 if RCDATA=""
QUIT
+34 SET R=RCREF_"+"_Z1_"^RCDPESR8"
SET RC=$PIECE($TEXT(@R),";;",2)
+35 IF RC=""!($PIECE(RC,U)'=RCREF)
if $SELECT(RCDATA'=""
SET RCCT=RCCT+1
SET @RCMOUT@(RCCT)="NO DATA DEFINITION PC "_Z1_": "_RCDATA
QUIT
+36 IF RC'=""
Begin DoDot:3
+37 NEW X,X1,Y
+38 SET X1=$PIECE(RC,U,4,99)
+39 ; Output transform
IF $GET(RCFMT)
IF X1'=""
SET X=RCDATA
XECUTE X1
SET RCDATA=Y
+40 SET RC=$PIECE(RC,U,3)
+41 if RC=""&(RCDATA="")
QUIT
+42 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
+43 IF $GET(RCFULL)'=""
DO FMTDSP(RCMOUT,RCFULL,$GET(RCW))
+44 QUIT
+45 ;
FMTDSP(RCMUN,RCMFO,RCW) ; Format the display data in array named in RCMUN into
+1 ; lines up to RCW characters wide RCMUN must be set up the same as the
+2 ; 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 NEW Z,RCLINE,RCCT,RCCT1,RCMID,RCD,RCSTART,RCDASH
+7 KILL @RCMFO
+8 if '$GET(RCW)
SET RCW=80
+9 SET RCDASH=" "_$TRANSLATE($JUSTIFY("",RCW-2)," ","-")
+10 SET (RCCT,RCCT1)=0
SET RCLINE=""
SET RCMID=RCW\2-1
+11 SET Z=0
FOR
SET Z=$ORDER(@RCMUN@(Z))
if 'Z
QUIT
SET RCD=$GET(@RCMUN@(Z))
Begin DoDot:1
+12 ; New line needed ... record start
IF $EXTRACT(RCD,1,3)="<<<"
Begin DoDot:2
+13 IF $LENGTH(RCLINE)>0
SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=RCLINE
SET RCLINE=""
+14 IF $LENGTH(RCLINE)=0
Begin DoDot:3
+15 IF Z>1
SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=" "
+16 IF RCD["<<<Line Type: 01 "
SET RCCT1=RCCT1+1
SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=RCDASH
SET RCCT=RCCT+1
SET @RCMFO@(RCCT)="*** EFT PAYMENT DETAIL START - PAYMENT SEQUENCE #"_RCCT1_"***"
SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=RCDASH
+17 IF $LENGTH(RCD)>RCW
Begin DoDot:4
+18 SET RCSTART=1
+19 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
+20 SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=RCD
End DoDot:3
End DoDot:2
QUIT
+21 ;
+22 ; Split line if greater than width given
IF $LENGTH(RCD)>RCW
Begin DoDot:2
+23 IF $LENGTH(RCLINE)
SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=RCLINE
+24 SET RCSTART=1
+25 FOR
SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=$EXTRACT(RCD,RCSTART,RCSTART+RCW-1)
SET RCSTART=RCSTART+RCW
if RCSTART>$LENGTH(RCD)
QUIT
+26 SET RCLINE=""
End DoDot:2
QUIT
+27 ; Format left side of line
IF $LENGTH(RCLINE)=0
Begin DoDot:2
+28 SET RCLINE=RCD
+29 ;
+30 IF $LENGTH(RCLINE)>RCMID
SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=RCLINE
SET RCLINE=""
End DoDot:2
QUIT
+31 ;
+32 ; data too long for right side of line
IF (RCMID+$LENGTH(RCD)+1)>RCW
Begin DoDot:2
+33 SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=RCLINE
SET RCLINE=""
End DoDot:2
QUIT
+34 SET RCLINE=$EXTRACT(RCLINE_$JUSTIFY("",RCMID),1,RCMID)_" "_RCD
SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=RCLINE
SET RCLINE=""
End DoDot:1
+35 IF $LENGTH(RCLINE)
SET RCCT=RCCT+1
SET @RCMFO@(RCCT)=RCLINE
+36 QUIT
+37 ;
+38 ;
DISPADJ(RC3444,RCARRAY) ; Returns formatted lines of ERA level takeback data
+1 ; in array @RCARRAY@(n) where n=line #. Data is taken from entry
+2 ; # RC3444 in file 344.4, subfile 344.42
+3 NEW RCT,Z,Z0
+4 SET RCT=0
+5 SET Z=0
FOR
SET Z=$ORDER(^RCY(344.4,RC3444,2,Z))
if 'Z
QUIT
SET Z0=$GET(^(Z,0))
Begin DoDot:1
+6 SET RCT=RCT+1
SET @RCARRAY@(RCT)="REFERENCE #/BILL #: "_$PIECE(Z0,U)
+7 SET RCT=RCT+1
SET @RCARRAY@(RCT)=" "_$EXTRACT("ADJUSTMENT CODE: "_$PIECE(Z0,U,2)_$JUSTIFY("",30),1,30)_"AMOUNT: "_$JUSTIFY($PIECE(Z0,U,3),0,2)
End DoDot:1
+8 QUIT
+9 ;
EFT ;;HEADER DATA
+1 ;;EFT^^Return Message ID^S Y=X_" (EFT HEADER DATA)"
+2 ;;EFT^^^S Y=""
+3 ;;EFT^^File Date^S Y=$$FDT^RCDPESR9(X)
+4 ;;EFT^^File Time^S Y=$E(X,1,2)-$S($E(X,1,2)>12:12,1:0)_":"_$E(X,3,4)_$S($E(X,1,2)=24:" AM",$E(X,1,2)>11:" PM",1:" AM")
+5 ;;EFT^1^
+6 ;;EFT^^Deposit #
+7 ;;EFT^^Deposit Date^S Y=$$FDT^RCDPESR9(X)
+8 ;;EFT^^Total Deposit Amount^S Y=$$ZERO^RCDPESR9(X,1)
+9 ;
01 ;;EFT DETAIL RECORD
+1 ;;01^^Line Type^S Y=X_" (PAYMENT IDENTIFICATION)"
+2 ;;01^^Trace #
+3 ;;01^^Date Claims Paid^S Y=$$FDT^RCDPESR9(X)
+4 ;;01^^TOTAL AMOUNT PAID^S Y=$$ZERO^RCDPESR9(X,1)
+5 ;;01^^Payer Name
+6 ;;01^^Payer ID
+7 ;;01^^Provider Tax ID Sent
+8 ;;01^^Tax ID correction Flag^S Y=$S(X="E":"CHANGED BY EPHRA",X="C":"DETERMINED FROM CLAIM DATA",X="":"NO CHANGE MADE",1:X)
+9 ;;01^^ACH Trace #
+10 ;
