source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPE8NZ.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: 4.5 KB
Line 
1RCDPE8NZ ;ALB/TMK-report of unlinked payments in 5287/8NZZ ;19 MAR 2003
2 ;;4.5;Accounts Receivable;**173,212,208**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN N RCDPPADT,%ZIS,ZTRTN,ZTSAVE,ZTDESC,POP,ZTSK,DIR,X,Y
6 S DIR("A")="Start with Deposit Date: FIRST// ",DIR(0)="DOA^:"_DT_":AEP" W ! D ^DIR K DIR
7 I $D(DUOUT)!$D(DTOUT) Q
8 S RCDPPADT=+Y
9 ; Ask device
10 S %ZIS="QM" D ^%ZIS G:POP PRQ
11 I $D(IO("Q")) D G PRQ
12 . S ZTRTN="PR^RCDPE8NZ",ZTDESC="AR - List of unlinked EFT deposit payments"
13 . S ZTSAVE("RCDPPADT")=""
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 ;
19PR ; Entrypoint for queued job
20 ;
21 N RCCT,RCOK,RCPG,RCEFT,RCEFT1,RCDATA,RCDATA0,RCDA,RCREC,RCSTAT,RCDT,RCTOT,RCEFTD,RCSTOP,RCRDT,X,Y,Z
22 ;
23 ; get list of unlinked EFT deposit data
24 K ^TMP("RCDPE8NZZ_EFT",$J) ; subscripts: dep date,EFT ien,EFT det ien
25 ; Data is FMS doc indicator^FMS doc #^FMS Doc Status
26 ; FMS doc indicator = -1:no receipt -2:no FMS doc 1:FMS doc exists
27 ;
28 S (RCCT,RCSTOP)=0
29 S RCEFT1="" F S RCEFT1=$O(^RCY(344.3,"ARDEP",RCEFT1)) Q:RCEFT1=""!RCSTOP S RCDA=0 F S RCDA=$O(^RCY(344.3,"ARDEP",RCEFT1,RCDA)) Q:'RCDA D Q:RCSTOP
30 . S RCDATA=$G(^RCY(344.3,RCDA,0)),RCDT=$P(RCDATA,U,7),RCTOT=0
31 . Q:RCDT<RCDPPADT ; Before date selected
32 . Q:'$P(RCDATA,"^",8) ; no payment amt
33 . S RCEFT=0 F S RCEFT=$O(^RCY(344.31,"B",RCDA,RCEFT)) Q:'RCEFT!RCSTOP S RCDATA0=$G(^RCY(344.31,RCEFT,0)) D Q:RCSTOP S:RCTOT ^TMP("RCDPE8NZZ_EFT",$J,RCDT,RCDA)=RCTOT
34 .. S RCCT=RCCT+1
35 .. I '(RCCT#100),$D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ Q
36 .. S RCREC=+$P($G(^RCY(344.4,+$P(RCDATA0,U,10),0)),U,8)
37 .. S RCOK=1
38 .. I 'RCREC D Q
39 ... I $P(RCDATA0,U,16)'="" Q
40 ... S ^TMP("RCDPE8NZZ_EFT",$J,RCDT,RCDA,RCEFT)=-1,RCTOT=RCTOT+$P(RCDATA0,U,7) S RCOK=0 ; No receipt
41 .. S RCSTAT=$$FMSSTAT^RCDPUREC(RCREC)
42 .. Q:$P(RCSTAT,U,2)["ACCEPTED"!($P(RCSTAT,U,2)["FINAL")!($P(RCSTAT,U,2)["ON LINE ENTRY")
43 .. S RCTOT=RCTOT+$P(RCDATA0,U,7)
44 .. I RCSTAT=-1 S ^TMP("RCDPE8NZZ_EFT",$J,RCDT,RCDA,RCEFT)="-2^^"_$P(RCSTAT,U) Q ; No FMS doc
45 .. S ^TMP("RCDPE8NZZ_EFT",$J,RCDT,RCDA,RCEFT)="1^"_$P(RCSTAT,U,1,2)
46 ;
47 S (RCPG,RCDT)=0,RCRDT=$$FMTE^XLFDT($$NOW^XLFDT(),2)
48 F S RCDT=$O(^TMP("RCDPE8NZZ_EFT",$J,RCDT)) Q:'RCDT D Q:RCSTOP
49 . I 'RCPG!(($Y+5)>IOSL) D Q:RCSTOP
50 .. D HDR(RCRDT,.RCPG,.RCSTOP)
51 . E W !
52 . W ! S Z="DEPOSIT DATE: "_$$FMTE^XLFDT(RCDT,1) W ?(80-$L(Z)\2),Z,!
53 . ;
54 . S RCEFT1=0 F S RCEFT1=$O(^TMP("RCDPE8NZZ_EFT",$J,RCDT,RCEFT1)) Q:'RCEFT1 D
55 .. S RCCT=RCCT+1
56 .. I '(RCCT#100),$D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 W:$G(RCPG) !!,"TASK STOPPED BY USER!!" K ZTREQ Q
57 .. S RCDATA0=$G(^RCY(344.3,RCEFT1,0))
58 .. I ($Y+5)>IOSL D HDR(RCRDT,.RCPG,.RCSTOP) Q:RCSTOP
59 .. W !,$J("",4),$E($P(RCDATA0,U,6)_$S('$$HACEFT^RCDPEU(RCEFT1):"",1:"-HAC")_$J("",10),1,10)_" "_$E($$FMTE^XLFDT($P(RCDATA0,U,7),2)_$J("",16),1,16)_" "_$E($J(+$P(RCDATA0,U,8),"",2)_$J("",20),1,20)
60 .. W " "_$J(+$G(^TMP("RCDPE8NZZ_EFT",$J,RCDT,RCEFT1)),"",2)
61 .. ;
62 .. S RCEFT=0 F S RCEFT=$O(^TMP("RCDPE8NZZ_EFT",$J,RCDT,RCEFT1,RCEFT)) Q:'RCEFT S RCDATA=$G(^(RCEFT)),RCEFTD=$G(^RCY(344.31,RCEFT,0)) D
63 ... I ($Y+5)>IOSL D HDR(RCRDT,.RCPG,.RCSTOP) Q:RCSTOP
64 ... W !,$J("",6)_$E($E($P(RCEFTD,U,2),1,18)_"/"_$E($P(RCEFTD,U,3),1,10)_$J("",30),1,30)_$E($P(RCEFTD,U,4)_$J("",20),1,20)_" "
65 ... W $E($J(+$P(RCEFTD,U,7),"",2)_$J("",12),1,12)_" "_$S($P(RCEFTD,U,9)'="":$P($G(^RCY(344,+$P(RCEFTD,U,9),0)),U),1:"NO RECEIPT")
66 ... S Z=$P(RCEFTD,U,8)
67 ... W !,$J("",8)_$E($S('Z:"UNMATCHED",Z=2:"PAPER EOB",1:"MATCHED TO ERA #: "_$P(RCEFTD,U,10)_$S(Z=-1:" (TOTALS MISMATCH)",1:""))_$J("",40),1,40)_" "
68 ... W $S($P(RCDATA,U)<0:"NO FMS DOCUMENT",1:$P(RCDATA,U,2)_" - "_$P(RCDATA,U,3)),!
69 ;
70 I $D(ZTQUEUED) S ZTREQ="@"
71 I '$D(ZTQUEUED) D ^%ZISC
72 G:RCSTOP PRQ
73 I $E(IOST,1,2)="C-" D ASK(.RCSTOP)
74 ;
75PRQ K ^TMP("RCDPE8NZZ_EFT",$J)
76 Q
77 ;
78HDR(RCRDT,RCPG,RCSTOP) ; Print header data
79 I 'RCSTOP,RCPG D ASK(.RCSTOP) Q:RCSTOP
80 I RCPG!($E(IOST,1,2)="C-") W @IOF,*13
81 S RCPG=RCPG+1
82 W !,$S(RCDPPADT'>0:"ALL ",1:"")_"UNAPPLIED EFT PAYMENT DEPOSITS"_$S(RCDPPADT>0:" AFTER "_$$FMTE^XLFDT(RCDPPADT,2),1:""),?50,RCRDT,?70,"PAGE: ",RCPG
83 W !!," DEPOSIT # DEPOSIT DATE TOT AMT OF DEPOSIT TOT AMT UNPOSTED"
84 W !,$E(" PAYER/ID"_$J("",36),1,36)_"TRACE # PAYMENT AMT RECEIPT #",!,$J("",8)_$E("ERA MATCHED"_$J("",40),1,40)_" FMS DOC #/STATUS"
85 W !,$TR($J("",IOM)," ","=")
86 Q
87 ;
88ASK(RCSTOP) ;
89 I $E(IOST,1,2)'["C-" Q
90 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
91 S DIR(0)="E" W ! D ^DIR
92 I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
93 Q
94 ;
Note: See TracBrowser for help on using the repository browser.