source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPEWLC.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1RCDPEWLC ;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 ;
5SUMRPT(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)
19SUMRPTQ Q
20 ;
21RPTOUT(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 ;
41NOTSET ;
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 ;
47HDR(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 ;
64ASK(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 ;
Note: See TracBrowser for help on using the repository browser.