1 | IBCB2 ;ALB/AAS - Process bill after enter/edited ;13-DEC-89
|
---|
2 | ;;2.0;INTEGRATED BILLING;**52,51,161,182,155**;21-MAR-94
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | ;MAP TO DGCRB2
|
---|
6 | ;
|
---|
7 | ;IBQUIT = Flag to stop processing
|
---|
8 | ;IBVIEW = Flag showing Bill has been viewed
|
---|
9 | ;IBDISP = Flag showing Bill entering display has been viewed.
|
---|
10 | ;IBNOFIX = Flag to indicate do not ask to edit or review bill screens
|
---|
11 | ;IBREEDIT = Flag to indicate Bill has been re-edited
|
---|
12 | ;
|
---|
13 | VIEW ;View screens; if status allows editing , allow editing
|
---|
14 | N Y,DIR
|
---|
15 | S IBPOPOUT=0
|
---|
16 | S IBVIEW=1,IBV=$S($D(IBV):IBV,1:1)
|
---|
17 | S DIR(0)="YA",DIR("B")="NO",DIR("A")="WANT TO "_$S('IBV:"EDIT",1:"REVIEW")_" SCREENS? ",DIR("?",1)=" YES - to "_$S('IBV:"EDIT",1:"REVIEW")_" the screens",DIR("?")=" NO - To take no action"
|
---|
18 | D ^DIR K DIR
|
---|
19 | S:$D(DTOUT) IBQUIT=1
|
---|
20 | Q:Y'=1
|
---|
21 | I $G(IBREEDIT)=1,'IBV S IBREEDIT=2 ; set flag indicating re-edit
|
---|
22 | VIEW1 S IBVIEW=1,IBEDIT=0
|
---|
23 | D SCREENS
|
---|
24 | S:$G(IBPOPOUT) IBQUIT=1
|
---|
25 | Q
|
---|
26 | ;
|
---|
27 | DISP S IB("S")=$S($D(^DGCR(399,IBIFN,"S")):^("S"),1:"")
|
---|
28 | W ! D DISP^IBCNQ W !
|
---|
29 | S IBDISP=1 Q
|
---|
30 | Q
|
---|
31 | ;
|
---|
32 | EDITS ; Perform edits on bill prior to authorization/transmission
|
---|
33 | N IBREEDIT
|
---|
34 | ED1 ;
|
---|
35 | S IBQUIT=0
|
---|
36 | I '$D(IBER)!('$D(PRCASV)) D ALLED(.IBQUIT)
|
---|
37 | ;
|
---|
38 | ; If the user is wanting to quit, but there are some unresolved
|
---|
39 | ; errors reported by ClaimsManager, then capture the user's Exit
|
---|
40 | ; comments.
|
---|
41 | ;
|
---|
42 | I $$CM^IBCIUT1(IBIFN),IBQUIT,$P($G(^IBA(351.9,IBIFN,0)),U,2)=4 D COMMENT^IBCIUT7(IBIFN,1)
|
---|
43 | ;
|
---|
44 | Q:IBQUIT
|
---|
45 | D:'$D(IBDISP) DISP
|
---|
46 | ;
|
---|
47 | ; If claim re-edit, then call the IB edit checks again
|
---|
48 | I '$D(IBVIEW) S IBREEDIT=1 D VIEW I $G(IBREEDIT)=2 K IBER,IBDISP,IBVIEW G ED1
|
---|
49 | Q
|
---|
50 | ;
|
---|
51 | ALLED(IBQUIT) ; Billing edit/correction
|
---|
52 | N IBQUIT1,IBDONE1,IBDONE,IBEDIT,IBCORR,IBER,IBPRT,IBXERR
|
---|
53 | S (IBQUIT,IBDONE,IBCORR)=0,IBER=""
|
---|
54 | ; IBDONE = 1 ==> exit, no errors
|
---|
55 | ; IBQUIT = 1 ==> exit, errors not corrected
|
---|
56 | I $$FT^IBCEF(IBIFN)=2,'$G(IBNOFIX) D DISP24(IBIFN,.IBCORR,.IBQUIT)
|
---|
57 | ;
|
---|
58 | F D Q:IBQUIT!IBDONE D VIEW1 I $$FT^IBCEF(IBIFN)=2,'$G(IBNOFIX),'IBQUIT S IBCORR=0 D DISP24(IBIFN,.IBCORR,.IBQUIT)
|
---|
59 | . I $G(IBPOPOUT) S IBQUIT=1
|
---|
60 | . Q:IBQUIT!IBCORR
|
---|
61 | . I $G(IBNOFIX) D
|
---|
62 | .. W !!,"... Checking claim validity"
|
---|
63 | . E D
|
---|
64 | .. W !!,"... Executing national IB edits"
|
---|
65 | . D EN^IBCBB,LOCERR
|
---|
66 | . ;
|
---|
67 | . I $G(IBER)'=""!$D(IBXERR) D Q:'IBDONE
|
---|
68 | .. D DSPLERR ; Displays warnings/errors
|
---|
69 | .. K IBXERR
|
---|
70 | .. Q:IBQUIT!(IBDONE)
|
---|
71 | .. I $G(IBNOFIX) S IBDONE=1 Q
|
---|
72 | .. I '$$ASKEDIT($G(IBAC)) W ! S IBQUIT=1 ; Don't want to re-edit
|
---|
73 | .. ;
|
---|
74 | . I $G(IBNOFIX) S IBDONE=1 Q
|
---|
75 | . S IBEDIT=0
|
---|
76 | . I $S($P($G(^DGCR(399,IBIFN,0)),U,13)>2:1,$D(PRCASV):'$D(PRCASV("OKAY")),1:0) D S:'IBQUIT&'IBEDIT IBDONE=1 Q
|
---|
77 | .. N IBQUIT1
|
---|
78 | .. S IBQUIT1=0
|
---|
79 | .. W !!!,"... Executing A/R edits"
|
---|
80 | .. I $P($G(^DGCR(399,IBIFN,0)),U,13)>2 D GVAR^IBCBB,ARRAY^IBCBB1
|
---|
81 | .. D ARCHK($G(IBNOFIX),0,.IBQUIT1,.IBQUIT,.IBEDIT,.PRCASV)
|
---|
82 | . S IBDONE=1 ; No errors
|
---|
83 | . S:$G(IBPRT("PRT"))'<0 IBQUIT=0
|
---|
84 | Q
|
---|
85 | ;
|
---|
86 | ARCHK(IBNOFIX,IBNOPRT,IBQUIT1,IBQUIT,IBEDIT,PRCASV) ; A/R Verification
|
---|
87 | ; Returns IBEDIT, IBQUIT1, IBQUIT,PRCASV array if passed by reference
|
---|
88 | ; IBNOFIX = 1 if no editing needed
|
---|
89 | ; IBNOPRT = 1 if no printing needed
|
---|
90 | F D ^PRCASVC6 D Q:IBQUIT1!IBEDIT D GVAR^IBCBB,ARRAY^IBCBB1
|
---|
91 | . I '$G(IBNOPRT) Q:$G(IBPRT("PRT"))<0
|
---|
92 | . I PRCASV("OKAY") W:'$G(IBNOPRT) !!,"No A/R errors found" S IBQUIT1=1 Q
|
---|
93 | . I 'PRCASV("OKAY") D Q
|
---|
94 | .. D DSPARERR($G(IBNOPRT)) ; Display A/R errors
|
---|
95 | .. Q:IBQUIT
|
---|
96 | .. I $G(IBNOFIX) S IBQUIT1=1 Q
|
---|
97 | .. I '$$ASKEDIT($G(IBAC)) W !,"There is an unresolved A/R error - cannot authorize bill" D PAUSE^VALM1 S (IBQUIT,IBQUIT1)=1 Q
|
---|
98 | .. S IBEDIT=1
|
---|
99 | ;
|
---|
100 | Q
|
---|
101 | ;
|
---|
102 | DSPLERR ; Display national/local edits failed
|
---|
103 | N Z
|
---|
104 | D PRTH(.IBPRT)
|
---|
105 | I IBPRT("PRT")<0 S IBQUIT=1 Q
|
---|
106 | S Z=0 F S Z=$O(^TMP($J,"BILL-WARN",Z)) Q:'Z W !,^(Z) W:'$O(^(Z)) !
|
---|
107 | S Y2=""
|
---|
108 | I IBER'="WARN" F I=1:1 S X=$P(IBER,";",I) Q:X="" W:I=1 !?5,"**Errors**:" I $D(^IBE(350.8,+$O(^IBE(350.8,"AC",X,0)),0)) S Y=^(0),Y1=$P(Y,"^",5),Y2=Y2_Y1 I Y1<5 W !?5,$E($P(Y,"^",2),1,80)
|
---|
109 | ; IBXERR = local edits return error array
|
---|
110 | ; If IBXERR returns = 1 then we have at least one error
|
---|
111 | ; = "" or 0, then we have only local warnings
|
---|
112 | ; undefined = no local errors or warnings
|
---|
113 | I $D(IBXERR) D
|
---|
114 | . S I="" W !!,?3,"Local Edits:"
|
---|
115 | . S:$G(IBXERR) Y2=3,IBER="L"
|
---|
116 | . F S I=$O(IBXERR(I)) Q:I="" W !,?5,$E(IBXERR(I),1,75)
|
---|
117 | I $G(IBPRT("PRT")) D CLOSE(.IBPRT)
|
---|
118 | G:$G(IBNOFIX) Q
|
---|
119 | I $G(IBER)="WARN"!($G(IBXERR)=0) D ;Warnings only - make biller stop and look
|
---|
120 | . W !
|
---|
121 | . N DIR,X,Y
|
---|
122 | . S DIR(0)="YA",DIR("B")="NO",DIR("A",1)="THIS BILL STILL HAS ONE OR MORE WARNINGS - PLEASE REVIEW THEM CAREFULLY",DIR("A")="ARE YOU SURE IT'S OK TO CONTINUE? "
|
---|
123 | . D ^DIR K DIR
|
---|
124 | . I Y'=1 S Y2=3 Q
|
---|
125 | . S IBER="",IBDONE=1 K IBXERR
|
---|
126 | I $S(Y2'["3"&'$G(IBXERR):0,1:1) K IBXERR
|
---|
127 | Q K ^TMP($J,"BILL-WARN")
|
---|
128 | Q
|
---|
129 | ;
|
---|
130 | DSPARERR(IBNOPRT) ; Displays A/R errors
|
---|
131 | N I,J,Y,X,ERRPRT
|
---|
132 | I '$G(IBNOPRT) D PRTH(.IBPRT) I IBPRT("PRT")<0 S IBQUIT=1 Q
|
---|
133 | I $P($G(PRCAERR),U,2)'="" D
|
---|
134 | . N Z
|
---|
135 | . S Z=+$O(^IBE(350.8,"C",$P(PRCAERR,U,2),0)),Z=$P($G(^IBE(350.8,+Z,0)),U,2)
|
---|
136 | . W !,?5,"An A/R error has been reported - bill cannot be authorized",!!,?5,$P(PRCAERR,U,2)," - ",$S(Z'="":Z,1:"??")
|
---|
137 | E D
|
---|
138 | . W !,?5,"An undetermined A/R error was found - "_$G(PRCAERR)
|
---|
139 | I $G(IBPRT("PRT")) D CLOSE(.IBPRT)
|
---|
140 | Q
|
---|
141 | ;
|
---|
142 | NOPTF S IBAC1=1 I $D(^DGCR(399,IBIFN,0)),$P(^(0),"^",8),'$D(^DGPT($P(^(0),"^",8),0)) S IBAC1=0
|
---|
143 | Q
|
---|
144 | ;
|
---|
145 | NOPTF1 W !!,*7,"PTF Record for this Bill was DELETED!",!,"Further processing not allowed. Cancel and re-enter." Q
|
---|
146 | ;
|
---|
147 | LOCERR ; Check for local edits
|
---|
148 | ; Execute screen post-processor for bills with local scrn 9 affiliations
|
---|
149 | N IBZ,IBXIEN,IBPRT
|
---|
150 | K IBXERR
|
---|
151 | S IBZ=$$LOCSCRN^IBCSC9(IBIFN)
|
---|
152 | I IBZ S IBXIEN=IBIFN W !!,"... Executing local IB edits" D FPOST^IBCEFG7(IBZ,0,.IBXERR) I '$D(IBXERR) W !!,"No errors found for local edits"
|
---|
153 | Q
|
---|
154 | ;
|
---|
155 | PRTH(IBPRT,IBA) ; Print a heading for error/warnings sent to a printer
|
---|
156 | ; Returns IBPRT = 1 if valid pritner selected
|
---|
157 | ; IBPRT = -1 if '^' entered
|
---|
158 | ; IBPRT = 0 if home device
|
---|
159 | N POP,%ZIS,POP
|
---|
160 | S %ZIS("A")="ERROR/WARNING OUTPUT DEVICE: "
|
---|
161 | D ^%ZIS
|
---|
162 | I POP S IBPRT("PRT")=-1 Q
|
---|
163 | I IO=IO(0) S IBPRT("PRT")=0 Q
|
---|
164 | S IBPRT("PRT")=1
|
---|
165 | U IO
|
---|
166 | W !,"INCONSISTENCIES LIST FOR BILL #: ",$P($G(^DGCR(399,IBIFN,0)),U),!,$J("",29),"AT: ",$$FMTE^XLFDT($$NOW^XLFDT,2),!,$J("",19),"GENERATED BY: ",$P($G(^VA(200,DUZ,0)),U),!!
|
---|
167 | Q
|
---|
168 | ;
|
---|
169 | CLOSE(IBPRT) ; Close device, reset printer flag
|
---|
170 | D ^%ZISC
|
---|
171 | S IBPRT("PRT")=0
|
---|
172 | D HOME^%ZIS
|
---|
173 | Q
|
---|
174 | ;
|
---|
175 | ASKEDIT(IBAC) ; Ask if edit/review of bill is desired
|
---|
176 | ; FUNCTION returns 0/1 for NO/YES
|
---|
177 | ; IBAC = flag for function being performed - to determine edit/review
|
---|
178 | N DIR,X,Y
|
---|
179 | S DIR(0)="YA"
|
---|
180 | S DIR("A",1)=" ",DIR("A",2)=" ",DIR("A")="Do you wish to "_$S($G(IBAC)<4:"edit",1:"review")_" the inconsistencies now? ",DIR("B")="NO"
|
---|
181 | S DIR("?",1)=" ",DIR("?",2)=" ",DIR("?",3)=" YES - To edit inconsistent fields",DIR("?")=" NO - To discontinue this process."
|
---|
182 | D ^DIR K DIR
|
---|
183 | Q (Y=1)
|
---|
184 | ;
|
---|
185 | SCREENS ;
|
---|
186 | N IBH
|
---|
187 | D ^IBCSCU,^IBCSC1
|
---|
188 | I $G(IBV) K IBPOPOUT
|
---|
189 | Q
|
---|
190 | ;
|
---|
191 | DISP24(IBIFN,IBCORR,IBQUIT) ;
|
---|
192 | W @IOF D BL24^IBCSCH(IBIFN,0)
|
---|
193 | S DIR("A",1)=" ",DIR("A")="Are the above charges correct for this bill? ",DIR("B")="YES",DIR(0)="YA" D ^DIR K DIR
|
---|
194 | I Y'=1 D
|
---|
195 | . I Y=0,$$ASKEDIT($G(IBAC)) S IBCORR=1 Q
|
---|
196 | . S IBQUIT=1
|
---|
197 | Q
|
---|
198 | ;
|
---|
199 | IICM(IBIFN) ; Ingenix ClaimsManager: Claim Scrubber
|
---|
200 | ; Send the bill to ClaimsManager, the IBCISTAT variable returned from ClaimsManager indicates
|
---|
201 | ; 3 - Passed CM with no errors
|
---|
202 | ; 5 - User overriding the CM errors
|
---|
203 | ; 7 - the CM interface isn't working
|
---|
204 | ; 11 - User overriding the CM errors (CM not updated)
|
---|
205 | ;
|
---|
206 | ; Returns False (0) if the bill fails the ClaimsManager Scrubber/errors found
|
---|
207 | ; Returns True (1) if the bill passed the ClaimsManager Scrubber/no errors found or ClaimsManager not On at site
|
---|
208 | ;
|
---|
209 | N IBOK S IBOK=1
|
---|
210 | I +$G(IBIFN),$$CM^IBCIUT1(IBIFN) S IBCISNT=1 D ST2^IBCIST I '$F(".3.5.7.11.","."_IBCISTAT_".") S IBOK=0
|
---|
211 | Q IBOK
|
---|
212 | ;
|
---|
213 | IIQMED(IBIFN) ; DSS QuadraMed Interface: QuadraMed Claim Scrubber
|
---|
214 | ; Send the bill to the QuadraMed Claim Scrubber
|
---|
215 | ; Returns False (0) if the bill fails the QuadraMed Scrubber/errors found
|
---|
216 | ; Returns True (1) if the bill passed the QuadraMed Scrubber/no errors found or QuadraMed not On at site
|
---|
217 | ;
|
---|
218 | ; QuadraMed Scrubber EN^VEJDIBSC returns IBQMED = 1 if no error found, returns 0 if error found
|
---|
219 | ;
|
---|
220 | N IBQMED S IBQMED=1
|
---|
221 | I +$G(IBIFN),$$QMED^IBCU1("EN^VEJDIBSC",IBIFN) D EN^VEJDIBSC(IBIFN)
|
---|
222 | Q IBQMED
|
---|