IBCAPP ;ALB/WCJ - Claims Auto Processing Main Processer;27-AUG-10
;;2.0;INTEGRATED BILLING;**432,447,568**;21-MAR-94;Build 40
;;Per VA Directive 6402, this routine should not be modified.
G AWAY
AWAY Q
;
EN(IBIFN,IBORIG,IBPYMT,IBWLF) ;
; This is called from tag BULL^IBCNSBL2. It is the starting point for the claims auto-processing.
; Instead of sending a bulletin which started a manual process, the bulletin routine calls this routine
; which will evaluate the claim and perform one of three actions.
; 1) auto-process the claim to a subsequent payer.
; 2) auto-print a claim in case the payer does not want to receive secondary/tertiary claims electronically
; 3) put the claim on the new COB Management work list.
;
; Input: IBIFN -- Pointer to AR (file #430), or Claim (file #399) (same internal number goes to files)
; IBORIG -- Original amount of the claim
; IBPYMT -- Total Amount paid on the claim
; IBWLF -- 1 or 2 if it should go straight to the work list or
; 0 if it should be evaluated.
;
N IBREASON,IBX,IBMRANOT,IBERRMSG,IBEOB,IBINS,Z,IB,IBF,IBFT,IBNCN,IBDV,IBREG,IBNCN
S IBMRANOT=1
;
; A specific non-human user for all reg 835 EOB filing processes.
; Change the DUZ to be this user.
; *** Integration Agreement 4129 - Activated on 30-June-2003 ***
S IBREG=$$IBREG()
I IBREG>0 NEW DUZ D DUZ^XUP(IBREG) ; IA#4129
;
; Check if this is being forced to the work list.
;I $G(IBWLF) S IBREASON="IB813:CHAMPVA Center or TRICARE Fiscal Intermediary or TRICARE Supplemental policy." D PUTONWL(IBIFN,IBREASON) G ENX ;IB*2*432
I $G(IBWLF) D G ENX ;IB*2*568
.I IBWLF=2 S IBREASON="IB815:Balance bill this patient using the appropriate cost-based rate type." D PUTONWL(IBIFN,IBREASON) Q
.I IBWLF=1 S IBREASON="IB813:CHAMPVA Center or TRICARE Fiscal Intermediary or TRICARE Supplemental policy." D PUTONWL(IBIFN,IBREASON) Q
.Q
;
I IBPYMT'<IBORIG D WLCK^IBCNSBL2(IBIFN) Q ; no reason to continue if nothing else owed
;
; Make sure there is another payer
I '$P($G(^DGCR(399,IBIFN,"I"_($$COBN^IBCEF(IBIFN)+1))),U,1) D WLCK^IBCNSBL2(IBIFN) G ENX ;IB*2*432
;
; stop if the subsequent claim was already created
I +$P($G(^DGCR(399,IBIFN,"M1")),U,$$COBN^IBCEF(IBIFN)+5) D WLCK^IBCNSBL2(IBIFN) G ENX ;IB*2*432
;
; stop if the subsequent payer is Medicare. If there is a non-Medicare tertiary payer, force to worklist
I $$WNRBILL^IBEFUNC(IBIFN,$$COBN^IBCEF(IBIFN)+1) D Q
.I $D(^DGCR(399,IBIFN,"I3")),'$$WNRBILL^IBEFUNC(IBIFN,3) D PUTONWL(IBIFN,"IB814") Q
.D WLCK^IBCNSBL2(IBIFN) Q
;
; check the Commercial Auto Processing criteria
S IBX=$$CRIT^IBCAPP1(IBIFN,.IBEOB)
;
; If it fails the criteria check, put it on the work list
I '+IBX D PUTONWL(IBIFN,$P(IBX,U,2)) G ENX ;IB*2*432
;
; Auto Process this bad boy
;
; first check that if it's supposed to be printed locally, the printers are defined.
; if not, put on the work list
; if they are, then fall through
S Z=$$COBN^IBCEF(IBIFN)+1
S IBINS=$$POLICY^IBCEF(IBIFN,1,Z)
S IBWLF=0
I $P($G(^DIC(36,IBINS,6)),U,9)=1 D I IBWLF D PUTONWL(IBIFN,IBREASON) G ENX ;IB*2*432
.I $$EOBPRT^IBCAPR()="" S IBWLF=1,IBREASON="IB811:Auto-printer not defined in IB Site Parameters" Q
.I $$MRAPRT^IBCAPR()="" S IBWLF=1,IBREASON="IB811:Auto-printer not defined in IB Site Parameters" Q
.S IB=$$FT^IBCU3(IBIFN) ; form type ien (2 or 3)
.I "^2^3^"'[(U_IB_U) S IBWLF=1,IBREASON="IB810:No Form Type defined" Q
.S IBFT=$$FTN^IBCU3(IB) ; form type name
.S IBF=$P($G(^IBE(353,+IB,2)),U,8)
.S:IBF="" IBF=IB ;Forces the use of the output formatter to print bills
.; get default CMS or UB printer (based on claim form type)
.S IBDV=$S(IB=2:$$CMS1500^IBCAPR1(),1:$$UB4PRT^IBCAPR1())
.I IBDV="" S IBWLF=1,IBREASON="IB811:Auto-printer not defined in IB Site Parameters" Q
I $G(IBREASON)]"" D PUTONWL(IBIFN,IBREASON) G ENX ;IB*2*432
;
; create the new claim
S IBNCN="" ; Initialize New Claim Number
D AUTOCOB^IBCEMQA(IBIFN,IBEOB,.IBERRMSG,IBMRANOT,.IBNCN)
;
; make sure everything was cool with creating the new claim.
I $G(IBERRMSG)]""!('+$G(IBNCN)) S IBREASON="IB812:Failed AUTOCOB Generation" D PUTONWL(IBIFN,IBREASON) G ENX ;IB*2*432
;
; If it's to be auto printed, set force to local print flag on new claim
S IBINS=$$POLICY^IBCEF(IBNCN,1,$$COBN^IBCEF(IBNCN))
; set field 35 on original claim to indicate subsequent claim was auto-created IB*2.0*447
I $P($G(^DIC(36,IBINS,6)),U,9)=1 D FORCEPRT(IBNCN),AUTOPRC($G(IBIFN),2)
D:$P($G(^DIC(36,IBINS,6)),U,9)'=1 AUTOPRC($G(IBIFN),3)
;
; authorize the new claim
D AUTH^IBCEMQA(IBNCN,.IBERRMSG,IBMRANOT)
;
; If AUTH error occurred, file the automatic bill generation failure message
I $G(IBERRMSG)]"" D AUTOMSG^IBCESRV3(IBEOB,IBERRMSG) G ENX
;
; If local print, then print it
I $P($G(^DIC(36,IBINS,6)),U,9)=1 D STFLP^IBCAPR1(IBNCN)
;
ENX ;Quit and Cleanup of Main Entry Point, added with IB*2*432
;
; DBIA #10111: Allows FM read access of ^XMB(3.8,D0,0) using DIC.
S DIC="^XMB(3.8,",DIC(0)="QM",X="IB DEV TEAM" D ^DIC
;
Q
;
PUTONWL(IBIFN,IBREASON) ; Put a claim on the worklist
; IBIFN - internal claim number
; IBREASON - reason why this is being put on the worklist (error code:text)
;
N DA,DIE,DR
S DA=IBIFN
S DIE="^DGCR(399,"
S DR="35///1" ; place on the worklist
S DR=DR_";"_"36///"_$P(IBREASON,":") ; why placed on worklist
D ^DIE
Q
;
AUTOPRC(IBIFN,IBAP) ; record that a claim was auto-processed IB*2.0*447
; IBIFN - internal claim number
; IBAP - 2 = AUTO LOCAL PRINT, 3 = AUTO EDI
;
N DA,DIE,DR
Q:IBIFN=""
Q:IBAP=""
S DA=IBIFN
S DIE="^DGCR(399,"
S DR="35///"_IBAP ; UPDATE AUTO-PROCESS FIELD
D ^DIE
Q
;
FORCEPRT(IBIFN) ; set force to local print flag in claim
; IBIFN - internal claim number
;
N DA,DIE,DR
S DA=IBIFN
S DIE="^DGCR(399,"
S DR="27///1" ; Force Local Print
D ^DIE
Q
;
IBREG() ; Returns IEN (Internal Entry Number) from file #200 for
; the Bill Authorizer of acceptable regular (non MRA) secondary claims,
; namely, AUTHORIZER,IB REG
;
; Output: -1 if record not on file
; IEN if record is on file
;
N DIC,X,Y
S DIC(0)="MO",DIC="^VA(200,",X="AUTHORIZER,IB REG"
; call FM lookup utility
D ^DIC
; if record is already on file, return IEN
; else return -1
Q +Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCAPP 6493 printed Apr 09, 2024@21:18:18 Page 2
IBCAPP ;ALB/WCJ - Claims Auto Processing Main Processer;27-AUG-10
+1 ;;2.0;INTEGRATED BILLING;**432,447,568**;21-MAR-94;Build 40
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 GOTO AWAY
AWAY QUIT
+1 ;
EN(IBIFN,IBORIG,IBPYMT,IBWLF) ;
+1 ; This is called from tag BULL^IBCNSBL2. It is the starting point for the claims auto-processing.
+2 ; Instead of sending a bulletin which started a manual process, the bulletin routine calls this routine
+3 ; which will evaluate the claim and perform one of three actions.
+4 ; 1) auto-process the claim to a subsequent payer.
+5 ; 2) auto-print a claim in case the payer does not want to receive secondary/tertiary claims electronically
+6 ; 3) put the claim on the new COB Management work list.
+7 ;
+8 ; Input: IBIFN -- Pointer to AR (file #430), or Claim (file #399) (same internal number goes to files)
+9 ; IBORIG -- Original amount of the claim
+10 ; IBPYMT -- Total Amount paid on the claim
+11 ; IBWLF -- 1 or 2 if it should go straight to the work list or
+12 ; 0 if it should be evaluated.
+13 ;
+14 NEW IBREASON,IBX,IBMRANOT,IBERRMSG,IBEOB,IBINS,Z,IB,IBF,IBFT,IBNCN,IBDV,IBREG,IBNCN
+15 SET IBMRANOT=1
+16 ;
+17 ; A specific non-human user for all reg 835 EOB filing processes.
+18 ; Change the DUZ to be this user.
+19 ; *** Integration Agreement 4129 - Activated on 30-June-2003 ***
+20 SET IBREG=$$IBREG()
+21 ; IA#4129
IF IBREG>0
NEW DUZ
DO DUZ^XUP(IBREG)
+22 ;
+23 ; Check if this is being forced to the work list.
+24 ;I $G(IBWLF) S IBREASON="IB813:CHAMPVA Center or TRICARE Fiscal Intermediary or TRICARE Supplemental policy." D PUTONWL(IBIFN,IBREASON) G ENX ;IB*2*432
+25 ;IB*2*568
IF $GET(IBWLF)
Begin DoDot:1
+26 IF IBWLF=2
SET IBREASON="IB815:Balance bill this patient using the appropriate cost-based rate type."
DO PUTONWL(IBIFN,IBREASON)
QUIT
+27 IF IBWLF=1
SET IBREASON="IB813:CHAMPVA Center or TRICARE Fiscal Intermediary or TRICARE Supplemental policy."
DO PUTONWL(IBIFN,IBREASON)
QUIT
+28 QUIT
End DoDot:1
GOTO ENX
+29 ;
+30 ; no reason to continue if nothing else owed
IF IBPYMT'<IBORIG
DO WLCK^IBCNSBL2(IBIFN)
QUIT
+31 ;
+32 ; Make sure there is another payer
+33 ;IB*2*432
IF '$PIECE($GET(^DGCR(399,IBIFN,"I"_($$COBN^IBCEF(IBIFN)+1))),U,1)
DO WLCK^IBCNSBL2(IBIFN)
GOTO ENX
+34 ;
+35 ; stop if the subsequent claim was already created
+36 ;IB*2*432
IF +$PIECE($GET(^DGCR(399,IBIFN,"M1")),U,$$COBN^IBCEF(IBIFN)+5)
DO WLCK^IBCNSBL2(IBIFN)
GOTO ENX
+37 ;
+38 ; stop if the subsequent payer is Medicare. If there is a non-Medicare tertiary payer, force to worklist
+39 IF $$WNRBILL^IBEFUNC(IBIFN,$$COBN^IBCEF(IBIFN)+1)
Begin DoDot:1
+40 IF $DATA(^DGCR(399,IBIFN,"I3"))
IF '$$WNRBILL^IBEFUNC(IBIFN,3)
DO PUTONWL(IBIFN,"IB814")
QUIT
+41 DO WLCK^IBCNSBL2(IBIFN)
QUIT
End DoDot:1
QUIT
+42 ;
+43 ; check the Commercial Auto Processing criteria
+44 SET IBX=$$CRIT^IBCAPP1(IBIFN,.IBEOB)
+45 ;
+46 ; If it fails the criteria check, put it on the work list
+47 ;IB*2*432
IF '+IBX
DO PUTONWL(IBIFN,$PIECE(IBX,U,2))
GOTO ENX
+48 ;
+49 ; Auto Process this bad boy
+50 ;
+51 ; first check that if it's supposed to be printed locally, the printers are defined.
+52 ; if not, put on the work list
+53 ; if they are, then fall through
+54 SET Z=$$COBN^IBCEF(IBIFN)+1
+55 SET IBINS=$$POLICY^IBCEF(IBIFN,1,Z)
+56 SET IBWLF=0
+57 ;IB*2*432
IF $PIECE($GET(^DIC(36,IBINS,6)),U,9)=1
Begin DoDot:1
+58 IF $$EOBPRT^IBCAPR()=""
SET IBWLF=1
SET IBREASON="IB811:Auto-printer not defined in IB Site Parameters"
QUIT
+59 IF $$MRAPRT^IBCAPR()=""
SET IBWLF=1
SET IBREASON="IB811:Auto-printer not defined in IB Site Parameters"
QUIT
+60 ; form type ien (2 or 3)
SET IB=$$FT^IBCU3(IBIFN)
+61 IF "^2^3^"'[(U_IB_U)
SET IBWLF=1
SET IBREASON="IB810:No Form Type defined"
QUIT
+62 ; form type name
SET IBFT=$$FTN^IBCU3(IB)
+63 SET IBF=$PIECE($GET(^IBE(353,+IB,2)),U,8)
+64 ;Forces the use of the output formatter to print bills
if IBF=""
SET IBF=IB
+65 ; get default CMS or UB printer (based on claim form type)
+66 SET IBDV=$SELECT(IB=2:$$CMS1500^IBCAPR1(),1:$$UB4PRT^IBCAPR1())
+67 IF IBDV=""
SET IBWLF=1
SET IBREASON="IB811:Auto-printer not defined in IB Site Parameters"
QUIT
End DoDot:1
IF IBWLF
DO PUTONWL(IBIFN,IBREASON)
GOTO ENX
+68 ;IB*2*432
IF $GET(IBREASON)]""
DO PUTONWL(IBIFN,IBREASON)
GOTO ENX
+69 ;
+70 ; create the new claim
+71 ; Initialize New Claim Number
SET IBNCN=""
+72 DO AUTOCOB^IBCEMQA(IBIFN,IBEOB,.IBERRMSG,IBMRANOT,.IBNCN)
+73 ;
+74 ; make sure everything was cool with creating the new claim.
+75 ;IB*2*432
IF $GET(IBERRMSG)]""!('+$GET(IBNCN))
SET IBREASON="IB812:Failed AUTOCOB Generation"
DO PUTONWL(IBIFN,IBREASON)
GOTO ENX
+76 ;
+77 ; If it's to be auto printed, set force to local print flag on new claim
+78 SET IBINS=$$POLICY^IBCEF(IBNCN,1,$$COBN^IBCEF(IBNCN))
+79 ; set field 35 on original claim to indicate subsequent claim was auto-created IB*2.0*447
+80 IF $PIECE($GET(^DIC(36,IBINS,6)),U,9)=1
DO FORCEPRT(IBNCN)
DO AUTOPRC($GET(IBIFN),2)
+81 if $PIECE($GET(^DIC(36,IBINS,6)),U,9)'=1
DO AUTOPRC($GET(IBIFN),3)
+82 ;
+83 ; authorize the new claim
+84 DO AUTH^IBCEMQA(IBNCN,.IBERRMSG,IBMRANOT)
+85 ;
+86 ; If AUTH error occurred, file the automatic bill generation failure message
+87 IF $GET(IBERRMSG)]""
DO AUTOMSG^IBCESRV3(IBEOB,IBERRMSG)
GOTO ENX
+88 ;
+89 ; If local print, then print it
+90 IF $PIECE($GET(^DIC(36,IBINS,6)),U,9)=1
DO STFLP^IBCAPR1(IBNCN)
+91 ;
ENX ;Quit and Cleanup of Main Entry Point, added with IB*2*432
+1 ;
+2 ; DBIA #10111: Allows FM read access of ^XMB(3.8,D0,0) using DIC.
+3 SET DIC="^XMB(3.8,"
SET DIC(0)="QM"
SET X="IB DEV TEAM"
DO ^DIC
+4 ;
+5 QUIT
+6 ;
PUTONWL(IBIFN,IBREASON) ; Put a claim on the worklist
+1 ; IBIFN - internal claim number
+2 ; IBREASON - reason why this is being put on the worklist (error code:text)
+3 ;
+4 NEW DA,DIE,DR
+5 SET DA=IBIFN
+6 SET DIE="^DGCR(399,"
+7 ; place on the worklist
SET DR="35///1"
+8 ; why placed on worklist
SET DR=DR_";"_"36///"_$PIECE(IBREASON,":")
+9 DO ^DIE
+10 QUIT
+11 ;
AUTOPRC(IBIFN,IBAP) ; record that a claim was auto-processed IB*2.0*447
+1 ; IBIFN - internal claim number
+2 ; IBAP - 2 = AUTO LOCAL PRINT, 3 = AUTO EDI
+3 ;
+4 NEW DA,DIE,DR
+5 if IBIFN=""
QUIT
+6 if IBAP=""
QUIT
+7 SET DA=IBIFN
+8 SET DIE="^DGCR(399,"
+9 ; UPDATE AUTO-PROCESS FIELD
SET DR="35///"_IBAP
+10 DO ^DIE
+11 QUIT
+12 ;
FORCEPRT(IBIFN) ; set force to local print flag in claim
+1 ; IBIFN - internal claim number
+2 ;
+3 NEW DA,DIE,DR
+4 SET DA=IBIFN
+5 SET DIE="^DGCR(399,"
+6 ; Force Local Print
SET DR="27///1"
+7 DO ^DIE
+8 QUIT
+9 ;
IBREG() ; Returns IEN (Internal Entry Number) from file #200 for
+1 ; the Bill Authorizer of acceptable regular (non MRA) secondary claims,
+2 ; namely, AUTHORIZER,IB REG
+3 ;
+4 ; Output: -1 if record not on file
+5 ; IEN if record is on file
+6 ;
+7 NEW DIC,X,Y
+8 SET DIC(0)="MO"
SET DIC="^VA(200,"
SET X="AUTHORIZER,IB REG"
+9 ; call FM lookup utility
+10 DO ^DIC
+11 ; if record is already on file, return IEN
+12 ; else return -1
+13 QUIT +Y
