IBCEMRAB.m

IBCEMRAB ;ALB/DSM - MEDICARE REMITTANCE ADVICE DETAIL-PART B ; 3/10/11 10:14am

 ;;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  ; this routine must be called at an entry point

 ;

 ;  This routine prints MRA Report for CMS-1500 (Part B) Form Type

PRNT ;

 ; Claim Level Adjustments

 N DIC,Y,IBEOB,IBILL,IBILLU,IBTD,IBFD,TOT,PRFRMID

 D GDATA,HDR

 ;

 ; Initialize Totals

 S (TOT("ALWD"),TOT("SRVDED"),TOT("SRVCOIN"),TOT("SRVADJ"),TOT("PAID"))=0

 ;

 ; Service Line Level Adjustments

 I $D(^IBM(361.1,IEN,15)) D SRVPRNT I IBQUIT Q

 ;

 ; Print Totals Line

 D TOTAL

 ;

 ; Print Disclaimer

 D DSCLMR^IBCEMRAX

 ;

 Q  ;PRNT

 ;

GDATA ; Get MRA data

 ;

 N I

 F I=0,1,2,3,6 S IBEOB(I)=$G(^IBM(361.1,IEN,I))

 S IBILL=$G(^DGCR(399,$P(IBEOB(0),U),0)),IBILLU=$G(^DGCR(399,$P(IBEOB(0),U),"U"))

 S IBTD=$$FMTE^XLFDT($P(IBILLU,U),5),IBFD=$$FMTE^XLFDT($P(IBILLU,U,2),5)

 Q  ;GDATA

 ;

HDR ; Print Header

 I $E(IOST,1,2)["C-" W @IOF

 S IBPGN=IBPGN+1

 ;

 ; Row 1,2,3

 W !,?102,"Medicare-equivalent",!?104,"Remittance Advice",!

 ; Row 7

 W !!!!,"DEPT OF VETERANS AFFAIRS"

 ;

 N PRVDR,LINE,PTNM,PTLEN,RMKS,HIC

 ;

 ; gather the pay-to provider information - IB*2*400

 S PRVDR=$$PRVDATA^IBJPS3($P(IBEOB(0),U,1))

 ;

 ; Row 8

 W !,$P(PRVDR,U,5),?97,"PROVIDER #:",?111,"VA0"_$P($$SITE^VASITE,U,3)

 ; Row 9

 W !,$P(PRVDR,U,6),?97,"PAGE #:",?111,$J(IBPGN,3)

 ; Row 10

 W !,$P(PRVDR,U,7),", ",$P(PRVDR,U,8)," ",$P(PRVDR,U,9),?97,"DATE:",?111,$$FMTE^XLFDT($P(IBEOB(0),U,6),5)

 ; Row 14

 W !!!!,"PERF PROV",?12,"SERV DATE",?25,"POS",?29,"NOS",?34,"PROC",?40,"MODS",?53,"BILLED",?63,"ALLOWED",?75,"DEDUCT"

 W ?87,"COINS",?93,"GRP-RC",?107,"AMT",?114,"PROV PD"

 ; Row 15

 S $P(LINE,"-",122)="" W !,LINE

 ;

 ; 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)

 ;

 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))

 ; Row 17

 ; Patient Name, HIC, ACNT, ICN, ASG

 W !!,"NAME",?7,PTNM,?31,"HIC",?35,HIC

 W ?49,"ACNT",?54,$P($$SITE^VASITE,U,3),"-",$P(IBILL,U)

 ; HIPAA 5010 Changes

 N ICN

 S ICN=$P(IBEOB(0),U,14)

 W ?76,"ICN",?80,ICN W:$L(ICN)>17 !

 W ?97,"ASG",?101,$S($P(IBILLU,U,6):"Y",1:"N")

 ;

 ; MOA: Medicare Outpatient Remarks Code

 S RMKS=$P(IBEOB(3),U,3,7) I RMKS="" S RMKS="^^^^"

 W ?104,"MOA   " I RMKS'?1."^" W $P(RMKS,U,1)," ",$P(RMKS,U,2)

 I $P(RMKS,U,3,5)'?1."^" S RMKS=$TR(RMKS,U," ") W !,RMKS

 ; Secondary Performing Provider ID

 ; On CMS-1500 Form Type reports, If Medicare WNR is Primary or Secondary, then set Performing Provider ID

 I $$WNRBILL^IBEFUNC(IBIFN,1)!$$WNRBILL^IBEFUNC(IBIFN,2) S PRFRMID="V"_$$MCRSPEC^IBCEU4(IBIFN,1)_$P($$SITE^VASITE,U,3)

 Q  ;HDR

 ;

