source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNERP6.m@ 619

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

initial load of WorldVistAEHR
File size: 8.9 KB
Line 
1IBCNERP6 ;DAOU/BHS - IIV PAYER REPORT PRINT ;05-JUN-2002
2 ;;2.0;INTEGRATED BILLING;**184,271**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; IIV - Insurance Identification and Verification Interface
6 ;
7 ; Called by IBCNERPA
8 ;
9 ; Input variables from IBCNERP4 and IBCNERP5:
10 ; IBCNERTN = "IBCNERP4"
11 ; IBCNESPC("BEGDT") = Start Date for dt range
12 ; IBCNESPC("ENDDT") = End Date for dt range
13 ; IBCNESPC("PYR") = Payer IEN for report, if = "", then include all
14 ; IBCNESPC("SORT") = 1 - Payer name OR 2 - Total Inquiries
15 ; IBCNESPC("DTL")= 1 - YES OR 0 - NO - display Rejection detail
16 ; ^TMP($J,IBCNERTN,SORT1,SORT2,SORT3)=InqCreatedCount^InqCancelledCt^
17 ; InqQueuedCt^1stTransCount^
18 ; RetryCount^Non-ErrorRespCount^
19 ; ErrorRespCount^TotRespTime-days^
20 ; CommFailRespCount^PendRespCount^
21 ; DeactivationDTM
22 ; IBCNERTN = "IBCNERP4"
23 ; SORT1 = PayerName (SORT=1) or -InquiryCount(SORT=2)
24 ; SORT2 = PayerIEN (SORT=1) or PayerName (SORT=2)
25 ; SORT3 = "*" (SORT=1) or PayerIEN (SORT=2)
26 ;
27 ; ^TMP($J,IBCNERTN,SORT1,SORT2,SORT3,ERRCD)=InquiryCount
28 ; (see above)
29 ; ERRCD = Error Condition code (ptr to 365.018)
30 ;
31 ; Must call at appropriate tag
32 Q
33 ;
34 ;
35PRINT(RTN,BDT,EDT,PYR,RDTL,SRT,PGC,PXT,MAX,CRT) ; Print data
36 ; Input params: RNT = "IBCNERP4" - routine, BDT = starting dt,
37 ; EDT = ending dt, PYR = payer ien,
38 ; RDTL = 0/1, SRT = 0/1, PGC = page ct, PXT = exit flg, MAX = max line
39 ; ct/page, CRT = 0/1
40 ;
41 ; Init vars
42 N EORMSG,NONEMSG,COUNT,TOTDASHS,DISPDATA,SORT1,SORT2,SORT3,CT,PRT1,PRT2
43 ;
44 S EORMSG="*** END OF REPORT ***"
45 S NONEMSG="* * * N O D A T A F O U N D * * *"
46 S $P(TOTDASHS,"=",89)=""
47 S CT=0
48 ;
49 I '$D(^TMP($J,RTN)) D HEADER W !,?(132-$L(NONEMSG)\2),NONEMSG,!! G PRINT2
50 S SORT1=""
51 F S SORT1=$O(^TMP($J,RTN,SORT1)) Q:SORT1="" D Q:$G(ZTSTOP)!PXT
52 . S PRT1=$S(SORT1="~NO PAYER":"* No Payer Identified",1:SORT1)
53 . S SORT2=""
54 . F S SORT2=$O(^TMP($J,RTN,SORT1,SORT2)) Q:SORT2="" D Q:$G(ZTSTOP)!PXT
55 . . S PRT2=$S(SORT2="~NO PAYER":"* No Payer Identified",1:SORT2)
56 . . S SORT3=""
57 . . F S SORT3=$O(^TMP($J,RTN,SORT1,SORT2,SORT3)) Q:SORT3="" D Q:$G(ZTSTOP)!PXT
58 . . . S CT=CT+1
59 . . . ; Build lines of data to display
60 . . . KILL DISPDATA
61 . . . D DATA(.DISPDATA)
62 . . . ; Display lines of response
63 . . . D LINE(.DISPDATA)
64 . . . Q
65 . . Q
66 . Q
67 ;
68 ; Display totals line if space is available
69 I $G(ZTSTOP)!PXT G PRINTX
70 I $Y+1>MAX!('PGC) D HEADER I $G(ZTSTOP)!PXT G PRINTX
71 W !,?43,TOTDASHS
72 ; Print totals for report
73 KILL DISPDATA
74 D TOTALS(.DISPDATA)
75 ; Display lines of totals
76 D LINE(.DISPDATA)
77 ;
78PRINT2 I $G(ZTSTOP)!PXT G PRINTX
79 I $Y+1>MAX!('PGC) D HEADER I $G(ZTSTOP)!PXT G PRINTX
80 W !,?(132-$L(EORMSG)\2),EORMSG
81 ;
82PRINTX ; PRINT exit point
83 Q
84 ;
85HEADER ; Print header info for each page
86 ; Assumes vars from PRINT: CRT,PGC,PXT,MAX,SRT,BDT,EDT,PYR,RDTL,MAR
87 ; Init vars
88 N DIR,X,Y,DTOUT,DUOUT,OFFSET,HDR,DASHES,LIN
89 ;
90 I CRT,PGC>0,'$D(ZTQUEUED) D I PXT G HEADERX
91 . I MAX<51 F LIN=1:1:(MAX-$Y) W !
92 . S DIR(0)="E" D ^DIR K DIR
93 . I $D(DTOUT)!$D(DUOUT) S PXT=1 Q
94 I $D(ZTQUEUED),$$S^%ZTLOAD() S (ZTSTOP,PXT)=1 G HEADERX
95 S PGC=PGC+1
96 W @IOF,!,?1,"IIV Payer Report"
97 S HDR=$$FMTE^XLFDT($$NOW^XLFDT,1)_" Page: "_PGC
98 S OFFSET=131-$L(HDR)
99 W ?OFFSET,HDR
100 W !,?1,"Sorted by: "_$S(SRT=1:"Payer",1:"Total Inquiries")
101 S HDR="Rejection Detail: "_$S('RDTL:"Not",1:"")_" Included"
102 S OFFSET=131-$L(HDR)
103 W ?OFFSET,HDR
104 S HDR=$$FMTE^XLFDT(BDT,"5Z")_" - "_$$FMTE^XLFDT(EDT,"5Z")
105 S OFFSET=132-$L(HDR)\2
106 W !,?OFFSET,HDR
107 ; Display Payer Range
108 S HDR=""
109 I PYR="" S HDR="All Payers"
110 I HDR="" S HDR=$P($G(^IBE(365.12,PYR,0)),U,1)
111 S OFFSET=132-$L(HDR)\2
112 W !,?OFFSET,HDR
113 W ! ; Skip line
114 ; Display column headings
115 W !,?70,"***** SENT *****",?88,"*** RECEIVED ***",?106,"AvgResp"
116 W !,?1,"Payer [Inactive Date]",?43,"Created",?52," Cancel",?61," Queued",?70,"1st Att",?79," Retry",?88," Good",?97," Error",?106," (Days)",?115,"Timeout",?124,"Pending"
117 S $P(DASHES,"=",131)=""
118 W !,?1,DASHES
119 ;
120HEADERX ; HEADER exit pt
121 Q
122 ;
123LINE(DISPDATA) ; Print line of data
124 ; Assumes vars from PRINT: PGC,PXT,MAX
125 ; Init vars
126 N CT,II
127 ;
128 S CT=+$O(DISPDATA(""),-1)
129 I $Y+1+CT>MAX D HEADER I $G(ZTSTOP)!PXT G LINEX
130 F II=1:1:CT D Q:$G(ZTSTOP)!PXT
131 . I $Y+1>MAX!('PGC) D HEADER I $G(ZTSTOP)!PXT Q
132 . W !,?1,DISPDATA(II)
133 . Q
134 ;
135LINEX ; LINE exit pt
136 Q
137 ;
138DATA(DISPDATA) ; Gather and format lines of data to be printed
139 ; Assumes vars from PRINT: RTN,SRT,SORT1,SORT2,SORT3,RDTL,CT,PRT1,PRT2
140 ; Init vars
141 N LINECT,INQS,TIME,AVG,APPS,REJS,DASHES2,ERRCD,ERROR,DEACMSG
142 N REJDASHS,RPTDATA,FAIL,PEND,RETS,CT2,FIRST,QUED,CANC,PAYER,DEACDT
143 ;
144 S $P(DASHES2,"-",89)=""
145 S $P(REJDASHS,"-",8)=""
146 S LINECT=1
147 ;M RPTDATA=^TMP($J,RTN,SORT1,SORT2,SORT3)
148 N %X,%Y
149 S %X="^TMP($J,RTN,SORT1,SORT2,SORT3,"
150 S %Y="RPTDATA("
151 I $D(^TMP($J,RTN,SORT1,SORT2,SORT3))#10=1 S RPTDATA=^TMP($J,RTN,SORT1,SORT2,SORT3)
152 D %XY^%RCR K %X,%Y
153 S INQS=+$P(RPTDATA,U,1)
154 S CANC=+$P(RPTDATA,U,2)
155 S QUED=+$P(RPTDATA,U,3)
156 S FIRST=+$P(RPTDATA,U,4)
157 S RETS=+$P(RPTDATA,U,5)
158 S APPS=+$P(RPTDATA,U,6)
159 S REJS=+$P(RPTDATA,U,7)
160 S TIME=+$P(RPTDATA,U,8)
161 S FAIL=+$P(RPTDATA,U,9)
162 S PEND=+$P(RPTDATA,U,10)
163 S AVG=$FN($S((APPS+REJS)>0:TIME/(APPS+REJS),1:0),"",2)
164 S PAYER=$S(SRT=1:PRT1,1:PRT2)
165 I $P(RPTDATA,U,11) D
166 . S DEACMSG=" [Inactive"
167 . S DEACDT=" "_$$FMTE^XLFDT($P(RPTDATA,U,11)\1,"5Z")
168 . I $L(PAYER)+$L(DEACMSG)+$L(DEACDT)<40 S PAYER=PAYER_DEACMSG_DEACDT_"]" Q
169 . I $L(PAYER)+$L(DEACMSG)<40 S PAYER=PAYER_DEACMSG_"]" Q
170 . S PAYER=$E(PAYER,1,39-$L(DEACMSG))_DEACMSG_"]"
171 ; Update Report Totals
172 F CT2=1:1:10 S $P(TOTALS,U,CT2)=$P($G(TOTALS),U,CT2)+$P(RPTDATA,U,CT2)
173 S DISPDATA(LINECT)=$$FO^IBCNEUT1(PAYER,40)_$$FO^IBCNEUT1(INQS,9,"R")_$$FO^IBCNEUT1(CANC,9,"R")_$$FO^IBCNEUT1(QUED,9,"R")_$$FO^IBCNEUT1(FIRST,9,"R")_$$FO^IBCNEUT1(RETS,9,"R")
174 S DISPDATA(LINECT)=DISPDATA(LINECT)_$$FO^IBCNEUT1(APPS,9,"R")_$$FO^IBCNEUT1(REJS,9,"R")_$$FO^IBCNEUT1(AVG,9,"R")_$$FO^IBCNEUT1(FAIL,9,"R")_$$FO^IBCNEUT1(PEND,9,"R")
175 S LINECT=LINECT+1
176 I 'RDTL!(REJS=0) G DATAX
177 ; Include Rejection Detail - if necessary
178 S DISPDATA(LINECT)=$$FO^IBCNEUT1("",41)_$$FO^IBCNEUT1("Rejection Detail",56)_REJDASHS
179 S LINECT=LINECT+1
180 S ERRCD=""
181 F S ERRCD=$O(RPTDATA(ERRCD)) Q:ERRCD="" D
182 . ; Determine Error Condition Description based on ERRCD
183 . ; If just Error Text 4.01 field, then keep it as is
184 . I 'ERRCD D
185 .. S ERROR=$P(ERRCD,U,2,99)
186 .. S DISPDATA(LINECT)=$$FO^IBCNEUT1("",41)_" "_$$FO^IBCNEUT1(ERROR,53)_$$FO^IBCNEUT1(+RPTDATA(ERRCD),9,"R")
187 . ; If IEN, get the code and description
188 . I ERRCD D
189 .. S ERROR=$G(^IBE(365.017,ERRCD,0))
190 .. S DISPDATA(LINECT)=$$FO^IBCNEUT1("",41)_" "_$$FO^IBCNEUT1($P(ERROR,U)_$S($P(ERROR,U,2)'="":"-"_$P(ERROR,U,2),1:""),53)_$$FO^IBCNEUT1(+RPTDATA(ERRCD),9,"R")
191 . S LINECT=LINECT+1
192 . ; Update Report Totals
193 . S TOTALS(ERRCD)=+$G(TOTALS(ERRCD))+RPTDATA(ERRCD)
194 . Q
195 ;
196DATAX ; DATA exit pt
197 ; Display end of record dashes only if other records follow
198 I $O(^TMP($J,RTN,SORT1,SORT2,SORT3))'=""!($O(^TMP($J,RTN,SORT1,SORT2))'="")!($O(^TMP($J,RTN,SORT1))'="") S DISPDATA(LINECT)=$$FO^IBCNEUT1("",42)_DASHES2,LINECT=LINECT+1
199 Q
200 ;
201TOTALS(DISPDATA) ; Gather and format lines of totals to be printed
202 ; Assumes vars from PRINT: RDTL,MAR
203 ; Init vars
204 N LINECT,INQS,TIME,AVG,APPS,REJS,ERRCD,DASHES,REJDASHS,FAIL,PEND,RETS
205 N FIRST,QUED,ERROR,CANC
206 ;
207 S $P(DASHES,"=",131)=""
208 S $P(REJDASHS,"-",8)=""
209 S LINECT=1
210 S INQS=+$P(TOTALS,U,1)
211 S CANC=+$P(TOTALS,U,2)
212 S QUED=+$P(TOTALS,U,3)
213 S FIRST=+$P(TOTALS,U,4)
214 S RETS=+$P(TOTALS,U,5)
215 S APPS=+$P(TOTALS,U,6)
216 S REJS=+$P(TOTALS,U,7)
217 S TIME=+$P(TOTALS,U,8)
218 S FAIL=+$P(TOTALS,U,9)
219 S PEND=+$P(TOTALS,U,10)
220 S AVG=$FN($S((APPS+REJS)>0:TIME/(APPS+REJS),1:0),"",2)
221 S DISPDATA(LINECT)=$$FO^IBCNEUT1("Grand Totals",40)_$$FO^IBCNEUT1(INQS,9,"R")_$$FO^IBCNEUT1(CANC,9,"R")_$$FO^IBCNEUT1(QUED,9,"R")_$$FO^IBCNEUT1(FIRST,9,"R")_$$FO^IBCNEUT1(RETS,9,"R")
222 S DISPDATA(LINECT)=DISPDATA(LINECT)_$$FO^IBCNEUT1(APPS,9,"R")_$$FO^IBCNEUT1(REJS,9,"R")_$$FO^IBCNEUT1(AVG,9,"R")_$$FO^IBCNEUT1(FAIL,9,"R")_$$FO^IBCNEUT1(PEND,9,"R")
223 S LINECT=LINECT+1
224 I 'RDTL!(REJS=0) G TOTALSX
225 ; Include Rejection Detail - if necessary
226 S DISPDATA(LINECT)=$$FO^IBCNEUT1("",41)_$$FO^IBCNEUT1("Rejection Detail",56)_REJDASHS
227 S LINECT=LINECT+1
228 S ERRCD=""
229 F S ERRCD=$O(TOTALS(ERRCD)) Q:ERRCD="" D
230 . ; If IEN, get the code and description
231 . I ERRCD D
232 .. S ERROR=$G(^IBE(365.017,ERRCD,0))
233 .. S DISPDATA(LINECT)=$$FO^IBCNEUT1("",41)_" "_$$FO^IBCNEUT1($P(ERROR,U)_$S($P(ERROR,U,2)'="":"-"_$P(ERROR,U,2),1:""),53)_$$FO^IBCNEUT1(+TOTALS(ERRCD),9,"R")
234 . ; If error text display as is
235 . I 'ERRCD D
236 .. S ERROR=$P(ERRCD,U,2,99)
237 .. S DISPDATA(LINECT)=$$FO^IBCNEUT1("",41)_" "_$$FO^IBCNEUT1(ERROR,53)_$$FO^IBCNEUT1(+TOTALS(ERRCD),9,"R")
238 . S LINECT=LINECT+1
239 . Q
240 ;
241TOTALSX ; DATA exit pt
242 S DISPDATA(LINECT)=DASHES
243 Q
244 ;
245 ;
Note: See TracBrowser for help on using the repository browser.