- IBCAPR2 ;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 IBCAPR2
- N IBI,IBICNT,EOBDATE
- N FRMTYP,INPAT,IBALL,IBSHEOB
- ;
- S VALMBCK="R"
- I '$G(IBIFN),$D(VALMBG),$D(VALMLST) S IBIFN=$$GETIBIFN
- Q:$G(IBIFN)=""
- S FRMTYP=$$FT^IBCEF(IBIFN) ;Form Type
- S INPAT=$$INPAT^IBCEF(IBIFN) ;Inpatient Flag
- ;
- D GETEOBCL^IBCAPR(IBIFN,.IBALL) ; get all associated claims
- D GETEOBS(.IBALL,.IBSHEOB) ; get all eobs associated with these claims
- S IBICNT=$$MRACNT^IBCEMU1(IBIFN,0) ; count of MRAs
- I $D(IBSHEOB) S IBI="",IBICNT="" F S IBI=$O(IBSHEOB(IBI)) Q:IBI="" S IBICNT=IBICNT+1 ; count of EOBs (reset counter since MRAs are in here)
- ;
- I IBICNT<1 D Q
- . D FULL^VALM1
- . W !!?5,"There is no electronic EOB for this claim."
- . D PAUSE^VALM1
- . Q
- I IBICNT=1 D Q
- .S EOBDATE=$O(^IBM(361.1,"ABD",IBIFN,"")) Q:'EOBDATE
- .S IBI=$O(^IBM(361.1,"ABD",IBIFN,EOBDATE,0)) Q:'IBI
- .I $$MRACNT^IBCEMU1(IBIFN,0) D MRAPRINT(IBI) Q
- .I $$MRACNT^IBCEMU1(IBIFN,1) D EOBPRINT(IBI) Q
- ;
- S IBI=$$SEL(.IBSHEOB)
- I +IBI=0 Q
- ;
- I $P($G(^IBM(361.1,IBI,0)),U,4)=1 D MRAPRINT(IBI) Q
- ;
- I $P($G(^IBM(361.1,IBI,0)),U,4)'=1 D EOBPRINT(IBI) Q
- ;
- Q
- ;
- EOBPRINT(IBI,IBSHEOB) ; PRINT THE REQUESTED EOB
- N %ZIS,POP,FULLSTOP
- S FULLSTOP=0
- S %ZIS("A")="EOB Device: "
- S %ZIS="QM" D ^%ZIS Q:POP
- I $D(IO("Q")) D G EOBQUIT
- . S ZTRTN="REGION0^IBCAPR2(IBI,.IBSHEOB)"
- . S ZTSAVE("IB*")="",ZTSAVE("IEN")="",ZTSAVE("FRMTYP")="",ZTSAVE("INPAT")="",ZTSAVE("EOBDATE")=""
- . S ZTDESC="IB - EOB PRINTING"
- . D ^%ZTLOAD
- . W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
- . K IO("Q"),ZTSK D HOME^%ZIS
- U IO D REGION0(IBI,.IBSHEOB)
- EOBQUIT ;
- I $D(ZTQUEUED) S ZTREQ="@"
- I FULLSTOP=0,$E(IOST,1,2)["C-" D PAUSE^VALM1
- D ^%ZISC
- Q
- ;
- MRAPRINT(IBI) ; PRINT THE REQUESTED MRA
- N IEN,%ZIS,POP
- N IBQUIT,IBPGN S IBQUIT=0
- S IEN=IBI
- S %ZIS("A")="MRA Device: "
- S %ZIS="QM" D ^%ZIS Q:POP
- I $D(IO("Q")) D G MRAQUIT
- . S ZTRTN="PRNTMRA^IBCEMRAA"
- . S ZTSAVE("IB*")="",ZTSAVE("IEN")="",ZTSAVE("FRMTYP")="",ZTSAVE("INPAT")="",ZTSAVE("EOBDATE")=""
- . S ZTDESC="IB - MRA PRINTING"
- . D ^%ZTLOAD
- . W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
- . K IO("Q"),ZTSK D HOME^%ZIS
- U IO D PRNTMRA^IBCEMRAA
- MRAQUIT ;
- I $D(ZTQUEUED) S ZTREQ="@"
- I $E(IOST,1,2)["C-" D PAUSE^VALM1
- D ^%ZISC
- Q
- ;
- 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
- ;
- WRITE(IBSTR) ;
- W IBSTR,!
- Q $$PAUSE
- ;
- PAUSE() ;
- Q:$E(IOST,1,2)'["C-" 0
- I $Y>(IOSL-5) D W @IOF,*13 I $D(DIRUT)!($D(DUOUT)) S FULLSTOP=1 K DIRUT,DTOUT,DUOUT Q 1
- . S DIR(0)="E" D ^DIR K DIR
- Q 0
- ;
- ; ---------- Start of EOB Printing Section ----------
- REGION0(IBI,IBSHEOB) ; Print one or several EOBS depending what is passed in.
- ; Input: IEN to EOB file 361.1 if only one to be printed
- ; Input: IBSHEOB (optional) array of EOBs to be printed
- I $G(IBI) D REGION1(IBI) Q
- S IBI=0 F S IBI=$O(IBSHEOB(IBI)) Q:'+IBI D REGION1(IBI) I $O(IBSHEOB(IBI)) W @IOF
- Q
- REGION1(IBI) ; EOB Claim Header Information
- N IBD,IBSTR,IBX,IBM,IBM1,IBM2,IBCA,IBCN
- N IBPR,IBPT,IBPY,IBST,IBTA,IBTS,IBTY,IBSPL
- ;
- ; Line 1
- S IBD="EOB/MRA Information"
- S IBSTR=$$SETLN(IBD,"",30,45) Q:$$WRITE(IBSTR)
- ;
- ; Line 2
- ; IBSPL = 0 if EOB represents one bill's payment
- ; = 1 if AR had to split the EOB between multiple bills
- S IBSPL=+$O(^IBM(361.1,IBI,8,0)),IBSPL=(+$O(^(IBSPL))'=IBSPL)
- 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,25)
- S IBD="Claim Number: "_$$GET1^DIQ(399,IBIFN_", ",.01),IBSTR=$$SETLN(IBD,IBSTR,51,25)
- Q:$$WRITE(IBSTR)
- ;
- ; 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)
- Q:$$WRITE(IBSTR)
- ;
- ; 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)
- Q:$$WRITE(IBSTR)
- ;
- ; 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)
- Q:$$WRITE(IBSTR)
- ;
- ; 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)
- Q:$$WRITE(IBSTR)
- ;
- ; 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)
- Q:$$WRITE(IBSTR)
- ;
- REGION2 ; EOB 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) W IBSTR,!
- . 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)
- .. Q:$$WRITE(IBSTR)
- .. 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 Q:$$WRITE(IBSTR)
- . I 'IBST D
- .. S IBSTR=$$SETLN("None","",1,10)
- .. Q:$$WRITE(IBSTR)
- ;
- REGION3 ; EOB CLAIM and LINE level Information
- N Z
- K ^TMP("PRCA_EOB",$J)
- D GETEOB^IBCECSA6(IBI,2)
- S Z="" F S Z=$O(^TMP("PRCA_EOB",$J,IBI,Z),-1) Q:Z="" Q:$TR($G(^TMP("PRCA_EOB",$J,IBI,Z))," ","")'="" D
- . K ^TMP("PRCA_EOB",$J,IBI,Z)
- 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) Q:$$WRITE(IBSTR)
- K ^TMP("PRCA_EOB",$J)
- ;
- REGION4 ; EOB 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) Q:$$WRITE(IBSTR)
- S Z=0 F S Z=$O(^IBM(361.1,IBI,"ERR",Z)) Q:'Z S IBSTR=$$SETLN($G(^(Z,0)),"",1,79) Q:$$WRITE(IBSTR)
- 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)
- ;
- ; ---------- End of EOB Printing Section ----------
- ;
- EOBALL(IBIFN) ;
- ;
- ; This is passed in a claim and prints all EOBs associated with the claim.
- ; Only ask the device once.
- ; It prints EOB for current payer sequence and works backwards.
- ;
- N IBALL,IBSHEOB,IBI,Z
- D GETEOBCL^IBCAPR(IBIFN,.IBALL)
- ;
- D GETEOBS(.IBALL,.IBSHEOB)
- Q:'$D(IBSHEOB) ; nothing to print
- ;
- Q:'$$OKTOPRT()
- D EOBPRINT("",.IBSHEOB)
- Q
- ;
- OKTOPRT() ; This procedure is called when the user is printing bills
- ; and we know that one or more EOBs exist for this bill. We ask the
- ; user if the EOB(s) should be printed at this time too.
- ;
- NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- ;
- S DIR(0)="YO",DIR("B")="YES"
- S DIR("A",1)="There are one or more EOBs associated with this bill."
- S DIR("A")="Do you want to print them now"
- S DIR("?")="Please answer Yes or No. If you answer Yes, then you will be asked to supply the output device and all EOBs associated with this bill will then be printed."
- W !!
- D ^DIR
- Q $S(Y:1,1:0)
- ;
- GETEOBS(IBALL,IBSHEOB) ; Get all the EOBS
- ; INPUT - IBALL array of claim numbers (IEN to 399)
- ; OUTPUT - IBSHEOB array of EOBs (IEN to 361.1)
- ;
- N IBIFN
- 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 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 IBSHEOB(IBI)=1 ; EOB has been reapportioned at the site
- ;
- Q
- ;
- SEL(IBSHEOB) ; Function to display and allow user selection
- ; of an EOB/MRA on file in 361.1 for a sequence of bills.
- ;
- ; Input: IBSHEOB - array of internal bill numbers (required)
- ; ex IBSHEOB(361.1 IEN1)=""
- ; IBSHEOB(361.1 IEN2)=""
- ;
- ; Function Value: IEN to file 361.1 or nil if no selection made
- ;
- NEW IBEOB,EOBDATE,COUNT,IEN,IBM,INSCO,SEQ,EOBDT,EOBTYP,CLMSTAT,LIST
- NEW J,A,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBM1
- ;
- S IBEOB=""
- Q:'$D(IBSHEOB) IBEOB
- S IEN="",COUNT=0
- F S IEN=$O(IBSHEOB(IEN)) Q:'+IEN D
- . S IBM=$G(^IBM(361.1,IEN,0))
- . S INSCO=$$EXTERNAL^DILFD(361.1,.02,,$P(IBM,U,2))
- . S SEQ=$E($$EXTERNAL^DILFD(361.1,.15,,$P(IBM,U,15)),1)
- . S EOBDT=$$FMTE^XLFDT($P($P(IBM,U,6),".",1),"2Z")
- . S EOBTYP=$P("EOB^MRA",U,$P(IBM,U,4)+1)
- . S CLMSTAT=$$EXTERNAL^DILFD(361.1,.13,"",$P(IBM,U,13))
- . S COUNT=COUNT+1
- . S LIST(COUNT)=IEN_U_SEQ_U_INSCO_U_EOBDT_U_EOBTYP_U_CLMSTAT
- ;
- I 'COUNT G SELX ; no mra/eob data found
- ;
- ; Display mra/eob data
- S J="EOB's/MRA's"
- I COUNT>1 W !!,"The selected bill has multiple ",J," on file. Please choose one."
- W !!?7,"#",?11,"Seq",?17,"Insurance Company",?40,"EOB Date"
- W ?51,"Type",?57,"Claim Status"
- F J=1:1:COUNT S A=LIST(J) D
- . W !?5,$J(J,3),?11,"(",$P(A,U,2),")",?17,$E($P(A,U,3),1,20)
- . W ?40,$P(A,U,4),?51,$P(A,U,5),?57,$P(A,U,6)
- . Q
- ;
- ; User Selection
- W ! S DIR(0)="NO^1:"_COUNT,DIR("A")="Select an EOB/MRA"
- D ^DIR K DIR
- I 'Y G SELX ; no selection made
- S IBEOB=+$G(LIST(Y))
- ;
- SELX ;
- Q IBEOB
- ;
- PRINTOPT ; PRINT EOB OPTION
- N DIC,IBIFN,Y
- 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
- S IBI=$P(Y,U,1),IBIFN=$P(Y,U,2)
- D EOBPRINT(IBI) ; PRINT THE REQUESTED EOB
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCAPR2 10981 printed Feb 18, 2025@23:35:03 Page 2
- IBCAPR2 ;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 IBCAPR2
- +1 NEW IBI,IBICNT,EOBDATE
- +2 NEW FRMTYP,INPAT,IBALL,IBSHEOB
- +3 ;
- +4 SET VALMBCK="R"
- +5 IF '$GET(IBIFN)
- IF $DATA(VALMBG)
- IF $DATA(VALMLST)
- SET IBIFN=$$GETIBIFN
- +6 if $GET(IBIFN)=""
- QUIT
- +7 ;Form Type
- SET FRMTYP=$$FT^IBCEF(IBIFN)
- +8 ;Inpatient Flag
- SET INPAT=$$INPAT^IBCEF(IBIFN)
- +9 ;
- +10 ; get all associated claims
- DO GETEOBCL^IBCAPR(IBIFN,.IBALL)
- +11 ; get all eobs associated with these claims
- DO GETEOBS(.IBALL,.IBSHEOB)
- +12 ; count of MRAs
- SET IBICNT=$$MRACNT^IBCEMU1(IBIFN,0)
- +13 ; count of EOBs (reset counter since MRAs are in here)
- IF $DATA(IBSHEOB)
- SET IBI=""
- SET IBICNT=""
- FOR
- SET IBI=$ORDER(IBSHEOB(IBI))
- if IBI=""
- QUIT
- SET IBICNT=IBICNT+1
- +14 ;
- +15 IF IBICNT<1
- Begin DoDot:1
- +16 DO FULL^VALM1
- +17 WRITE !!?5,"There is no electronic EOB for this claim."
- +18 DO PAUSE^VALM1
- +19 QUIT
- End DoDot:1
- QUIT
- +20 IF IBICNT=1
- Begin DoDot:1
- +21 SET EOBDATE=$ORDER(^IBM(361.1,"ABD",IBIFN,""))
- if 'EOBDATE
- QUIT
- +22 SET IBI=$ORDER(^IBM(361.1,"ABD",IBIFN,EOBDATE,0))
- if 'IBI
- QUIT
- +23 IF $$MRACNT^IBCEMU1(IBIFN,0)
- DO MRAPRINT(IBI)
- QUIT
- +24 IF $$MRACNT^IBCEMU1(IBIFN,1)
- DO EOBPRINT(IBI)
- QUIT
- End DoDot:1
- QUIT
- +25 ;
- +26 SET IBI=$$SEL(.IBSHEOB)
- +27 IF +IBI=0
- QUIT
- +28 ;
- +29 IF $PIECE($GET(^IBM(361.1,IBI,0)),U,4)=1
- DO MRAPRINT(IBI)
- QUIT
- +30 ;
- +31 IF $PIECE($GET(^IBM(361.1,IBI,0)),U,4)'=1
- DO EOBPRINT(IBI)
- QUIT
- +32 ;
- +33 QUIT
- +34 ;
- EOBPRINT(IBI,IBSHEOB) ; PRINT THE REQUESTED EOB
- +1 NEW %ZIS,POP,FULLSTOP
- +2 SET FULLSTOP=0
- +3 SET %ZIS("A")="EOB Device: "
- +4 SET %ZIS="QM"
- DO ^%ZIS
- if POP
- QUIT
- +5 IF $DATA(IO("Q"))
- Begin DoDot:1
- +6 SET ZTRTN="REGION0^IBCAPR2(IBI,.IBSHEOB)"
- +7 SET ZTSAVE("IB*")=""
- SET ZTSAVE("IEN")=""
- SET ZTSAVE("FRMTYP")=""
- SET ZTSAVE("INPAT")=""
- SET ZTSAVE("EOBDATE")=""
- +8 SET ZTDESC="IB - EOB PRINTING"
- +9 DO ^%ZTLOAD
- +10 WRITE !!,$SELECT($DATA(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
- +11 KILL IO("Q"),ZTSK
- DO HOME^%ZIS
- End DoDot:1
- GOTO EOBQUIT
- +12 USE IO
- DO REGION0(IBI,.IBSHEOB)
- EOBQUIT ;
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 IF FULLSTOP=0
- IF $EXTRACT(IOST,1,2)["C-"
- DO PAUSE^VALM1
- +3 DO ^%ZISC
- +4 QUIT
- +5 ;
- MRAPRINT(IBI) ; PRINT THE REQUESTED MRA
- +1 NEW IEN,%ZIS,POP
- +2 NEW IBQUIT,IBPGN
- SET IBQUIT=0
- +3 SET IEN=IBI
- +4 SET %ZIS("A")="MRA Device: "
- +5 SET %ZIS="QM"
- DO ^%ZIS
- if POP
- QUIT
- +6 IF $DATA(IO("Q"))
- Begin DoDot:1
- +7 SET ZTRTN="PRNTMRA^IBCEMRAA"
- +8 SET ZTSAVE("IB*")=""
- SET ZTSAVE("IEN")=""
- SET ZTSAVE("FRMTYP")=""
- SET ZTSAVE("INPAT")=""
- SET ZTSAVE("EOBDATE")=""
- +9 SET ZTDESC="IB - MRA PRINTING"
- +10 DO ^%ZTLOAD
- +11 WRITE !!,$SELECT($DATA(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
- +12 KILL IO("Q"),ZTSK
- DO HOME^%ZIS
- End DoDot:1
- GOTO MRAQUIT
- +13 USE IO
- DO PRNTMRA^IBCEMRAA
- MRAQUIT ;
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 IF $EXTRACT(IOST,1,2)["C-"
- DO PAUSE^VALM1
- +3 DO ^%ZISC
- +4 QUIT
- +5 ;
- 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 ;
- WRITE(IBSTR) ;
- +1 WRITE IBSTR,!
- +2 QUIT $$PAUSE
- +3 ;
- PAUSE() ;
- +1 if $EXTRACT(IOST,1,2)'["C-"
- QUIT 0
- +2 IF $Y>(IOSL-5)
- Begin DoDot:1
- +3 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- End DoDot:1
- WRITE @IOF,*13
- IF $DATA(DIRUT)!($DATA(DUOUT))
- SET FULLSTOP=1
- KILL DIRUT,DTOUT,DUOUT
- QUIT 1
- +4 QUIT 0
- +5 ;
- +6 ; ---------- Start of EOB Printing Section ----------
- REGION0(IBI,IBSHEOB) ; Print one or several EOBS depending what is passed in.
- +1 ; Input: IEN to EOB file 361.1 if only one to be printed
- +2 ; Input: IBSHEOB (optional) array of EOBs to be printed
- +3 IF $GET(IBI)
- DO REGION1(IBI)
- QUIT
- +4 SET IBI=0
- FOR
- SET IBI=$ORDER(IBSHEOB(IBI))
- if '+IBI
- QUIT
- DO REGION1(IBI)
- IF $ORDER(IBSHEOB(IBI))
- WRITE @IOF
- +5 QUIT
- REGION1(IBI) ; EOB Claim Header Information
- +1 NEW IBD,IBSTR,IBX,IBM,IBM1,IBM2,IBCA,IBCN
- +2 NEW IBPR,IBPT,IBPY,IBST,IBTA,IBTS,IBTY,IBSPL
- +3 ;
- +4 ; Line 1
- +5 SET IBD="EOB/MRA Information"
- +6 SET IBSTR=$$SETLN(IBD,"",30,45)
- if $$WRITE(IBSTR)
- QUIT
- +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 SET IBSPL=+$ORDER(^IBM(361.1,IBI,8,0))
- SET IBSPL=(+$ORDER(^(IBSPL))'=IBSPL)
- +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,25)
- +17 SET IBD="Claim Number: "_$$GET1^DIQ(399,IBIFN_", ",.01)
- SET IBSTR=$$SETLN(IBD,IBSTR,51,25)
- +18 if $$WRITE(IBSTR)
- QUIT
- +19 ;
- +20 ; Line 3
- +21 SET IBCN=$PIECE(IBM,U,14)
- +22 SET IBX="0.00"
- +23 SET IBD="ICN: "_IBCN
- SET IBSTR=$$SETLN(IBD,"",10,30)
- +24 SET IBM1=$GET(^IBM(361.1,IBI,1))
- +25 ; patient responsibility 1.02 field
- SET IBPT=$PIECE(IBM1,U,2)
- +26 ; filing error
- IF $PIECE(IBM,U,4)
- IF $DATA(^IBM(361.1,IBI,"ERR"))
- SET IBPT=0
- +27 ; If MRA & UB, then calculate patient responsiblity value
- +28 IF $PIECE(IBM,U,4)
- IF $$FT^IBCEF(+$PIECE(IBM,U,1))=3
- SET IBPT=$$PTRESPI^IBCECOB1(IBI)
- +29 SET IBD="Patient Resp Amount: "_$SELECT('IBPT:IBX,1:IBPT)
- +30 SET IBSTR=$$SETLN(IBD,IBSTR,44,35)
- +31 if $$WRITE(IBSTR)
- QUIT
- +32 ;
- +33 ; Line 4
- +34 SET IBPY=$$GET1^DIQ(36,+$PIECE(IBM,U,2)_", ",.01)
- +35 SET IBM2=$GET(^IBM(361.1,IBI,2))
- SET IBTA=$PIECE(IBM2,U,3)
- +36 ; if no Total Allowed Amount, sum up amounts on Line Level Adjustment
- +37 IF IBTA=""
- SET IBTA=$$ALLOWED^IBCEMU2(IBI)
- +38 SET IBD="Payer Name: "_IBPY
- SET IBSTR=$$SETLN(IBD,"",3,40)
- +39 SET IBD="Total Allowed Amount: "_$SELECT('IBTA:IBX,1:IBTA)
- +40 SET IBSTR=$$SETLN(IBD,IBSTR,43,36)
- +41 if $$WRITE(IBSTR)
- QUIT
- +42 ;
- +43 ; Line 5
- +44 SET IBTS=$PIECE(IBM2,U,4)
- +45 SET IBPR=$$FMTE^XLFDT($PIECE(IBM,U,6))
- +46 SET IBD="EOB Date: "_IBPR
- SET IBSTR=$$SETLN(IBD,"",5,35)
- +47 SET IBD="Total Submitted Charges: "_$SELECT('IBTS:IBX,1:IBTS)
- +48 SET IBSTR=$$SETLN(IBD,IBSTR,40,39)
- +49 if $$WRITE(IBSTR)
- QUIT
- +50 ;
- +51 ; Line 6
- +52 SET IBD="Svc From Dt: "_$$DAT1^IBOUTL($PIECE(IBM1,U,10))
- +53 SET IBSTR=$$SETLN(IBD,"",2,38)
- +54 SET IBD="Svc To Dt: "_$$DAT1^IBOUTL($PIECE(IBM1,U,11))
- +55 SET IBSTR=$$SETLN(IBD,IBSTR,54,25)
- +56 if $$WRITE(IBSTR)
- QUIT
- +57 ;
- +58 ; Line 7
- +59 SET IBCA=$PIECE(IBM1,U)
- +60 SET IBST=$PIECE(IBM,U,16)
- SET IBST=$$EXPAND^IBTRE(361.1,.16,+IBST)
- +61 SET IBSTR=""
- +62 IF IBTY["MRA"
- SET IBD="MRA Review Status: "_IBST
- SET IBSTR=$$SETLN(IBD,"",2,38)
- +63 SET IBD=$SELECT('$GET(IBSPL):" ",1:"**")_"Reported Payment Amt: "_$SELECT('IBCA:$JUSTIFY(IBX,"",2),1:$JUSTIFY(+IBCA,"",2))
- +64 SET IBSTR=$$SETLN(IBD,IBSTR,41,37)
- +65 if $$WRITE(IBSTR)
- QUIT
- +66 ;
- REGION2 ; EOB 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)
- WRITE IBSTR,!
- +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 if $$WRITE(IBSTR)
- QUIT
- +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
- if $$WRITE(IBSTR)
- QUIT
- End DoDot:2
- +13 IF 'IBST
- Begin DoDot:2
- +14 SET IBSTR=$$SETLN("None","",1,10)
- +15 if $$WRITE(IBSTR)
- QUIT
- End DoDot:2
- End DoDot:1
- +16 ;
- REGION3 ; EOB CLAIM and LINE level Information
- +1 NEW Z
- +2 KILL ^TMP("PRCA_EOB",$JOB)
- +3 DO GETEOB^IBCECSA6(IBI,2)
- +4 SET Z=""
- FOR
- SET Z=$ORDER(^TMP("PRCA_EOB",$JOB,IBI,Z),-1)
- if Z=""
- QUIT
- if $TRANSLATE($GET(^TMP("PRCA_EOB",$JOB,IBI,Z))," ","")'=""
- QUIT
- Begin DoDot:1
- +5 KILL ^TMP("PRCA_EOB",$JOB,IBI,Z)
- End DoDot:1
- +6 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)
- if $$WRITE(IBSTR)
- QUIT
- +7 KILL ^TMP("PRCA_EOB",$JOB)
- +8 ;
- REGION4 ; EOB 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)
- if $$WRITE(IBSTR)
- QUIT
- +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)
- if $$WRITE(IBSTR)
- QUIT
- +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 ;
- +7 ; ---------- End of EOB Printing Section ----------
- +8 ;
- EOBALL(IBIFN) ;
- +1 ;
- +2 ; This is passed in a claim and prints all EOBs associated with the claim.
- +3 ; Only ask the device once.
- +4 ; It prints EOB for current payer sequence and works backwards.
- +5 ;
- +6 NEW IBALL,IBSHEOB,IBI,Z
- +7 DO GETEOBCL^IBCAPR(IBIFN,.IBALL)
- +8 ;
- +9 DO GETEOBS(.IBALL,.IBSHEOB)
- +10 ; nothing to print
- if '$DATA(IBSHEOB)
- QUIT
- +11 ;
- +12 if '$$OKTOPRT()
- QUIT
- +13 DO EOBPRINT("",.IBSHEOB)
- +14 QUIT
- +15 ;
- OKTOPRT() ; This procedure is called when the user is printing bills
- +1 ; and we know that one or more EOBs exist for this bill. We ask the
- +2 ; user if the EOB(s) should be printed at this time too.
- +3 ;
- +4 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- +5 ;
- +6 SET DIR(0)="YO"
- SET DIR("B")="YES"
- +7 SET DIR("A",1)="There are one or more EOBs associated with this bill."
- +8 SET DIR("A")="Do you want to print them now"
- +9 SET DIR("?")="Please answer Yes or No. If you answer Yes, then you will be asked to supply the output device and all EOBs associated with this bill will then be printed."
- +10 WRITE !!
- +11 DO ^DIR
- +12 QUIT $SELECT(Y:1,1:0)
- +13 ;
- GETEOBS(IBALL,IBSHEOB) ; Get all the EOBS
- +1 ; INPUT - IBALL array of claim numbers (IEN to 399)
- +2 ; OUTPUT - IBSHEOB array of EOBs (IEN to 361.1)
- +3 ;
- +4 NEW IBIFN
- +5 SET IBIFN=0
- +6 FOR
- SET IBIFN=$ORDER(IBALL(IBIFN))
- if IBIFN=""
- QUIT
- Begin DoDot:1
- +7 ; 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 IBSHEOB(IBI)=0
- +8 ;
- +9 ; EOB has been reapportioned at the site
- SET IBI=0
- FOR
- SET IBI=$ORDER(^IBM(361.1,"C",IBIFN,IBI))
- if 'IBI
- QUIT
- SET IBSHEOB(IBI)=1
- End DoDot:1
- +10 ;
- +11 QUIT
- +12 ;
- SEL(IBSHEOB) ; Function to display and allow user selection
- +1 ; of an EOB/MRA on file in 361.1 for a sequence of bills.
- +2 ;
- +3 ; Input: IBSHEOB - array of internal bill numbers (required)
- +4 ; ex IBSHEOB(361.1 IEN1)=""
- +5 ; IBSHEOB(361.1 IEN2)=""
- +6 ;
- +7 ; Function Value: IEN to file 361.1 or nil if no selection made
- +8 ;
- +9 NEW IBEOB,EOBDATE,COUNT,IEN,IBM,INSCO,SEQ,EOBDT,EOBTYP,CLMSTAT,LIST
- +10 NEW J,A,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBM1
- +11 ;
- +12 SET IBEOB=""
- +13 if '$DATA(IBSHEOB)
- QUIT IBEOB
- +14 SET IEN=""
- SET COUNT=0
- +15 FOR
- SET IEN=$ORDER(IBSHEOB(IEN))
- if '+IEN
- QUIT
- Begin DoDot:1
- +16 SET IBM=$GET(^IBM(361.1,IEN,0))
- +17 SET INSCO=$$EXTERNAL^DILFD(361.1,.02,,$PIECE(IBM,U,2))
- +18 SET SEQ=$EXTRACT($$EXTERNAL^DILFD(361.1,.15,,$PIECE(IBM,U,15)),1)
- +19 SET EOBDT=$$FMTE^XLFDT($PIECE($PIECE(IBM,U,6),".",1),"2Z")
- +20 SET EOBTYP=$PIECE("EOB^MRA",U,$PIECE(IBM,U,4)+1)
- +21 SET CLMSTAT=$$EXTERNAL^DILFD(361.1,.13,"",$PIECE(IBM,U,13))
- +22 SET COUNT=COUNT+1
- +23 SET LIST(COUNT)=IEN_U_SEQ_U_INSCO_U_EOBDT_U_EOBTYP_U_CLMSTAT
- End DoDot:1
- +24 ;
- +25 ; no mra/eob data found
- IF 'COUNT
- GOTO SELX
- +26 ;
- +27 ; Display mra/eob data
- +28 SET J="EOB's/MRA's"
- +29 IF COUNT>1
- WRITE !!,"The selected bill has multiple ",J," on file. Please choose one."
- +30 WRITE !!?7,"#",?11,"Seq",?17,"Insurance Company",?40,"EOB Date"
- +31 WRITE ?51,"Type",?57,"Claim Status"
- +32 FOR J=1:1:COUNT
- SET A=LIST(J)
- Begin DoDot:1
- +33 WRITE !?5,$JUSTIFY(J,3),?11,"(",$PIECE(A,U,2),")",?17,$EXTRACT($PIECE(A,U,3),1,20)
- +34 WRITE ?40,$PIECE(A,U,4),?51,$PIECE(A,U,5),?57,$PIECE(A,U,6)
- +35 QUIT
- End DoDot:1
- +36 ;
- +37 ; User Selection
- +38 WRITE !
- SET DIR(0)="NO^1:"_COUNT
- SET DIR("A")="Select an EOB/MRA"
- +39 DO ^DIR
- KILL DIR
- +40 ; no selection made
- IF 'Y
- GOTO SELX
- +41 SET IBEOB=+$GET(LIST(Y))
- +42 ;
- SELX ;
- +1 QUIT IBEOB
- +2 ;
- PRINTOPT ; PRINT EOB OPTION
- +1 NEW DIC,IBIFN,Y
- +2 SET DIC="^IBM(361.1,"
- SET DIC(0)="AEMQ"
- SET DIC("S")="I $P(^(0),U,4)='1"
- +3 ; modify generic lister
- SET DIC("W")="D EOBLST^IBCEMU1(Y)"
- +4 DO ^DIC
- +5 IF Y<1!$DATA(DTOUT)!$DATA(DUOUT)
- SET IBQUIT=1
- QUIT
- +6 SET IBI=$PIECE(Y,U,1)
- SET IBIFN=$PIECE(Y,U,2)
- +7 ; PRINT THE REQUESTED EOB
- DO EOBPRINT(IBI)
- +8 QUIT