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