IBCEMRAA ;ALB/DSM/PJH - MEDICARE REMITTANCE ADVICE DETAIL-PART A ; 8/2/10 9:12pm
;;2.0;INTEGRATED BILLING;**155,323,349,400,431**;21-MAR-94;Build 106
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q ; must call an entry point
;
; This routine prints MRA Report for UB-04 (Part A) Form Type
;
MRA(IBIFN) ;;Module - Entry point to print ALL MRA reports, for a given IBIFN.
; This entry point doesn't ask for a Bill Number, it must pass IBIFN as Input.
; It will prompt the user for a device.
;
; Input IBIFN = ien of Bill Number (required)
;
N IBQUIT,IBPGN S IBQUIT=0
D ENT1
Q ;MRA
;
ENT ; Menu Option Entry Point
N IBQUIT,IBEOB,IBIFN,FRMTYP,IBPGN
S IBQUIT=0
D GETBIL I IBQUIT Q ;ENT
;
ENT1 ; Prompt for a print device and print MRA Reports
D DEV^IBCEMRAX(IBIFN) I IBQUIT Q ; device handling ENT1
;
PROC ; This section must have IBIFN defined
; This section is called as both a foreground and a background process,
; so all write stmts need to consider printing in both cases.
N FRMTYP,IEN,IBZDATA,INPAT
S IBQUIT=$G(IBQUIT)
S FRMTYP=$$FT^IBCEF(IBIFN) ;Form Type
S INPAT=$$INPAT^IBCEF(IBIFN) ;Inpatient Flag
;
; Get Service Line Level Data from 837 Extract - Make the appropriate call
; based on the Bill's Form Type 3=UB-04 ; 2=CMS-1500
D ;
. I FRMTYP=2 D F^IBCEF("N-HCFA 1500 SERVICE LINE (EDI)","IBZDATA",,IBIFN) Q
. D F^IBCEF("N-UB-04 SERVICE LINE (EDI)","IBZDATA",,IBIFN)
;
; For a given IBIFN, print all MRA's on file for that Bill
S IEN=0
F S IEN=$O(^IBM(361.1,"B",IBIFN,IEN)) Q:'IEN D I IBQUIT Q
. I $P($G(^IBM(361.1,IEN,0)),U,4)'=1 Q ;not an MRA
. D PRNTMRA ; print an MRA
;
; Force a form feed at end of a printer report
I $E(IOST,1,2)'["C-" W @IOF
; Pause on screen before exiting
I 'IBQUIT,$E(IOST,1,2)["C-" W ! S DIR("A")="Press RETURN to continue: ",DIR(0)="EA" D ^DIR K DIR
;
; Quit if called from a background process (ZTQUEUED defined)
I $D(ZTQUEUED) S ZTREQ="@" Q ;PROC
D ^%ZISC ; handle device closing before exiting
Q ;PROC
;
PRNTMRA ; Print a single MRA
; Input IEN - the ien# of EOB file (361.1); Required
S IBPGN=0
; Print Part B - CMS-1500
I FRMTYP=2 D PRNT^IBCEMRAB Q ;PRNTMRA
;
; Print Part A - Institutional next
; Claim Level
N RSNCD,NCVRCHRG,IBILL,IBILLU,IBCOINS,IBCTADJ,IBEOB,RMKS,IBFD,IBTD,IBDED,CLMADJ
I IBPGN>1 D PAUSE^IBCEMRAX I IBQUIT Q ;pause between EOB reports
D CLMDATA,CLMHDR I IBQUIT Q
D CLMPRNT
;
; Print Service Line Level Adjustments - check if exist
I $D(^IBM(361.1,IEN,15)) D I IBQUIT Q
. I ($Y+4)>IOSL D PAUSE^IBCEMRAX Q:IBQUIT W @IOF D CLMHDR
. D SRVHDR^IBCEMRAX,SRVDATA^IBCEMRAX
;
; Print Disclaimer
D DSCLMR^IBCEMRAX
Q ;PRTMRA
;
GETBIL ; Prompt the user for a Bill#. Get INIFN and IBEOB.
;
N DIC,Y W !
; Access Explanation Of Benefits File #361.1
; Screen: only allow access to EOB's of Type = 1 (Medicare MRA)
S DIC="^IBM(361.1,",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,4)=1"
S DIC("W")="D EOBLST^IBCEMU1(Y)" ; modify generic lister
D ^DIC
I Y<1!$D(DTOUT)!$D(DUOUT) S IBQUIT=1 Q ; GETBIL
S IBIFN=+$P(Y,U,2) ; get index to Bill file (#399)
Q ;GETBIL
;
CLMDATA ; Get MRA Claim Level data of EOB file (#361.1)
N I,RCNT,GRPCD,GLVL,GLVLD,RLVL,RLVLD,RCDED,RCOINS,RCTADJ,RCNCVR,RCLMADJ,CLMLVL
F I=1:1:5 S @($P($T(TABLE+I),";",3))=$P($T(TABLE+I),";",4)
;
; Get Top Levels of EOB file (#361.1)
F I=0,1,3:1:6 S IBEOB(I)=$G(^IBM(361.1,IEN,I))
;
; Get Claim Level Remarks Code from appropriate levels of 361.1 based on
; whether Bill is Outpatient or Inpatient.
D ;
. I INPAT S RMKS=IBEOB(5) Q ; Inpatient remarks code
. S RMKS=$P(IBEOB(3),U,3,7) ; Outpatient remarks code
;
; Get Group Level Data
; RLVLD=reason_code^amount^quantity^reason text
; CLMLVL=Claim Level Flag indicating where the displayed data is coming from
; 1=Claim Level; 0=Line Level
;
S (GLVL,RLVL,RCNT,NCVRCHRG,IBDED,IBCOINS,IBCTADJ,CLMADJ,CLMLVL)=0
F S GLVL=$O(^IBM(361.1,IEN,10,GLVL)) Q:'GLVL S GLVLD=^(GLVL,0) D ;
. S GRPCD=$P(GLVLD,U),RLVL=0
. F S RLVL=$O(^IBM(361.1,IEN,10,GLVL,1,RLVL)) Q:'RLVL S RLVLD=^(RLVL,0) D ;
. . S RSNCD=$P(RLVLD,U)
. . I GRPCD="PR",RSNCD="AAA" Q ;exception
. . I GRPCD="OA",RSNCD="AB3" Q ;exception
. . I GRPCD="LQ" Q ;exception
. . S RCNT=RCNT+1,RSNCD(RCNT)=RSNCD ;display
. . I RCLMADJ[(","_RSNCD_",") S CLMADJ=CLMADJ+$P(RLVLD,U,2),CLMLVL=1 ;Claim Adjustment
. . ; Get data from Claim Level: calculate Coinsurance, Contractual Adjustment,
. . ; Noncovered Charges and Deductible amounts
. . I GRPCD="PR",RCOINS[(","_RSNCD_",") S IBCOINS=$P(RLVLD,U,2),CLMLVL=1 Q
. . I GRPCD="PR",RCDED[(","_RSNCD_",") S IBDED=IBDED+$P(RLVLD,U,2),CLMLVL=1 Q
. . I GRPCD="CO" D ;
. . . I RCTADJ[(","_RSNCD_",") S IBCTADJ=IBCTADJ+$P(RLVLD,U,2),CLMLVL=1
. . . I RCNCVR'[(","_RSNCD_",") S NCVRCHRG=NCVRCHRG+$P(RLVLD,U,2),CLMLVL=1
;
; If no data was found at Claim Level, get data from Line Level
I 'CLMLVL D LINELVL^IBCEMRAX
S IBILL=$G(^DGCR(399,$P(IBEOB(0),U),0)),IBILLU=$G(^DGCR(399,$P(IBEOB(0),U),"U"))
S IBFD=$$FMTE^XLFDT($P(IBILLU,U),5),IBTD=$$FMTE^XLFDT($P(IBILLU,U,2),5)
;
Q ;CLMDATA
;
CLMHDR ; Print Claim Level Header
S IBPGN=IBPGN+1
I IBPGN=1,$E(IOST,1,2)["C-" W @IOF ; refresh terminal screen on 1st hdr
;
; Rows 1 to 3
W !,?108,"Medicare-equivalent",!?110,"Remittance Advice",!
N PRVDR
;
; gather the pay-to provider information - IB*2*400
S PRVDR=$$PRVDATA^IBJPS3($P(IBEOB(0),U,1))
;
; Row 4 to 15
W !!!,"DEPT OF VETERANS AFFAIRS"
W !,$P(PRVDR,U,5),?103,"PROVIDER #:",?117,$P($G(^IBE(350.9,1,1)),U,5) ;Tax ID
W !,$P(PRVDR,U,6),?103,"PAGE #:",?117,$J(IBPGN,3)
W !,$P(PRVDR,U,7),", ",$P(PRVDR,U,8)," ",$P(PRVDR,U,9),?103,"DATE: ",?117,$$FMTE^XLFDT($P(IBEOB(0),U,6),5)
W !!,"PATIENT NAME",?24,"PATIENT CNTRL NUMBER",?48,"RC",?52,"REM",?58,"DRG#",?72,"DRG OUT AMT"
W ?86,"COINSURANCE",?100,"PAT REFUND",?115,"CONTRACT ADJ"
W !,"HIC NUMBER",?48,"RC",?52,"REM",?58,"OUTCD CAPCD",?72,"DRG CAP AMT"
W ?86,"COVD CHGS",?100,"ESRD NET ADJ",?115,"PER DIEM RTE"
W !,"ICN NUMBER"
W !,"FROM DT THRU DT",?24,"NACHG HICHG TOB",?48,"RC",?52,"REM",?58,"PROF COMP",?72,"MSP PAYMT"
W ?86,"NCOVD CHGS",?100,"INTEREST",?115,"PROC CD AMT"
W !,"CLM STATUS",?24,"COST COVDY NCOVDY",?48,"RC",?52,"REM",?58,"DRG AMT",?72,"DEDUCTIBLES"
W ?86,"DENIED CHGS",?100,"CLAIM ADJ",?115,"NET REIMB",!
Q ;CLMHDR
;
CLMPRNT ; - Print Claim Level part of the Report
N PTNM,PTLEN,HIC
; ROW 16
; format and standardize patient name for display
S PTNM("FILE")=2,PTNM("IENS")=$P(IBILL,U,2),PTNM("FIELD")=.01,PTLEN=23
S PTNM=$$BLDNAME^XLFNAME(.PTNM,PTLEN)
I $P(IBEOB(6),U,1)'="" S PTNM=$E($P(IBEOB(6),U,1),1,PTLEN)
W !,PTNM
; Account # (Bill #)
W ?24,$P($$SITE^VASITE,U,3),"-",$P(IBILL,U)
; Reason Code,Remarks Code 1
W ?48,$G(RSNCD(1)),?52,$P(RMKS,U,1)
; DRG Code Used
W ?58,$P(IBEOB(0),U,10)
; Coinsurance, Contract Adjustment
W ?86,$J($G(IBCOINS),11,2),?115,$J($G(IBCTADJ),11,2)
; ROW 17
; HIC & ICN
S HIC=$S($P(IBEOB(6),U,2)'="":$P(IBEOB(6),U,2),$$WNRBILL^IBEFUNC(IBIFN,1):$P($G(^DGCR(399,$P(IBEOB(0),U),"I1")),U,2),1:$P($G(^DGCR(399,$P(IBEOB(0),U),"I2")),U,2))
W !,HIC
; Reason Code, Remarks Code 2
W ?48,$G(RSNCD(2)),?52,$P(RMKS,U,2)
; covered charges
W ?86,$J($P(IBEOB(1),U,3),11,2)
; Outpatient Reimbursement Rate
I 'INPAT W ?115,$J($P(IBEOB(3),U,1),11,2)
;ICN moved with HIPAA 5010
W !,$P(IBEOB(0),U,14)
; ROW 18
W !,IBFD,?12,IBTD
; Type of Bill (=Location of Care_Bill Clasification_Frequency)
W ?38,$P(IBILL,U,24)_$P($G(^DGCR(399.1,$P(IBILL,U,25),0)),U,2)_$P(IBILL,U,26)
; Reason Code,Remarks Code 3
W ?48,$G(RSNCD(3)),?52,$P(RMKS,U,3)
; non-covered amount (Pt Responsibility)
W ?86,$J(NCVRCHRG,11,2)
; Interest Amount
I $P(IBEOB(1),U,7) W ?100,$J($P(IBEOB(1),U,7),11,2)
; Procedure code amount
W ?115,$J($P(IBEOB(3),U,2),11,2)
; ROW 19
; claim status
W !?6,$E($P(IBEOB(0),U,21),1,2)
; M-Care Inp Cost Report Day Ct
W ?24,$P(IBEOB(4),U,14)
; M-Care Inp Cov. Days/Visit Ct
W ?30,$P(IBEOB(4),U,1)
; Medicare Non-Covered Days
W ?38,$P(IBEOB(4),U,19)
; Reason Code,Remarks Code 4
W ?48,$G(RSNCD(4)),?52,$P(RMKS,U,4)
; M-Care Inp Claim Drg Amt
W ?58,$J($P(IBEOB(4),U,3),11,2)
; if Group Code is PR, print the sum of Reason Codes 1 and 66
W ?72,$J($G(IBDED),11,2)
; Claim Adjustments
W ?100,$J($G(CLMADJ),10,2)
; net reimburse
W ?115,$J($P(IBEOB(1),U,1),11,2)
; Row 20
; Reason Code,Remarks Code 5
W !?48,$G(RSNCD(5)),?52,$P(RMKS,U,5)
;
Q ; CLMPRNT
TABLE ;;variable;list of Reason Codes w/leading & trailing commas; description;
;;RCDED;,1,66,;reason code to calc deductible amount;
;;RCOINS;,2,;reason code to calc coinsurance amount;
;;RCTADJ;,A2,;reason codes to calc contract adjustment amount;
;;RCNCVR;,1,2,23,42,45,66,70,71,89,94,97,118,A1,A2,B3,B6,;reason codes excluded from calc of noncovered charges amount;
;;RCLMADJ;,42,45,70,94,97,122,A1,;reason codes to calc claim adj
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEMRAA 9126 printed Dec 13, 2024@02:10:58 Page 2
IBCEMRAA ;ALB/DSM/PJH - MEDICARE REMITTANCE ADVICE DETAIL-PART A ; 8/2/10 9:12pm
+1 ;;2.0;INTEGRATED BILLING;**155,323,349,400,431**;21-MAR-94;Build 106
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; must call an entry point
QUIT
+5 ;
+6 ; This routine prints MRA Report for UB-04 (Part A) Form Type
+7 ;
MRA(IBIFN) ;;Module - Entry point to print ALL MRA reports, for a given IBIFN.
+1 ; This entry point doesn't ask for a Bill Number, it must pass IBIFN as Input.
+2 ; It will prompt the user for a device.
+3 ;
+4 ; Input IBIFN = ien of Bill Number (required)
+5 ;
+6 NEW IBQUIT,IBPGN
SET IBQUIT=0
+7 DO ENT1
+8 ;MRA
QUIT
+9 ;
ENT ; Menu Option Entry Point
+1 NEW IBQUIT,IBEOB,IBIFN,FRMTYP,IBPGN
+2 SET IBQUIT=0
+3 ;ENT
DO GETBIL
IF IBQUIT
QUIT
+4 ;
ENT1 ; Prompt for a print device and print MRA Reports
+1 ; device handling ENT1
DO DEV^IBCEMRAX(IBIFN)
IF IBQUIT
QUIT
+2 ;
PROC ; This section must have IBIFN defined
+1 ; This section is called as both a foreground and a background process,
+2 ; so all write stmts need to consider printing in both cases.
+3 NEW FRMTYP,IEN,IBZDATA,INPAT
+4 SET IBQUIT=$GET(IBQUIT)
+5 ;Form Type
SET FRMTYP=$$FT^IBCEF(IBIFN)
+6 ;Inpatient Flag
SET INPAT=$$INPAT^IBCEF(IBIFN)
+7 ;
+8 ; Get Service Line Level Data from 837 Extract - Make the appropriate call
+9 ; based on the Bill's Form Type 3=UB-04 ; 2=CMS-1500
+10 ;
Begin DoDot:1
+11 IF FRMTYP=2
DO F^IBCEF("N-HCFA 1500 SERVICE LINE (EDI)","IBZDATA",,IBIFN)
QUIT
+12 DO F^IBCEF("N-UB-04 SERVICE LINE (EDI)","IBZDATA",,IBIFN)
End DoDot:1
+13 ;
+14 ; For a given IBIFN, print all MRA's on file for that Bill
+15 SET IEN=0
+16 FOR
SET IEN=$ORDER(^IBM(361.1,"B",IBIFN,IEN))
if 'IEN
QUIT
Begin DoDot:1
+17 ;not an MRA
IF $PIECE($GET(^IBM(361.1,IEN,0)),U,4)'=1
QUIT
+18 ; print an MRA
DO PRNTMRA
End DoDot:1
IF IBQUIT
QUIT
+19 ;
+20 ; Force a form feed at end of a printer report
+21 IF $EXTRACT(IOST,1,2)'["C-"
WRITE @IOF
+22 ; Pause on screen before exiting
+23 IF 'IBQUIT
IF $EXTRACT(IOST,1,2)["C-"
WRITE !
SET DIR("A")="Press RETURN to continue: "
SET DIR(0)="EA"
DO ^DIR
KILL DIR
+24 ;
+25 ; Quit if called from a background process (ZTQUEUED defined)
+26 ;PROC
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+27 ; handle device closing before exiting
DO ^%ZISC
+28 ;PROC
QUIT
+29 ;
PRNTMRA ; Print a single MRA
+1 ; Input IEN - the ien# of EOB file (361.1); Required
+2 SET IBPGN=0
+3 ; Print Part B - CMS-1500
+4 ;PRNTMRA
IF FRMTYP=2
DO PRNT^IBCEMRAB
QUIT
+5 ;
+6 ; Print Part A - Institutional next
+7 ; Claim Level
+8 NEW RSNCD,NCVRCHRG,IBILL,IBILLU,IBCOINS,IBCTADJ,IBEOB,RMKS,IBFD,IBTD,IBDED,CLMADJ
+9 ;pause between EOB reports
IF IBPGN>1
DO PAUSE^IBCEMRAX
IF IBQUIT
QUIT
+10 DO CLMDATA
DO CLMHDR
IF IBQUIT
QUIT
+11 DO CLMPRNT
+12 ;
+13 ; Print Service Line Level Adjustments - check if exist
+14 IF $DATA(^IBM(361.1,IEN,15))
Begin DoDot:1
+15 IF ($Y+4)>IOSL
DO PAUSE^IBCEMRAX
if IBQUIT
QUIT
WRITE @IOF
DO CLMHDR
+16 DO SRVHDR^IBCEMRAX
DO SRVDATA^IBCEMRAX
End DoDot:1
IF IBQUIT
QUIT
+17 ;
+18 ; Print Disclaimer
+19 DO DSCLMR^IBCEMRAX
+20 ;PRTMRA
QUIT
+21 ;
GETBIL ; Prompt the user for a Bill#. Get INIFN and IBEOB.
+1 ;
+2 NEW DIC,Y
WRITE !
+3 ; Access Explanation Of Benefits File #361.1
+4 ; Screen: only allow access to EOB's of Type = 1 (Medicare MRA)
+5 SET DIC="^IBM(361.1,"
SET DIC(0)="AEMQ"
SET DIC("S")="I $P(^(0),U,4)=1"
+6 ; modify generic lister
SET DIC("W")="D EOBLST^IBCEMU1(Y)"
+7 DO ^DIC
+8 ; GETBIL
IF Y<1!$DATA(DTOUT)!$DATA(DUOUT)
SET IBQUIT=1
QUIT
+9 ; get index to Bill file (#399)
SET IBIFN=+$PIECE(Y,U,2)
+10 ;GETBIL
QUIT
+11 ;
CLMDATA ; Get MRA Claim Level data of EOB file (#361.1)
+1 NEW I,RCNT,GRPCD,GLVL,GLVLD,RLVL,RLVLD,RCDED,RCOINS,RCTADJ,RCNCVR,RCLMADJ,CLMLVL
+2 FOR I=1:1:5
SET @($PIECE($TEXT(TABLE+I),";",3))=$PIECE($TEXT(TABLE+I),";",4)
+3 ;
+4 ; Get Top Levels of EOB file (#361.1)
+5 FOR I=0,1,3:1:6
SET IBEOB(I)=$GET(^IBM(361.1,IEN,I))
+6 ;
+7 ; Get Claim Level Remarks Code from appropriate levels of 361.1 based on
+8 ; whether Bill is Outpatient or Inpatient.
+9 ;
Begin DoDot:1
+10 ; Inpatient remarks code
IF INPAT
SET RMKS=IBEOB(5)
QUIT
+11 ; Outpatient remarks code
SET RMKS=$PIECE(IBEOB(3),U,3,7)
End DoDot:1
+12 ;
+13 ; Get Group Level Data
+14 ; RLVLD=reason_code^amount^quantity^reason text
+15 ; CLMLVL=Claim Level Flag indicating where the displayed data is coming from
+16 ; 1=Claim Level; 0=Line Level
+17 ;
+18 SET (GLVL,RLVL,RCNT,NCVRCHRG,IBDED,IBCOINS,IBCTADJ,CLMADJ,CLMLVL)=0
+19 ;
FOR
SET GLVL=$ORDER(^IBM(361.1,IEN,10,GLVL))
if 'GLVL
QUIT
SET GLVLD=^(GLVL,0)
Begin DoDot:1
+20 SET GRPCD=$PIECE(GLVLD,U)
SET RLVL=0
+21 ;
FOR
SET RLVL=$ORDER(^IBM(361.1,IEN,10,GLVL,1,RLVL))
if 'RLVL
QUIT
SET RLVLD=^(RLVL,0)
Begin DoDot:2
+22 SET RSNCD=$PIECE(RLVLD,U)
+23 ;exception
IF GRPCD="PR"
IF RSNCD="AAA"
QUIT
+24 ;exception
IF GRPCD="OA"
IF RSNCD="AB3"
QUIT
+25 ;exception
IF GRPCD="LQ"
QUIT
+26 ;display
SET RCNT=RCNT+1
SET RSNCD(RCNT)=RSNCD
+27 ;Claim Adjustment
IF RCLMADJ[(","_RSNCD_",")
SET CLMADJ=CLMADJ+$PIECE(RLVLD,U,2)
SET CLMLVL=1
+28 ; Get data from Claim Level: calculate Coinsurance, Contractual Adjustment,
+29 ; Noncovered Charges and Deductible amounts
+30 IF GRPCD="PR"
IF RCOINS[(","_RSNCD_",")
SET IBCOINS=$PIECE(RLVLD,U,2)
SET CLMLVL=1
QUIT
+31 IF GRPCD="PR"
IF RCDED[(","_RSNCD_",")
SET IBDED=IBDED+$PIECE(RLVLD,U,2)
SET CLMLVL=1
QUIT
+32 ;
IF GRPCD="CO"
Begin DoDot:3
+33 IF RCTADJ[(","_RSNCD_",")
SET IBCTADJ=IBCTADJ+$PIECE(RLVLD,U,2)
SET CLMLVL=1
+34 IF RCNCVR'[(","_RSNCD_",")
SET NCVRCHRG=NCVRCHRG+$PIECE(RLVLD,U,2)
SET CLMLVL=1
End DoDot:3
End DoDot:2
End DoDot:1
+35 ;
+36 ; If no data was found at Claim Level, get data from Line Level
+37 IF 'CLMLVL
DO LINELVL^IBCEMRAX
+38 SET IBILL=$GET(^DGCR(399,$PIECE(IBEOB(0),U),0))
SET IBILLU=$GET(^DGCR(399,$PIECE(IBEOB(0),U),"U"))
+39 SET IBFD=$$FMTE^XLFDT($PIECE(IBILLU,U),5)
SET IBTD=$$FMTE^XLFDT($PIECE(IBILLU,U,2),5)
+40 ;
+41 ;CLMDATA
QUIT
+42 ;
CLMHDR ; Print Claim Level Header
+1 SET IBPGN=IBPGN+1
+2 ; refresh terminal screen on 1st hdr
IF IBPGN=1
IF $EXTRACT(IOST,1,2)["C-"
WRITE @IOF
+3 ;
+4 ; Rows 1 to 3
+5 WRITE !,?108,"Medicare-equivalent",!?110,"Remittance Advice",!
+6 NEW PRVDR
+7 ;
+8 ; gather the pay-to provider information - IB*2*400
+9 SET PRVDR=$$PRVDATA^IBJPS3($PIECE(IBEOB(0),U,1))
+10 ;
+11 ; Row 4 to 15
+12 WRITE !!!,"DEPT OF VETERANS AFFAIRS"
+13 ;Tax ID
WRITE !,$PIECE(PRVDR,U,5),?103,"PROVIDER #:",?117,$PIECE($GET(^IBE(350.9,1,1)),U,5)
+14 WRITE !,$PIECE(PRVDR,U,6),?103,"PAGE #:",?117,$JUSTIFY(IBPGN,3)
+15 WRITE !,$PIECE(PRVDR,U,7),", ",$PIECE(PRVDR,U,8)," ",$PIECE(PRVDR,U,9),?103,"DATE: ",?117,$$FMTE^XLFDT($PIECE(IBEOB(0),U,6),5)
+16 WRITE !!,"PATIENT NAME",?24,"PATIENT CNTRL NUMBER",?48,"RC",?52,"REM",?58,"DRG#",?72,"DRG OUT AMT"
+17 WRITE ?86,"COINSURANCE",?100,"PAT REFUND",?115,"CONTRACT ADJ"
+18 WRITE !,"HIC NUMBER",?48,"RC",?52,"REM",?58,"OUTCD CAPCD",?72,"DRG CAP AMT"
+19 WRITE ?86,"COVD CHGS",?100,"ESRD NET ADJ",?115,"PER DIEM RTE"
+20 WRITE !,"ICN NUMBER"
+21 WRITE !,"FROM DT THRU DT",?24,"NACHG HICHG TOB",?48,"RC",?52,"REM",?58,"PROF COMP",?72,"MSP PAYMT"
+22 WRITE ?86,"NCOVD CHGS",?100,"INTEREST",?115,"PROC CD AMT"
+23 WRITE !,"CLM STATUS",?24,"COST COVDY NCOVDY",?48,"RC",?52,"REM",?58,"DRG AMT",?72,"DEDUCTIBLES"
+24 WRITE ?86,"DENIED CHGS",?100,"CLAIM ADJ",?115,"NET REIMB",!
+25 ;CLMHDR
QUIT
+26 ;
CLMPRNT ; - Print Claim Level part of the Report
+1 NEW PTNM,PTLEN,HIC
+2 ; ROW 16
+3 ; format and standardize patient name for display
+4 SET PTNM("FILE")=2
SET PTNM("IENS")=$PIECE(IBILL,U,2)
SET PTNM("FIELD")=.01
SET PTLEN=23
+5 SET PTNM=$$BLDNAME^XLFNAME(.PTNM,PTLEN)
+6 IF $PIECE(IBEOB(6),U,1)'=""
SET PTNM=$EXTRACT($PIECE(IBEOB(6),U,1),1,PTLEN)
+7 WRITE !,PTNM
+8 ; Account # (Bill #)
+9 WRITE ?24,$PIECE($$SITE^VASITE,U,3),"-",$PIECE(IBILL,U)
+10 ; Reason Code,Remarks Code 1
+11 WRITE ?48,$GET(RSNCD(1)),?52,$PIECE(RMKS,U,1)
+12 ; DRG Code Used
+13 WRITE ?58,$PIECE(IBEOB(0),U,10)
+14 ; Coinsurance, Contract Adjustment
+15 WRITE ?86,$JUSTIFY($GET(IBCOINS),11,2),?115,$JUSTIFY($GET(IBCTADJ),11,2)
+16 ; ROW 17
+17 ; HIC & ICN
+18 SET HIC=$SELECT($PIECE(IBEOB(6),U,2)'="":$PIECE(IBEOB(6),U,2),$$WNRBILL^IBEFUNC(IBIFN,1):$PIECE($GET(^DGCR(399,$PIECE(IBEOB(0),U),"I1")),U,2),1:$PIECE($GET(^DGCR(399,$PIECE(IBEOB(0),U),"I2")),U,2))
+19 WRITE !,HIC
+20 ; Reason Code, Remarks Code 2
+21 WRITE ?48,$GET(RSNCD(2)),?52,$PIECE(RMKS,U,2)
+22 ; covered charges
+23 WRITE ?86,$JUSTIFY($PIECE(IBEOB(1),U,3),11,2)
+24 ; Outpatient Reimbursement Rate
+25 IF 'INPAT
WRITE ?115,$JUSTIFY($PIECE(IBEOB(3),U,1),11,2)
+26 ;ICN moved with HIPAA 5010
+27 WRITE !,$PIECE(IBEOB(0),U,14)
+28 ; ROW 18
+29 WRITE !,IBFD,?12,IBTD
+30 ; Type of Bill (=Location of Care_Bill Clasification_Frequency)
+31 WRITE ?38,$PIECE(IBILL,U,24)_$PIECE($GET(^DGCR(399.1,$PIECE(IBILL,U,25),0)),U,2)_$PIECE(IBILL,U,26)
+32 ; Reason Code,Remarks Code 3
+33 WRITE ?48,$GET(RSNCD(3)),?52,$PIECE(RMKS,U,3)
+34 ; non-covered amount (Pt Responsibility)
+35 WRITE ?86,$JUSTIFY(NCVRCHRG,11,2)
+36 ; Interest Amount
+37 IF $PIECE(IBEOB(1),U,7)
WRITE ?100,$JUSTIFY($PIECE(IBEOB(1),U,7),11,2)
+38 ; Procedure code amount
+39 WRITE ?115,$JUSTIFY($PIECE(IBEOB(3),U,2),11,2)
+40 ; ROW 19
+41 ; claim status
+42 WRITE !?6,$EXTRACT($PIECE(IBEOB(0),U,21),1,2)
+43 ; M-Care Inp Cost Report Day Ct
+44 WRITE ?24,$PIECE(IBEOB(4),U,14)
+45 ; M-Care Inp Cov. Days/Visit Ct
+46 WRITE ?30,$PIECE(IBEOB(4),U,1)
+47 ; Medicare Non-Covered Days
+48 WRITE ?38,$PIECE(IBEOB(4),U,19)
+49 ; Reason Code,Remarks Code 4
+50 WRITE ?48,$GET(RSNCD(4)),?52,$PIECE(RMKS,U,4)
+51 ; M-Care Inp Claim Drg Amt
+52 WRITE ?58,$JUSTIFY($PIECE(IBEOB(4),U,3),11,2)
+53 ; if Group Code is PR, print the sum of Reason Codes 1 and 66
+54 WRITE ?72,$JUSTIFY($GET(IBDED),11,2)
+55 ; Claim Adjustments
+56 WRITE ?100,$JUSTIFY($GET(CLMADJ),10,2)
+57 ; net reimburse
+58 WRITE ?115,$JUSTIFY($PIECE(IBEOB(1),U,1),11,2)
+59 ; Row 20
+60 ; Reason Code,Remarks Code 5
+61 WRITE !?48,$GET(RSNCD(5)),?52,$PIECE(RMKS,U,5)
+62 ;
+63 ; CLMPRNT
QUIT
TABLE ;;variable;list of Reason Codes w/leading & trailing commas; description;
+1 ;;RCDED;,1,66,;reason code to calc deductible amount;
+2 ;;RCOINS;,2,;reason code to calc coinsurance amount;
+3 ;;RCTADJ;,A2,;reason codes to calc contract adjustment amount;
+4 ;;RCNCVR;,1,2,23,42,45,66,70,71,89,94,97,118,A1,A2,B3,B6,;reason codes excluded from calc of noncovered charges amount;
+5 ;;RCLMADJ;,42,45,70,94,97,122,A1,;reason codes to calc claim adj
+6 ;
