source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPEAR2.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 6.2 KB
Line 
1RCDPEAR2 ;ALB/TMK - ELECTRONIC EFT AGING REPORT - FILE 344.3 ;04-NOV-02
2 ;;4.5;Accounts Receivable;**173**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6EN1 ; Entry from option - run on the fly
7 N RCDETAIL,RCMIN,DIR,X,Y,%ZIS,ZTRTN,ZTSAVE,ZTDESC,POP
8 S DIR(0)="NA^0:1000",DIR("A")="Enter the minimum # of days elapsed before including on report (0-1000): " S:$P($G(^RC(342,1,7)),U,2) DIR("B")=$P(^(7),U,2)
9 S DIR("?",1)="This is the # minimum # of days this EFT has been in an UNMATCHED status",DIR("?",2)="before being included on this report. EFT's with a 0 dollar balance are",DIR("?")="always excluded from this report."
10 W ! D ^DIR K DIR
11 I $D(DUOUT)!$D(DTOUT) G EN1Q
12 S RCMIN=+Y
13 S DIR(0)="SA^S:SUMMARY;D:DETAIL",DIR("A")="DO YOU WANT (S)UMMARY OR (D)ETAIL?: ",DIR("B")="SUMMARY" D ^DIR K DIR
14 I $D(DUOUT)!$D(DTOUT) G EN1Q
15 S RCDETAIL=(Y="D")
16 ; Ask device
17 S %ZIS="QM" D ^%ZIS G:POP EN1Q
18 I $D(IO("Q")) D G EN1Q
19 . S ZTRTN="RPTOUT^RCDPEAR2("_RCMIN_","_RCDETAIL_")",ZTDESC="AR - EDI LOCKBOX EFT AGING REPORT"
20 . D ^%ZTLOAD
21 . W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
22 . K ZTSK,IO("Q") D HOME^%ZIS
23 U IO
24 D RPTOUT(RCMIN,RCDETAIL)
25EN1Q Q
26 ;
27RPTOUT(RCMIN,RCDETAIL,RCPRT) ; Entrypoint for queued job, nightly job
28 ; RCMIN = the minimum # of days before an entry is included on report
29 ; RCDETAIL = 1 if detail is needed, otherwise only summary is reported
30 ; RCPRT = name of the subscript for ^TMP to use to return all lines
31 ; (for bulletin). If undefined or null, output is printed
32 ; Return global if RCPRT not null: ^TMP($J,RCPRT,line#)=line text
33 N RCCT,RCPG,RCSTOP,RCNT,RCTOT,RCOUT,RCEDT,RC0,RC1,RC13,RCZ,RCZ0,RC00,Z,Z0
34 S RCPRT=$G(RCPRT)
35 S (RCCT,RCSTOP,RCPG,RCNT,RCTOT)=0
36 S RCEDT=$$FMADD^XLFDT(DT,-RCMIN)
37 K ^TMP($J,"RCEFT_AGED")
38 I RCPRT'="" K ^TMP($J,RCPRT)
39 S RCZ0=0 F S RCZ0=$O(^RCY(344.31,"AMATCH",0,RCZ0)) Q:'RCZ0 D
40 . Q:$P($G(^RCY(344.31,RCZ0,0)),U,7)=0
41 . S RC13=$P($G(^RCY(344.31,RCZ0,0)),U,13)
42 . I RC13>RCEDT Q
43 . ; Minimum days have elapsed - include on report
44 . S ^TMP($J,"RCEFT_AGED",$$FMDIFF^XLFDT(RC13,DT),RCZ0)=0,RCNT=RCNT+1
45 ;
46 S RCZ="" F S RCZ=$O(^TMP($J,"RCEFT_AGED",RCZ)) Q:RCZ="" S RCZ0=0 F S RCZ0=$O(^TMP($J,"RCEFT_AGED",RCZ,RCZ0)) Q:'RCZ0 D G:RCSTOP PRTQ
47 . I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W:RCPRT="" !!,"***TASK STOPPED BY USER***" Q
48 . I RCDETAIL,RCPG D SETLINE(" ",.RCCT,.RCPRT) ; On detail list, skip line
49 . I 'RCPG!(($Y+5)>IOSL) D HDR(.RCCT,.RCPG,RCMIN,.RCSTOP,RCPRT,RCDETAIL) Q:RCSTOP
50 . S RC0=$G(^RCY(344.31,RCZ0,0)),RC00=$G(^RCY(344.3,+RC0,0))
51 . S RCTOT=RCTOT+$P(RC0,U,7)
52 . S Z=$$SETSTR^VALM1($J(-RCZ,4),"",1,4)
53 . S Z=$$SETSTR^VALM1(" "_$P(RC0,U,4),Z,5,22)
54 . S Z=$$SETSTR^VALM1(" "_$E($P(RC0,U,2),1,30)_"/"_$P(RC0,U,3),Z,27,43)
55 . S Z=$$SETSTR^VALM1(" "_$$FMTE^XLFDT($P(RC0,U,12),2),Z,70,10)
56 . D SETLINE(Z,.RCCT,RCPRT)
57 . S Z=$$SETSTR^VALM1($J("",6)_$S($P(RC0,U,13):$$FMTE^XLFDT($P(RC0,U,13),2),1:""),"",1,17)
58 . S Z=$$SETSTR^VALM1(" "_$J($P(RC0,U,7),15,2),Z,18,17)
59 . S Z=$$SETSTR^VALM1(" "_$P(RC00,U,6),Z,35,8)
60 . S Z=$$SETSTR^VALM1(" "_$S($P(RC00,U,12):"",1:"NOT ")_"POSTED TO 8NZZ"_$S($P(RC00,U,12):" ON "_$$FMTE^XLFDT($P(RC00,U,11),2),1:""),Z,44,36)
61 . D SETLINE(Z,.RCCT,RCPRT)
62 . ;
63 . I RCDETAIL D ; Detail wanted
64 .. K RCOUT
65 .. D GETS^DIQ(344.31,RCZ0_",",2,"E","RCOUT")
66 .. Q:'$O(RCOUT(344.31,RCZ0_",",2,0))
67 .. D SETLINE($J("",8)_"--EXCEPTION NOTES--",.RCCT,RCPRT)
68 .. S Z=0 F S Z=$O(RCOUT(344.31,RCZ0_",",2,Z)) Q:'Z D Q:RCSTOP
69 ... I ($Y+5)>IOSL D HDR(.RCCT,.RCPG,RCMIN,.RCSTOP,RCPRT,RCDETAIL) Q:RCSTOP
70 ... D SETLINE($J("",8)_" "_RCOUT(344.31,RCZ0_",",2,Z),.RCCT,RCPRT)
71 ;
72 F Z0=1:1:2 D SETLINE(" ",.RCCT,RCPRT)
73 I ($Y+7)>IOSL!'RCPG D HDR(.RCCT,.RCPG,RCMIN,.RCSTOP,RCPRT,RCDETAIL)
74 S Z=$$SETSTR^VALM1("TOTALS:","",1,79)
75 D SETLINE(Z,.RCCT,RCPRT)
76 S Z=$$SETSTR^VALM1(" NUMBER AGED ELECTRONIC EFT MESSAGES FOUND: "_RCNT,"",1,79)
77 D SETLINE(Z,.RCCT,RCPRT)
78 S Z=$$SETSTR^VALM1(" AMOUNT AGED ELECTRONIC EFT MESSAGES FOUND: "_$J(+RCTOT,0,2),"",1,79)
79 D SETLINE(Z,.RCCT,RCPRT)
80 ;
81PRTQ I '$D(ZTQUEUED),'RCSTOP,RCPG,RCPRT="" D ASK()
82 I $D(ZTQUEUED) S ZTREQ="@"
83 I '$D(ZTQUEUED) D ^%ZISC
84 K ^TMP($J,"RCEFT_AGED")
85 Q
86 ;
87HDR(RCCT,RCPG,RCMIN,RCSTOP,RCPRT,RCDETAIL) ;Prints report heading
88 ; Function returns RCPG = current page # and RCCT = running line count
89 ; and RCSTOP = 1 if user aborted print
90 ; Above parameters must be passed by reference
91 ; RCMIN = the minimum # of days before an entry is included on report
92 ; RCDETAIL = 1 if detail is needed, otherwise only summary is reported
93 ; RCPRT = name of the subscript for ^TMP to use to return all lines
94 ; (for bulletin). If undefined or null, output is printed
95 N Z,Z0
96 I RCPG!($E(IOST,1,2)="C-") D
97 . I RCPG&($E(IOST,1,2)="C-")&(RCPRT="") D ASK(.RCSTOP) Q:RCSTOP
98 . I RCPRT="" W @IOF,*13 Q ; Write form feed for report
99 . ; Add 2 blank lines for bulletin
100 . F Z=1:1:2 D SETLINE(" ",.RCCT,RCPRT)
101 Q:$G(RCSTOP)
102 S RCPG=RCPG+1
103 S Z0="EDI LOCKBOX EFT UNMATCHED AGING "_$S(RCDETAIL:"DETAIL",1:"SUMMARY")_" REPORT"
104 S Z=$$SETSTR^VALM1($J("",80-$L(Z0)\2)_Z0,"",1,79)
105 S Z=$$SETSTR^VALM1("Page: "_RCPG,Z,70,10)
106 D SETLINE(Z,.RCCT,RCPRT)
107 S Z0="MINIMUM DAYS NOT MATCHED FOR AGING: "_RCMIN,Z0=$J("",80-$L(Z0)\2)_Z0
108 S Z=$$SETSTR^VALM1(Z0,"",1,79)
109 D SETLINE(Z,.RCCT,RCPRT)
110 S Z0="RUN DATE: "_$$FMTE^XLFDT(DT,2),Z0=$J("",80-$L(Z0)\2)_Z0
111 S Z=$$SETSTR^VALM1(Z0,"",1,79)
112 D SETLINE(Z,.RCCT,RCPRT)
113 D SETLINE(" ",.RCCT,RCPRT)
114 D SETLINE("AGED",.RCCT,RCPRT)
115 S Z=$$SETSTR^VALM1("DAYS"_$J("",2)_"TRACE #"_$J("",15)_"DEPOSIT FROM/ID"_$J("",28)_"DEP DATE","",1,79)
116 D SETLINE(Z,.RCCT,RCPRT)
117 D SETLINE(" ",.RCCT,RCPRT)
118 S Z=$$SETSTR^VALM1($J("",6)_"FILE DATE"_$J("",5)_"DEPOSIT AMOUNT"_$J("",2)_"DEP # "_$J("",2)_"DEPOSIT POST STATUS",Z,1,79)
119 D SETLINE(Z,.RCCT,RCPRT)
120 D SETLINE($TR($J("",IOM-1)," ","="),.RCCT,RCPRT)
121 Q
122 ;
123SETLINE(Z,RCCT,RCPRT) ; Sets line into print global or writes line
124 ; Z = txt to output
125 ; RCCT = line counter
126 ; RCPRT = flag if 1, indicates output to global, no writes
127 S RCCT=RCCT+1
128 I RCPRT="" W !,Z Q
129 S ^TMP($J,RCPRT,RCCT)=Z
130 Q
131 ;
132ASK(RCSTOP) ; Ask to continue
133 ; If passed by reference ,RCSTOP is returned as 1 if print is aborted
134 I $E(IOST,1,2)'["C-" Q
135 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
136 S DIR(0)="E" W ! D ^DIR
137 I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
138 Q
139 ;
Note: See TracBrowser for help on using the repository browser.