source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPEAR1.m@ 1150

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

initial load of WorldVistAEHR

File size: 6.8 KB
Line 
1RCDPEAR1 ;ALB/TMK - ELECTRONIC ERA AGING REPORT - FILE 344.4 ;31-OCT-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,3) DIR("B")=$P(^(7),U,3)
9 W ! D ^DIR K DIR
10 I $D(DUOUT)!$D(DTOUT) G EN1Q
11 S RCMIN=+Y
12 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
13 I $D(DUOUT)!$D(DTOUT) G EN1Q
14 S RCDETAIL=(Y="D")
15 ; Ask device
16 S %ZIS="QM" D ^%ZIS G:POP EN1Q
17 I $D(IO("Q")) D G EN1Q
18 . S ZTRTN="RPTOUT^RCDPEAR1("_RCMIN_","_RCDETAIL_")",ZTDESC="AR - EDI LOCKBOX ERA AGING REPORT"
19 . D ^%ZTLOAD
20 . W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
21 . K ZTSK,IO("Q") D HOME^%ZIS
22 U IO
23 D RPTOUT(RCMIN,RCDETAIL)
24EN1Q Q
25 ;
26RPTOUT(RCMIN,RCDETAIL,RCPRT) ; Entrypoint for queued job, nightly job
27 ; RCMIN = the minimum # of days before an entry is included on report
28 ; RCDETAIL = 1 if detail is needed, otherwise only summary is reported
29 ; RCPRT = name of the subscript for ^TMP to use to return all lines
30 ; (for bulletin). If undefined or null, output is printed
31 ; Return global if RCPRT not null: ^TMP($J,RCPRT,line#)=line text
32 N RCCT,RCPG,RCSTOP,RCNT,RCDATA,RCOUT,RCEDT,RC0,RC7,RCZ,RCZ0,RCZ1,RC00,RCTOT,Z,Z0
33 S RCPRT=$G(RCPRT)
34 S (RCCT,RCSTOP,RCPG,RCNT,RCTOT)=0
35 S RCEDT=$$FMADD^XLFDT(DT,-RCMIN)
36 K ^TMP($J,"RCERA_AGED"),^TMP($J,"RCERA_ADJ")
37 I RCPRT'="" K ^TMP($J,RCPRT)
38 S RCZ0=0 F S RCZ0=$O(^RCY(344.4,"AMATCH",0,RCZ0)) Q:'RCZ0 D
39 . S RC7=$P($G(^RCY(344.4,RCZ0,0)),U,7)\1
40 . I RC7>RCEDT Q
41 . ; Minimum days have elapsed - include on report
42 . S ^TMP($J,"RCERA_AGED",$$FMDIFF^XLFDT(RC7,DT),RCZ0)=0,RCNT=RCNT+1
43 S RCZ="" F S RCZ=$O(^TMP($J,"RCERA_AGED",RCZ)) Q:RCZ="" S RCZ0=0 F S RCZ0=$O(^TMP($J,"RCERA_AGED",RCZ,RCZ0)) Q:'RCZ0 D G:RCSTOP PRTQ
44 . I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W:RCPRT="" !!,"***TASK STOPPED BY USER***" Q
45 . I RCDETAIL,RCPG D SETLINE(" ",.RCCT,.RCPRT) ; On detail list, skip line
46 . I 'RCPG!(($Y+5)>IOSL) D HDR(.RCCT,.RCPG,.RCSTOP,RCPRT,RCDETAIL,RCMIN) Q:RCSTOP
47 . S RC0=$G(^RCY(344.4,RCZ0,0)),RCTOT=RCTOT+$P(RC0,U,5)
48 . S Z=$$SETSTR^VALM1($J(-RCZ,4),"",1,4)
49 . S Z=$$SETSTR^VALM1(" "_$P(RC0,U,2),Z,5,22)
50 . S Z=$$SETSTR^VALM1(" "_$E($P(RC0,U,6),1,30)_"/"_$P(RC0,U,3),Z,27,43)
51 . S Z=$$SETSTR^VALM1(" "_$$FMTE^XLFDT($P(RC0,U,4),2),Z,70,10)
52 . D SETLINE(Z,.RCCT,RCPRT)
53 . S Z=$$SETSTR^VALM1($J("",16)_$S($P(RC0,U,7):$$FMTE^XLFDT($P(RC0,U,7)\1,2),1:""),"",1,25)
54 . S Z=$$SETSTR^VALM1(" "_$J($P(RC0,U,5),15,2),Z,26,17)
55 . S Z=$$SETSTR^VALM1(" "_+$P(RC0,U,11),Z,43,11)
56 . S Z=$$SETSTR^VALM1(" "_$P(RC0,U),Z_$S('$$HACERA^RCDPEU(RCZ0):"",1:" (HAC ERA)"),54,26)
57 . D SETLINE(Z,.RCCT,RCPRT)
58 . ;
59 . I "23"[$$ADJ^RCDPEU(RCZ0) D SETLINE($J("",9)_"** CLAIM LEVEL ADJUSTMENTS EXIST FOR THIS ERA ***",.RCCT,RCPRT)
60 . I $O(^RCY(344.4,RCZ0,2,0)) D ; ERA level adjustments exist
61 .. N Q
62 .. D DISPADJ^RCDPESR8(RCZ0,"^TMP("_$J_",""RCERA_ADJ"")")
63 .. I $O(^TMP($J,"RCERA_ADJ",0)) D SETLINE($J("",9)_"** GENERAL ADJUSTMENT DATA EXISTS FOR ERA **",.RCCT,RCPRT)
64 .. S Q=0 F S Q=$O(^TMP($J,"RCERA_ADJ",Q)) Q:'Q D SETLINE($J("",9)_$G(^TMP($J,"RCERA_ADJ",Q)),.RCCT,RCPRT)
65 . ;
66 . I RCDETAIL D ; Detail wanted
67 .. S RCZ1=0 F S RCZ1=$O(^RCY(344.4,RCZ0,1,RCZ1)) Q:'RCZ1 S RC00=$G(^(RCZ1,0)) D Q:RCSTOP
68 ... N D
69 ... K RCDATA,RCOUT
70 ... ;I $O(^RCY(344.4,RCZ0,1,RCZ1),-1) D SETLINE(" ",.RCCT,RCPRT)
71 ... I ($Y+5)>IOSL D HDR(.RCCT,.RCPG,.RCSTOP,RCPRT,RCDETAIL,RCMIN) Q:RCSTOP
72 ... S D=$J("",7)_" EEOB Seq #: "_$P(RC00,U)_$S($D(^RCY(344.4,RCZ0,1,"ATB",1,RCZ1)):" (REVERSAL)",1:"")_" EEOB "
73 ... S D=D_$S('$P(RC00,U,2):"not on file",1:"on file for "_$P($G(^DGCR(399,+$G(^IBM(361.1,+$P(RC00,U,2),0)),0)),U))_" "_$J(+$P(RC00,U,3),"",2)
74 ... D SETLINE(D,.RCCT,RCPRT)
75 ... Q:$P(RC00,U,2)
76 ... D DISP^RCDPESR0("^RCY(344.4,"_RCZ0_",1,"_RCZ1_",1)","RCDATA",1,"RCOUT",68,1)
77 ... I '$O(RCOUT(0)) D SETLINE($J("",9)_" NO DETAIL FOUND",.RCCT,RCPRT) Q
78 ... S Z=0 F S Z=$O(RCOUT(Z)) Q:'Z D Q:RCSTOP
79 .... I ($Y+5)>IOSL D HDR(.RCCT,.RCPG,.RCSTOP,RCPRT,RCDETAIL,RCMIN) Q:RCSTOP
80 .... D SETLINE($J("",9)_"*"_RCOUT(Z),.RCCT,RCPRT)
81 ;
82 F Z0=1:1:2 D SETLINE(" ",.RCCT,RCPRT)
83 I ($Y+7)>IOSL!'RCPG D HDR(.RCCT,.RCPG,.RCSTOP,RCPRT,RCDETAIL,RCMIN)
84 S Z=$$SETSTR^VALM1("TOTALS:","",1,79)
85 D SETLINE(Z,.RCCT,RCPRT)
86 S Z=$$SETSTR^VALM1(" NUMBER AGED ELECTRONIC ERA MESSAGES FOUND: "_RCNT,"",1,79)
87 D SETLINE(Z,.RCCT,RCPRT)
88 S Z=$$SETSTR^VALM1(" AMOUNT AGED ELECTRONIC ERA MESSAGES FOUND: "_$J(RCTOT,0,2),"",1,79)
89 D SETLINE(Z,.RCCT,RCPRT)
90 ;
91PRTQ I '$D(ZTQUEUED),'RCSTOP,RCPG,RCPRT="" D ASK()
92 I $D(ZTQUEUED) S ZTREQ="@"
93 I '$D(ZTQUEUED) D ^%ZISC
94 K ^TMP($J,"RCERA_AGED")
95 Q
96 ;
97HDR(RCCT,RCPG,RCSTOP,RCPRT,RCDETAIL,RCMIN) ;Prints report heading
98 ; Function returns RCPG = current page # and RCCT = running line count
99 ; and RCSTOP = 1 if user aborted print
100 ; Parameters must be passed by reference
101 ; RCDETAIL = 1 if detail is needed, otherwise only summary is reported
102 ; RCPRT = name of the subscript for ^TMP to use to return all lines
103 ; (for bulletin). If undefined or null, output is printed
104 ; RCMIN = minimum # days being used to age
105 N Z,Z0
106 Q:$G(RCSTOP)
107 I RCPG!($E(IOST,1,2)="C-") D Q:$G(RCSTOP)
108 . I RCPG&($E(IOST,1,2)="C-")&(RCPRT="") D ASK(.RCSTOP) Q:RCSTOP
109 . I RCPRT="" W @IOF,*13 Q ; Write form feed for report
110 . ; Add 2 blank lines for bulletin
111 . F Z=1:1:2 D SETLINE(" ",.RCCT,RCPRT)
112 S RCPG=RCPG+1
113 S Z0="EDI LOCKBOX ERA AGING "_$S(RCDETAIL:"DETAIL",1:"SUMMARY")_" REPORT"
114 S Z=$$SETSTR^VALM1($J("",80-$L(Z0)\2)_Z0,"",1,79)
115 S Z=$$SETSTR^VALM1("Page: "_RCPG,Z,70,10)
116 D SETLINE(Z,.RCCT,RCPRT)
117 S Z0="MINIMUM DAYS FOR AGING: "_RCMIN,Z0=$J("",80-$L(Z0)\2)_Z0
118 S Z=$$SETSTR^VALM1(Z0,"",1,79)
119 D SETLINE(Z,.RCCT,RCPRT)
120 S Z0="RUN DATE: "_$$FMTE^XLFDT(DT,2),Z0=$J("",80-$L(Z0)\2)_Z0
121 S Z=$$SETSTR^VALM1(Z0,"",1,79)
122 D SETLINE(Z,.RCCT,RCPRT)
123 D SETLINE(" ",.RCCT,RCPRT)
124 D SETLINE("AGED",.RCCT,RCPRT)
125 S Z=$$SETSTR^VALM1("DAYS"_$J("",2)_"TRACE #"_$J("",15)_"PAYMENT FROM/ID"_$J("",28)_"ERA DATE","",1,79)
126 D SETLINE(Z,.RCCT,RCPRT)
127 D SETLINE(" ",.RCCT,RCPRT)
128 S Z=$$SETSTR^VALM1($J("",16)_"FILE DATE"_$J("",6)_"AMOUNT PAID"_$J("",2)_"EEOB CNT "_$J("",2)_"ERA #",Z,1,79)
129 D SETLINE(Z,.RCCT,RCPRT)
130 D SETLINE($TR($J("",IOM-1)," ","="),.RCCT,RCPRT)
131 Q
132 ;
133SETLINE(Z,RCCT,RCPRT) ; Sets line into print global or writes line
134 ; Z = txt to output
135 ; RCCT = line counter
136 ; RCPRT = flag if 1, indicates output to global, no writes
137 S RCCT=RCCT+1
138 I RCPRT="" W !,Z Q
139 S ^TMP($J,RCPRT,RCCT)=Z
140 Q
141 ;
142ASK(RCSTOP) ; Ask to continue
143 ; If passed by reference ,RCSTOP is returned as 1 if print is aborted
144 I $E(IOST,1,2)'["C-" Q
145 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
146 S DIR(0)="E" W ! D ^DIR
147 I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
148 Q
149 ;
Note: See TracBrowser for help on using the repository browser.