- 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 Mar 13, 2025@20:49:06 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
