IBCEMRAX ;ALB/DSM - MEDICARE REMITTANCE ADVICE DETAIL-PART A Cont'd ;25-APR-2003
;;2.0;INTEGRATED BILLING;**155,432**;21-MAR-94;Build 192
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
DEV(IBIFN,IBMRANOT) ; Prompt the user for a device ; WCJ IB*2.0*432
; Input: IBIFN= ien# of Claim file
; IBMRANOT = 1 if NOT an MRA ; WCJ IB*2.0*432
N %ZIS,ZTRTN,ZTSAVE,ZTDESC,POP,MRACNT
I '$G(IBIFN) Q ;DEV
W !!,"This report displays Medicare-equivalent Remittance Advice Detail."
S MRACNT=$$MRACNT^IBCEMU1(IBIFN,$G(IBMRANOT))
I MRACNT>1 W !,"*** Multiple MRAs on File for this claim. ",MRACNT," MRAs will be printed. ***"
W !,"You will need a 132 column printer for this report",!
;
S %ZIS="QM" D ^%ZIS I POP S IBQUIT=1 Q
; handle queuing report next
I $D(IO("Q")) D S IBQUIT=1 Q
. S ZTRTN="PROC^IBCEMRAA" ; background re-entry point
. S ZTDESC="Medicare-equivalent Remittance Advice Detail Print"
. S ZTSAVE("IB*")=""
. D ^%ZTLOAD
. W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
. K ZTSK,IO("Q") D HOME^%ZIS
U IO ; Output device
Q ;DEV
;
SRVHDR ; Print Srvice Level Header
; ROW 23 -
; Service (Line) Level Adjustments Data
W !!! I '$G(INPAT) W "SERV DATE" ;print only on outpatient claims
W ?12,"PT",?15,"PROC",?21,"MODS",?30,"REV",?35,"APC",?43,"UNITS",?50,"TOT CHARGES"
W ?67,"DEDUCT",?80,"COINS",?90,"ALLOWED",?102,"PAYMENT",?111,"GRP-RC",?123,"ADJ AMT"
Q ;SRVHDR
;
SRVDATA ; Get Service Level Data of EOB file (#361.1 Level 15)
;
N LNLVL,RLVL,GLVL,RLVLD,GLVLD,SRVDED,GRPCD,RSNCD,SRVCOIN,I,MOD,SRMKS,LNLVLD
N PRCD,REVCD,UNIT,SRVDT,PRCTYP,ALWD,PAID,SRVDED,GLVL,RCNT,OPRCD,TOTL,LNORD,LNCNT
; Use array LNORD to sort Service Lines in order of Referenced Line #
S LNLVL=0,LNCNT=1000
F S LNLVL=$O(^IBM(361.1,IEN,15,LNLVL)) Q:'LNLVL S LNORD=$P(^(LNLVL,0),U,12) D ;
. I LNORD S LNORD(LNORD)=LNLVL Q
. S LNORD(LNCNT)=LNLVL,LNCNT=LNCNT+1
;
S LNORD=0
F S LNORD=$O(LNORD(LNORD)) Q:'LNORD S LNLVL=LNORD(LNORD) D I IBQUIT Q
. S LNLVLD=$G(^IBM(361.1,IEN,15,LNLVL,0)) I LNLVLD="" Q
. I ($Y+4)>IOSL D I IBQUIT Q
. . D PAUSE I IBQUIT Q
. . W @IOF D CLMHDR^IBCEMRAA
. . D SRVHDR
. ;
. K MOD,RCNT,TOTL S RCNT=0
. ; Procedure Code, Revenue Code, Units, From Service Date, Procedure Type
. S PRCD=$P(LNLVLD,U,4),REVCD=$P(LNLVLD,U,10),UNIT=$P(LNLVLD,U,11),SRVDT=$P(LNLVLD,U,16)
. S PRCTYP=$P(LNLVLD,U,18) I PRCTYP="NU" S PRCTYP="" ;don't display NU for Proc Type
. ; Resolve Revenue Code Pointer
. I REVCD'="" S REVCD=$P($G(^DGCR(399.2,REVCD,0)),U)
. ; Allowed, Payment, Original Procedure Code
. S ALWD=$P(LNLVLD,U,13),PAID=$P(LNLVLD,U,3),OPRCD=$P(LNLVLD,U,15)
. ; Handle Multiple Paid Modifiers from the Service Line Level (may have 4 mod's, could only fit 3)
. M MOD=^IBM(361.1,IEN,15,LNLVL,2) S MOD="" F I=1:1:3 Q:'$D(MOD(I)) S MOD=MOD_$S(MOD="":"",1:",")_MOD(I,0)
. ; Get Total Charge by matching 837 Extract Records with Bill's Original Line# on the current Service Line (LNLVLD)
. S TOTL=$P($G(IBZDATA($P(LNLVLD,U,12))),U,5)
. ; Service Line Level Remarks Codes
. S SRMKS=$G(^IBM(361.1,IEN,15,LNLVL,3))
. ; Row 24 - print Service date only on Outpatient claims (skip on Inpatients)
. W ! I '$G(INPAT) W $$FMTE^XLFDT(SRVDT,5)
. W ?12,PRCTYP,?15,PRCD,?21,MOD,?30,REVCD,?41,$J(UNIT,7),?49,$J($G(TOTL),12,2)
. ;
. ; Get Service Level Group Code/Reason Code Data
. ; RLVLD=reason_code^amount^quantity^reason text
. S (SRVDED,GLVL,RCNT,SRVCOIN)=0 K RSNCD
. F S GLVL=$O(^IBM(361.1,IEN,15,LNLVL,1,GLVL)) Q:'GLVL S GLVLD=^(GLVL,0) D ;
. . S GRPCD=$P(GLVLD,U),RLVL=0
. . F S RLVL=$O(^IBM(361.1,IEN,15,LNLVL,1,GLVL,1,RLVL)) Q:'RLVL S RLVLD=^(RLVL,0),RSNCD=$P(RLVLD,U) D ;
. . . I GRPCD="PR",RSNCD="AAA" Q ;exception
. . . I GRPCD="OA",RSNCD="AB3" Q ;exception
. . . I GRPCD="LQ" Q ;exception
. . . I GRPCD="PR",RSNCD=1!(RSNCD=66) S SRVDED=SRVDED+$P(RLVLD,U,2) Q ;deductible
. . . I GRPCD="PR",RSNCD=2 S SRVCOIN=$P(RLVLD,U,2) Q ;coinsurance
. . . S RCNT=RCNT+1,RSNCD(RCNT)=GRPCD_"-"_RSNCD_U_$P(RLVLD,U,2)
. ; Print Service Level Group Code/Reason Code Data
. ; Service Level deductible, Coinsurance, Allowed, Paid Amount
. W ?62,$J(SRVDED,11,2),?74,$J(SRVCOIN,11,2),?86,$J(ALWD,11,2),?98,$J(PAID,11,2)
. ; Print Group Code-Reason Code, Adjustment Amount
. F I=1:1:RCNT W:I>1 ! W ?111,$P(RSNCD(I),U),?118,$J($P(RSNCD(I),U,2),12,2)
. ; Row 25
. I OPRCD="",(SRMKS="") Q
. W ! I OPRCD'="" W ?15,"(",$E(OPRCD,1,4),")"
. I SRMKS'="" W ?26,"REM:",?30,$P(SRMKS,U)
;
Q ;SRVDATA
;
PAUSE ; Pause at the bottom of screen. This section is called
; from different points of the MRA report.
;
I $E(IOST,1,2)'["C-" Q ;if not terminal, don't pause
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="E" D ^DIR
I $D(DIRUT)!($D(DUOUT)) S IBQUIT=1 Q
Q ;PAUSE
;
DSCLMR ;
N LINE
S $P(LINE,"-",122)=""
W !!,LINE
W !,"This is a printed representation of a remittance advice, developed through a joint effort between the Centers for Medicare and"
W !,"Medicaid Services and the Department of Veterans Affairs, for a claim for services or supplies furnished to a Medicare-eligible"
W !,"veteran through a facility of the Department of Veterans Affairs. The remittance advice shows the amount that Medicare would have"
W !,"paid had the claim been payable by Medicare, as well as the coinsurance and deductible amounts that would have applied."
W !,"The claim is not payable under the Medicare program, and no Medicare payment was issued."
W !
Q ;DSCLMR
;
LINELVL ; This section is called when printing Institutional Reports
; The values of Coinsurance, Contractual Adjustment, Noncovered Charges
; and Deductible are calculated from the Service Line level and not
; from the Claim level.
;
; RLVLD=reason_code^amount^quantity^reason text
; IBCOINS,IBCTADJ,NCVRCHRG,CLMADJ are set to zero in the calling section CLMDATA
;
N LNLVL,LNLVLD,GLVL,GLVLD,RLVL,RLVLD,GRPCD,RSNCD
S LNLVL=0
F S LNLVL=$O(^IBM(361.1,IEN,15,LNLVL)) Q:'LNLVL S LNLVLD=^(LNLVL,0) D ;
. S GLVL=0 F S GLVL=$O(^IBM(361.1,IEN,15,LNLVL,1,GLVL)) Q:'GLVL S GLVLD=^(GLVL,0) D ;
. . S GRPCD=$P(GLVLD,U),RLVL=0
. . F S RLVL=$O(^IBM(361.1,IEN,15,LNLVL,1,GLVL,1,RLVL)) Q:'RLVL S RLVLD=^(RLVL,0),RSNCD=$P(RLVLD,U) D ;
. . . I GRPCD="PR",RSNCD="AAA" Q ;exception
. . . I GRPCD="OA",RSNCD="AB3" Q ;exception
. . . I GRPCD="LQ" Q ;exception
. . . ; set Claim Adjustment only if none were found at the claim level (don't check for group code)
. . . I RCLMADJ[(","_RSNCD_",") S CLMADJ=CLMADJ+$P(RLVLD,U,2)
. . . ; Coinsurance
. . . I GRPCD="PR",RCOINS[(","_RSNCD_",") S IBCOINS=IBCOINS+$P(RLVLD,U,2) Q
. . . ; Deductible
. . . I GRPCD="PR" I RCDED[(","_RSNCD_",") S IBDED=IBDED+$P(RLVLD,U,2) Q
. . . I GRPCD="CO" D ;
. . . . ; Contractual Adjustment
. . . . I RCTADJ[(","_RSNCD_",") S IBCTADJ=IBCTADJ+$P(RLVLD,U,2)
. . . . ; Noncovered Charges
. . . . I RCNCVR'[(","_RSNCD_",") S NCVRCHRG=NCVRCHRG+$P(RLVLD,U,2)
Q ;LINELVL
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEMRAX 7150 printed Oct 16, 2024@18:11:40 Page 2
IBCEMRAX ;ALB/DSM - MEDICARE REMITTANCE ADVICE DETAIL-PART A Cont'd ;25-APR-2003
+1 ;;2.0;INTEGRATED BILLING;**155,432**;21-MAR-94;Build 192
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
DEV(IBIFN,IBMRANOT) ; Prompt the user for a device ; WCJ IB*2.0*432
+1 ; Input: IBIFN= ien# of Claim file
+2 ; IBMRANOT = 1 if NOT an MRA ; WCJ IB*2.0*432
+3 NEW %ZIS,ZTRTN,ZTSAVE,ZTDESC,POP,MRACNT
+4 ;DEV
IF '$GET(IBIFN)
QUIT
+5 WRITE !!,"This report displays Medicare-equivalent Remittance Advice Detail."
+6 SET MRACNT=$$MRACNT^IBCEMU1(IBIFN,$GET(IBMRANOT))
+7 IF MRACNT>1
WRITE !,"*** Multiple MRAs on File for this claim. ",MRACNT," MRAs will be printed. ***"
+8 WRITE !,"You will need a 132 column printer for this report",!
+9 ;
+10 SET %ZIS="QM"
DO ^%ZIS
IF POP
SET IBQUIT=1
QUIT
+11 ; handle queuing report next
+12 IF $DATA(IO("Q"))
Begin DoDot:1
+13 ; background re-entry point
SET ZTRTN="PROC^IBCEMRAA"
+14 SET ZTDESC="Medicare-equivalent Remittance Advice Detail Print"
+15 SET ZTSAVE("IB*")=""
+16 DO ^%ZTLOAD
+17 WRITE !!,$SELECT($DATA(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
+18 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
SET IBQUIT=1
QUIT
+19 ; Output device
USE IO
+20 ;DEV
QUIT
+21 ;
SRVHDR ; Print Srvice Level Header
+1 ; ROW 23 -
+2 ; Service (Line) Level Adjustments Data
+3 ;print only on outpatient claims
WRITE !!!
IF '$GET(INPAT)
WRITE "SERV DATE"
+4 WRITE ?12,"PT",?15,"PROC",?21,"MODS",?30,"REV",?35,"APC",?43,"UNITS",?50,"TOT CHARGES"
+5 WRITE ?67,"DEDUCT",?80,"COINS",?90,"ALLOWED",?102,"PAYMENT",?111,"GRP-RC",?123,"ADJ AMT"
+6 ;SRVHDR
QUIT
+7 ;
SRVDATA ; Get Service Level Data of EOB file (#361.1 Level 15)
+1 ;
+2 NEW LNLVL,RLVL,GLVL,RLVLD,GLVLD,SRVDED,GRPCD,RSNCD,SRVCOIN,I,MOD,SRMKS,LNLVLD
+3 NEW PRCD,REVCD,UNIT,SRVDT,PRCTYP,ALWD,PAID,SRVDED,GLVL,RCNT,OPRCD,TOTL,LNORD,LNCNT
+4 ; Use array LNORD to sort Service Lines in order of Referenced Line #
+5 SET LNLVL=0
SET LNCNT=1000
+6 ;
FOR
SET LNLVL=$ORDER(^IBM(361.1,IEN,15,LNLVL))
if 'LNLVL
QUIT
SET LNORD=$PIECE(^(LNLVL,0),U,12)
Begin DoDot:1
+7 IF LNORD
SET LNORD(LNORD)=LNLVL
QUIT
+8 SET LNORD(LNCNT)=LNLVL
SET LNCNT=LNCNT+1
End DoDot:1
+9 ;
+10 SET LNORD=0
+11 FOR
SET LNORD=$ORDER(LNORD(LNORD))
if 'LNORD
QUIT
SET LNLVL=LNORD(LNORD)
Begin DoDot:1
+12 SET LNLVLD=$GET(^IBM(361.1,IEN,15,LNLVL,0))
IF LNLVLD=""
QUIT
+13 IF ($Y+4)>IOSL
Begin DoDot:2
+14 DO PAUSE
IF IBQUIT
QUIT
+15 WRITE @IOF
DO CLMHDR^IBCEMRAA
+16 DO SRVHDR
End DoDot:2
IF IBQUIT
QUIT
+17 ;
+18 KILL MOD,RCNT,TOTL
SET RCNT=0
+19 ; Procedure Code, Revenue Code, Units, From Service Date, Procedure Type
+20 SET PRCD=$PIECE(LNLVLD,U,4)
SET REVCD=$PIECE(LNLVLD,U,10)
SET UNIT=$PIECE(LNLVLD,U,11)
SET SRVDT=$PIECE(LNLVLD,U,16)
+21 ;don't display NU for Proc Type
SET PRCTYP=$PIECE(LNLVLD,U,18)
IF PRCTYP="NU"
SET PRCTYP=""
+22 ; Resolve Revenue Code Pointer
+23 IF REVCD'=""
SET REVCD=$PIECE($GET(^DGCR(399.2,REVCD,0)),U)
+24 ; Allowed, Payment, Original Procedure Code
+25 SET ALWD=$PIECE(LNLVLD,U,13)
SET PAID=$PIECE(LNLVLD,U,3)
SET OPRCD=$PIECE(LNLVLD,U,15)
+26 ; Handle Multiple Paid Modifiers from the Service Line Level (may have 4 mod's, could only fit 3)
+27 MERGE MOD=^IBM(361.1,IEN,15,LNLVL,2)
SET MOD=""
FOR I=1:1:3
if '$DATA(MOD(I))
QUIT
SET MOD=MOD_$SELECT(MOD="":"",1:",")_MOD(I,0)
+28 ; Get Total Charge by matching 837 Extract Records with Bill's Original Line# on the current Service Line (LNLVLD)
+29 SET TOTL=$PIECE($GET(IBZDATA($PIECE(LNLVLD,U,12))),U,5)
+30 ; Service Line Level Remarks Codes
+31 SET SRMKS=$GET(^IBM(361.1,IEN,15,LNLVL,3))
+32 ; Row 24 - print Service date only on Outpatient claims (skip on Inpatients)
+33 WRITE !
IF '$GET(INPAT)
WRITE $$FMTE^XLFDT(SRVDT,5)
+34 WRITE ?12,PRCTYP,?15,PRCD,?21,MOD,?30,REVCD,?41,$JUSTIFY(UNIT,7),?49,$JUSTIFY($GET(TOTL),12,2)
+35 ;
+36 ; Get Service Level Group Code/Reason Code Data
+37 ; RLVLD=reason_code^amount^quantity^reason text
+38 SET (SRVDED,GLVL,RCNT,SRVCOIN)=0
KILL RSNCD
+39 ;
FOR
SET GLVL=$ORDER(^IBM(361.1,IEN,15,LNLVL,1,GLVL))
if 'GLVL
QUIT
SET GLVLD=^(GLVL,0)
Begin DoDot:2
+40 SET GRPCD=$PIECE(GLVLD,U)
SET RLVL=0
+41 ;
FOR
SET RLVL=$ORDER(^IBM(361.1,IEN,15,LNLVL,1,GLVL,1,RLVL))
if 'RLVL
QUIT
SET RLVLD=^(RLVL,0)
SET RSNCD=$PIECE(RLVLD,U)
Begin DoDot:3
+42 ;exception
IF GRPCD="PR"
IF RSNCD="AAA"
QUIT
+43 ;exception
IF GRPCD="OA"
IF RSNCD="AB3"
QUIT
+44 ;exception
IF GRPCD="LQ"
QUIT
+45 ;deductible
IF GRPCD="PR"
IF RSNCD=1!(RSNCD=66)
SET SRVDED=SRVDED+$PIECE(RLVLD,U,2)
QUIT
+46 ;coinsurance
IF GRPCD="PR"
IF RSNCD=2
SET SRVCOIN=$PIECE(RLVLD,U,2)
QUIT
+47 SET RCNT=RCNT+1
SET RSNCD(RCNT)=GRPCD_"-"_RSNCD_U_$PIECE(RLVLD,U,2)
End DoDot:3
End DoDot:2
+48 ; Print Service Level Group Code/Reason Code Data
+49 ; Service Level deductible, Coinsurance, Allowed, Paid Amount
+50 WRITE ?62,$JUSTIFY(SRVDED,11,2),?74,$JUSTIFY(SRVCOIN,11,2),?86,$JUSTIFY(ALWD,11,2),?98,$JUSTIFY(PAID,11,2)
+51 ; Print Group Code-Reason Code, Adjustment Amount
+52 FOR I=1:1:RCNT
if I>1
WRITE !
WRITE ?111,$PIECE(RSNCD(I),U),?118,$JUSTIFY($PIECE(RSNCD(I),U,2),12,2)
+53 ; Row 25
+54 IF OPRCD=""
IF (SRMKS="")
QUIT
+55 WRITE !
IF OPRCD'=""
WRITE ?15,"(",$EXTRACT(OPRCD,1,4),")"
+56 IF SRMKS'=""
WRITE ?26,"REM:",?30,$PIECE(SRMKS,U)
End DoDot:1
IF IBQUIT
QUIT
+57 ;
+58 ;SRVDATA
QUIT
+59 ;
PAUSE ; Pause at the bottom of screen. This section is called
+1 ; from different points of the MRA report.
+2 ;
+3 ;if not terminal, don't pause
IF $EXTRACT(IOST,1,2)'["C-"
QUIT
+4 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+5 SET DIR(0)="E"
DO ^DIR
+6 IF $DATA(DIRUT)!($DATA(DUOUT))
SET IBQUIT=1
QUIT
+7 ;PAUSE
QUIT
+8 ;
DSCLMR ;
+1 NEW LINE
+2 SET $PIECE(LINE,"-",122)=""
+3 WRITE !!,LINE
+4 WRITE !,"This is a printed representation of a remittance advice, developed through a joint effort between the Centers for Medicare and"
+5 WRITE !,"Medicaid Services and the Department of Veterans Affairs, for a claim for services or supplies furnished to a Medicare-eligible"
+6 WRITE !,"veteran through a facility of the Department of Veterans Affairs. The remittance advice shows the amount that Medicare would have"
+7 WRITE !,"paid had the claim been payable by Medicare, as well as the coinsurance and deductible amounts that would have applied."
+8 WRITE !,"The claim is not payable under the Medicare program, and no Medicare payment was issued."
+9 WRITE !
+10 ;DSCLMR
QUIT
+11 ;
LINELVL ; This section is called when printing Institutional Reports
+1 ; The values of Coinsurance, Contractual Adjustment, Noncovered Charges
+2 ; and Deductible are calculated from the Service Line level and not
+3 ; from the Claim level.
+4 ;
+5 ; RLVLD=reason_code^amount^quantity^reason text
+6 ; IBCOINS,IBCTADJ,NCVRCHRG,CLMADJ are set to zero in the calling section CLMDATA
+7 ;
+8 NEW LNLVL,LNLVLD,GLVL,GLVLD,RLVL,RLVLD,GRPCD,RSNCD
+9 SET LNLVL=0
+10 ;
FOR
SET LNLVL=$ORDER(^IBM(361.1,IEN,15,LNLVL))
if 'LNLVL
QUIT
SET LNLVLD=^(LNLVL,0)
Begin DoDot:1
+11 ;
SET GLVL=0
FOR
SET GLVL=$ORDER(^IBM(361.1,IEN,15,LNLVL,1,GLVL))
if 'GLVL
QUIT
SET GLVLD=^(GLVL,0)
Begin DoDot:2
+12 SET GRPCD=$PIECE(GLVLD,U)
SET RLVL=0
+13 ;
FOR
SET RLVL=$ORDER(^IBM(361.1,IEN,15,LNLVL,1,GLVL,1,RLVL))
if 'RLVL
QUIT
SET RLVLD=^(RLVL,0)
SET RSNCD=$PIECE(RLVLD,U)
Begin DoDot:3
+14 ;exception
IF GRPCD="PR"
IF RSNCD="AAA"
QUIT
+15 ;exception
IF GRPCD="OA"
IF RSNCD="AB3"
QUIT
+16 ;exception
IF GRPCD="LQ"
QUIT
+17 ; set Claim Adjustment only if none were found at the claim level (don't check for group code)
+18 IF RCLMADJ[(","_RSNCD_",")
SET CLMADJ=CLMADJ+$PIECE(RLVLD,U,2)
+19 ; Coinsurance
+20 IF GRPCD="PR"
IF RCOINS[(","_RSNCD_",")
SET IBCOINS=IBCOINS+$PIECE(RLVLD,U,2)
QUIT
+21 ; Deductible
+22 IF GRPCD="PR"
IF RCDED[(","_RSNCD_",")
SET IBDED=IBDED+$PIECE(RLVLD,U,2)
QUIT
+23 ;
IF GRPCD="CO"
Begin DoDot:4
+24 ; Contractual Adjustment
+25 IF RCTADJ[(","_RSNCD_",")
SET IBCTADJ=IBCTADJ+$PIECE(RLVLD,U,2)
+26 ; Noncovered Charges
+27 IF RCNCVR'[(","_RSNCD_",")
SET NCVRCHRG=NCVRCHRG+$PIECE(RLVLD,U,2)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+28 ;LINELVL
QUIT
+29 ;
