IBCEMQA ;DAOU/ESG - MRA QUIET BILL AUTHORIZATION ;25-MAR-2003
;;2.0;INTEGRATED BILLING;**155,432,592**;21-MAR-94;Build 58
;;Per VA Directive 6402, this routine should not be modified.
;
Q ; must be called at proper entry point
;
;
AUTOCOB(IBIFN,IBEOB,ERRMSG,IBMRANOT,IBNCN) ; This procedure mimics and automates the
; Process COB action on the MRA management screen. This is intended
; to be called in background mode (no user interface).
;
; Input
; IBIFN - bill#
; IBEOB - ien of entry in file 361.1 (MRA)
; IBMRANOT - 1 indicates process is NOT from MRA
; IBNCN - By Reference. Need to pass back the new claim number
;
; Output
; ERRMSG - optional output parameter, passed by reference
; - error message text
;
;JWS;IB*2.0*592; added IBQUIT to new - SQA
NEW MRADATA,IB364,IBCBASK,IBCBCOPY,IBCAN,IBIFNH,IBAUTO,IBDA,IBQUIT
NEW IBCE,IBSILENT,IBPRCOB,IBERRMSG,IBSTSM
NEW IBCOB,IBCOBIL,IBCOBN,IBINS,IBINSN,IBINSOLD,IBMRAIO,IBMRAO,IBNMOLD
S (IBIFN,IBIFNH)=+$G(IBIFN),IBEOB=+$G(IBEOB),ERRMSG=""
;
S MRADATA=$G(^IBM(361.1,IBEOB,0))
; IB*2.0*432 - Add auto-process of non-MRA's
I $G(IBMRANOT)'=1,$P(MRADATA,U,1)'=IBIFN S ERRMSG="Incorrect Bill or MRA EOB" G AUCOBX
I $G(IBMRANOT)'=1,$P(MRADATA,U,4)'=1 S ERRMSG="EOB is not a Medicare MRA" G AUCOBX
S IB364=+$P(MRADATA,U,19)
I $G(IBMRANOT)'=1,'IB364 S ERRMSG="Missing or incorrect Transmission record" G AUCOBX
;
I '$P($G(^DGCR(399,IBIFN,"I"_($$COBN^IBCEF(IBIFN)+1))),U,1) D G AUCOBX
. S ERRMSG="No next payer for this bill"
. Q
;
; Make sure that Medicare WNR is the current insurance for this bill if MRA processing
I $G(IBMRANOT)'=1,'$$WNRBILL^IBEFUNC(IBIFN) D G AUCOBX
. S ERRMSG="Medicare (WNR) is not the current payer for this bill"
. Q
;
; Set variable flags for use in IBCCCB/IBCCC2
S (IBCBASK,IBCBCOPY,IBCAN,IBAUTO,IBCE("EDI"),IBSILENT,IBPRCOB)=1
; IB*2.0*432 - if non-MRA processing, set Secondary/Tertiary Silent mode=1
S:$G(IBMRANOT)=1 IBSTSM=1
S IBDA=IBEOB
;
D CHKB1^IBCCCB
;
I $G(IBMRANOT)=1 S IBNCN=$S($G(IBCE("EDI","NEW")):IBCE("EDI","NEW"),1:$G(IBHV("IBIFN1")))
S IBIFN=IBIFNH ; restore bill#
I $G(IBERRMSG)'="" S ERRMSG=IBERRMSG G AUCOBX ; error message
D UPDEDI^IBCEM(IB364,"Z") ; status updates
AUCOBX ;
Q
;
;
AUTH(IBIFN,ERRMSG,IBMRANOT) ; Entry Point
; This procedure's job is to authorize this bill. The manual
; process to authorize a bill is found in routine IBCB1. This
; routine borrows heavily from that routine.
;
; *** Any changes here should be considered also in IBCB1 ***
;
; This routine is called when receiving an incoming MRA from
; Medicare. If that MRA/EOB meets certain criteria, then the bill
; will become a secondary bill and we will try to authorize it (using
; this procedure) and put it in the EDI queue ready for extract.
;
; Input
; IBIFN - internal bill#
; IBMRANOT - 1 indicates process is NOT from MRA
;
; Output
; ERRMSG - optional output parameter, passed by reference
; - error message text
;
NEW CST,IBTXSTAT,IB364,PRCASV,DFN,STSMSG
NEW DIE,DA,DR,IBYY
;
; Check the bill, make sure the current status is valid
S IBIFN=+$G(IBIFN),ERRMSG=""
S CST=$P($G(^DGCR(399,IBIFN,0)),U,13)
I CST="" S ERRMSG="Bill has no current status defined." G AUTHX
; IB*2.0*432 add auto-processing of non-MRA's
I $G(IBMRANOT)'=1,CST'=2 S ERRMSG="This bill's status is "_$$GET1^DIQ(399,IBIFN_",",.13)_". It must be REQUEST MRA." G AUTHX
;
; authorize the bill quietly
S DIE=399,DA=IBIFN,DR="[IB STATUS]",IBYY="@902" D ^DIE
;
; Update the review status for all EOB's on file
D STAT^IBCEMU2(IBIFN,3) ; Accepted - Complete EOB
;
; Checks for need to add any codes to bill for EDI (call in quiet mode)
D AUTOCK^IBCEU2(IBIFN,1)
;
; Calculate transmittable status
; 0 = not transmittable
; 1 = yes, live transmittable
; 2 = yes, test transmittable
; P432 add MRANOT flag so it will create new entry in trans file for non-MRA's
S IBTXSTAT=+$$TXMT^IBCEF4(IBIFN,,$G(IBMRANOT))
;
; If transmittable, add this bill to the bill transmission file
I IBTXSTAT D I ERRMSG'="" G AUTHX
. S IB364=$$ADDTBILL^IBCB1(IBIFN,IBTXSTAT)
. I '$P(IB364,U,3) S ERRMSG="Error loading bill into transmit file."
. Q
;
; Pass completed bill to Accounts Receivable (quietly)
D ARPASS^IBCB1(IBIFN,0)
I '$G(PRCASV("OKAY")) S ERRMSG="Error while passing bill to A/R." G AUTHX
;
; Find and process any IB charges on hold
S DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2)
D FIND^IBOHCK(DFN,IBIFN)
;
; If transmittable, check for unreviewed items & update 364 status
I IBTXSTAT D
. S STSMSG=$$STATUS^IBCEF4(IBIFN)
. I $P(STSMSG,U,1) D UPDEDI^IBCEM($P(STSMSG,U,1),"E")
. I $P(STSMSG,U,2),$P(STSMSG,U,2)'=$P(STSMSG,U,1) D UPDEDI^IBCEM($P(STSMSG,U,2),"E")
. Q
;
AUTHX ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEMQA 4971 printed Oct 16, 2024@18:11:36 Page 2
IBCEMQA ;DAOU/ESG - MRA QUIET BILL AUTHORIZATION ;25-MAR-2003
+1 ;;2.0;INTEGRATED BILLING;**155,432,592**;21-MAR-94;Build 58
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; must be called at proper entry point
QUIT
+5 ;
+6 ;
AUTOCOB(IBIFN,IBEOB,ERRMSG,IBMRANOT,IBNCN) ; This procedure mimics and automates the
+1 ; Process COB action on the MRA management screen. This is intended
+2 ; to be called in background mode (no user interface).
+3 ;
+4 ; Input
+5 ; IBIFN - bill#
+6 ; IBEOB - ien of entry in file 361.1 (MRA)
+7 ; IBMRANOT - 1 indicates process is NOT from MRA
+8 ; IBNCN - By Reference. Need to pass back the new claim number
+9 ;
+10 ; Output
+11 ; ERRMSG - optional output parameter, passed by reference
+12 ; - error message text
+13 ;
+14 ;JWS;IB*2.0*592; added IBQUIT to new - SQA
+15 NEW MRADATA,IB364,IBCBASK,IBCBCOPY,IBCAN,IBIFNH,IBAUTO,IBDA,IBQUIT
+16 NEW IBCE,IBSILENT,IBPRCOB,IBERRMSG,IBSTSM
+17 NEW IBCOB,IBCOBIL,IBCOBN,IBINS,IBINSN,IBINSOLD,IBMRAIO,IBMRAO,IBNMOLD
+18 SET (IBIFN,IBIFNH)=+$GET(IBIFN)
SET IBEOB=+$GET(IBEOB)
SET ERRMSG=""
+19 ;
+20 SET MRADATA=$GET(^IBM(361.1,IBEOB,0))
+21 ; IB*2.0*432 - Add auto-process of non-MRA's
+22 IF $GET(IBMRANOT)'=1
IF $PIECE(MRADATA,U,1)'=IBIFN
SET ERRMSG="Incorrect Bill or MRA EOB"
GOTO AUCOBX
+23 IF $GET(IBMRANOT)'=1
IF $PIECE(MRADATA,U,4)'=1
SET ERRMSG="EOB is not a Medicare MRA"
GOTO AUCOBX
+24 SET IB364=+$PIECE(MRADATA,U,19)
+25 IF $GET(IBMRANOT)'=1
IF 'IB364
SET ERRMSG="Missing or incorrect Transmission record"
GOTO AUCOBX
+26 ;
+27 IF '$PIECE($GET(^DGCR(399,IBIFN,"I"_($$COBN^IBCEF(IBIFN)+1))),U,1)
Begin DoDot:1
+28 SET ERRMSG="No next payer for this bill"
+29 QUIT
End DoDot:1
GOTO AUCOBX
+30 ;
+31 ; Make sure that Medicare WNR is the current insurance for this bill if MRA processing
+32 IF $GET(IBMRANOT)'=1
IF '$$WNRBILL^IBEFUNC(IBIFN)
Begin DoDot:1
+33 SET ERRMSG="Medicare (WNR) is not the current payer for this bill"
+34 QUIT
End DoDot:1
GOTO AUCOBX
+35 ;
+36 ; Set variable flags for use in IBCCCB/IBCCC2
+37 SET (IBCBASK,IBCBCOPY,IBCAN,IBAUTO,IBCE("EDI"),IBSILENT,IBPRCOB)=1
+38 ; IB*2.0*432 - if non-MRA processing, set Secondary/Tertiary Silent mode=1
+39 if $GET(IBMRANOT)=1
SET IBSTSM=1
+40 SET IBDA=IBEOB
+41 ;
+42 DO CHKB1^IBCCCB
+43 ;
+44 IF $GET(IBMRANOT)=1
SET IBNCN=$SELECT($GET(IBCE("EDI","NEW")):IBCE("EDI","NEW"),1:$GET(IBHV("IBIFN1")))
+45 ; restore bill#
SET IBIFN=IBIFNH
+46 ; error message
IF $GET(IBERRMSG)'=""
SET ERRMSG=IBERRMSG
GOTO AUCOBX
+47 ; status updates
DO UPDEDI^IBCEM(IB364,"Z")
AUCOBX ;
+1 QUIT
+2 ;
+3 ;
AUTH(IBIFN,ERRMSG,IBMRANOT) ; Entry Point
+1 ; This procedure's job is to authorize this bill. The manual
+2 ; process to authorize a bill is found in routine IBCB1. This
+3 ; routine borrows heavily from that routine.
+4 ;
+5 ; *** Any changes here should be considered also in IBCB1 ***
+6 ;
+7 ; This routine is called when receiving an incoming MRA from
+8 ; Medicare. If that MRA/EOB meets certain criteria, then the bill
+9 ; will become a secondary bill and we will try to authorize it (using
+10 ; this procedure) and put it in the EDI queue ready for extract.
+11 ;
+12 ; Input
+13 ; IBIFN - internal bill#
+14 ; IBMRANOT - 1 indicates process is NOT from MRA
+15 ;
+16 ; Output
+17 ; ERRMSG - optional output parameter, passed by reference
+18 ; - error message text
+19 ;
+20 NEW CST,IBTXSTAT,IB364,PRCASV,DFN,STSMSG
+21 NEW DIE,DA,DR,IBYY
+22 ;
+23 ; Check the bill, make sure the current status is valid
+24 SET IBIFN=+$GET(IBIFN)
SET ERRMSG=""
+25 SET CST=$PIECE($GET(^DGCR(399,IBIFN,0)),U,13)
+26 IF CST=""
SET ERRMSG="Bill has no current status defined."
GOTO AUTHX
+27 ; IB*2.0*432 add auto-processing of non-MRA's
+28 IF $GET(IBMRANOT)'=1
IF CST'=2
SET ERRMSG="This bill's status is "_$$GET1^DIQ(399,IBIFN_",",.13)_". It must be REQUEST MRA."
GOTO AUTHX
+29 ;
+30 ; authorize the bill quietly
+31 SET DIE=399
SET DA=IBIFN
SET DR="[IB STATUS]"
SET IBYY="@902"
DO ^DIE
+32 ;
+33 ; Update the review status for all EOB's on file
+34 ; Accepted - Complete EOB
DO STAT^IBCEMU2(IBIFN,3)
+35 ;
+36 ; Checks for need to add any codes to bill for EDI (call in quiet mode)
+37 DO AUTOCK^IBCEU2(IBIFN,1)
+38 ;
+39 ; Calculate transmittable status
+40 ; 0 = not transmittable
+41 ; 1 = yes, live transmittable
+42 ; 2 = yes, test transmittable
+43 ; P432 add MRANOT flag so it will create new entry in trans file for non-MRA's
+44 SET IBTXSTAT=+$$TXMT^IBCEF4(IBIFN,,$GET(IBMRANOT))
+45 ;
+46 ; If transmittable, add this bill to the bill transmission file
+47 IF IBTXSTAT
Begin DoDot:1
+48 SET IB364=$$ADDTBILL^IBCB1(IBIFN,IBTXSTAT)
+49 IF '$PIECE(IB364,U,3)
SET ERRMSG="Error loading bill into transmit file."
+50 QUIT
End DoDot:1
IF ERRMSG'=""
GOTO AUTHX
+51 ;
+52 ; Pass completed bill to Accounts Receivable (quietly)
+53 DO ARPASS^IBCB1(IBIFN,0)
+54 IF '$GET(PRCASV("OKAY"))
SET ERRMSG="Error while passing bill to A/R."
GOTO AUTHX
+55 ;
+56 ; Find and process any IB charges on hold
+57 SET DFN=+$PIECE($GET(^DGCR(399,IBIFN,0)),U,2)
+58 DO FIND^IBOHCK(DFN,IBIFN)
+59 ;
+60 ; If transmittable, check for unreviewed items & update 364 status
+61 IF IBTXSTAT
Begin DoDot:1
+62 SET STSMSG=$$STATUS^IBCEF4(IBIFN)
+63 IF $PIECE(STSMSG,U,1)
DO UPDEDI^IBCEM($PIECE(STSMSG,U,1),"E")
+64 IF $PIECE(STSMSG,U,2)
IF $PIECE(STSMSG,U,2)'=$PIECE(STSMSG,U,1)
DO UPDEDI^IBCEM($PIECE(STSMSG,U,2),"E")
+65 QUIT
End DoDot:1
+66 ;
AUTHX ;
+1 QUIT
+2 ;