SRVPRNT ; Print Service Level Data of EOB file (#361.1 Level 15)

 ;

 N LNLVL,RLVL,RLVLD,LNLVLD,SRVFDT,SRVTDT,UNIT,PRCD,MOD,I

 N ALWD,GLVL,GLVLD,GRPCD,OPRCD,PAID,RCNT,SRMKS,SRVCOIN

 N SRVDED,SRVADJ,SRVCHRG,SRVDT,CLMLN,Z

 ;

 ; RLVLD=reason_code^amount^quantity^reason text

 S LNLVL=0

 F  S LNLVL=$O(^IBM(361.1,IEN,15,LNLVL)) Q:'LNLVL  S LNLVLD=^(LNLVL,0) D  I IBQUIT Q

 . I ($Y+4)>IOSL D  I IBQUIT Q

 . . D PAUSE^IBCEMRAX I IBQUIT Q

 . . W @IOF D HDR

 . ; From Service Date, To Service Date

 . S SRVFDT=$P(LNLVLD,U,16),SRVTDT=$P(LNLVLD,U,17)

 . S SRVFDT=$$FMTE^XLFDT(SRVFDT,5),SRVTDT=$$FMTE^XLFDT(SRVTDT,5)

 . ; Get Units, Procedure Code, Original Procedure Code

 . S UNIT=$P(LNLVLD,U,11),PRCD=$P(LNLVLD,U,4),OPRCD=$P(LNLVLD,U,15)

 . S PAID=$P(LNLVLD,U,3),TOT("PAID")=TOT("PAID")+PAID    ; Provider Paid Amount

 . S ALWD=$P(LNLVLD,U,13),TOT("ALWD")=TOT("ALWD")+ALWD   ; Allowed Amount

 . ; Handle Multiple Paid Modifiers from the Service Line Level - string together

 . K MOD M MOD=^IBM(361.1,IEN,15,LNLVL,2) S MOD="" F I=1:1:4 Q:'$D(MOD(I))  S MOD=MOD_MOD(I,0)

 . ; Calculate Submitted Service Line Charge

 . S CLMLN=$P(LNLVLD,U,12)   ; use to match EOB line # to VistA Bill line#

 . S SRVCHRG=$P($G(IBZDATA(CLMLN)),U,8)*$P($G(IBZDATA(CLMLN)),U,9)

 . ; Service Line Level Remarks Codes

 . S Z=0 F  S Z=$O(^IBM(361.1,IEN,15,LNLVL,4,Z)) Q:'Z  I $G(^(Z,0))'="" S SRMKS(Z)=$P(^(0),U,2)

 . ; Get Service Level Group Code/Reason Code Data

 . 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 S SRVDED=SRVDED+$P(RLVLD,U,2),TOT("SRVDED")=TOT("SRVDED")+SRVDED Q  ;deductible

 . . . I GRPCD="PR",RSNCD=2 S SRVCOIN=$P(RLVLD,U,2),TOT("SRVCOIN")=TOT("SRVCOIN")+SRVCOIN Q  ;coinsurance

 . . . S SRVADJ=$P(RLVLD,U,2),TOT("SRVADJ")=TOT("SRVADJ")+SRVADJ  ;adjustment

 . . . S RCNT=RCNT+1,RSNCD(RCNT)=GRPCD_"-"_RSNCD_U_SRVADJ

 . ; Performing Provider ID

 . W !,$G(PRFRMID)

 . ; From Date in MMDD (w/leading zero) format

 . I SRVFDT'="" S SRVDT=$E("00",1,2-$L(+SRVFDT))_+SRVFDT_$E("00",1,2-$L($P(SRVFDT,"/",2)))_$P(SRVFDT,"/",2) W ?12,SRVDT

 . ; To Date in MMDDYY (w/leading zero) format

 . I SRVTDT'="" W ?17,$E("00",1,2-$L(+SRVTDT)),+SRVTDT,$E("00",1,2-$L($P(SRVTDT,"/",2))),$P(SRVTDT,"/",2),$E($P(SRVTDT,"/",3),3,4)

 . ; If To Date is Null, Print From Date with year (if not Null)

 . I SRVTDT="",SRVFDT'="" W ?17,SRVDT,$E($P(SRVFDT,"/",3),3,4)

 . ; Place of Service - from 837 Extract from CMS-1500 Service Line Level

 . W ?25,$P($G(IBZDATA(CLMLN)),U,3)

 . ; Print Units, Procedure Code Paid, Modifiers, Submitted Line Charge, Allowed Amt, Deductable, Coinsurance

 . W ?28,UNIT,?34,PRCD,?40,MOD,?49,$J(SRVCHRG,10,2),?60,$J(ALWD,10,2),?71,$J(SRVDED,10,2),?82,$J(SRVCOIN,10,2)

 . ; Print 1st Line of Group Code-Reason Code, Adjustment Amount, Paid Amount

 . W ?93,$P($G(RSNCD(1)),U),?100,$J($P($G(RSNCD(1)),U,2),10,2),?111,$J(PAID,10,2)

 . ; print PRCD Submitted, Remarks if any

 . I OPRCD'=""!$O(SRMKS(0)) W ! D  ;

 . . I OPRCD'="" W ?33,"(",OPRCD,")"

 . . I $O(SRMKS(0)) W ?44,"REM: " S Z=0 F  S Z=$O(SRMKS(Z)) Q:'Z  W SRMKS(Z),$S($O(SRMKS(Z)):",",1:"")

 . ; Print the rest of Group Code-Reason Code, Reason Code Amount

 . F I=2:1:RCNT W !?93,$P(RSNCD(I),U),?100,$J($P(RSNCD(I),U,2),10,2)

 Q  ;SRVPRNT

 ;

TOTAL ; Print Totals

 W !!,"PT RESP ",$J($P($G(IBEOB(1)),U,2),10,2)  ;Patient Responsibility

 ; Billed Amount, Allowed Amount, Deductable Amount

 W ?35,"CLAIM TOTAL",?49,$J($P($G(IBEOB(2)),U,4),10,2),?60,$J(TOT("ALWD"),10,2),?71,$J(TOT("SRVDED"),10,2)

 ; Coinsurance Amount, Adjustment Amount, Paid Amount

 W ?82,$J(TOT("SRVCOIN"),10,2),?100,$J(TOT("SRVADJ"),10,2),?111,$J(TOT("PAID"),10,2)

 Q  ;TOTAL

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBCEMRAB   7042     printed  Feb 18, 2025@23:37:23                                                                                                                                                                                                    Page 2

IBCEMRAB  ;ALB/DSM - MEDICARE REMITTANCE ADVICE DETAIL-PART B ; 3/10/11 10:14am

 +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       ; this routine must be called at an entry point

           QUIT 

 +5       ;

 +6       ;  This routine prints MRA Report for CMS-1500 (Part B) Form Type

PRNT      ;

 +1       ; Claim Level Adjustments

 +2        NEW DIC,Y,IBEOB,IBILL,IBILLU,IBTD,IBFD,TOT,PRFRMID

 +3        DO GDATA

           DO HDR

 +4       ;

 +5       ; Initialize Totals

 +6        SET (TOT("ALWD"),TOT("SRVDED"),TOT("SRVCOIN"),TOT("SRVADJ"),TOT("PAID"))=0

 +7       ;

 +8       ; Service Line Level Adjustments

 +9        IF $DATA(^IBM(361.1,IEN,15))

               DO SRVPRNT

               IF IBQUIT

                   QUIT 

 +10      ;

 +11      ; Print Totals Line

 +12       DO TOTAL

 +13      ;

 +14      ; Print Disclaimer

 +15       DO DSCLMR^IBCEMRAX

 +16      ;

 +17      ;PRNT

           QUIT 

 +18      ;

GDATA     ; Get MRA data

 +1       ;

 +2        NEW I

 +3        FOR I=0,1,2,3,6

               SET IBEOB(I)=$GET(^IBM(361.1,IEN,I))

 +4        SET IBILL=$GET(^DGCR(399,$PIECE(IBEOB(0),U),0))

           SET IBILLU=$GET(^DGCR(399,$PIECE(IBEOB(0),U),"U"))

 +5        SET IBTD=$$FMTE^XLFDT($PIECE(IBILLU,U),5)

           SET IBFD=$$FMTE^XLFDT($PIECE(IBILLU,U,2),5)

 +6       ;GDATA

           QUIT 

 +7       ;

HDR       ; Print Header

 +1        IF $EXTRACT(IOST,1,2)["C-"

               WRITE @IOF

 +2        SET IBPGN=IBPGN+1

 +3       ;

 +4       ; Row 1,2,3

 +5        WRITE !,?102,"Medicare-equivalent",!?104,"Remittance Advice",!

 +6       ; Row 7

 +7        WRITE !!!!,"DEPT OF VETERANS AFFAIRS"

 +8       ;

 +9        NEW PRVDR,LINE,PTNM,PTLEN,RMKS,HIC

 +10      ;

 +11      ; gather the pay-to provider information - IB*2*400

 +12       SET PRVDR=$$PRVDATA^IBJPS3($PIECE(IBEOB(0),U,1))

 +13      ;

 +14      ; Row 8

 +15       WRITE !,$PIECE(PRVDR,U,5),?97,"PROVIDER #:",?111,"VA0"_$PIECE($$SITE^VASITE,U,3)

 +16      ; Row 9

 +17       WRITE !,$PIECE(PRVDR,U,6),?97,"PAGE #:",?111,$JUSTIFY(IBPGN,3)

 +18      ; Row 10

 +19       WRITE !,$PIECE(PRVDR,U,7),", ",$PIECE(PRVDR,U,8)," ",$PIECE(PRVDR,U,9),?97,"DATE:",?111,$$FMTE^XLFDT($PIECE(IBEOB(0),U,6),5)

 +20      ; Row 14

 +21       WRITE !!!!,"PERF PROV",?12,"SERV DATE",?25,"POS",?29,"NOS",?34,"PROC",?40,"MODS",?53,"BILLED",?63,"ALLOWED",?75,"DEDUCT"

 +22       WRITE ?87,"COINS",?93,"GRP-RC",?107,"AMT",?114,"PROV PD"

 +23      ; Row 15

 +24       SET $PIECE(LINE,"-",122)=""

           WRITE !,LINE

 +25      ;

 +26      ; format and standardize patient name for display

 +27       SET PTNM("FILE")=2

           SET PTNM("IENS")=$PIECE(IBILL,U,2)

           SET PTNM("FIELD")=.01

           SET PTLEN=23

 +28       SET PTNM=$$BLDNAME^XLFNAME(.PTNM,PTLEN)

 +29       IF $PIECE(IBEOB(6),U,1)'=""

               SET PTNM=$EXTRACT($PIECE(IBEOB(6),U,1),1,PTLEN)

 +30      ;

 +31       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))

 +32      ; Row 17

 +33      ; Patient Name, HIC, ACNT, ICN, ASG

 +34       WRITE !!,"NAME",?7,PTNM,?31,"HIC",?35,HIC

 +35       WRITE ?49,"ACNT",?54,$PIECE($$SITE^VASITE,U,3),"-",$PIECE(IBILL,U)

 +36      ; HIPAA 5010 Changes

 +37       NEW ICN

 +38       SET ICN=$PIECE(IBEOB(0),U,14)

 +39       WRITE ?76,"ICN",?80,ICN

           if $LENGTH(ICN)>17

               WRITE !

 +40       WRITE ?97,"ASG",?101,$SELECT($PIECE(IBILLU,U,6):"Y",1:"N")

 +41      ;

 +42      ; MOA: Medicare Outpatient Remarks Code

 +43       SET RMKS=$PIECE(IBEOB(3),U,3,7)

           IF RMKS=""

               SET RMKS="^^^^"

 +44       WRITE ?104,"MOA   "

           IF RMKS'?1."^"

               WRITE $PIECE(RMKS,U,1)," ",$PIECE(RMKS,U,2)

 +45       IF $PIECE(RMKS,U,3,5)'?1."^"

               SET RMKS=$TRANSLATE(RMKS,U," ")

               WRITE !,RMKS

 +46      ; Secondary Performing Provider ID

 +47      ; On CMS-1500 Form Type reports, If Medicare WNR is Primary or Secondary, then set Performing Provider ID

 +48       IF $$WNRBILL^IBEFUNC(IBIFN,1)!$$WNRBILL^IBEFUNC(IBIFN,2)

               SET PRFRMID="V"_$$MCRSPEC^IBCEU4(IBIFN,1)_$PIECE($$SITE^VASITE,U,3)

 +49      ;HDR

           QUIT 

 +50      ;

