IBCAPR ;ALB/BI - PRINT EOB/MRA ;20-SEP-2010
;;2.0;INTEGRATED BILLING;**432**;21-MAR-94;Build 192
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
EN(IBIFN) ; -- main entry point for IBCAPR
S VALMBCK="R"
I '$G(IBIFN),$D(VALMBG),$D(VALMLST) S IBIFN=$$GETIBIFN
Q:$G(IBIFN)=""
D EN^VALM("IBCAPR")
Q
;
HDR ; -- header code
N PTNAME,CLONED
S PTNAME=$$GET1^DIQ(399,IBIFN_", ",.02)
S VALMHDR(1)="PATIENT: "_PTNAME
;
S CLONED=$$GET1^DIQ(399,IBIFN_", ",30)
S:CLONED'="" VALMHDR(2)="CLONED FROM: "_CLONED
Q
;
INIT ; -- init variables and list array
K ^TMP("IBCAPR",$J)
S VALMCNT=$$EOB(IBIFN)-1
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("IBCAPR",$J)
D FULL^VALM1
Q
;
EXPND ; -- expand code
Q
;
EOB(IBIFN) ; Obtain the EOB Information from Dictionary 361.1, EXPLANATION OF BENEFITS.
;
N IBALL,IBI,IBILLCNT,IBLN,IBSHEOB
N IBCA,IBCN,IBCT,IBFT,IBMSG,IBPR,IBPT,IBPY,IBQUIT,IBREC1,IBST
N IBSTR,IBTA,IBTS,IBTY,IBX,IBXARRAY,IBXARRY,IBXDATA,IBXERR,IBXSAVE,IBZ,Z
;
D GETEOBCL(IBIFN,.IBALL) ; get all associated claims
;
S IBLN=1,IBILLCNT=0
;
S IBIFN=0
F S IBIFN=$O(IBALL(IBIFN)) Q:IBIFN="" D
.S IBI=0 F S IBI=$O(^IBM(361.1,"B",IBIFN,IBI)) Q:'IBI S Z=+$O(^IBM(361.1,IBI,8,0)) I '$O(^(Z)) S IBILLCNT=IBILLCNT+1,IBSHEOB(IBI)=0 ; Entire EOB belongs to the bill
.;
.S IBI=0 F S IBI=$O(^IBM(361.1,"C",IBIFN,IBI)) Q:'IBI S IBCT=IBCT+1,IBSHEOB(IBI)=1 ; EOB has been reapportioned at the site
;
Q:'$D(IBSHEOB) ; nothing to print
;
S Z=0,IBI=0
F IBZ=1:1 S IBI=$O(IBSHEOB(IBI)) Q:'IBI D I $O(IBSHEOB(IBI)) W @IOF
. D REGION1(IBI,+IBSHEOB(IBI),IBZ,IBILLCNT)
. D REGION2,REGION3,REGION4
;
Q IBLN
;
REGION1(IBI,IBSPL,IBEOBCT,IBCTOF) ; Claim Header Information
N IBD,IBSTR,IBX,IBM,IBM1,IBM2
;
; Line 1
S IBEOBCT=$G(IBEOBCT),IBCTOF=$G(IBCTOF)
S IBD="EOB/MRA Information"_$S(IBCTOF'="":" ("_IBEOBCT_" OF "_IBCTOF_")",1:"")
S IBSTR=$$SETLN(IBD,"",30,45),$E(IBSTR,1,2)=">>",IBLN=$$SET(IBSTR,IBLN)
;
; Line 2
; IBSPL = 0 if EOB represents one bill's payment
; = 1 if AR had to split the EOB between multiple bills
; Assumes IBLN is defined and returns it with line count
S IBM=$G(^IBM(361.1,IBI,0))
S IBTY=$P(IBM,U,4),IBTY=$S(IBTY:"MEDICARE MRA",1:"NORMAL EOB")
I IBTY'["MRA",IBSPL S IBTY="A/R SPLIT/COVERS MORE THAN 1 BILL"
I $P(IBM,U,13)>1,$P(IBM,U,13)<5 S IBTY=IBTY_" ("_$$EXTERNAL^DILFD(361.1,.13,,$P(IBM,U,13))_")"
S IBD="EOB Type: "_IBTY,IBSTR=$$SETLN(IBD,"",5,59)
S IBLN=$$SET(IBSTR,IBLN)
;
; Line 3
S IBCN=$P(IBM,U,14)
S IBX="0.00"
S IBD="ICN: "_IBCN,IBSTR=$$SETLN(IBD,"",10,30)
S IBM1=$G(^IBM(361.1,IBI,1))
S IBPT=$P(IBM1,U,2) ; patient responsibility 1.02 field
I $P(IBM,U,4),$D(^IBM(361.1,IBI,"ERR")) S IBPT=0 ; filing error
; If MRA & UB, then calculate patient responsiblity value
I $P(IBM,U,4),$$FT^IBCEF(+$P(IBM,U,1))=3 S IBPT=$$PTRESPI^IBCECOB1(IBI)
S IBD="Patient Resp Amount: "_$S('IBPT:IBX,1:IBPT)
S IBSTR=$$SETLN(IBD,IBSTR,44,35)
S IBLN=$$SET(IBSTR,IBLN)
;
; Line 4
S IBPY=$$GET1^DIQ(36,+$P(IBM,U,2)_", ",.01)
S IBM2=$G(^IBM(361.1,IBI,2)),IBTA=$P(IBM2,U,3)
; if no Total Allowed Amount, sum up amounts on Line Level Adjustment
I IBTA="" S IBTA=$$ALLOWED^IBCEMU2(IBI)
S IBD="Payer Name: "_IBPY,IBSTR=$$SETLN(IBD,"",3,40)
S IBD="Total Allowed Amount: "_$S('IBTA:IBX,1:IBTA)
S IBSTR=$$SETLN(IBD,IBSTR,43,36)
S IBLN=$$SET(IBSTR,IBLN)
;
; Line 5
S IBTS=$P(IBM2,U,4)
S IBPR=$$FMTE^XLFDT($P(IBM,U,6))
S IBD="EOB Date: "_IBPR,IBSTR=$$SETLN(IBD,"",5,35)
S IBD="Total Submitted Charges: "_$S('IBTS:IBX,1:IBTS)
S IBSTR=$$SETLN(IBD,IBSTR,40,39)
S IBLN=$$SET(IBSTR,IBLN)
;
; Line 6
S IBD="Svc From Dt: "_$$DAT1^IBOUTL($P(IBM1,U,10))
S IBSTR=$$SETLN(IBD,"",2,38)
S IBD="Svc To Dt: "_$$DAT1^IBOUTL($P(IBM1,U,11))
S IBSTR=$$SETLN(IBD,IBSTR,54,25)
S IBLN=$$SET(IBSTR,IBLN)
;
; Line 7
S IBCA=$P(IBM1,U)
S IBST=$P(IBM,U,16),IBST=$$EXPAND^IBTRE(361.1,.16,+IBST)
S IBSTR=""
I IBTY["MRA" S IBD="MRA Review Status: "_IBST,IBSTR=$$SETLN(IBD,"",2,38)
S IBD=$S('$G(IBSPL):" ",1:"**")_"Reported Payment Amt: "_$S('IBCA:$J(IBX,"",2),1:$J(+IBCA,"",2))
S IBSTR=$$SETLN(IBD,IBSTR,41,37)
S IBLN=$$SET(IBSTR,IBLN)
;
REGION2 ; MEDICARE RA Information
;
I IBTY["MRA",$D(^IBM(361.1,IBI,21)) D
. S IBD=$TR($J("",35)," ","-")_"Review"_$TR($J("",38)," ","-")
. S IBSTR=$$SETLN(IBD,"",1,79),IBLN=$$SET(IBSTR,IBLN)
. S (IBST,IBCN)=0 F S IBCN=$O(^IBM(361.1,IBI,21,IBCN)) Q:'IBCN S X=$G(^(IBCN,0)) D
.. S IBST=0
.. S IBD="Review Date: "_$$DAT1^IBOUTL($P(X,U))
.. S IBSTR=$$SETLN(IBD,"",1,30)
.. S IBD="Reviewed By: "_$$GET1^DIQ(200,+$P(X,U,2)_", ",.01) ; DBIA 10060
.. S IBSTR=$$SETLN(IBD,IBSTR,40,39)
.. S IBLN=$$SET(IBSTR,IBLN)
.. S IBD=0 F S IBD=$O(^IBM(361.1,IBI,21,IBCN,1,IBD)) Q:'IBD S IBSTR=$$SETLN($S('IBST:"Comments: ",1:"")_$G(^(IBD,0)),"",1,$S('IBST:69,1:79)),IBST=1,IBLN=$$SET(IBSTR,IBLN)
. I 'IBST D
.. S IBSTR=$$SETLN("None","",1,10)
.. S IBLN=$$SET(IBSTR,IBLN)
Q
;
REGION3 ; CLAIM and LINE level Information
N Z
K ^TMP("PRCA_EOB",$J)
D GETEOB^IBCECSA6(IBI,2)
S Z=0 F S Z=$O(^TMP("PRCA_EOB",$J,IBI,Z)) Q:'Z S IBSTR=$$SETLN($G(^TMP("PRCA_EOB",$J,IBI,Z)),"",1,79),IBLN=$$SET(IBSTR,IBLN)
K ^TMP("PRCA_EOB",$J)
Q
;
REGION4 ; Display information about any 361.1 message storage or filing errors
N Z
I '$O(^IBM(361.1,IBI,"ERR",0)) Q
S IBSTR=$$SETLN(" ** MESSAGE STORAGE ERRORS **","",1,79),IBLN=$$SET(IBSTR,IBLN)
S Z=0 F S Z=$O(^IBM(361.1,IBI,"ERR",Z)) Q:'Z S IBSTR=$$SETLN($G(^(Z,0)),"",1,79),IBLN=$$SET(IBSTR,IBLN)
Q
;
SETLN(S,V,X,L) ; -- insert text(S) into variable(V)
; S := string to insert
; V := destination string
; X := insert @ col X
; L := clear # of chars (length)
Q $E(V_$J("",X-1),1,X-1)_$E(S_$J("",L),1,L)_$E(V,X+L,999)
;
SET(STR,LN) ; set up TMP array with EOB Data
S ^TMP("IBCAPR",$J,LN,0)=STR
Q LN+1
;
PRTOPT1 ; LIST MANAGER FORM entry point to print EOB, asking for print device.
N IBSCAN
D FULL^VALM1
D ^%ZIS Q:POP
F IBSCAN=1:1:$O(^TMP("IBCAPR",$J,""),-1) D
. U IO W ^TMP("IBCAPR",$J,IBSCAN,0),!
D ^%ZISC
D PAUSE^VALM1
I X="^" S VALMBCK="Q" Q
S VALMBCK="R"
Q
;
PRTOPT2 ; LIST MANAGER FORM entry point to print to default print device.
N IBSCAN,X,IOP
D FULL^VALM1
S VALMBCK="R"
S IOP=$$EOBPRT
D:IOP=""
. Write !!,"*** The default EOB Printer doesn't seem to be defined ***"
. D PAUSE^VALM1
. S X="^"
Q:$G(X)="^"
D ^%ZIS Q:POP
F IBSCAN=1:1:$O(^TMP("IBCAPR",$J,""),-1) D
. U IO W ^TMP("IBCAPR",$J,IBSCAN,0),!
D ^%ZISC
Q
;
PRTOPT3 ; LIST MANAGER FORM entry point to print EOB and MRA, asking for print devices.
N IBSCAN
D FULL^VALM1
W !!,"Select Printer for the EOB",!
D ^%ZIS Q:POP
F IBSCAN=1:1:$O(^TMP("IBCAPR",$J,""),-1) D
. U IO W ^TMP("IBCAPR",$J,IBSCAN,0),!
D ^%ZISC
D PAUSE^VALM1
I X="^" S VALMBCK="Q" Q
W !!,"Select Printer for the MRA",!
D MRA^IBCEMRAA(IBIFN)
D PAUSE^VALM1
I X="^" S VALMBCK="Q" Q
S VALMBCK="R"
Q
;
PRTOPT4 ; LIST MANAGER FORM entry point to print EOB and MRA to default print devices.
N IBSCAN,X,IOP
D FULL^VALM1
S VALMBCK="R"
S IOP=$$EOBPRT
D:IOP=""
. Write !!,"*** The default EOB Printer doesn't seem to be defined ***"
. D PAUSE^VALM1
. S X="^"
Q:$G(X)="^"
D ^%ZIS
F IBSCAN=1:1:$O(^TMP("IBCAPR",$J,""),-1) D
. U IO W ^TMP("IBCAPR",$J,IBSCAN,0),!
D ^%ZISC
S IOP=$$MRAPRT
D:IOP=""
. Write !!,"*** The default MRA Printer doesn't seem to be defined ***"
. D PAUSE^VALM1
. S X="^"
Q:$G(X)="^"
D ^%ZIS
U IO
D PROC^IBCEMRAA
D ^%ZISC
Q
;
PRTOPT5(IBIFN) ; External entry point to print EOB information, asking for print device.
N IBSCAN
D EOB(IBIFN)
D ^%ZIS Q:POP 0
F IBSCAN=1:1:$O(^TMP("IBCAPR",$J,""),-1) D
. U IO W ^TMP("IBCAPR",$J,IBSCAN,0),!
D ^%ZISC
K ^TMP("IBCAPR",$J)
Q 1
;
PRTOPT6(IBIFN) ; External entry point to print EOB information to default print device.
N IBSCAN,IOP
I '$$PRTCHK16 Q $$PRTCHK16
S IOP=$$EOBPRT
Q:IOP="" "0^EOB PRINTER NOT DEFINED"
D EOB(IBIFN)
D ^%ZIS Q:POP
F IBSCAN=1:1:$O(^TMP("IBCAPR",$J,""),-1) D
. U IO W ^TMP("IBCAPR",$J,IBSCAN,0),!
D ^%ZISC
K ^TMP("IBCAPR",$J)
Q 1
;
PRTOPT7(IBIFN) ; External entry point to print EOB and MRA information, asking for print devices.
N IBSCAN
D EOB(IBIFN)
W !!,"Select Printer for the EOB",!
D ^%ZIS Q:POP 0
F IBSCAN=1:1:$O(^TMP("IBCAPR",$J,""),-1) D
. U IO W ^TMP("IBCAPR",$J,IBSCAN,0),!
D ^%ZISC
K ^TMP("IBCAPR",$J)
W !!,"Select Printer for the MRA",!
D MRA^IBCEMRAA(IBIFN)
Q 1
;
PRTOPT8(IBIFN) ; External entry point to print EOB and MRA information to default print devices.
N IBSCAN,IOP
I '$$PRTCHK16 Q $$PRTCHK16
S IOP=$$EOBPRT
Q:IOP="" "0^EOB PRINTER NOT DEFINED"
D EOB(IBIFN)
D ^%ZIS Q:POP "0^EOB PRINTER NOT DEFINED CORRECTLY"
F IBSCAN=1:1:$O(^TMP("IBCAPR",$J,""),-1) D
. U IO W ^TMP("IBCAPR",$J,IBSCAN,0),!
D ^%ZISC
K ^TMP("IBCAPR",$J)
I '$$PRTCHK14 Q $$PRTCHK14
S IOP=$$MRAPRT
Q:IOP="" "0^MRA PRINTER NOT DEFINED"
D ^%ZIS Q:POP "0^MRA PRINTER NOT DEFINED CORRECTLY"
U IO
D PROC^IBCEMRAA
D ^%ZISC
Q 1
;
PRINT8Q(IBIFN) ; External entry point to QUEUE the EOB and MRA print jobs
; Queue to Print EOB portion to the default EOB printer.
N %ZIS,ZTDTH,ZTRTN,ZTSAVE,ZTDESC,POP,IOP,IBTSK1,IBTSK2
I '$G(IBIFN) Q "0^CLAIM NUMBER NOT DEFINED"
I '$$PRTCHK16 Q $$PRTCHK16
S IOP=$$EOBPRT
Q:IOP="" "0^EOB PRINTER NOT DEFINED"
S %ZIS="QN"
D ^%ZIS I POP Q "0^EOB PRINTER NOT DEFINED CORRECTLY"
S ZTRTN="PRINT8Q1^IBCAPR" ; Background re-entry point.
S ZTDESC="EOB PRINT"
S ZTSAVE("IB*")=""
S ZTDTH=$H
D ^%ZTLOAD S IBTSK1=$G(ZTSK)
K ZTSK,IO("Q") D HOME^%ZIS
; Queue to Print MRA portion to the default MRA printer.
K %ZIS,ZTRTN,ZTSAVE,ZTDESC,POP
I '$$PRTCHK14 Q $$PRTCHK14
S IOP=$$MRAPRT
Q:IOP="" "0^MRA PRINTER NOT DEFINED"
S IBIFN=$$GETMRACL(IBIFN)
Q:'IBIFN "0^NO MRA CLAIM TO PRINT"
S %ZIS="QN"
D ^%ZIS I POP Q "0^MRA PRINTER NOT DEFINED CORRECTLY"
S ZTRTN="PROC^IBCEMRAA" ; Background re-entry point.
S ZTDESC="MRA PRINT"
S ZTSAVE("IB*")=""
S ZTDTH=$H
D ^%ZTLOAD S IBTSK2=$G(ZTSK)
K ZTSK,IO("Q") D HOME^%ZIS
Q 1_"^"_IBTSK1_"^"_IBTSK2
PRINT8Q1 ; Background re-entry point.
D EOB(IBIFN)
F IBSCAN=1:1:$O(^TMP("IBCAPR",$J,""),-1) D
. W ^TMP("IBCAPR",$J,IBSCAN,0),!
D ^%ZISC
Q
;
EOBPRT() ; Get EOB Printer Name
Q $$GET1^DIQ(350.9,"1, ",8.16)
;
MRAPRT() ; Get MRA Printer Name
Q $$GET1^DIQ(350.9,"1, ",8.19)
;
PRTCHK(ERROR) ; ; Validate ALL printer parameters.
; USAGE EXAMPLES: W $$PRTCHK^IBCAPR(.ERRMSG)," ",ERRMSG,!
; I '$$PRTCHK^IBCAPR Q
N X,ERR14,ERR15,ERR16,ERR19,STATUS
S ERROR="",STATUS=1
S:'$$PRTCHK14(.X,.ERR14) STATUS=0
S:'$$PRTCHK15(.X,.ERR15) STATUS=0
S:'$$PRTCHK16(.X,.ERR16) STATUS=0
S:'$$PRTCHK19(.X,.ERR19) STATUS=0
Q:STATUS 1
I ERR14'="" S ERROR=ERR14
I ERR15'="" S ERROR=ERROR_$S(ERROR="":ERR15,1:", "_ERR15)
I ERR16'="" S ERROR=ERROR_$S(ERROR="":ERR16,1:", "_ERR16)
I ERR19'="" S ERROR=ERROR_$S(ERROR="":ERR19,1:", "_ERR19)
Q 0
;
PRTCHK14(PRTNM,ERROR) ; Validate the CMS-1500 printer parameter.
; USAGE EXAMPLES: I $$PRTCHK14^IBCAPR(.NAME,.ERRMSG) S IOP=NAME
; I '$$PRTCHK14^IBCAPR Q
N POP
S ERROR=""
S IOP=$$CMS1500^IBCAPR1(),PRTNM=IOP
I IOP="" S ERROR="CMS-1500 PRINTER NOT DEFINED" Q "0^"_ERROR
S %ZIS="QN"
D ^%ZIS I POP S ERROR="CMS-1500 PRINTER NOT DEFINED CORRECTLY" Q "0^"_ERROR
Q 1
;
PRTCHK15(PRTNM,ERROR) ; Validate the UB-04 printer parameter.
; USAGE EXAMPLE: I $$PRTCHK15^IBCAPR(.NAME,.ERRMSG) S IOP=NAME
; I '$$PRTCHK15^IBCAPR Q
N POP
S ERROR=""
S IOP=$$UB4PRT^IBCAPR1(),PRTNM=IOP
I IOP="" S ERROR="UB-04 PRINTER NOT DEFINED" Q "0^"_ERROR
S %ZIS="QN"
D ^%ZIS I POP S ERROR="UB-04 PRINTER NOT DEFINED CORRECTLY" Q "0^"_ERROR
Q 1
;
PRTCHK16(PRTNM,ERROR) ; Validate the EOB printer parameter.
; USAGE EXAMPLE: I $$PRTCHK16^IBCAPR(.NAME,.ERRMSG) S IOP=NAME
; I '$$PRTCHK16^IBCAPR Q
N POP
S ERROR=""
S IOP=$$EOBPRT(),PRTNM=IOP
I IOP="" S ERROR="EOB PRINTER NOT DEFINED" Q "0^"_ERROR
S %ZIS="QN"
D ^%ZIS I POP S ERROR="EOB PRINTER NOT DEFINED CORRECTLY" Q "0^"_ERROR
Q 1
;
PRTCHK19(PRTNM,ERROR) ; Validate the MRA printer parameter.
; USAGE EXAMPLE: I $$PRTCHK19^IBCAPR(.NAME,.ERRMSG) S IOP=NAME
; I '$$PRTCHK19^IBCAPR Q
N POP
S ERROR=""
S IOP=$$MRAPRT(),PRTNM=IOP
I IOP="" S ERROR="MRA PRINTER NOT DEFINED" Q "0^"_ERROR
S %ZIS="QN"
D ^%ZIS I POP S ERROR="MRA PRINTER NOT DEFINED CORRECTLY" Q "0^"_ERROR
Q 1
;
GETIBIFN() ; Get Internal Claim Pointer
N DIR,IBDA,IBIFN S IBIFN=""
D FULL^VALM1
D EN^VALM2($G(XQORNOD(0)),"S")
S IBDA=$O(VALMY(0))
S:IBDA IBIFN=$P($G(^TMP("IBCECOB",$J,IBDA)),U,2)
Q IBIFN
;
GETMRACL(IBIFN) ; Get MRA claim #
; Find if there was MEDICARE WNR on the bill being passed in and then get the claim associated with it.
N IBMRASEQ,IBWNRFL,IBM1,IBMRACL
F IBMRASEQ=1:1:3 S IBWNRFL=$$WNRBILL^IBEFUNC(IBIFN,IBMRASEQ) Q:+IBWNRFL
I '+IBWNRFL Q 0 ; No Medicare WNR on Bill
S IBM1=$G(^DGCR(399,IBIFN,"M1"))
S IBMRACL=$P(IBM1,U,4+IBMRASEQ)
I +IBMRACL Q IBMRACL
;
; Since Medicare WNR does not generate a new bill # and hence may not
; point to a previous bill, this may need to grab the secondary bill
I IBMRASEQ=1 S IBMRACL=$P(IBM1,U,6)
;
Q +IBMRACL
;
GETEOBCL(IBIFN,IBALL) ; Get all Claims associated with this one.
; If it's secondary, get primary
; If it's a tertiary, get secondary and primary
; Input: IBIFN - IEN to 399 for cliam being printed
; IBALL by reference
; Output: IBALL - Array of claim numbers which have EOBS for this claim.
N IBCOBN,IBPRVCL,IBM1,LOOP
S IBALL(IBIFN)=""
S IBM1=$G(^DGCR(399,IBIFN,"M1"))
S IBCOBN=$$COBN^IBCEF(IBIFN)-1
Q:IBCOBN<1
F LOOP=IBCOBN:-1:1 S IBPRVCL=$P(IBM1,U,4+LOOP) S:IBPRVCL]"" IBALL(IBPRVCL)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCAPR 14092 printed Dec 13, 2024@02:08:36 Page 2
IBCAPR ;ALB/BI - PRINT EOB/MRA ;20-SEP-2010
+1 ;;2.0;INTEGRATED BILLING;**432**;21-MAR-94;Build 192
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN(IBIFN) ; -- main entry point for IBCAPR
+1 SET VALMBCK="R"
+2 IF '$GET(IBIFN)
IF $DATA(VALMBG)
IF $DATA(VALMLST)
SET IBIFN=$$GETIBIFN
+3 if $GET(IBIFN)=""
QUIT
+4 DO EN^VALM("IBCAPR")
+5 QUIT
+6 ;
HDR ; -- header code
+1 NEW PTNAME,CLONED
+2 SET PTNAME=$$GET1^DIQ(399,IBIFN_", ",.02)
+3 SET VALMHDR(1)="PATIENT: "_PTNAME
+4 ;
+5 SET CLONED=$$GET1^DIQ(399,IBIFN_", ",30)
+6 if CLONED'=""
SET VALMHDR(2)="CLONED FROM: "_CLONED
+7 QUIT
+8 ;
INIT ; -- init variables and list array
+1 KILL ^TMP("IBCAPR",$JOB)
+2 SET VALMCNT=$$EOB(IBIFN)-1
+3 QUIT
+4 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("IBCAPR",$JOB)
+2 DO FULL^VALM1
+3 QUIT
+4 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
EOB(IBIFN) ; Obtain the EOB Information from Dictionary 361.1, EXPLANATION OF BENEFITS.
+1 ;
+2 NEW IBALL,IBI,IBILLCNT,IBLN,IBSHEOB
+3 NEW IBCA,IBCN,IBCT,IBFT,IBMSG,IBPR,IBPT,IBPY,IBQUIT,IBREC1,IBST
+4 NEW IBSTR,IBTA,IBTS,IBTY,IBX,IBXARRAY,IBXARRY,IBXDATA,IBXERR,IBXSAVE,IBZ,Z
+5 ;
+6 ; get all associated claims
DO GETEOBCL(IBIFN,.IBALL)
+7 ;
+8 SET IBLN=1
SET IBILLCNT=0
+9 ;
+10 SET IBIFN=0
+11 FOR
SET IBIFN=$ORDER(IBALL(IBIFN))
if IBIFN=""
QUIT
Begin DoDot:1
+12 ; Entire EOB belongs to the bill
SET IBI=0
FOR
SET IBI=$ORDER(^IBM(361.1,"B",IBIFN,IBI))
if 'IBI
QUIT
SET Z=+$ORDER(^IBM(361.1,IBI,8,0))
IF '$ORDER(^(Z))
SET IBILLCNT=IBILLCNT+1
SET IBSHEOB(IBI)=0
+13 ;
+14 ; EOB has been reapportioned at the site
SET IBI=0
FOR
SET IBI=$ORDER(^IBM(361.1,"C",IBIFN,IBI))
if 'IBI
QUIT
SET IBCT=IBCT+1
SET IBSHEOB(IBI)=1
End DoDot:1
+15 ;
+16 ; nothing to print
if '$DATA(IBSHEOB)
QUIT
+17 ;
+18 SET Z=0
SET IBI=0
+19 FOR IBZ=1:1
SET IBI=$ORDER(IBSHEOB(IBI))
if 'IBI
QUIT
Begin DoDot:1
+20 DO REGION1(IBI,+IBSHEOB(IBI),IBZ,IBILLCNT)
+21 DO REGION2
DO REGION3
DO REGION4
End DoDot:1
IF $ORDER(IBSHEOB(IBI))
WRITE @IOF
+22 ;
+23 QUIT IBLN
+24 ;
REGION1(IBI,IBSPL,IBEOBCT,IBCTOF) ; Claim Header Information
+1 NEW IBD,IBSTR,IBX,IBM,IBM1,IBM2
+2 ;
+3 ; Line 1
+4 SET IBEOBCT=$GET(IBEOBCT)
SET IBCTOF=$GET(IBCTOF)
+5 SET IBD="EOB/MRA Information"_$SELECT(IBCTOF'="":" ("_IBEOBCT_" OF "_IBCTOF_")",1:"")
+6 SET IBSTR=$$SETLN(IBD,"",30,45)
SET $EXTRACT(IBSTR,1,2)=">>"
SET IBLN=$$SET(IBSTR,IBLN)
+7 ;
+8 ; Line 2
+9 ; IBSPL = 0 if EOB represents one bill's payment
+10 ; = 1 if AR had to split the EOB between multiple bills
+11 ; Assumes IBLN is defined and returns it with line count
+12 SET IBM=$GET(^IBM(361.1,IBI,0))
+13 SET IBTY=$PIECE(IBM,U,4)
SET IBTY=$SELECT(IBTY:"MEDICARE MRA",1:"NORMAL EOB")
+14 IF IBTY'["MRA"
IF IBSPL
SET IBTY="A/R SPLIT/COVERS MORE THAN 1 BILL"
+15 IF $PIECE(IBM,U,13)>1
IF $PIECE(IBM,U,13)<5
SET IBTY=IBTY_" ("_$$EXTERNAL^DILFD(361.1,.13,,$PIECE(IBM,U,13))_")"
+16 SET IBD="EOB Type: "_IBTY
SET IBSTR=$$SETLN(IBD,"",5,59)
+17 SET IBLN=$$SET(IBSTR,IBLN)
+18 ;
+19 ; Line 3
+20 SET IBCN=$PIECE(IBM,U,14)
+21 SET IBX="0.00"
+22 SET IBD="ICN: "_IBCN
SET IBSTR=$$SETLN(IBD,"",10,30)
+23 SET IBM1=$GET(^IBM(361.1,IBI,1))
+24 ; patient responsibility 1.02 field
SET IBPT=$PIECE(IBM1,U,2)
+25 ; filing error
IF $PIECE(IBM,U,4)
IF $DATA(^IBM(361.1,IBI,"ERR"))
SET IBPT=0
+26 ; If MRA & UB, then calculate patient responsiblity value
+27 IF $PIECE(IBM,U,4)
IF $$FT^IBCEF(+$PIECE(IBM,U,1))=3
SET IBPT=$$PTRESPI^IBCECOB1(IBI)
+28 SET IBD="Patient Resp Amount: "_$SELECT('IBPT:IBX,1:IBPT)
+29 SET IBSTR=$$SETLN(IBD,IBSTR,44,35)
+30 SET IBLN=$$SET(IBSTR,IBLN)
+31 ;
+32 ; Line 4
+33 SET IBPY=$$GET1^DIQ(36,+$PIECE(IBM,U,2)_", ",.01)
+34 SET IBM2=$GET(^IBM(361.1,IBI,2))
SET IBTA=$PIECE(IBM2,U,3)
+35 ; if no Total Allowed Amount, sum up amounts on Line Level Adjustment
+36 IF IBTA=""
SET IBTA=$$ALLOWED^IBCEMU2(IBI)
+37 SET IBD="Payer Name: "_IBPY
SET IBSTR=$$SETLN(IBD,"",3,40)
+38 SET IBD="Total Allowed Amount: "_$SELECT('IBTA:IBX,1:IBTA)
+39 SET IBSTR=$$SETLN(IBD,IBSTR,43,36)
+40 SET IBLN=$$SET(IBSTR,IBLN)
+41 ;
+42 ; Line 5
+43 SET IBTS=$PIECE(IBM2,U,4)
+44 SET IBPR=$$FMTE^XLFDT($PIECE(IBM,U,6))
+45 SET IBD="EOB Date: "_IBPR
SET IBSTR=$$SETLN(IBD,"",5,35)
+46 SET IBD="Total Submitted Charges: "_$SELECT('IBTS:IBX,1:IBTS)
+47 SET IBSTR=$$SETLN(IBD,IBSTR,40,39)
+48 SET IBLN=$$SET(IBSTR,IBLN)
+49 ;
+50 ; Line 6
+51 SET IBD="Svc From Dt: "_$$DAT1^IBOUTL($PIECE(IBM1,U,10))
+52 SET IBSTR=$$SETLN(IBD,"",2,38)
+53 SET IBD="Svc To Dt: "_$$DAT1^IBOUTL($PIECE(IBM1,U,11))
+54 SET IBSTR=$$SETLN(IBD,IBSTR,54,25)
+55 SET IBLN=$$SET(IBSTR,IBLN)
+56 ;
+57 ; Line 7
+58 SET IBCA=$PIECE(IBM1,U)
+59 SET IBST=$PIECE(IBM,U,16)
SET IBST=$$EXPAND^IBTRE(361.1,.16,+IBST)
+60 SET IBSTR=""
+61 IF IBTY["MRA"
SET IBD="MRA Review Status: "_IBST
SET IBSTR=$$SETLN(IBD,"",2,38)
+62 SET IBD=$SELECT('$GET(IBSPL):" ",1:"**")_"Reported Payment Amt: "_$SELECT('IBCA:$JUSTIFY(IBX,"",2),1:$JUSTIFY(+IBCA,"",2))
+63 SET IBSTR=$$SETLN(IBD,IBSTR,41,37)
+64 SET IBLN=$$SET(IBSTR,IBLN)
+65 ;
REGION2 ; MEDICARE RA Information
+1 ;
+2 IF IBTY["MRA"
IF $DATA(^IBM(361.1,IBI,21))
Begin DoDot:1
+3 SET IBD=$TRANSLATE($JUSTIFY("",35)," ","-")_"Review"_$TRANSLATE($JUSTIFY("",38)," ","-")
+4 SET IBSTR=$$SETLN(IBD,"",1,79)
SET IBLN=$$SET(IBSTR,IBLN)
+5 SET (IBST,IBCN)=0
FOR
SET IBCN=$ORDER(^IBM(361.1,IBI,21,IBCN))
if 'IBCN
QUIT
SET X=$GET(^(IBCN,0))
Begin DoDot:2
+6 SET IBST=0
+7 SET IBD="Review Date: "_$$DAT1^IBOUTL($PIECE(X,U))
+8 SET IBSTR=$$SETLN(IBD,"",1,30)
+9 ; DBIA 10060
SET IBD="Reviewed By: "_$$GET1^DIQ(200,+$PIECE(X,U,2)_", ",.01)
+10 SET IBSTR=$$SETLN(IBD,IBSTR,40,39)
+11 SET IBLN=$$SET(IBSTR,IBLN)
+12 SET IBD=0
FOR
SET IBD=$ORDER(^IBM(361.1,IBI,21,IBCN,1,IBD))
if 'IBD
QUIT
SET IBSTR=$$SETLN($SELECT('IBST:"Comments: ",1:"")_$GET(^(IBD,0)),"",1,$SELECT('IBST:69,1:79))
SET IBST=1
SET IBLN=$$SET(IBSTR,IBLN)
End DoDot:2
+13 IF 'IBST
Begin DoDot:2
+14 SET IBSTR=$$SETLN("None","",1,10)
+15 SET IBLN=$$SET(IBSTR,IBLN)
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
REGION3 ; CLAIM and LINE level Information
+1 NEW Z
+2 KILL ^TMP("PRCA_EOB",$JOB)
+3 DO GETEOB^IBCECSA6(IBI,2)
+4 SET Z=0
FOR
SET Z=$ORDER(^TMP("PRCA_EOB",$JOB,IBI,Z))
if 'Z
QUIT
SET IBSTR=$$SETLN($GET(^TMP("PRCA_EOB",$JOB,IBI,Z)),"",1,79)
SET IBLN=$$SET(IBSTR,IBLN)
+5 KILL ^TMP("PRCA_EOB",$JOB)
+6 QUIT
+7 ;
REGION4 ; Display information about any 361.1 message storage or filing errors
+1 NEW Z
+2 IF '$ORDER(^IBM(361.1,IBI,"ERR",0))
QUIT
+3 SET IBSTR=$$SETLN(" ** MESSAGE STORAGE ERRORS **","",1,79)
SET IBLN=$$SET(IBSTR,IBLN)
+4 SET Z=0
FOR
SET Z=$ORDER(^IBM(361.1,IBI,"ERR",Z))
if 'Z
QUIT
SET IBSTR=$$SETLN($GET(^(Z,0)),"",1,79)
SET IBLN=$$SET(IBSTR,IBLN)
+5 QUIT
+6 ;
SETLN(S,V,X,L) ; -- insert text(S) into variable(V)
+1 ; S := string to insert
+2 ; V := destination string
+3 ; X := insert @ col X
+4 ; L := clear # of chars (length)
+5 QUIT $EXTRACT(V_$JUSTIFY("",X-1),1,X-1)_$EXTRACT(S_$JUSTIFY("",L),1,L)_$EXTRACT(V,X+L,999)
+6 ;
SET(STR,LN) ; set up TMP array with EOB Data
+1 SET ^TMP("IBCAPR",$JOB,LN,0)=STR
+2 QUIT LN+1
+3 ;
PRTOPT1 ; LIST MANAGER FORM entry point to print EOB, asking for print device.
+1 NEW IBSCAN
+2 DO FULL^VALM1
+3 DO ^%ZIS
if POP
QUIT
+4 FOR IBSCAN=1:1:$ORDER(^TMP("IBCAPR",$JOB,""),-1)
Begin DoDot:1
+5 USE IO
WRITE ^TMP("IBCAPR",$JOB,IBSCAN,0),!
End DoDot:1
+6 DO ^%ZISC
+7 DO PAUSE^VALM1
+8 IF X="^"
SET VALMBCK="Q"
QUIT
+9 SET VALMBCK="R"
+10 QUIT
+11 ;
PRTOPT2 ; LIST MANAGER FORM entry point to print to default print device.
+1 NEW IBSCAN,X,IOP
+2 DO FULL^VALM1
+3 SET VALMBCK="R"
+4 SET IOP=$$EOBPRT
+5 if IOP=""
Begin DoDot:1
+6 WRITE !!,"*** The default EOB Printer doesn't seem to be defined ***"
+7 DO PAUSE^VALM1
+8 SET X="^"
End DoDot:1
+9 if $GET(X)="^"
QUIT
+10 DO ^%ZIS
if POP
QUIT
+11 FOR IBSCAN=1:1:$ORDER(^TMP("IBCAPR",$JOB,""),-1)
Begin DoDot:1
+12 USE IO
WRITE ^TMP("IBCAPR",$JOB,IBSCAN,0),!
End DoDot:1
+13 DO ^%ZISC
+14 QUIT
+15 ;
PRTOPT3 ; LIST MANAGER FORM entry point to print EOB and MRA, asking for print devices.
+1 NEW IBSCAN
+2 DO FULL^VALM1
+3 WRITE !!,"Select Printer for the EOB",!
+4 DO ^%ZIS
if POP
QUIT
+5 FOR IBSCAN=1:1:$ORDER(^TMP("IBCAPR",$JOB,""),-1)
Begin DoDot:1
+6 USE IO
WRITE ^TMP("IBCAPR",$JOB,IBSCAN,0),!
End DoDot:1
+7 DO ^%ZISC
+8 DO PAUSE^VALM1
+9 IF X="^"
SET VALMBCK="Q"
QUIT
+10 WRITE !!,"Select Printer for the MRA",!
+11 DO MRA^IBCEMRAA(IBIFN)
+12 DO PAUSE^VALM1
+13 IF X="^"
SET VALMBCK="Q"
QUIT
+14 SET VALMBCK="R"
+15 QUIT
+16 ;
PRTOPT4 ; LIST MANAGER FORM entry point to print EOB and MRA to default print devices.
+1 NEW IBSCAN,X,IOP
+2 DO FULL^VALM1
+3 SET VALMBCK="R"
+4 SET IOP=$$EOBPRT
+5 if IOP=""
Begin DoDot:1
+6 WRITE !!,"*** The default EOB Printer doesn't seem to be defined ***"
+7 DO PAUSE^VALM1
+8 SET X="^"
End DoDot:1
+9 if $GET(X)="^"
QUIT
+10 DO ^%ZIS
+11 FOR IBSCAN=1:1:$ORDER(^TMP("IBCAPR",$JOB,""),-1)
Begin DoDot:1
+12 USE IO
WRITE ^TMP("IBCAPR",$JOB,IBSCAN,0),!
End DoDot:1
+13 DO ^%ZISC
+14 SET IOP=$$MRAPRT
+15 if IOP=""
Begin DoDot:1
+16 WRITE !!,"*** The default MRA Printer doesn't seem to be defined ***"
+17 DO PAUSE^VALM1
+18 SET X="^"
End DoDot:1
+19 if $GET(X)="^"
QUIT
+20 DO ^%ZIS
+21 USE IO
+22 DO PROC^IBCEMRAA
+23 DO ^%ZISC
+24 QUIT
+25 ;
PRTOPT5(IBIFN) ; External entry point to print EOB information, asking for print device.
+1 NEW IBSCAN
+2 DO EOB(IBIFN)
+3 DO ^%ZIS
if POP
QUIT 0
+4 FOR IBSCAN=1:1:$ORDER(^TMP("IBCAPR",$JOB,""),-1)
Begin DoDot:1
+5 USE IO
WRITE ^TMP("IBCAPR",$JOB,IBSCAN,0),!
End DoDot:1
+6 DO ^%ZISC
+7 KILL ^TMP("IBCAPR",$JOB)
+8 QUIT 1
+9 ;
PRTOPT6(IBIFN) ; External entry point to print EOB information to default print device.
+1 NEW IBSCAN,IOP
+2 IF '$$PRTCHK16
QUIT $$PRTCHK16
+3 SET IOP=$$EOBPRT
+4 if IOP=""
QUIT "0^EOB PRINTER NOT DEFINED"
+5 DO EOB(IBIFN)
+6 DO ^%ZIS
if POP
QUIT
+7 FOR IBSCAN=1:1:$ORDER(^TMP("IBCAPR",$JOB,""),-1)
Begin DoDot:1
+8 USE IO
WRITE ^TMP("IBCAPR",$JOB,IBSCAN,0),!
End DoDot:1
+9 DO ^%ZISC
+10 KILL ^TMP("IBCAPR",$JOB)
+11 QUIT 1
+12 ;
PRTOPT7(IBIFN) ; External entry point to print EOB and MRA information, asking for print devices.
+1 NEW IBSCAN
+2 DO EOB(IBIFN)
+3 WRITE !!,"Select Printer for the EOB",!
+4 DO ^%ZIS
if POP
QUIT 0
+5 FOR IBSCAN=1:1:$ORDER(^TMP("IBCAPR",$JOB,""),-1)
Begin DoDot:1
+6 USE IO
WRITE ^TMP("IBCAPR",$JOB,IBSCAN,0),!
End DoDot:1
+7 DO ^%ZISC
+8 KILL ^TMP("IBCAPR",$JOB)
+9 WRITE !!,"Select Printer for the MRA",!
+10 DO MRA^IBCEMRAA(IBIFN)
+11 QUIT 1
+12 ;
PRTOPT8(IBIFN) ; External entry point to print EOB and MRA information to default print devices.
+1 NEW IBSCAN,IOP
+2 IF '$$PRTCHK16
QUIT $$PRTCHK16
+3 SET IOP=$$EOBPRT
+4 if IOP=""
QUIT "0^EOB PRINTER NOT DEFINED"
+5 DO EOB(IBIFN)
+6 DO ^%ZIS
if POP
QUIT "0^EOB PRINTER NOT DEFINED CORRECTLY"
+7 FOR IBSCAN=1:1:$ORDER(^TMP("IBCAPR",$JOB,""),-1)
Begin DoDot:1
+8 USE IO
WRITE ^TMP("IBCAPR",$JOB,IBSCAN,0),!
End DoDot:1
+9 DO ^%ZISC
+10 KILL ^TMP("IBCAPR",$JOB)
+11 IF '$$PRTCHK14
QUIT $$PRTCHK14
+12 SET IOP=$$MRAPRT
+13 if IOP=""
QUIT "0^MRA PRINTER NOT DEFINED"
+14 DO ^%ZIS
if POP
QUIT "0^MRA PRINTER NOT DEFINED CORRECTLY"
+15 USE IO
+16 DO PROC^IBCEMRAA
+17 DO ^%ZISC
+18 QUIT 1
+19 ;
PRINT8Q(IBIFN) ; External entry point to QUEUE the EOB and MRA print jobs
+1 ; Queue to Print EOB portion to the default EOB printer.
+2 NEW %ZIS,ZTDTH,ZTRTN,ZTSAVE,ZTDESC,POP,IOP,IBTSK1,IBTSK2
+3 IF '$GET(IBIFN)
QUIT "0^CLAIM NUMBER NOT DEFINED"
+4 IF '$$PRTCHK16
QUIT $$PRTCHK16
+5 SET IOP=$$EOBPRT
+6 if IOP=""
QUIT "0^EOB PRINTER NOT DEFINED"
+7 SET %ZIS="QN"
+8 DO ^%ZIS
IF POP
QUIT "0^EOB PRINTER NOT DEFINED CORRECTLY"
+9 ; Background re-entry point.
SET ZTRTN="PRINT8Q1^IBCAPR"
+10 SET ZTDESC="EOB PRINT"
+11 SET ZTSAVE("IB*")=""
+12 SET ZTDTH=$HOROLOG
+13 DO ^%ZTLOAD
SET IBTSK1=$GET(ZTSK)
+14 KILL ZTSK,IO("Q")
DO HOME^%ZIS
+15 ; Queue to Print MRA portion to the default MRA printer.
+16 KILL %ZIS,ZTRTN,ZTSAVE,ZTDESC,POP
+17 IF '$$PRTCHK14
QUIT $$PRTCHK14
+18 SET IOP=$$MRAPRT
+19 if IOP=""
QUIT "0^MRA PRINTER NOT DEFINED"
+20 SET IBIFN=$$GETMRACL(IBIFN)
+21 if 'IBIFN
QUIT "0^NO MRA CLAIM TO PRINT"
+22 SET %ZIS="QN"
+23 DO ^%ZIS
IF POP
QUIT "0^MRA PRINTER NOT DEFINED CORRECTLY"
+24 ; Background re-entry point.
SET ZTRTN="PROC^IBCEMRAA"
+25 SET ZTDESC="MRA PRINT"
+26 SET ZTSAVE("IB*")=""
+27 SET ZTDTH=$HOROLOG
+28 DO ^%ZTLOAD
SET IBTSK2=$GET(ZTSK)
+29 KILL ZTSK,IO("Q")
DO HOME^%ZIS
+30 QUIT 1_"^"_IBTSK1_"^"_IBTSK2
PRINT8Q1 ; Background re-entry point.
+1 DO EOB(IBIFN)
+2 FOR IBSCAN=1:1:$ORDER(^TMP("IBCAPR",$JOB,""),-1)
Begin DoDot:1
+3 WRITE ^TMP("IBCAPR",$JOB,IBSCAN,0),!
End DoDot:1
+4 DO ^%ZISC
+5 QUIT
+6 ;
EOBPRT() ; Get EOB Printer Name
+1 QUIT $$GET1^DIQ(350.9,"1, ",8.16)
+2 ;
MRAPRT() ; Get MRA Printer Name
+1 QUIT $$GET1^DIQ(350.9,"1, ",8.19)
+2 ;
PRTCHK(ERROR) ; ; Validate ALL printer parameters.
+1 ; USAGE EXAMPLES: W $$PRTCHK^IBCAPR(.ERRMSG)," ",ERRMSG,!
+2 ; I '$$PRTCHK^IBCAPR Q
+3 NEW X,ERR14,ERR15,ERR16,ERR19,STATUS
+4 SET ERROR=""
SET STATUS=1
+5 if '$$PRTCHK14(.X,.ERR14)
SET STATUS=0
+6 if '$$PRTCHK15(.X,.ERR15)
SET STATUS=0
+7 if '$$PRTCHK16(.X,.ERR16)
SET STATUS=0
+8 if '$$PRTCHK19(.X,.ERR19)
SET STATUS=0
+9 if STATUS
QUIT 1
+10 IF ERR14'=""
SET ERROR=ERR14
+11 IF ERR15'=""
SET ERROR=ERROR_$SELECT(ERROR="":ERR15,1:", "_ERR15)
+12 IF ERR16'=""
SET ERROR=ERROR_$SELECT(ERROR="":ERR16,1:", "_ERR16)
+13 IF ERR19'=""
SET ERROR=ERROR_$SELECT(ERROR="":ERR19,1:", "_ERR19)
+14 QUIT 0
+15 ;
PRTCHK14(PRTNM,ERROR) ; Validate the CMS-1500 printer parameter.
+1 ; USAGE EXAMPLES: I $$PRTCHK14^IBCAPR(.NAME,.ERRMSG) S IOP=NAME
+2 ; I '$$PRTCHK14^IBCAPR Q
+3 NEW POP
+4 SET ERROR=""
+5 SET IOP=$$CMS1500^IBCAPR1()
SET PRTNM=IOP
+6 IF IOP=""
SET ERROR="CMS-1500 PRINTER NOT DEFINED"
QUIT "0^"_ERROR
+7 SET %ZIS="QN"
+8 DO ^%ZIS
IF POP
SET ERROR="CMS-1500 PRINTER NOT DEFINED CORRECTLY"
QUIT "0^"_ERROR
+9 QUIT 1
+10 ;
PRTCHK15(PRTNM,ERROR) ; Validate the UB-04 printer parameter.
+1 ; USAGE EXAMPLE: I $$PRTCHK15^IBCAPR(.NAME,.ERRMSG) S IOP=NAME
+2 ; I '$$PRTCHK15^IBCAPR Q
+3 NEW POP
+4 SET ERROR=""
+5 SET IOP=$$UB4PRT^IBCAPR1()
SET PRTNM=IOP
+6 IF IOP=""
SET ERROR="UB-04 PRINTER NOT DEFINED"
QUIT "0^"_ERROR
+7 SET %ZIS="QN"
+8 DO ^%ZIS
IF POP
SET ERROR="UB-04 PRINTER NOT DEFINED CORRECTLY"
QUIT "0^"_ERROR
+9 QUIT 1
+10 ;
PRTCHK16(PRTNM,ERROR) ; Validate the EOB printer parameter.
+1 ; USAGE EXAMPLE: I $$PRTCHK16^IBCAPR(.NAME,.ERRMSG) S IOP=NAME
+2 ; I '$$PRTCHK16^IBCAPR Q
+3 NEW POP
+4 SET ERROR=""
+5 SET IOP=$$EOBPRT()
SET PRTNM=IOP
+6 IF IOP=""
SET ERROR="EOB PRINTER NOT DEFINED"
QUIT "0^"_ERROR
+7 SET %ZIS="QN"
+8 DO ^%ZIS
IF POP
SET ERROR="EOB PRINTER NOT DEFINED CORRECTLY"
QUIT "0^"_ERROR
+9 QUIT 1
+10 ;
PRTCHK19(PRTNM,ERROR) ; Validate the MRA printer parameter.
+1 ; USAGE EXAMPLE: I $$PRTCHK19^IBCAPR(.NAME,.ERRMSG) S IOP=NAME
+2 ; I '$$PRTCHK19^IBCAPR Q
+3 NEW POP
+4 SET ERROR=""
+5 SET IOP=$$MRAPRT()
SET PRTNM=IOP
+6 IF IOP=""
SET ERROR="MRA PRINTER NOT DEFINED"
QUIT "0^"_ERROR
+7 SET %ZIS="QN"
+8 DO ^%ZIS
IF POP
SET ERROR="MRA PRINTER NOT DEFINED CORRECTLY"
QUIT "0^"_ERROR
+9 QUIT 1
+10 ;
GETIBIFN() ; Get Internal Claim Pointer
+1 NEW DIR,IBDA,IBIFN
SET IBIFN=""
+2 DO FULL^VALM1
+3 DO EN^VALM2($GET(XQORNOD(0)),"S")
+4 SET IBDA=$ORDER(VALMY(0))
+5 if IBDA
SET IBIFN=$PIECE($GET(^TMP("IBCECOB",$JOB,IBDA)),U,2)
+6 QUIT IBIFN
+7 ;
GETMRACL(IBIFN) ; Get MRA claim #
+1 ; Find if there was MEDICARE WNR on the bill being passed in and then get the claim associated with it.
+2 NEW IBMRASEQ,IBWNRFL,IBM1,IBMRACL
+3 FOR IBMRASEQ=1:1:3
SET IBWNRFL=$$WNRBILL^IBEFUNC(IBIFN,IBMRASEQ)
if +IBWNRFL
QUIT
+4 ; No Medicare WNR on Bill
IF '+IBWNRFL
QUIT 0
+5 SET IBM1=$GET(^DGCR(399,IBIFN,"M1"))
+6 SET IBMRACL=$PIECE(IBM1,U,4+IBMRASEQ)
+7 IF +IBMRACL
QUIT IBMRACL
+8 ;
+9 ; Since Medicare WNR does not generate a new bill # and hence may not
+10 ; point to a previous bill, this may need to grab the secondary bill
+11 IF IBMRASEQ=1
SET IBMRACL=$PIECE(IBM1,U,6)
+12 ;
+13 QUIT +IBMRACL
+14 ;
GETEOBCL(IBIFN,IBALL) ; Get all Claims associated with this one.
+1 ; If it's secondary, get primary
+2 ; If it's a tertiary, get secondary and primary
+3 ; Input: IBIFN - IEN to 399 for cliam being printed
+4 ; IBALL by reference
+5 ; Output: IBALL - Array of claim numbers which have EOBS for this claim.
+6 NEW IBCOBN,IBPRVCL,IBM1,LOOP
+7 SET IBALL(IBIFN)=""
+8 SET IBM1=$GET(^DGCR(399,IBIFN,"M1"))
+9 SET IBCOBN=$$COBN^IBCEF(IBIFN)-1
+10 if IBCOBN<1
QUIT
+11 FOR LOOP=IBCOBN:-1:1
SET IBPRVCL=$PIECE(IBM1,U,4+LOOP)
if IBPRVCL]""
SET IBALL(IBPRVCL)=""
+12 QUIT
