RCDPEAR4 ;ALB/TMK/PJH - ERA Unmatched Aging Report (file #344.4) ;Dec 20, 2014@18:41:35
;;4.5;Accounts Receivable;**409**;Mar 20, 1995;Build 17
;Per VA Directive 6402, this routine should not be modified.
Q
;
; PRCA*4.5*409 New routine - RCEPEAR1 split due to size limitations
;
RPTOUT2 ;EP from RCDPEAR1
; Input: LNECNT - # of lines on current page
; RCDISPTY - Display type (Excel)
; RCFLIEN - IEN in file #344.4
; RCHDR - Header array
; RCLNCNT - Global Line counter
; RCLSTMGR - List manager flag
; RCTMPND - Name of the subscript for ^TMP to use to return all lines
; (for bulletin). If undefined or null, output is printed
; RCSF0 - Zero node of sub-file entry (^RCY(344.4,RCFLIEN,1,RCSFIEN,0)
; RCSTOP - Flag used to stop output of report
;
;PRCA*4.5*409 Begin - Lines restored ePayments Build 17 version of routine
N Z
I "23"[$$ADJ^RCDPEU(RCFLIEN) D
. D SL^RCDPEARL($J("",9)_"** CLAIM LEVEL ADJUSTMENTS EXIST FOR THIS ERA ***",.RCLNCNT,RCTMPND)
. S LNECNT=LNECNT+1
I $O(^RCY(344.4,RCFLIEN,2,0)) D ; ERA level adjustments exist
. N Q
. D DISPADJ^RCDPESR8(RCFLIEN,"^TMP("_$J_",""RCERA_ADJ"")")
. I $O(^TMP($J,"RCERA_ADJ",0)) D
. . D SL^RCDPEARL($J("",9)_"** GENERAL ADJUSTMENT DATA EXIST FOR THIS ERA **",.RCLNCNT,RCTMPND)
. . S LNECNT=LNECNT+1
. S Q=0
. F D Q:'Q
. . S Q=$O(^TMP($J,"RCERA_ADJ",Q))
. . Q:'Q
. . I 'RCLSTMGR,LNECNT>(IOSL-2) D HDRLST^RCDPEARL(.RCSTOP,.RCHDR) Q:RCSTOP
. . D SL^RCDPEARL($J("",9)_$G(^TMP($J,"RCERA_ADJ",Q)),.RCLNCNT,RCTMPND)
. . S LNECNT=LNECNT+1
;
N D,RCSFIEN
S RCSFIEN=0 ; RCSFIEN - sub-file ien, RCSF0 - zero node of sub-file entry
F S RCSFIEN=$O(^RCY(344.4,RCFLIEN,1,RCSFIEN)) Q:'RCSFIEN S RCSF0=$G(^(RCSFIEN,0)) D Q:RCSTOP
. N RCDATA,RCOUT ; set by RCDPESR0, RCDATA - message data, RCOUT - formatted message display
. I 'RCLSTMGR,RCLNCNT>(IOSL-RCHDR(0)) D HDRLST^RCDPEARL(.RCSTOP,.RCHDR) Q:RCSTOP
. S D=$J("",7)_" EEOB Seq #: "_$P(RCSF0,U)_$S($D(^RCY(344.4,RCFLIEN,1,"ATB",1,RCSFIEN)):" (REVERSAL)",1:"")_" EEOB "
. S D=D_$S('$P(RCSF0,U,2):"not on file",1:"on file for "_$P($G(^DGCR(399,+$G(^IBM(361.1,+$P(RCSF0,U,2),0)),0)),U))_" "_$J(+$P(RCSF0,U,3),"",2)
. D SL^RCDPEARL(D,.RCLNCNT,RCTMPND)
. S LNECNT=LNECNT+1
. Q:$P(RCSF0,U,2)
. D DISP^RCDPESR0("^RCY(344.4,"_RCFLIEN_",1,"_RCSFIEN_",1)","RCDATA",1,"RCOUT",68,1)
. I '$O(RCOUT(0)) D SL^RCDPEARL($J("",9)_" NO DETAIL FOUND",.RCLNCNT,RCTMPND) Q
. S Z=0 F S Z=$O(RCOUT(Z)) Q:'Z D Q:RCSTOP
. . I 'RCDISPTY,'RCLSTMGR,LNECNT>(IOSL-2) D HDRLST^RCDPEARL(.RCSTOP,.RCHDR) Q:RCSTOP
. . D SL^RCDPEARL($J("",9)_"*"_RCOUT(Z),.RCLNCNT,RCTMPND)
. . S LNECNT=LNECNT+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEAR4 2827 printed Apr 09, 2024@20:52:52 Page 2
RCDPEAR4 ;ALB/TMK/PJH - ERA Unmatched Aging Report (file #344.4) ;Dec 20, 2014@18:41:35
+1 ;;4.5;Accounts Receivable;**409**;Mar 20, 1995;Build 17
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ; PRCA*4.5*409 New routine - RCEPEAR1 split due to size limitations
+6 ;
RPTOUT2 ;EP from RCDPEAR1
+1 ; Input: LNECNT - # of lines on current page
+2 ; RCDISPTY - Display type (Excel)
+3 ; RCFLIEN - IEN in file #344.4
+4 ; RCHDR - Header array
+5 ; RCLNCNT - Global Line counter
+6 ; RCLSTMGR - List manager flag
+7 ; RCTMPND - Name of the subscript for ^TMP to use to return all lines
+8 ; (for bulletin). If undefined or null, output is printed
+9 ; RCSF0 - Zero node of sub-file entry (^RCY(344.4,RCFLIEN,1,RCSFIEN,0)
+10 ; RCSTOP - Flag used to stop output of report
+11 ;
+12 ;PRCA*4.5*409 Begin - Lines restored ePayments Build 17 version of routine
+13 NEW Z
+14 IF "23"[$$ADJ^RCDPEU(RCFLIEN)
Begin DoDot:1
+15 DO SL^RCDPEARL($JUSTIFY("",9)_"** CLAIM LEVEL ADJUSTMENTS EXIST FOR THIS ERA ***",.RCLNCNT,RCTMPND)
+16 SET LNECNT=LNECNT+1
End DoDot:1
+17 ; ERA level adjustments exist
IF $ORDER(^RCY(344.4,RCFLIEN,2,0))
Begin DoDot:1
+18 NEW Q
+19 DO DISPADJ^RCDPESR8(RCFLIEN,"^TMP("_$JOB_",""RCERA_ADJ"")")
+20 IF $ORDER(^TMP($JOB,"RCERA_ADJ",0))
Begin DoDot:2
+21 DO SL^RCDPEARL($JUSTIFY("",9)_"** GENERAL ADJUSTMENT DATA EXIST FOR THIS ERA **",.RCLNCNT,RCTMPND)
+22 SET LNECNT=LNECNT+1
End DoDot:2
+23 SET Q=0
+24 FOR
Begin DoDot:2
+25 SET Q=$ORDER(^TMP($JOB,"RCERA_ADJ",Q))
+26 if 'Q
QUIT
+27 IF 'RCLSTMGR
IF LNECNT>(IOSL-2)
DO HDRLST^RCDPEARL(.RCSTOP,.RCHDR)
if RCSTOP
QUIT
+28 DO SL^RCDPEARL($JUSTIFY("",9)_$GET(^TMP($JOB,"RCERA_ADJ",Q)),.RCLNCNT,RCTMPND)
+29 SET LNECNT=LNECNT+1
End DoDot:2
if 'Q
QUIT
End DoDot:1
+30 ;
+31 NEW D,RCSFIEN
+32 ; RCSFIEN - sub-file ien, RCSF0 - zero node of sub-file entry
SET RCSFIEN=0
+33 FOR
SET RCSFIEN=$ORDER(^RCY(344.4,RCFLIEN,1,RCSFIEN))
if 'RCSFIEN
QUIT
SET RCSF0=$GET(^(RCSFIEN,0))
Begin DoDot:1
+34 ; set by RCDPESR0, RCDATA - message data, RCOUT - formatted message display
NEW RCDATA,RCOUT
+35 IF 'RCLSTMGR
IF RCLNCNT>(IOSL-RCHDR(0))
DO HDRLST^RCDPEARL(.RCSTOP,.RCHDR)
if RCSTOP
QUIT
+36 SET D=$JUSTIFY("",7)_" EEOB Seq #: "_$PIECE(RCSF0,U)_$SELECT($DATA(^RCY(344.4,RCFLIEN,1,"ATB",1,RCSFIEN)):" (REVERSAL)",1:"")_" EEOB "
+37 SET D=D_$SELECT('$PIECE(RCSF0,U,2):"not on file",1:"on file for "_$PIECE($GET(^DGCR(399,+$GET(^IBM(361.1,+$PIECE(RCSF0,U,2),0)),0)),U))_" "_$JUSTIFY(+$PIECE(RCSF0,U,3),"",2)
+38 DO SL^RCDPEARL(D,.RCLNCNT,RCTMPND)
+39 SET LNECNT=LNECNT+1
+40 if $PIECE(RCSF0,U,2)
QUIT
+41 DO DISP^RCDPESR0("^RCY(344.4,"_RCFLIEN_",1,"_RCSFIEN_",1)","RCDATA",1,"RCOUT",68,1)
+42 IF '$ORDER(RCOUT(0))
DO SL^RCDPEARL($JUSTIFY("",9)_" NO DETAIL FOUND",.RCLNCNT,RCTMPND)
QUIT
+43 SET Z=0
FOR
SET Z=$ORDER(RCOUT(Z))
if 'Z
QUIT
Begin DoDot:2
+44 IF 'RCDISPTY
IF 'RCLSTMGR
IF LNECNT>(IOSL-2)
DO HDRLST^RCDPEARL(.RCSTOP,.RCHDR)
if RCSTOP
QUIT
+45 DO SL^RCDPEARL($JUSTIFY("",9)_"*"_RCOUT(Z),.RCLNCNT,RCTMPND)
+46 SET LNECNT=LNECNT+1
End DoDot:2
if RCSTOP
QUIT
End DoDot:1
if RCSTOP
QUIT
+47 QUIT
