- 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 Feb 18, 2025@23:37:19 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 ;