| 1 | RCDPEWLC ;ALB/TMK - EEOB WORKLIST BATCH PROCESSING ;18-FEB-2004
|
|---|
| 2 | ;;4.5;Accounts Receivable;**208**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | SUMRPT(RCERA) ; Produce batch summary report from the ERA worklist for
|
|---|
| 6 | ; ERA worklist entry RCERA
|
|---|
| 7 | N POP,ZTDESC,ZTRTN,ZTQUEUED,%ZIS
|
|---|
| 8 | D FULL^VALM1
|
|---|
| 9 | I '$O(^RCY(344.49,RCERA,3,0)) D NOTSET Q
|
|---|
| 10 | ; Ask device
|
|---|
| 11 | S %ZIS="QM" D ^%ZIS G:POP SUMRPTQ
|
|---|
| 12 | I $D(IO("Q")) D G SUMRPTQ
|
|---|
| 13 | . S ZTRTN="RPTOUT^RCDPEWLC("_RCERA_")",ZTDESC="AR - EDI LOCKBOX BATCH SUMMARY REPORT"
|
|---|
| 14 | . D ^%ZTLOAD
|
|---|
| 15 | . W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
|
|---|
| 16 | . K ZTSK,IO("Q") D HOME^%ZIS
|
|---|
| 17 | U IO
|
|---|
| 18 | D RPTOUT(RCERA)
|
|---|
| 19 | SUMRPTQ Q
|
|---|
| 20 | ;
|
|---|
| 21 | RPTOUT(RCERA) ; Queued job entrypoint
|
|---|
| 22 | N RCPG,RCSTOP,RCT,RCHAS,Q,Z,Z0
|
|---|
| 23 | S (RCPG,RCSTOP,RCHAS)=0
|
|---|
| 24 | S Z=0 F S Z=$O(^RCY(344.49,RCERA,3,Z)) Q:'Z!RCSTOP S Z0=$G(^(Z,0)) D
|
|---|
| 25 | . I 'RCPG!(($Y+5)>IOSL) D HDR(.RCPG,RCERA,.RCSTOP)
|
|---|
| 26 | . Q:RCSTOP
|
|---|
| 27 | . S RCHAS=1,RCT=0
|
|---|
| 28 | . S Q=0 F S Q=$O(^RCY(344.49,RCERA,1,"ABAT",+Z0,Q)) Q:'Q S RCT=RCT+1
|
|---|
| 29 | . 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)
|
|---|
| 30 | . W !,$J("",9)_"# RECORDS: "_RCT_" CRITERIA: "_$$EXTERNAL^DILFD(344.493,.06,"",$P(Z0,U,6))
|
|---|
| 31 | . I $P(Z0,U,6)<3 W " FROM: "_$P(Z0,U,7)_" TO: "_$P(Z0,U,8)
|
|---|
| 32 | . I $P(Z0,U,6)=3 W " "_$P("PARTIAL^FULL^NO",U,+Z0)_" PAYMENT"
|
|---|
| 33 | . I $P(Z0,U,6)=4 W " "_$P("CO-PAY^NO CO-PAY",U,+Z0)
|
|---|
| 34 | ;
|
|---|
| 35 | I 'RCHAS D:'RCPG HDR(.RCPG,RCERA,.RCSTOP) W !,"THERE ARE NO BATCHES DEFINED FOR THIS ERA"
|
|---|
| 36 | I '$D(ZTQUEUED),'RCSTOP,RCPG D ASK()
|
|---|
| 37 | I $D(ZTQUEUED) S ZTREQ="@"
|
|---|
| 38 | I '$D(ZTQUEUED) D ^%ZISC
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | NOTSET ;
|
|---|
| 42 | N DIR,X,Y
|
|---|
| 43 | 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
|
|---|
| 44 | S VALMBCK="R"
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | HDR(RCPG,RCSCR,RCSTOP) ;Print report hdr
|
|---|
| 48 | ; RCPG = last page #
|
|---|
| 49 | ; RCSCR = the entry # in file 344.49
|
|---|
| 50 | ; RCSTOP = returned as 1 if abort is detected
|
|---|
| 51 | N RCZ0
|
|---|
| 52 | I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ W:+$G(RCPG) !,"***TASK STOPPED BY USER***" Q
|
|---|
| 53 | S RCZ0=$G(^RCY(344.4,RCSCR,0))
|
|---|
| 54 | I RCPG&($E(IOST,1,2)="C-") D ASK(.RCSTOP) Q:RCSTOP
|
|---|
| 55 | W !,@IOF,*13
|
|---|
| 56 | S RCPG=$G(RCPG)+1
|
|---|
| 57 | W !,"EDI LBOX WORKLIST - BATCH SUMMARY REPORT",?59,$$FMTE^XLFDT(DT,2),?70,"Page: ",RCPG,!
|
|---|
| 58 | W !,"ERA #: ",$E(RCSCR_$J("",29),1,29)_" TRACE #: "_$P(RCZ0,U,2)
|
|---|
| 59 | W !,"PAYER: "_$E($P(RCZ0,U,6)_$J("",30),1,30)_" ERA DT: "_$$FMTE^XLFDT($P(RCZ0,U,4),"2D")
|
|---|
| 60 | W !!,"BATCH # NAME"_$J("",28)_"READY TO POST? STATUS SET BY"
|
|---|
| 61 | W !,$TR($J("",IOM)," ","=")
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
| 64 | ASK(RCSTOP) ; Ask to continue
|
|---|
| 65 | ; If passed by reference ,RCSTOP is returned as 1 if print is aborted
|
|---|
| 66 | I $E(IOST,1,2)'["C-" Q
|
|---|
| 67 | N DIR,DIROUT,DIRUT,DTOUT,DUOUT
|
|---|
| 68 | S DIR(0)="E" W ! D ^DIR
|
|---|
| 69 | I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
