IBCB2 ;ALB/AAS - Process bill after enter/edited ;13-DEC-89
;;2.0;INTEGRATED BILLING;**52,51,161,182,155,447,592,623**;21-MAR-94;Build 70
;;Per VA Directive 6402, this routine should not be modified.
;
;MAP TO DGCRB2
;
;IBQUIT = Flag to stop processing
;IBVIEW = Flag showing Bill has been viewed
;IBDISP = Flag showing Bill entering display has been viewed.
;IBNOFIX = Flag to indicate do not ask to edit or review bill screens
;IBREEDIT = Flag to indicate Bill has been re-edited
;
VIEW ;View screens; if status allows editing , allow editing
N Y,DIR
S IBPOPOUT=0
S IBVIEW=1,IBV=$S($D(IBV):IBV,1:1)
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"
D ^DIR K DIR
S:$D(DTOUT) IBQUIT=1
Q:Y'=1
I $G(IBREEDIT)=1,'IBV S IBREEDIT=2 ; set flag indicating re-edit
VIEW1 S IBVIEW=1,IBEDIT=0
D SCREENS
S:$G(IBPOPOUT) IBQUIT=1
Q
;
DISP S IB("S")=$S($D(^DGCR(399,IBIFN,"S")):^("S"),1:"")
W ! D DISP^IBCNQ W !
S IBDISP=1 Q
Q
;
EDITS ; Perform edits on bill prior to authorization/transmission
N IBREEDIT
ED1 ;
S IBQUIT=0
I '$D(IBER)!('$D(PRCASV)) D ALLED(.IBQUIT)
;
; If the user is wanting to quit, but there are some unresolved
; errors reported by ClaimsManager, then capture the user's Exit
; comments.
;
I $$CM^IBCIUT1(IBIFN),IBQUIT,$P($G(^IBA(351.9,IBIFN,0)),U,2)=4 D COMMENT^IBCIUT7(IBIFN,1)
;
Q:IBQUIT
D:'$D(IBDISP) DISP
;
; If claim re-edit, then call the IB edit checks again
I '$D(IBVIEW) S IBREEDIT=1 D VIEW I $G(IBREEDIT)=2 K IBER,IBDISP,IBVIEW G ED1
Q
;
ALLED(IBQUIT) ; Billing edit/correction
N IBQUIT1,IBDONE1,IBDONE,IBEDIT,IBCORR,IBER,IBPRT,IBXERR
S (IBQUIT,IBDONE,IBCORR)=0,IBER=""
; IBDONE = 1 ==> exit, no errors
; IBQUIT = 1 ==> exit, errors not corrected
;JWS;IB*2.0*592:Dental form #7 don't display Box 24 info for dental
;I $$FT^IBCEF(IBIFN)=2,'$G(IBNOFIX) D DISP24(IBIFN,.IBCORR,.IBQUIT) ;/vd - IB*2.0*623 - Modified this line for US4055
I ($$FT^IBCEF(IBIFN)=2!($$FT^IBCEF(IBIFN)=7)),'$G(IBNOFIX) D DISP24(IBIFN,.IBCORR,.IBQUIT) ;/vd - IB*2.0*623
;JWS;IB*2.0*592:Dental form #7 do same as CMS-1500
;vd/IB*2.0*623 - Modified the following line as part of US4055
;F D Q:IBQUIT!IBDONE D VIEW1 I $$FT^IBCEF(IBIFN)=2!($$FT^IBCEF(IBIFN)=7),'$G(IBNOFIX),'IBQUIT S IBCORR=0 D:$$FT^IBCEF(IBIFN)'=7 DISP24(IBIFN,.IBCORR,.IBQUIT)
F D Q:IBQUIT!IBDONE D VIEW1 I ($$FT^IBCEF(IBIFN)=2!($$FT^IBCEF(IBIFN)=7)),'$G(IBNOFIX),'IBQUIT S IBCORR=0 D DISP24(IBIFN,.IBCORR,.IBQUIT) ;/vd - IB*2.0*623
. I $G(IBPOPOUT) S IBQUIT=1
. Q:IBQUIT!IBCORR
. I $G(IBNOFIX) D
.. W !!,"... Checking claim validity"
. E D
.. W !!,"... Executing national IB edits"
. D EN^IBCBB,LOCERR
. I $G(IBER)'=""!$D(IBXERR) D Q:'IBDONE
.. D DSPLERR ; Displays warnings/errors
.. K IBXERR
.. Q:IBQUIT!(IBDONE)
.. I $G(IBNOFIX) S IBDONE=1 Q
.. I '$$ASKEDIT($G(IBAC)) W ! S IBQUIT=1 ; Don't want to re-edit
.. ;
. I $G(IBNOFIX) S IBDONE=1 Q
. S IBEDIT=0
. 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
.. N IBQUIT1
.. S IBQUIT1=0
.. W !!!,"... Executing A/R edits"
.. I $P($G(^DGCR(399,IBIFN,0)),U,13)>2 D GVAR^IBCBB,ARRAY^IBCBB1
.. D ARCHK($G(IBNOFIX),0,.IBQUIT1,.IBQUIT,.IBEDIT,.PRCASV)
. S IBDONE=1 ; No errors
. S:$G(IBPRT("PRT"))'<0 IBQUIT=0
Q
;
ARCHK(IBNOFIX,IBNOPRT,IBQUIT1,IBQUIT,IBEDIT,PRCASV) ; A/R Verification
; Returns IBEDIT, IBQUIT1, IBQUIT,PRCASV array if passed by reference
; IBNOFIX = 1 if no editing needed
; IBNOPRT = 1 if no printing needed
F D ^PRCASVC6 D Q:IBQUIT1!IBEDIT D GVAR^IBCBB,ARRAY^IBCBB1
. I '$G(IBNOPRT) Q:$G(IBPRT("PRT"))<0
. I PRCASV("OKAY") W:'$G(IBNOPRT) !!,"No A/R errors found" S IBQUIT1=1 Q
. I 'PRCASV("OKAY") D Q
.. D DSPARERR($G(IBNOPRT)) ; Display A/R errors
.. Q:IBQUIT
.. I $G(IBNOFIX) S IBQUIT1=1 Q
.. I '$$ASKEDIT($G(IBAC)) W !,"There is an unresolved A/R error - cannot authorize bill" D PAUSE^VALM1 S (IBQUIT,IBQUIT1)=1 Q
.. S IBEDIT=1
;
Q
;
DSPLERR ; Display national/local edits failed
N Z
D PRTH(.IBPRT)
I IBPRT("PRT")<0 S IBQUIT=1 Q
S Z=0 F S Z=$O(^TMP($J,"BILL-WARN",Z)) Q:'Z W !,^(Z) W:'$O(^(Z)) !
S Y2=""
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)
; IBXERR = local edits return error array
; If IBXERR returns = 1 then we have at least one error
; = "" or 0, then we have only local warnings
; undefined = no local errors or warnings
I $D(IBXERR) D
. S I="" W !!,?3,"Local Edits:"
. S:$G(IBXERR) Y2=3,IBER="L"
. F S I=$O(IBXERR(I)) Q:I="" W !,?5,$E(IBXERR(I),1,75)
I $G(IBPRT("PRT")) D CLOSE(.IBPRT)
G:$G(IBNOFIX) Q
I $G(IBER)="WARN"!($G(IBXERR)=0) D ;Warnings only - make biller stop and look
. W !
. N DIR,X,Y
. 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? "
. D ^DIR K DIR
. I Y'=1 S Y2=3 Q
. S IBER="",IBDONE=1 K IBXERR
I $S(Y2'["3"&'$G(IBXERR):0,1:1) K IBXERR
Q K ^TMP($J,"BILL-WARN")
Q
;
DSPARERR(IBNOPRT) ; Displays A/R errors
N I,J,Y,X,ERRPRT
I '$G(IBNOPRT) D PRTH(.IBPRT) I IBPRT("PRT")<0 S IBQUIT=1 Q
I $P($G(PRCAERR),U,2)'="" D
. N Z
. S Z=+$O(^IBE(350.8,"C",$P(PRCAERR,U,2),0)),Z=$P($G(^IBE(350.8,+Z,0)),U,2)
. W !,?5,"An A/R error has been reported - bill cannot be authorized",!!,?5,$P(PRCAERR,U,2)," - ",$S(Z'="":Z,1:"??")
E D
. W !,?5,"An undetermined A/R error was found - "_$G(PRCAERR)
I $G(IBPRT("PRT")) D CLOSE(.IBPRT)
Q
;
NOPTF S IBAC1=1 I $D(^DGCR(399,IBIFN,0)),$P(^(0),"^",8),'$D(^DGPT($P(^(0),"^",8),0)) S IBAC1=0
Q
;
NOPTF1 W !!,*7,"PTF Record for this Bill was DELETED!",!,"Further processing not allowed. Cancel and re-enter." Q
;
LOCERR ; Check for local edits
; Execute screen post-processor for bills with local scrn 9 affiliations
N IBZ,IBXIEN,IBPRT
K IBXERR
S IBZ=$$LOCSCRN^IBCSC11(IBIFN) ; IB*2.0*447 BI
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"
Q
;
PRTH(IBPRT,IBA) ; Print a heading for error/warnings sent to a printer
; Returns IBPRT = 1 if valid pritner selected
; IBPRT = -1 if '^' entered
; IBPRT = 0 if home device
N POP,%ZIS,POP
S %ZIS("A")="ERROR/WARNING OUTPUT DEVICE: "
D ^%ZIS
I POP S IBPRT("PRT")=-1 Q
I IO=IO(0) S IBPRT("PRT")=0 Q
S IBPRT("PRT")=1
U IO
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),!!
Q
;
CLOSE(IBPRT) ; Close device, reset printer flag
D ^%ZISC
S IBPRT("PRT")=0
D HOME^%ZIS
Q
;
ASKEDIT(IBAC) ; Ask if edit/review of bill is desired
; FUNCTION returns 0/1 for NO/YES
; IBAC = flag for function being performed - to determine edit/review
N DIR,X,Y
S DIR(0)="YA"
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"
S DIR("?",1)=" ",DIR("?",2)=" ",DIR("?",3)=" YES - To edit inconsistent fields",DIR("?")=" NO - To discontinue this process."
D ^DIR K DIR
Q (Y=1)
;
SCREENS ;
N IBH
D ^IBCSCU,^IBCSC1
I $G(IBV) K IBPOPOUT
Q
;
DISP24(IBIFN,IBCORR,IBQUIT) ;
;/vd - IB*2.0*623/Beginning - modified the following US4055.
;W @IOF D BL24^IBCSCH(IBIFN,0)
W @IOF
I $$FT^IBCEF(IBIFN)=7 D DENTAL^IBCSCH2(IBIFN) I 1
E D BL24^IBCSCH(IBIFN,0)
;/vd - IB*2.0*623/End
S DIR("A",1)=" ",DIR("A")="Are the above charges correct for this bill? ",DIR("B")="YES",DIR(0)="YA" D ^DIR K DIR
I Y'=1 D
. I Y=0,$$ASKEDIT($G(IBAC)) S IBCORR=1 Q
. S IBQUIT=1
Q
;
IICM(IBIFN) ; Ingenix ClaimsManager: Claim Scrubber
; Send the bill to ClaimsManager, the IBCISTAT variable returned from ClaimsManager indicates
; 3 - Passed CM with no errors
; 5 - User overriding the CM errors
; 7 - the CM interface isn't working
; 11 - User overriding the CM errors (CM not updated)
;
; Returns False (0) if the bill fails the ClaimsManager Scrubber/errors found
; Returns True (1) if the bill passed the ClaimsManager Scrubber/no errors found or ClaimsManager not On at site
;
N IBOK S IBOK=1
I +$G(IBIFN),$$CM^IBCIUT1(IBIFN) S IBCISNT=1 D ST2^IBCIST I '$F(".3.5.7.11.","."_IBCISTAT_".") S IBOK=0
Q IBOK
;
IIQMED(IBIFN) ; DSS QuadraMed Interface: QuadraMed Claim Scrubber
; Send the bill to the QuadraMed Claim Scrubber
; Returns False (0) if the bill fails the QuadraMed Scrubber/errors found
; Returns True (1) if the bill passed the QuadraMed Scrubber/no errors found or QuadraMed not On at site
;
; QuadraMed Scrubber EN^VEJDIBSC returns IBQMED = 1 if no error found, returns 0 if error found
;
N IBQMED S IBQMED=1
I +$G(IBIFN),$$QMED^IBCU1("EN^VEJDIBSC",IBIFN) D EN^VEJDIBSC(IBIFN)
Q IBQMED
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCB2 9245 printed Apr 09, 2024@21:08:13 Page 2
IBCB2 ;ALB/AAS - Process bill after enter/edited ;13-DEC-89
+1 ;;2.0;INTEGRATED BILLING;**52,51,161,182,155,447,592,623**;21-MAR-94;Build 70
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;MAP TO DGCRB2
+5 ;
+6 ;IBQUIT = Flag to stop processing
+7 ;IBVIEW = Flag showing Bill has been viewed
+8 ;IBDISP = Flag showing Bill entering display has been viewed.
+9 ;IBNOFIX = Flag to indicate do not ask to edit or review bill screens
+10 ;IBREEDIT = Flag to indicate Bill has been re-edited
+11 ;
VIEW ;View screens; if status allows editing , allow editing
+1 NEW Y,DIR
+2 SET IBPOPOUT=0
+3 SET IBVIEW=1
SET IBV=$SELECT($DATA(IBV):IBV,1:1)
+4 SET DIR(0)="YA"
SET DIR("B")="NO"
SET DIR("A")="WANT TO "_$SELECT('IBV:"EDIT",1:"REVIEW")_" SCREENS? "
SET DIR("?",1)=" YES - to "_$SELECT('IBV:"EDIT",1:"REVIEW")_" the screens"
SET DIR("?")=" NO - To take no action"
+5 DO ^DIR
KILL DIR
+6 if $DATA(DTOUT)
SET IBQUIT=1
+7 if Y'=1
QUIT
+8 ; set flag indicating re-edit
IF $GET(IBREEDIT)=1
IF 'IBV
SET IBREEDIT=2
VIEW1 SET IBVIEW=1
SET IBEDIT=0
+1 DO SCREENS
+2 if $GET(IBPOPOUT)
SET IBQUIT=1
+3 QUIT
+4 ;
DISP SET IB("S")=$SELECT($DATA(^DGCR(399,IBIFN,"S")):^("S"),1:"")
+1 WRITE !
DO DISP^IBCNQ
WRITE !
+2 SET IBDISP=1
QUIT
+3 QUIT
+4 ;
EDITS ; Perform edits on bill prior to authorization/transmission
+1 NEW IBREEDIT
ED1 ;
+1 SET IBQUIT=0
+2 IF '$DATA(IBER)!('$DATA(PRCASV))
DO ALLED(.IBQUIT)
+3 ;
+4 ; If the user is wanting to quit, but there are some unresolved
+5 ; errors reported by ClaimsManager, then capture the user's Exit
+6 ; comments.
+7 ;
+8 IF $$CM^IBCIUT1(IBIFN)
IF IBQUIT
IF $PIECE($GET(^IBA(351.9,IBIFN,0)),U,2)=4
DO COMMENT^IBCIUT7(IBIFN,1)
+9 ;
+10 if IBQUIT
QUIT
+11 if '$DATA(IBDISP)
DO DISP
+12 ;
+13 ; If claim re-edit, then call the IB edit checks again
+14 IF '$DATA(IBVIEW)
SET IBREEDIT=1
DO VIEW
IF $GET(IBREEDIT)=2
KILL IBER,IBDISP,IBVIEW
GOTO ED1
+15 QUIT
+16 ;
ALLED(IBQUIT) ; Billing edit/correction
+1 NEW IBQUIT1,IBDONE1,IBDONE,IBEDIT,IBCORR,IBER,IBPRT,IBXERR
+2 SET (IBQUIT,IBDONE,IBCORR)=0
SET IBER=""
+3 ; IBDONE = 1 ==> exit, no errors
+4 ; IBQUIT = 1 ==> exit, errors not corrected
+5 ;JWS;IB*2.0*592:Dental form #7 don't display Box 24 info for dental
+6 ;I $$FT^IBCEF(IBIFN)=2,'$G(IBNOFIX) D DISP24(IBIFN,.IBCORR,.IBQUIT) ;/vd - IB*2.0*623 - Modified this line for US4055
+7 ;/vd - IB*2.0*623
IF ($$FT^IBCEF(IBIFN)=2!($$FT^IBCEF(IBIFN)=7))
IF '$GET(IBNOFIX)
DO DISP24(IBIFN,.IBCORR,.IBQUIT)
+8 ;JWS;IB*2.0*592:Dental form #7 do same as CMS-1500
+9 ;vd/IB*2.0*623 - Modified the following line as part of US4055
+10 ;F D Q:IBQUIT!IBDONE D VIEW1 I $$FT^IBCEF(IBIFN)=2!($$FT^IBCEF(IBIFN)=7),'$G(IBNOFIX),'IBQUIT S IBCORR=0 D:$$FT^IBCEF(IBIFN)'=7 DISP24(IBIFN,.IBCORR,.IBQUIT)
+11 ;/vd - IB*2.0*623
FOR
Begin DoDot:1
+12 IF $GET(IBPOPOUT)
SET IBQUIT=1
+13 if IBQUIT!IBCORR
QUIT
+14 IF $GET(IBNOFIX)
Begin DoDot:2
+15 WRITE !!,"... Checking claim validity"
End DoDot:2
+16 IF '$TEST
Begin DoDot:2
+17 WRITE !!,"... Executing national IB edits"
End DoDot:2
+18 DO EN^IBCBB
DO LOCERR
+19 IF $GET(IBER)'=""!$DATA(IBXERR)
Begin DoDot:2
+20 ; Displays warnings/errors
DO DSPLERR
+21 KILL IBXERR
+22 if IBQUIT!(IBDONE)
QUIT
+23 IF $GET(IBNOFIX)
SET IBDONE=1
QUIT
+24 ; Don't want to re-edit
IF '$$ASKEDIT($GET(IBAC))
WRITE !
SET IBQUIT=1
+25 ;
End DoDot:2
if 'IBDONE
QUIT
+26 IF $GET(IBNOFIX)
SET IBDONE=1
QUIT
+27 SET IBEDIT=0
+28 IF $SELECT($PIECE($GET(^DGCR(399,IBIFN,0)),U,13)>2:1,$DATA(PRCASV):'$DATA(PRCASV("OKAY")),1:0)
Begin DoDot:2
+29 NEW IBQUIT1
+30 SET IBQUIT1=0
+31 WRITE !!!,"... Executing A/R edits"
+32 IF $PIECE($GET(^DGCR(399,IBIFN,0)),U,13)>2
DO GVAR^IBCBB
DO ARRAY^IBCBB1
+33 DO ARCHK($GET(IBNOFIX),0,.IBQUIT1,.IBQUIT,.IBEDIT,.PRCASV)
End DoDot:2
if 'IBQUIT&'IBEDIT
SET IBDONE=1
QUIT
+34 ; No errors
SET IBDONE=1
+35 if $GET(IBPRT("PRT"))'<0
SET IBQUIT=0
End DoDot:1
if IBQUIT!IBDONE
QUIT
DO VIEW1
IF ($$FT^IBCEF(IBIFN)=2!($$FT^IBCEF(IBIFN)=7))
IF '$GET(IBNOFIX)
IF 'IBQUIT
SET IBCORR=0
DO DISP24(IBIFN,.IBCORR,.IBQUIT)
+36 QUIT
+37 ;
ARCHK(IBNOFIX,IBNOPRT,IBQUIT1,IBQUIT,IBEDIT,PRCASV) ; A/R Verification
+1 ; Returns IBEDIT, IBQUIT1, IBQUIT,PRCASV array if passed by reference
+2 ; IBNOFIX = 1 if no editing needed
+3 ; IBNOPRT = 1 if no printing needed
+4 FOR
DO ^PRCASVC6
Begin DoDot:1
+5 IF '$GET(IBNOPRT)
if $GET(IBPRT("PRT"))<0
QUIT
+6 IF PRCASV("OKAY")
if '$GET(IBNOPRT)
WRITE !!,"No A/R errors found"
SET IBQUIT1=1
QUIT
+7 IF 'PRCASV("OKAY")
Begin DoDot:2
+8 ; Display A/R errors
DO DSPARERR($GET(IBNOPRT))
+9 if IBQUIT
QUIT
+10 IF $GET(IBNOFIX)
SET IBQUIT1=1
QUIT
+11 IF '$$ASKEDIT($GET(IBAC))
WRITE !,"There is an unresolved A/R error - cannot authorize bill"
DO PAUSE^VALM1
SET (IBQUIT,IBQUIT1)=1
QUIT
+12 SET IBEDIT=1
End DoDot:2
QUIT
End DoDot:1
if IBQUIT1!IBEDIT
QUIT
DO GVAR^IBCBB
DO ARRAY^IBCBB1
+13 ;
+14 QUIT
+15 ;
DSPLERR ; Display national/local edits failed
+1 NEW Z
+2 DO PRTH(.IBPRT)
+3 IF IBPRT("PRT")<0
SET IBQUIT=1
QUIT
+4 SET Z=0
FOR
SET Z=$ORDER(^TMP($JOB,"BILL-WARN",Z))
if 'Z
QUIT
WRITE !,^(Z)
if '$ORDER(^(Z))
WRITE !
+5 SET Y2=""
+6 IF IBER'="WARN"
FOR I=1:1
SET X=$PIECE(IBER,";",I)
if X=""
QUIT
if I=1
WRITE !?5,"**Errors**:"
IF $DATA(^IBE(350.8,+$ORDER(^IBE(350.8,"AC",X,0)),0))
SET Y=^(0)
SET Y1=$PIECE(Y,"^",5)
SET Y2=Y2_Y1
IF Y1<5
WRITE !?5,$EXTRACT($PIECE(Y,"^",2),1,80)
+7 ; IBXERR = local edits return error array
+8 ; If IBXERR returns = 1 then we have at least one error
+9 ; = "" or 0, then we have only local warnings
+10 ; undefined = no local errors or warnings
+11 IF $DATA(IBXERR)
Begin DoDot:1
+12 SET I=""
WRITE !!,?3,"Local Edits:"
+13 if $GET(IBXERR)
SET Y2=3
SET IBER="L"
+14 FOR
SET I=$ORDER(IBXERR(I))
if I=""
QUIT
WRITE !,?5,$EXTRACT(IBXERR(I),1,75)
End DoDot:1
+15 IF $GET(IBPRT("PRT"))
DO CLOSE(.IBPRT)
+16 if $GET(IBNOFIX)
GOTO Q
+17 ;Warnings only - make biller stop and look
IF $GET(IBER)="WARN"!($GET(IBXERR)=0)
Begin DoDot:1
+18 WRITE !
+19 NEW DIR,X,Y
+20 SET DIR(0)="YA"
SET DIR("B")="NO"
SET DIR("A",1)="THIS BILL STILL HAS ONE OR MORE WARNINGS - PLEASE REVIEW THEM CAREFULLY"
SET DIR("A")="ARE YOU SURE IT'S OK TO CONTINUE? "
+21 DO ^DIR
KILL DIR
+22 IF Y'=1
SET Y2=3
QUIT
+23 SET IBER=""
SET IBDONE=1
KILL IBXERR
End DoDot:1
+24 IF $SELECT(Y2'["3"&'$GET(IBXERR):0,1:1)
KILL IBXERR
Q KILL ^TMP($JOB,"BILL-WARN")
+1 QUIT
+2 ;
DSPARERR(IBNOPRT) ; Displays A/R errors
+1 NEW I,J,Y,X,ERRPRT
+2 IF '$GET(IBNOPRT)
DO PRTH(.IBPRT)
IF IBPRT("PRT")<0
SET IBQUIT=1
QUIT
+3 IF $PIECE($GET(PRCAERR),U,2)'=""
Begin DoDot:1
+4 NEW Z
+5 SET Z=+$ORDER(^IBE(350.8,"C",$PIECE(PRCAERR,U,2),0))
SET Z=$PIECE($GET(^IBE(350.8,+Z,0)),U,2)
+6 WRITE !,?5,"An A/R error has been reported - bill cannot be authorized",!!,?5,$PIECE(PRCAERR,U,2)," - ",$SELECT(Z'="":Z,1:"??")
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 WRITE !,?5,"An undetermined A/R error was found - "_$GET(PRCAERR)
End DoDot:1
+9 IF $GET(IBPRT("PRT"))
DO CLOSE(.IBPRT)
+10 QUIT
+11 ;
NOPTF SET IBAC1=1
IF $DATA(^DGCR(399,IBIFN,0))
IF $PIECE(^(0),"^",8)
IF '$DATA(^DGPT($PIECE(^(0),"^",8),0))
SET IBAC1=0
+1 QUIT
+2 ;
NOPTF1 WRITE !!,*7,"PTF Record for this Bill was DELETED!",!,"Further processing not allowed. Cancel and re-enter."
QUIT
+1 ;
LOCERR ; Check for local edits
+1 ; Execute screen post-processor for bills with local scrn 9 affiliations
+2 NEW IBZ,IBXIEN,IBPRT
+3 KILL IBXERR
+4 ; IB*2.0*447 BI
SET IBZ=$$LOCSCRN^IBCSC11(IBIFN)
+5 IF IBZ
SET IBXIEN=IBIFN
WRITE !!,"... Executing local IB edits"
DO FPOST^IBCEFG7(IBZ,0,.IBXERR)
IF '$DATA(IBXERR)
WRITE !!,"No errors found for local edits"
+6 QUIT
+7 ;
PRTH(IBPRT,IBA) ; Print a heading for error/warnings sent to a printer
+1 ; Returns IBPRT = 1 if valid pritner selected
+2 ; IBPRT = -1 if '^' entered
+3 ; IBPRT = 0 if home device
+4 NEW POP,%ZIS,POP
+5 SET %ZIS("A")="ERROR/WARNING OUTPUT DEVICE: "
+6 DO ^%ZIS
+7 IF POP
SET IBPRT("PRT")=-1
QUIT
+8 IF IO=IO(0)
SET IBPRT("PRT")=0
QUIT
+9 SET IBPRT("PRT")=1
+10 USE IO
+11 WRITE !,"INCONSISTENCIES LIST FOR BILL #: ",$PIECE($GET(^DGCR(399,IBIFN,0)),U),!,$JUSTIFY("",29),"AT: ",$$FMTE^XLFDT($$NOW^XLFDT,2),!,$JUSTIFY("",19),"GENERATED BY: ",$PIECE($GET(^VA(200,DUZ,0)),U),!!
+12 QUIT
+13 ;
CLOSE(IBPRT) ; Close device, reset printer flag
+1 DO ^%ZISC
+2 SET IBPRT("PRT")=0
+3 DO HOME^%ZIS
+4 QUIT
+5 ;
ASKEDIT(IBAC) ; Ask if edit/review of bill is desired
+1 ; FUNCTION returns 0/1 for NO/YES
+2 ; IBAC = flag for function being performed - to determine edit/review
+3 NEW DIR,X,Y
+4 SET DIR(0)="YA"
+5 SET DIR("A",1)=" "
SET DIR("A",2)=" "
SET DIR("A")="Do you wish to "_$SELECT($GET(IBAC)<4:"edit",1:"review")_" the inconsistencies now? "
SET DIR("B")="NO"
+6 SET DIR("?",1)=" "
SET DIR("?",2)=" "
SET DIR("?",3)=" YES - To edit inconsistent fields"
SET DIR("?")=" NO - To discontinue this process."
+7 DO ^DIR
KILL DIR
+8 QUIT (Y=1)
+9 ;
SCREENS ;
+1 NEW IBH
+2 DO ^IBCSCU
DO ^IBCSC1
+3 IF $GET(IBV)
KILL IBPOPOUT
+4 QUIT
+5 ;
DISP24(IBIFN,IBCORR,IBQUIT) ;
+1 ;/vd - IB*2.0*623/Beginning - modified the following US4055.
+2 ;W @IOF D BL24^IBCSCH(IBIFN,0)
+3 WRITE @IOF
+4 IF $$FT^IBCEF(IBIFN)=7
DO DENTAL^IBCSCH2(IBIFN)
IF 1
+5 IF '$TEST
DO BL24^IBCSCH(IBIFN,0)
+6 ;/vd - IB*2.0*623/End
+7 SET DIR("A",1)=" "
SET DIR("A")="Are the above charges correct for this bill? "
SET DIR("B")="YES"
SET DIR(0)="YA"
DO ^DIR
KILL DIR
+8 IF Y'=1
Begin DoDot:1
+9 IF Y=0
IF $$ASKEDIT($GET(IBAC))
SET IBCORR=1
QUIT
+10 SET IBQUIT=1
End DoDot:1
+11 QUIT
+12 ;
IICM(IBIFN) ; Ingenix ClaimsManager: Claim Scrubber
+1 ; Send the bill to ClaimsManager, the IBCISTAT variable returned from ClaimsManager indicates
+2 ; 3 - Passed CM with no errors
+3 ; 5 - User overriding the CM errors
+4 ; 7 - the CM interface isn't working
+5 ; 11 - User overriding the CM errors (CM not updated)
+6 ;
+7 ; Returns False (0) if the bill fails the ClaimsManager Scrubber/errors found
+8 ; Returns True (1) if the bill passed the ClaimsManager Scrubber/no errors found or ClaimsManager not On at site
+9 ;
+10 NEW IBOK
SET IBOK=1
+11 IF +$GET(IBIFN)
IF $$CM^IBCIUT1(IBIFN)
SET IBCISNT=1
DO ST2^IBCIST
IF '$FIND(".3.5.7.11.","."_IBCISTAT_".")
SET IBOK=0
+12 QUIT IBOK
+13 ;
IIQMED(IBIFN) ; DSS QuadraMed Interface: QuadraMed Claim Scrubber
+1 ; Send the bill to the QuadraMed Claim Scrubber
+2 ; Returns False (0) if the bill fails the QuadraMed Scrubber/errors found
+3 ; Returns True (1) if the bill passed the QuadraMed Scrubber/no errors found or QuadraMed not On at site
+4 ;
+5 ; QuadraMed Scrubber EN^VEJDIBSC returns IBQMED = 1 if no error found, returns 0 if error found
+6 ;
+7 NEW IBQMED
SET IBQMED=1
+8 IF +$GET(IBIFN)
IF $$QMED^IBCU1("EN^VEJDIBSC",IBIFN)
DO EN^VEJDIBSC(IBIFN)
+9 QUIT IBQMED
