close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBECUSO.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

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

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

initial load of WorldVistAEHR
File size: 6.1 KB
RevLine 
1IBECUSO ;RLM/DVAMC - TRICARE PHARMACY BILLING OUTPUTS ; 21-AUG-96
2 ;;2.0;INTEGRATED BILLING;**52,240,309,347**;21-MAR-94;Build 24
3 ;
4REJ ; Generate the Pharmacy Billing Reject report.
5 ;
6 ; - quit if there are no rejects
7 I '$O(^IBA(351.52,0)) W !!,"There are no rejects to be printed." G REJQ
8 ;
9 ; - select a device
10 S %ZIS="QM" D ^%ZIS G:POP REJQ
11 I $D(IO("Q")) D G REJQ
12 .S ZTRTN="REJDQ^IBECUSO",ZTDESC="IB - LIST TRICARE PHARMACY BILLING REJECTS"
13 .D ^%ZTLOAD W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
14 .K ZTSK,IO("Q") D HOME^%ZIS
15 ;
16 U IO
17 ;
18REJDQ ; Tasked entry point.
19 ;
20 S (IBPAG,IBQ)=0 D REJHDR
21 ;
22 ; - print rejects
23 S IBR=0 F S IBR=$O(^IBA(351.52,IBR)) Q:'IBR D Q:IBQ
24 .S IBR0=$G(^IBA(351.52,IBR,0)),IBR1=$G(^(1))
25 .Q:'IBR0
26 .;
27 .S DFN=$$FILE^IBRXUTL(+IBR0,2),IBRXD=$$RXZERO^IBRXUTL(DFN,+IBR0)
28 .Q:IBRXD=""
29 .S IBFDT=$$FDT($P(IBR0,"^"))
30 .;
31 .; - display the prescription
32 .I $Y>(IOSL-4) D PAUSE Q:IBQ D REJHDR
33 .D REJERR
34 .;
35 .; - display errors
36 .F I=1:1 Q:$P(IBR1,",",I)="" S IBERRP=$P(IBR1,",",I) Q:IBERRP="" D Q:IBQ
37 ..I $Y>(IOSL-2) D PAUSE Q:IBQ D REJHDR,REJERR
38 ..S IBTXT=$$ERRTXT^IBECUS22(IBERRP)
39 ..I IBTXT]"" W !?4,IBTXT
40 ;
41 ; - end-of-report pause
42 D:'IBQ PAUSE
43 ;
44REJQ I '$D(ZTQUEUED) D ^%ZISC
45 K IBFDT,IBPAG,IBQ,IBR,IBR0,IBR1,IBRXD,DFN,IBERRP,IBTXT
46 Q
47 ;
48 ;
49REJHDR ; Print the Reject report header.
50 I $E(IOST,1,2)="C-"!(IBPAG) W @IOF,*13
51 S IBPAG=IBPAG+1
52 W !,$$DASH(),!,"Date: ",$$DAT1^IBOUTL(DT),?(IOM/2)-14,"IPS Unresolved Reject Report"
53 W ?(IOM-10),"Page: ",IBPAG,!,$$DASH()
54 Q
55 ;
56REJERR ; Write the prescription and name.
57 W !!,"RX# ",$P(IBRXD,"^"),", filled on ",$$DAT1^IBOUTL(IBFDT)
58 W " (",$E($P($G(^DPT(DFN,0)),"^"),1,17)," ",$P($G(^(0)),"^",9),")"
59 W " rejected because:"
60 Q
61 ;
62DASH() ; Return a dashed line.
63 Q $TR($J("",IOM)," ","=")
64 ;
65PAUSE ; Page break
66 Q:$E(IOST,1,2)'="C-"
67 N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
68 F IBX=$Y:1:(IOSL-3) W !
69 S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S IBQ=1
70 Q
71 ;
72 ;
73 ;
74TRN ; Generate the Pharmacy Billing Transmission Report
75 ;
76 ; - select dates
77 K DIR S DIR(0)="D^2960101:"_DT,DIR("A")="Beginning Date:" D ^DIR G:$D(DIRUT) TRNQ S IBBEG=Y
78 K DIR S DIR(0)="D^"_IBBEG_":"_DT,DIR("A")="Ending Date:" D ^DIR G:$D(DIRUT) TRNQ S IBEND=Y
79 I IBBEG>IBEND W !,"Beginning data must be before ending date.",! G TRN
80 ;
81 ; - select a device
82 S %ZIS="QM" D ^%ZIS G:POP TRNQ
83 I $D(IO("Q")) D G TRNQ
84 .S ZTRTN="TRNDQ^IBECUSO",ZTDESC="IB - LIST TRICARE PHARMACY BILLING TRANSMISSIONS"
85 .F I="IBBEG","IBEND" S ZTSAVE(I)=""
86 .D ^%ZTLOAD W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
87 .K ZTSK,IO("Q") D HOME^%ZIS
88 ;
89 U IO
90 ;
91TRNDQ ; Tasked entry point.
92 ;
93 S (IBPAG,IBQ)=0 D TRNHDR
94 ;
95 ; - print transactions
96 S IBC=0 F S IBC=$O(^IBA(351.5,IBC)) Q:'IBC D Q:IBQ
97 .S IBCD=$G(^IBA(351.5,IBC,0)),IBCD2=$G(^(2)),IBCD5=$G(^(5)),IBCD6=$G(^(6))
98 .Q:'IBCD
99 .S IBD=$$FILE^IBRXUTL(+IBCD,101) I IBD="" S IBD=$$FILE^IBRXUTL(+IBCD,22)
100 .I IBD<IBBEG Q
101 .I IBD>IBEND Q
102 .;
103 .S IBDPT(0)=$G(^DPT($P(IBCD,"^",2),0)),IBRXD=$$RXZERO^IBRXUTL($P(IBCD,"^",2),+IBCD)
104 .S IBFDT=$$FDT($P(IBCD,"^"))
105 .;
106 .I $Y>(IOSL-5) D PAUSE Q:IBQ D TRNHDR
107 .D TRNDAT
108 .D ZERO^IBRXUTL(+$P(IBRXD,"^",6))
109 .W !," Drug Name: ",$G(^TMP($J,"IBDRUG",+$P(IBRXD,"^",6),.01))
110 .K ^TMP($J,"IBDRUG")
111 .;
112 .W !?5,"Status: ",$S($P(IBCD6,"^")]"":"Reversed",IBCD5]"":"Rejected",1:"Accepted")
113 .;
114 .; - display errors
115 .I IBCD5]"" F I=1:1 S IBERRP=$P(IBCD5,",",I) Q:IBERRP="" D Q:IBQ
116 ..I $Y>(IOSL-2) D PAUSE Q:IBQ D TRNHDR,TRNDAT
117 ..S IBTXT=$$ERRTXT^IBECUS22(IBERRP)
118 ..I IBTXT]"" W !?4,IBTXT
119 .Q:IBCD5]""
120 .;
121 .I $Y>(IOSL-3) D PAUSE Q:IBQ D TRNHDR,TRNDAT
122 .W !,$P(IBCD,"^",4),?15,$J($P(IBCD,"^",5),6),?25,$J($P(IBCD2,"^"),6),?35,$J($P(IBCD2,"^",2),6),?45,$J($P(IBCD2,"^",3),6),?55,$J($P(IBCD2,"^",5),6)
123 .W !?15,$P(IBCD2,"^",6),?39,$P(IBCD2,"^",7)
124 .;
125 .I $P(IBCD6,"^",3)]"" F I=1:1 S IBERRP=$P($P(IBCD6,"^",3),",",I) Q:IBERRP="" D Q:IBQ
126 ..I $Y>(IOSL-2) D PAUSE Q:IBQ D TRNHDR,TRNDAT
127 ..S IBTXT=$$ERRTXT^IBECUS22(IBERRP)
128 ..I IBTXT]"" W !?4,IBTXT
129 .;
130 .I $P(IBCD6,"^")]"" D
131 ..I $Y>(IOSL-1) D PAUSE Q:IBQ D TRNHDR,TRNDAT
132 ..W !,"Reversal Authorization # ",$P(IBCD6,"^"),?40,"Reversed by: ",$P($G(^VA(200,+$P(IBCD6,"^",2),0)),"^")
133 ;
134 ; - end-of-report pause
135 D:'IBQ PAUSE
136 ;
137TRNQ I '$D(ZTQUEUED) D ^%ZISC
138 K IBPAG,IBQ,IBR,IBR0,IBR1,IBRXD,DFN,IBERRP,IBTXT,IBBEG,IBEND
139 K IBC,IBCD,IBCD2,IBCD5,IBCD6,IBDPT,IBD,IBFDT
140 Q
141 ;
142TRNHDR ; Print the Transmission Report header.
143 I $E(IOST,1,2)="C-"!(IBPAG) W @IOF,*13
144 S IBPAG=IBPAG+1
145 W !,$$DASH(),!,"Date: ",$$DAT1^IBOUTL(DT),?(IOM/2)-16,"IPS Prescription Status Report"
146 W ?(IOM-10),"Page: ",IBPAG
147 W !?(IOM/2)-17 S Y=IBBEG X ^DD("DD") W Y," through " S Y=IBEND X ^DD("DD") W Y
148 W !,"RX#",?15,"Fill Date",?27,"Patient Name",?62,"Patient SSN"
149 W !,"NDC",?15,"AWP",?25,"Copay",?35,"Ing Cost",?45,"Fee Paid",?55,"Total PD"
150 W !?15,"Auth. #",?39,"Message"
151 W !,"Reject Failure Codes"
152 W !,$$DASH(),!
153 Q
154 ;
155TRNDAT ; Display basic description information.
156 W !!,$P(IBRXD,"^"),?15,$$DAT1^IBOUTL(IBFDT)
157 W ?27,$P(IBDPT(0),"^"),?62,$P(IBDPT(0),"^",9)
158 Q
159 ;
160FDT(X) ; Find the Fill Date for the prescription.
161 ; Input: X -- 1;2 where 1 :> pointer to the rx in file #52, and
162 ; 2 :> pointer to the re-fill in #52.1, or
163 ; 0 if this is the original fill.
164 N IBRXN,Y,DFN S Y=""
165 I $G(X)="" G FDTQ
166 S IBRXN=+X
167 I $P(X,";",2) S Y=$$SUBFILE^IBRXUTL(IBRXN,$P(X,";",2),52,.01) G FDTQ
168 S DFN=$$FILE^IBRXUTL(IBRXN,2),Z2=$$RXSEC^IBRXUTL(DFN,IBRXN),Z3=$$RX3^IBRXUTL(DFN,IBRXN)
169 S Y=$S($P(Z2,"^",2):$P(Z2,"^",2),+Z3:+Z3,$P(Z2,"^",5):$P(Z2,"^",5),1:"")
170FDTQ Q Y
171 ;
172AWP ;
173 I '$D(^JADUTIL("AWP UPDATE")) W !,"No updates on file" Q
174 W !,"Date Quantity"
175 S A="" F S A=$O(^JADUTIL("AWP UPDATE",A)) Q:'A D
176 .I A<($P($H,",")-52) K ^JADUTIL("AWP UPDATE",A) Q
177 .S %H=A D YMD^%DTC S Y=X X ^DD("DD")
178 .W !,Y," ",^JADUTIL("AWP UPDATE",A)
179 Q
180 ;
181 ;
182 ;
183REM ; Delete rejects.
184 W !!,"Delete entry from IPS error file"
185 W !,"Delete RX#: " R JADTA:DTIME Q:JADTA=""!(JADTA="^")
186 I '$D(^JADREJ(JADTA)) W !,JADTA," is not in the error file." G REM
187 K ^JADREJ(JADTA) W !,JADTA," has been deleted." G REM
188 Q
Note: See TracBrowser for help on using the repository browser.