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

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

initial load of FOIAVistA 6/30/08 version

File size: 8.1 KB
Line 
1IBCB2 ;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 ;
13VIEW ;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
22VIEW1 S IBVIEW=1,IBEDIT=0
23 D SCREENS
24 S:$G(IBPOPOUT) IBQUIT=1
25 Q
26 ;
27DISP 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 ;
32EDITS ; Perform edits on bill prior to authorization/transmission
33 N IBREEDIT
34ED1 ;
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 ;
51ALLED(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 ;
86ARCHK(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 ;
102DSPLERR ; 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
127Q K ^TMP($J,"BILL-WARN")
128 Q
129 ;
130DSPARERR(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 ;
142NOPTF S IBAC1=1 I $D(^DGCR(399,IBIFN,0)),$P(^(0),"^",8),'$D(^DGPT($P(^(0),"^",8),0)) S IBAC1=0
143 Q
144 ;
145NOPTF1 W !!,*7,"PTF Record for this Bill was DELETED!",!,"Further processing not allowed. Cancel and re-enter." Q
146 ;
147LOCERR ; 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 ;
155PRTH(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 ;
169CLOSE(IBPRT) ; Close device, reset printer flag
170 D ^%ZISC
171 S IBPRT("PRT")=0
172 D HOME^%ZIS
173 Q
174 ;
175ASKEDIT(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 ;
185SCREENS ;
186 N IBH
187 D ^IBCSCU,^IBCSC1
188 I $G(IBV) K IBPOPOUT
189 Q
190 ;
191DISP24(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 ;
199IICM(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 ;
213IIQMED(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
Note: See TracBrowser for help on using the repository browser.