| [613] | 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 | 
|---|