SRVPRNT   ; Print Service Level Data of EOB file (#361.1 Level 15)

 +1       ;

 +2        NEW LNLVL,RLVL,RLVLD,LNLVLD,SRVFDT,SRVTDT,UNIT,PRCD,MOD,I

 +3        NEW ALWD,GLVL,GLVLD,GRPCD,OPRCD,PAID,RCNT,SRMKS,SRVCOIN

 +4        NEW SRVDED,SRVADJ,SRVCHRG,SRVDT,CLMLN,Z

 +5       ;

 +6       ; RLVLD=reason_code^amount^quantity^reason text

 +7        SET LNLVL=0

 +8        FOR 

               SET LNLVL=$ORDER(^IBM(361.1,IEN,15,LNLVL))

               if 'LNLVL

                   QUIT 

               SET LNLVLD=^(LNLVL,0)

               Begin DoDot:1

 +9                IF ($Y+4)>IOSL

                       Begin DoDot:2

 +10                       DO PAUSE^IBCEMRAX

                           IF IBQUIT

                               QUIT 

 +11                       WRITE @IOF

                           DO HDR

                       End DoDot:2

                       IF IBQUIT

                           QUIT 

 +12      ; From Service Date, To Service Date

 +13               SET SRVFDT=$PIECE(LNLVLD,U,16)

                   SET SRVTDT=$PIECE(LNLVLD,U,17)

 +14               SET SRVFDT=$$FMTE^XLFDT(SRVFDT,5)

                   SET SRVTDT=$$FMTE^XLFDT(SRVTDT,5)

 +15      ; Get Units, Procedure Code, Original Procedure Code

 +16               SET UNIT=$PIECE(LNLVLD,U,11)

                   SET PRCD=$PIECE(LNLVLD,U,4)

                   SET OPRCD=$PIECE(LNLVLD,U,15)

 +17      ; Provider Paid Amount

                   SET PAID=$PIECE(LNLVLD,U,3)

                   SET TOT("PAID")=TOT("PAID")+PAID

 +18      ; Allowed Amount

                   SET ALWD=$PIECE(LNLVLD,U,13)

                   SET TOT("ALWD")=TOT("ALWD")+ALWD

 +19      ; Handle Multiple Paid Modifiers from the Service Line Level - string together

 +20               KILL MOD

                   MERGE MOD=^IBM(361.1,IEN,15,LNLVL,2)

                   SET MOD=""

                   FOR I=1:1:4

                       if '$DATA(MOD(I))

                           QUIT 

                       SET MOD=MOD_MOD(I,0)

 +21      ; Calculate Submitted Service Line Charge

 +22      ; use to match EOB line # to VistA Bill line#

                   SET CLMLN=$PIECE(LNLVLD,U,12)

 +23               SET SRVCHRG=$PIECE($GET(IBZDATA(CLMLN)),U,8)*$PIECE($GET(IBZDATA(CLMLN)),U,9)

 +24      ; Service Line Level Remarks Codes

 +25               SET Z=0

                   FOR 

                       SET Z=$ORDER(^IBM(361.1,IEN,15,LNLVL,4,Z))

                       if 'Z

                           QUIT 

                       IF $GET(^(Z,0))'=""

                           SET SRMKS(Z)=$PIECE(^(0),U,2)

 +26      ; Get Service Level Group Code/Reason Code Data

 +27               SET (SRVDED,GLVL,RCNT,SRVCOIN)=0

                   KILL RSNCD

 +28      ;

                   FOR 

                       SET GLVL=$ORDER(^IBM(361.1,IEN,15,LNLVL,1,GLVL))

                       if 'GLVL

                           QUIT 

                       SET GLVLD=^(GLVL,0)

                       Begin DoDot:2

 +29                       SET GRPCD=$PIECE(GLVLD,U)

                           SET RLVL=0

 +30      ;

                           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

 +31      ;exception

                                   IF GRPCD="PR"

                                       IF RSNCD="AAA"

                                           QUIT 

 +32      ;exception

                                   IF GRPCD="OA"

                                       IF RSNCD="AB3"

                                           QUIT 

 +33      ;exception

                                   IF GRPCD="LQ"

                                       QUIT 

 +34      ;deductible

                                   IF GRPCD="PR"

                                       IF RSNCD=1

                                           SET SRVDED=SRVDED+$PIECE(RLVLD,U,2)

                                           SET TOT("SRVDED")=TOT("SRVDED")+SRVDED

                                           QUIT 

 +35      ;coinsurance

                                   IF GRPCD="PR"

                                       IF RSNCD=2

                                           SET SRVCOIN=$PIECE(RLVLD,U,2)

                                           SET TOT("SRVCOIN")=TOT("SRVCOIN")+SRVCOIN

                                           QUIT 

 +36      ;adjustment

                                   SET SRVADJ=$PIECE(RLVLD,U,2)

                                   SET TOT("SRVADJ")=TOT("SRVADJ")+SRVADJ

 +37                               SET RCNT=RCNT+1

                                   SET RSNCD(RCNT)=GRPCD_"-"_RSNCD_U_SRVADJ

                               End DoDot:3

                       End DoDot:2

 +38      ; Performing Provider ID

 +39               WRITE !,$GET(PRFRMID)

 +40      ; From Date in MMDD (w/leading zero) format

 +41               IF SRVFDT'=""

                       SET SRVDT=$EXTRACT("00",1,2-$LENGTH(+SRVFDT))_+SRVFDT_$EXTRACT("00",1,2-$LENGTH($PIECE(SRVFDT,"/",2)))_$PIECE(SRVFDT,"/",2)

                       WRITE ?12,SRVDT

 +42      ; To Date in MMDDYY (w/leading zero) format

 +43               IF SRVTDT'=""

                       WRITE ?17,$EXTRACT("00",1,2-$LENGTH(+SRVTDT)),+SRVTDT,$EXTRACT("00",1,2-$LENGTH($PIECE(SRVTDT,"/",2))),$PIECE(SRVTDT,"/",2),$EXTRACT($PIECE(SRVTDT,"/",3),3,4)

 +44      ; If To Date is Null, Print From Date with year (if not Null)

 +45               IF SRVTDT=""

                       IF SRVFDT'=""

                           WRITE ?17,SRVDT,$EXTRACT($PIECE(SRVFDT,"/",3),3,4)

 +46      ; Place of Service - from 837 Extract from CMS-1500 Service Line Level

 +47               WRITE ?25,$PIECE($GET(IBZDATA(CLMLN)),U,3)

 +48      ; Print Units, Procedure Code Paid, Modifiers, Submitted Line Charge, Allowed Amt, Deductable, Coinsurance

 +49               WRITE ?28,UNIT,?34,PRCD,?40,MOD,?49,$JUSTIFY(SRVCHRG,10,2),?60,$JUSTIFY(ALWD,10,2),?71,$JUSTIFY(SRVDED,10,2),?82,$JUSTIFY(SRVCOIN,10,2)

 +50      ; Print 1st Line of Group Code-Reason Code, Adjustment Amount, Paid Amount

 +51               WRITE ?93,$PIECE($GET(RSNCD(1)),U),?100,$JUSTIFY($PIECE($GET(RSNCD(1)),U,2),10,2),?111,$JUSTIFY(PAID,10,2)

 +52      ; print PRCD Submitted, Remarks if any

 +53      ;

                   IF OPRCD'=""!$ORDER(SRMKS(0))

                       WRITE !

                       Begin DoDot:2

 +54                       IF OPRCD'=""

                               WRITE ?33,"(",OPRCD,")"

 +55                       IF $ORDER(SRMKS(0))

                               WRITE ?44,"REM: "

                               SET Z=0

                               FOR 

                                   SET Z=$ORDER(SRMKS(Z))

                                   if 'Z

                                       QUIT 

                                   WRITE SRMKS(Z),$SELECT($ORDER(SRMKS(Z)):",",1:"")

                       End DoDot:2

 +56      ; Print the rest of Group Code-Reason Code, Reason Code Amount

 +57               FOR I=2:1:RCNT

                       WRITE !?93,$PIECE(RSNCD(I),U),?100,$JUSTIFY($PIECE(RSNCD(I),U,2),10,2)

               End DoDot:1

               IF IBQUIT

                   QUIT 

 +58      ;SRVPRNT

           QUIT 

 +59      ;

TOTAL     ; Print Totals

 +1       ;Patient Responsibility

           WRITE !!,"PT RESP ",$JUSTIFY($PIECE($GET(IBEOB(1)),U,2),10,2)

 +2       ; Billed Amount, Allowed Amount, Deductable Amount

 +3        WRITE ?35,"CLAIM TOTAL",?49,$JUSTIFY($PIECE($GET(IBEOB(2)),U,4),10,2),?60,$JUSTIFY(TOT("ALWD"),10,2),?71,$JUSTIFY(TOT("SRVDED"),10,2)

 +4       ; Coinsurance Amount, Adjustment Amount, Paid Amount

 +5        WRITE ?82,$JUSTIFY(TOT("SRVCOIN"),10,2),?100,$JUSTIFY(TOT("SRVADJ"),10,2),?111,$JUSTIFY(TOT("PAID"),10,2)

 +6       ;TOTAL

           QUIT 

 +7       ;