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 ---[H[J[2J[HIBCEMRAB 7042 printed Apr 09, 2024@21:20:24 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 ;
