RCDPEWLC ;ALB/TMK - EEOB WORKLIST BATCH PROCESSING ;18-FEB-2004
;;4.5;Accounts Receivable;**208**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
SUMRPT(RCERA) ; Produce batch summary report from the ERA worklist for
; ERA worklist entry RCERA
N POP,ZTDESC,ZTRTN,ZTQUEUED,%ZIS
D FULL^VALM1
I '$O(^RCY(344.49,RCERA,3,0)) D NOTSET Q
; Ask device
S %ZIS="QM" D ^%ZIS G:POP SUMRPTQ
I $D(IO("Q")) D G SUMRPTQ
. S ZTRTN="RPTOUT^RCDPEWLC("_RCERA_")",ZTDESC="AR - EDI LOCKBOX BATCH SUMMARY REPORT"
. D ^%ZTLOAD
. W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
. K ZTSK,IO("Q") D HOME^%ZIS
U IO
D RPTOUT(RCERA)
SUMRPTQ Q
;
RPTOUT(RCERA) ; Queued job entrypoint
N RCPG,RCSTOP,RCT,RCHAS,Q,Z,Z0
S (RCPG,RCSTOP,RCHAS)=0
S Z=0 F S Z=$O(^RCY(344.49,RCERA,3,Z)) Q:'Z!RCSTOP S Z0=$G(^(Z,0)) D
. I 'RCPG!(($Y+5)>IOSL) D HDR(.RCPG,RCERA,.RCSTOP)
. Q:RCSTOP
. S RCHAS=1,RCT=0
. S Q=0 F S Q=$O(^RCY(344.49,RCERA,1,"ABAT",+Z0,Q)) Q:'Q S RCT=RCT+1
. W !,$J(+Z0,7)_" "_$E($P(Z0,U,2)_$J("",30),1,30)_" "_$P("NO ^YES",U,$P(Z0,U,3)+1)_$J("",13)_$P($G(^VA(200,+$P(Z0,U,4),0)),U)
. W !,$J("",9)_"# RECORDS: "_RCT_" CRITERIA: "_$$EXTERNAL^DILFD(344.493,.06,"",$P(Z0,U,6))
. I $P(Z0,U,6)<3 W " FROM: "_$P(Z0,U,7)_" TO: "_$P(Z0,U,8)
. I $P(Z0,U,6)=3 W " "_$P("PARTIAL^FULL^NO",U,+Z0)_" PAYMENT"
. I $P(Z0,U,6)=4 W " "_$P("CO-PAY^NO CO-PAY",U,+Z0)
;
I 'RCHAS D:'RCPG HDR(.RCPG,RCERA,.RCSTOP) W !,"THERE ARE NO BATCHES DEFINED FOR THIS ERA"
I '$D(ZTQUEUED),'RCSTOP,RCPG D ASK()
I $D(ZTQUEUED) S ZTREQ="@"
I '$D(ZTQUEUED) D ^%ZISC
Q
;
NOTSET ;
N DIR,X,Y
S DIR(0)="EA",DIR("A",1)="THERE ARE NO BATCHES ASSIGNED TO THIS ERA",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR
S VALMBCK="R"
Q
;
HDR(RCPG,RCSCR,RCSTOP) ;Print report hdr
; RCPG = last page #
; RCSCR = the entry # in file 344.49
; RCSTOP = returned as 1 if abort is detected
N RCZ0
I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ W:+$G(RCPG) !,"***TASK STOPPED BY USER***" Q
S RCZ0=$G(^RCY(344.4,RCSCR,0))
I RCPG&($E(IOST,1,2)="C-") D ASK(.RCSTOP) Q:RCSTOP
W !,@IOF,*13
S RCPG=$G(RCPG)+1
W !,"EDI LBOX WORKLIST - BATCH SUMMARY REPORT",?59,$$FMTE^XLFDT(DT,2),?70,"Page: ",RCPG,!
W !,"ERA #: ",$E(RCSCR_$J("",29),1,29)_" TRACE #: "_$P(RCZ0,U,2)
W !,"PAYER: "_$E($P(RCZ0,U,6)_$J("",30),1,30)_" ERA DT: "_$$FMTE^XLFDT($P(RCZ0,U,4),"2D")
W !!,"BATCH # NAME"_$J("",28)_"READY TO POST? STATUS SET BY"
W !,$TR($J("",IOM)," ","=")
Q
;
ASK(RCSTOP) ; Ask to continue
; If passed by reference ,RCSTOP is returned as 1 if print is aborted
I $E(IOST,1,2)'["C-" Q
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="E" W ! D ^DIR
I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEWLC 2814 printed Sep 23, 2025@19:21:57 Page 2
RCDPEWLC ;ALB/TMK - EEOB WORKLIST BATCH PROCESSING ;18-FEB-2004
+1 ;;4.5;Accounts Receivable;**208**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
SUMRPT(RCERA) ; Produce batch summary report from the ERA worklist for
+1 ; ERA worklist entry RCERA
+2 NEW POP,ZTDESC,ZTRTN,ZTQUEUED,%ZIS
+3 DO FULL^VALM1
+4 IF '$ORDER(^RCY(344.49,RCERA,3,0))
DO NOTSET
QUIT
+5 ; Ask device
+6 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO SUMRPTQ
+7 IF $DATA(IO("Q"))
Begin DoDot:1
+8 SET ZTRTN="RPTOUT^RCDPEWLC("_RCERA_")"
SET ZTDESC="AR - EDI LOCKBOX BATCH SUMMARY REPORT"
+9 DO ^%ZTLOAD
+10 WRITE !!,$SELECT($DATA(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
+11 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
GOTO SUMRPTQ
+12 USE IO
+13 DO RPTOUT(RCERA)
SUMRPTQ QUIT
+1 ;
RPTOUT(RCERA) ; Queued job entrypoint
+1 NEW RCPG,RCSTOP,RCT,RCHAS,Q,Z,Z0
+2 SET (RCPG,RCSTOP,RCHAS)=0
+3 SET Z=0
FOR
SET Z=$ORDER(^RCY(344.49,RCERA,3,Z))
if 'Z!RCSTOP
QUIT
SET Z0=$GET(^(Z,0))
Begin DoDot:1
+4 IF 'RCPG!(($Y+5)>IOSL)
DO HDR(.RCPG,RCERA,.RCSTOP)
+5 if RCSTOP
QUIT
+6 SET RCHAS=1
SET RCT=0
+7 SET Q=0
FOR
SET Q=$ORDER(^RCY(344.49,RCERA,1,"ABAT",+Z0,Q))
if 'Q
QUIT
SET RCT=RCT+1
+8 WRITE !,$JUSTIFY(+Z0,7)_" "_$EXTRACT($PIECE(Z0,U,2)_$JUSTIFY("",30),1,30)_" "_$PIECE("NO ^YES",U,$PIECE(Z0,U,3)+1)_$JUSTIFY("",13)_$PIECE($GET(^VA(200,+$PIECE(Z0,U,4),0)),U)
+9 WRITE !,$JUSTIFY("",9)_"# RECORDS: "_RCT_" CRITERIA: "_$$EXTERNAL^DILFD(344.493,.06,"",$PIECE(Z0,U,6))
+10 IF $PIECE(Z0,U,6)<3
WRITE " FROM: "_$PIECE(Z0,U,7)_" TO: "_$PIECE(Z0,U,8)
+11 IF $PIECE(Z0,U,6)=3
WRITE " "_$PIECE("PARTIAL^FULL^NO",U,+Z0)_" PAYMENT"
+12 IF $PIECE(Z0,U,6)=4
WRITE " "_$PIECE("CO-PAY^NO CO-PAY",U,+Z0)
End DoDot:1
+13 ;
+14 IF 'RCHAS
if 'RCPG
DO HDR(.RCPG,RCERA,.RCSTOP)
WRITE !,"THERE ARE NO BATCHES DEFINED FOR THIS ERA"
+15 IF '$DATA(ZTQUEUED)
IF 'RCSTOP
IF RCPG
DO ASK()
+16 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+17 IF '$DATA(ZTQUEUED)
DO ^%ZISC
+18 QUIT
+19 ;
NOTSET ;
+1 NEW DIR,X,Y
+2 SET DIR(0)="EA"
SET DIR("A",1)="THERE ARE NO BATCHES ASSIGNED TO THIS ERA"
SET DIR("A")="PRESS RETURN TO CONTINUE "
WRITE !
DO ^DIR
KILL DIR
+3 SET VALMBCK="R"
+4 QUIT
+5 ;
HDR(RCPG,RCSCR,RCSTOP) ;Print report hdr
+1 ; RCPG = last page #
+2 ; RCSCR = the entry # in file 344.49
+3 ; RCSTOP = returned as 1 if abort is detected
+4 NEW RCZ0
+5 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET (RCSTOP,ZTSTOP)=1
KILL ZTREQ
if +$GET(RCPG)
WRITE !,"***TASK STOPPED BY USER***"
QUIT
+6 SET RCZ0=$GET(^RCY(344.4,RCSCR,0))
+7 IF RCPG&($EXTRACT(IOST,1,2)="C-")
DO ASK(.RCSTOP)
if RCSTOP
QUIT
+8 WRITE !,@IOF,*13
+9 SET RCPG=$GET(RCPG)+1
+10 WRITE !,"EDI LBOX WORKLIST - BATCH SUMMARY REPORT",?59,$$FMTE^XLFDT(DT,2),?70,"Page: ",RCPG,!
+11 WRITE !,"ERA #: ",$EXTRACT(RCSCR_$JUSTIFY("",29),1,29)_" TRACE #: "_$PIECE(RCZ0,U,2)
+12 WRITE !,"PAYER: "_$EXTRACT($PIECE(RCZ0,U,6)_$JUSTIFY("",30),1,30)_" ERA DT: "_$$FMTE^XLFDT($PIECE(RCZ0,U,4),"2D")
+13 WRITE !!,"BATCH # NAME"_$JUSTIFY("",28)_"READY TO POST? STATUS SET BY"
+14 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","=")
+15 QUIT
+16 ;
ASK(RCSTOP) ; Ask to continue
+1 ; If passed by reference ,RCSTOP is returned as 1 if print is aborted
+2 IF $EXTRACT(IOST,1,2)'["C-"
QUIT
+3 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+4 SET DIR(0)="E"
WRITE !
DO ^DIR
+5 IF ($DATA(DIRUT))!($DATA(DUOUT))
SET RCSTOP=1
QUIT
+6 QUIT
+7 ;
