source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCDP.m@ 1437

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

initial load of FOIAVistA 6/30/08 version
File size: 8.6 KB
Line 
1IBCDP ;ALB/ARH - AUTOMATED BILLER PRINT ; 12/01/04
2 ;;2.0;INTEGRATED BILLING;**287**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; OPTION ENTRY POINT: Auto Biller Report - get parameters then run the report
6 N X,Y,DIR,DIRUT,DTOUT,DUOUT,DIROUT,IBSDR,IBDATES,IBSEV,IBSBC,IBPATS,IBQUIT K ^TMP($J,"IBCDP")
7 W !!!,"Auto Biller Results Report"
8 W !,"This report contains results of the activity from the Third Party Auto Biller."
9 W !,"The Third Party Auto Biller processes Claims Tracking entries and may create a"
10 W !,"bill. This report will provide detail for all processed entries, including the"
11 W !,"bill number if a bill was created or the reason a bill could not be created."
12 ;
13 ; select sort/select by Auto Biller Date or Event Date
14 S DIR("?")="Sort the report by Event Date or by the Date(s) the Auto Biller Processed the Events."
15 S DIR(0)="S^1:Event Date;2:Auto Biller Date",DIR("B")="Event Date",DIR("A")="Sort By"
16 D ^DIR S IBSDR=+Y K DIR W ! I ('Y)!($D(DIRUT)) Q
17 ;
18 ; get date range
19 S IBDATES=$S(IBSDR=1:"Event Date",1:"Auto Biller Date"),IBDATES=$$FMDATES^IBCU2(IBDATES) I IBDATES="" Q
20 ;
21 ; get types of events to include in report
22 S DIR("?")="Select the Types of Events to include in the report."
23 S DIR(0)="S^1:Inpatient Admissions;2:Outpatient Visits;3:Prescriptions;4:All",DIR("B")="All",DIR("A")="Include"
24 D ^DIR S IBSEV=$S(+Y=4:"",1:+Y) K DIR I ('Y)!($D(DIRUT)) Q
25 ;
26 ; get types of auto biller results to include in report, either bill created or not
27 S DIR("?")="Include Claims Tracking events the Auto Biller was able to create bills for or those events the Auto Biller could not create a bill for (with the reason) or both types of events."
28 S DIR(0)="S^1:Bill Auto Created;2:No Bill Created;3:All",DIR("B")="All",DIR("A")="Include"
29 D ^DIR S IBSBC=$S(+Y=3:"",1:+Y) K DIR I ('Y)!($D(DIRUT)) Q
30 ;
31 ; get range of patient names
32 S DIR("?")="Select range of Patient Names to include in report." W !
33 S DIR(0)="FO" S DIR("B")="FIRST",DIR("A")="START WITH PATIENT NAME"
34 D ^DIR Q:$D(DIRUT) K DIR S IBPATS=$E(Y,1,$L(Y)-1)_$C($A($E(Y,$L(Y)))-1)_"~" I Y="FIRST" S IBPATS=""
35 ;
36 S DIR("?")="Select range of Patient Names to include in report."
37 S DIR(0)="FO^^I X'=""LAST"","""_IBPATS_"""]X K X",DIR("B")="LAST",DIR("A")="GO TO PATIENT NAME"
38 D ^DIR Q:$D(DIRUT) K DIR S:Y="LAST" Y="" S $P(IBPATS,U,2)=Y_"~"
39 ;
40 W !!,"Report requires 132 columns.",!
41 S IBQUIT=0 D DEV I IBQUIT G EXIT
42 ;
43RPT ;find, save, and print Auto Biller Report - entry for tasked jobs
44 ;
45 I IBSDR=1 D SORT1
46 I IBSDR=2 D SORT2
47 ;
48 D PRINT
49 ;
50EXIT ;clean up and quit
51 K ^TMP($J,"IBCDP") Q:$D(ZTQUEUED)
52 D ^%ZISC
53 Q
54 ;
55 ;
56SORT1 ; sort by Event Date in Claims Tracking
57 ; for each CT entry within the selected date range check/get it's auto biller entries, if they meet the criteria
58 N IBBEG,IBEND,IBEVDT,IBCTFN,IBABFN Q:'$G(IBDATES)
59 ;
60 S IBBEG=+$P(IBDATES,U,1)-.01,IBEND=+$P(IBDATES,U,2)+.7
61 ;
62 S IBEVDT=IBBEG F S IBEVDT=$O(^IBT(356,"D",IBEVDT)) Q:('IBEVDT)!(IBEVDT>IBEND) D
63 . S IBCTFN=0 F S IBCTFN=$O(^IBT(356,"D",IBEVDT,IBCTFN)) Q:'IBCTFN D
64 .. ;
65 .. S IBABFN=0 F S IBABFN=$O(^IBA(362.1,"C",IBCTFN,IBABFN)) Q:'IBABFN D
66 ... ;
67 ... D GETLN(IBABFN)
68 Q
69 ;
70SORT2 ; sort by Entry Date in Auto Biller
71 ; for each AB entry within the selected date range check/get the entry, if they meet the criteria
72 N IBBEG,IBEND,IBABFN,IBETDT Q:'IBDATES
73 ;
74 S IBBEG=+$P(IBDATES,U,1)-.01,IBEND=+$P(IBDATES,U,2)+.7
75 ;
76 S IBABFN=0 F S IBABFN=$O(^IBA(362.1,IBABFN)) Q:'IBABFN D
77 . S IBETDT=$P($G(^IBA(362.1,IBABFN,0)),U,5)
78 . ;
79 . I (IBETDT<IBBEG)!(IBETDT>IBEND) Q
80 . ;
81 . D GETLN(IBABFN)
82 ;
83 Q
84 ;
85 ;
86GETLN(IBABFN) ; check and select auto biller entries that meet the criteria, Input: all select criteria
87 ; Output: ^TMP($J,"IBCDP",sort date,event type,patient name_event date/time, AB FN) = CT FN
88 N IBAB0,IBCTFN,IBCT0,IBCTDT,IBCTTY,DFN,IBDFNN,IBABDT,IBDTBEG,IBDTEND,IBPTBEG,IBPTEND,IBSORT1,IBSORT3,IBX
89 Q:'$G(IBSDR) Q:'$G(IBDATES) S IBSEV=$G(IBSEV),IBSBC=$G(IBSBC),IBPATS=$G(IBPATS)
90 ;
91 S IBAB0=$G(^IBA(362.1,+$G(IBABFN),0)) Q:IBAB0=""
92 S IBCTFN=$P(IBAB0,U,2) Q:'IBCTFN S IBCT0=$G(^IBT(356,IBCTFN,0)) Q:IBCT0=""
93 ;
94 S IBCTDT=$P(IBCT0,U,6),IBCTTY=$P(IBCT0,U,18)
95 S DFN=$P(IBCT0,U,2) Q:'DFN S IBDFNN=$P($G(^DPT(DFN,0)),U,1)
96 S IBABDT=$P(IBAB0,U,5)
97 ;
98 S IBDTBEG=+$P(IBDATES,U,1)-.01,IBDTEND=+$P(IBDATES,U,2)+.7
99 S IBPTBEG=$P(IBPATS,U,1),IBPTEND=$P(IBPATS,U,2)
100 ;
101 ;
102 I IBSDR=1 I (IBCTDT<IBDTBEG)!(IBCTDT>IBDTEND) Q ; check entry within CT event date
103 I IBSDR=2 I (IBABDT<IBDTBEG)!(IBABDT>IBDTEND) Q ; check entry within AB entry date
104 ;
105 I IBSEV=1 I IBCTTY'=1 Q ; check types of events to include
106 I IBSEV=2 I IBCTTY'=2 Q
107 I IBSEV=3 I IBCTTY'=4 Q
108 ;
109 I +IBSBC S IBX=$$CHKBILL(IBCTFN) ; check if a bill is associated with the AB entry
110 I IBSBC=1,'IBX Q
111 I IBSBC=2,+IBX Q
112 ;
113 I IBPTBEG'="",IBDFNN']IBPTBEG Q ; check patient name is within the range selected
114 I IBPTEND'="",IBDFNN]IBPTEND Q
115 ;
116 ;
117 S IBSORT1=$S(IBSDR=1:IBCTDT,1:IBABDT),IBSORT1=$E(IBSORT1,1,7) ; sort by CT event date or AB entry date
118 S IBSORT3=IBDFNN_" ^"_IBCTDT ; sort by patient name and date/time
119 ;
120 S ^TMP($J,"IBCDP",+IBSORT1,+IBCTTY,IBSORT3,IBABFN)=IBCTFN
121 Q
122 ;
123CHKBILL(IBCTFN) ; return first bill found if Claims Tracking event had a bill created for it
124 N IBX,IBABFN,IBAB0 S IBX=0
125 I +$G(IBCTFN) S IBABFN=0 F S IBABFN=$O(^IBA(362.1,"C",IBCTFN,IBABFN)) Q:'IBABFN D Q:+IBX
126 . S IBAB0=$G(^IBA(362.1,IBABFN,0)) S IBX=+$P(IBAB0,U,3)
127 Q IBX
128 ;
129 ;
130 ;
131PRINT ;print the report from the temp sort file to the appropriate device
132 N IBSCRPT,IBPGN,IBLN,IBQUIT,IBS1,IBS2,IBS3,IBABFN,IBAB0,IBCTFN,IBCT0,DFN,IBDFN0,IBBLFN,IBBL0,IBBLU,IBX
133 N IBDFNN,IB1U4N,IBTYP,IBEVDT,IBBILL,IBBSTAT,IBBTF,IBBSF,IBBST,IBABC,IBHDR1,IBHDR2,IBHDR3,IBHDR4
134 I '$D(ZTQUEUED) U IO
135 S IBSCRPT="IBCDP",IBPGN=0,IBLN=99999,IBQUIT=0 D GETHDR Q:$$HDR
136 ;
137 S IBS1="" F S IBS1=$O(^TMP($J,IBSCRPT,IBS1)) Q:IBS1="" D Q:IBQUIT
138 . I +$G(IBSDR) W !,?20,$S(IBSDR=1:"Event Date: ",1:"Auto Bill Date: "),$$FMTE^XLFDT(IBS1),! S IBLN=IBLN+2
139 . ;
140 . S IBS2="" F S IBS2=$O(^TMP($J,IBSCRPT,IBS1,IBS2)) Q:IBS2="" D Q:IBQUIT W ! S IBLN=IBLN+1
141 .. S IBS3="" F S IBS3=$O(^TMP($J,IBSCRPT,IBS1,IBS2,IBS3)) Q:IBS3="" D Q:IBQUIT
142 ... S IBABFN="" F S IBABFN=$O(^TMP($J,IBSCRPT,IBS1,IBS2,IBS3,IBABFN)) Q:IBABFN="" D S IBQUIT=$$HDR Q:IBQUIT
143 .... ;
144 .... S IBAB0=$G(^IBA(362.1,IBABFN,0)) Q:IBAB0=""
145 .... S IBCTFN=$P(IBAB0,U,2) Q:'IBCTFN S IBCT0=$G(^IBT(356,IBCTFN,0)) Q:IBCT0=""
146 .... S DFN=$P(IBCT0,U,2) Q:'DFN S IBDFN0=$G(^DPT(DFN,0))
147 .... S IBBLFN=$P(IBAB0,U,3),IBBL0="",IBBLU=""
148 .... I +IBBLFN S IBBL0=$G(^DGCR(399,IBBLFN,0)),IBBLU=$G(^DGCR(399,IBBLFN,"U"))
149 .... ;
150 .... S IBDFNN=$P(IBDFN0,U,1)
151 .... S IB1U4N=$E(IBDFN0,1)_$E($P(IBDFN0,U,9),6,9)
152 .... S IBTYP=$P($G(^IBE(356.6,+$P(IBCT0,U,18),0)),U,1)
153 .... S IBEVDT=$$FMTE^XLFDT($P(IBCT0,U,6)),IBEVDT=$TR(IBEVDT,"@"," ")
154 .... S IBBILL=$P(IBBL0,U,1)
155 .... S IBBSTAT=$$EXSET^IBEFUNC($P(IBBL0,U,13),399,.13)
156 .... S IBBTF=$$EXSET^IBEFUNC($P(IBBL0,U,6),399,.06)
157 .... S IBBSF=$$FMTE^XLFDT(IBBLU)
158 .... S IBBST=$$FMTE^XLFDT($P(IBBLU,U,2))
159 .... ;
160 .... W !,$E(IBDFNN,1,20),?22,$E(IB1U4N,1,6),?30,$E(IBTYP,U,4),?37,$P(IBEVDT,":",1,2),?60,IBBILL,?70,$E(IBBSTAT,1,7),?82,$E(IBBTF,1,15),?102,IBBSF,?117,IBBST S IBLN=IBLN+1
161 .... ;
162 .... S IBABC=0 F S IBABC=$O(^IBA(362.1,IBABFN,11,IBABC)) Q:'IBABC D
163 ..... S IBX=$G(^IBA(362.1,IBABFN,11,IBABC,0)) I IBX'="" W !,?37,IBX S IBLN=IBLN+1
164 ;
165 I 'IBQUIT D PAUSE
166 Q
167 ;
168 ;
169GETHDR ; set up header lines
170 S IBHDR1="AUTOMATED BILLER ERRORS/COMMENTS FOR "_$$FMTE^XLFDT($G(IBDATES))_" - "_$$FMTE^XLFDT($P($G(IBDATES),U,2))
171 S IBHDR1=IBHDR1_$J("",(IOM-$L(IBHDR1)-30))_$P($$HTE^XLFDT($H),":",1,2)_$J("",$L(IOM-8))_"Page "
172 S IBHDR2=" EVENT BILL TIMEFRAME OF STATEMENT STATEMENT"
173 S IBHDR3="PATIENT TYPE EPISODE DATE NUMBER STATUS BILL COVERS FROM COVERS TO"
174 S IBHDR4="",$P(IBHDR4,"-",IOM+1)=""
175 Q
176 ;
177 ;
178HDR() ;print the report header
179 N IBQUIT,X,Y S IBQUIT=0
180 S IBQUIT=$$STOP I +IBQUIT G HDRQ
181 I IBLN<(IOSL-5) G HDRQ
182 I IBPGN>0 D PAUSE I +IBQUIT G HDRQ
183 S IBPGN=IBPGN+1,IBLN=5
184 I IBPGN>1!($E(IOST,1,2)["C-") W @IOF
185 ;
186 W !,IBHDR1,IBPGN,!,IBHDR2,!,IBHDR3,!,IBHDR4
187HDRQ Q IBQUIT
188 ;
189 ;
190PAUSE ;pause at end of screen if being displayed on a terminal
191 Q:$E(IOST,1,2)'["C-" S DIR(0)="E" D ^DIR K DIR I $D(DUOUT)!($D(DIRUT)) S IBQUIT=1
192 Q
193 ;
194 ;
195DEV ;get the device
196 S IBQUIT=0 S %ZIS="QM",%ZIS("A")="OUTPUT DEVICE: " D ^%ZIS I POP S IBQUIT=1 Q
197 I $D(IO("Q")) S ZTRTN="RPT^IBCDP",ZTDESC="Auto Biller Report",ZTSAVE("IB*")="" D ^%ZTLOAD K IO("Q") S IBQUIT=1
198 Q
199 ;
200STOP() ; determine if user has requested the queued report to stop
201 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPGN) W !,"***TASK STOPPED BY USER***"
202 Q +$G(ZTSTOP)
Note: See TracBrowser for help on using the repository browser.