Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCAPR2

IBCAPR2.m

Go to the documentation of this file.
  1. IBCAPR2 ;ALB/BI - PRINT EOB/MRA ;20-SEP-2010
  1. ;;2.0;INTEGRATED BILLING;**432**;21-MAR-94;Build 192
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. EN(IBIFN) ; -- main entry point for IBCAPR2
  1. N IBI,IBICNT,EOBDATE
  1. N FRMTYP,INPAT,IBALL,IBSHEOB
  1. ;
  1. S VALMBCK="R"
  1. I '$G(IBIFN),$D(VALMBG),$D(VALMLST) S IBIFN=$$GETIBIFN
  1. Q:$G(IBIFN)=""
  1. S FRMTYP=$$FT^IBCEF(IBIFN) ;Form Type
  1. S INPAT=$$INPAT^IBCEF(IBIFN) ;Inpatient Flag
  1. ;
  1. D GETEOBCL^IBCAPR(IBIFN,.IBALL) ; get all associated claims
  1. D GETEOBS(.IBALL,.IBSHEOB) ; get all eobs associated with these claims
  1. S IBICNT=$$MRACNT^IBCEMU1(IBIFN,0) ; count of MRAs
  1. 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)
  1. ;
  1. I IBICNT<1 D Q
  1. . D FULL^VALM1
  1. . W !!?5,"There is no electronic EOB for this claim."
  1. . D PAUSE^VALM1
  1. . Q
  1. I IBICNT=1 D Q
  1. .S EOBDATE=$O(^IBM(361.1,"ABD",IBIFN,"")) Q:'EOBDATE
  1. .S IBI=$O(^IBM(361.1,"ABD",IBIFN,EOBDATE,0)) Q:'IBI
  1. .I $$MRACNT^IBCEMU1(IBIFN,0) D MRAPRINT(IBI) Q
  1. .I $$MRACNT^IBCEMU1(IBIFN,1) D EOBPRINT(IBI) Q
  1. ;
  1. S IBI=$$SEL(.IBSHEOB)
  1. I +IBI=0 Q
  1. ;
  1. I $P($G(^IBM(361.1,IBI,0)),U,4)=1 D MRAPRINT(IBI) Q
  1. ;
  1. I $P($G(^IBM(361.1,IBI,0)),U,4)'=1 D EOBPRINT(IBI) Q
  1. ;
  1. Q
  1. ;
  1. EOBPRINT(IBI,IBSHEOB) ; PRINT THE REQUESTED EOB
  1. N %ZIS,POP,FULLSTOP
  1. S FULLSTOP=0
  1. S %ZIS("A")="EOB Device: "
  1. S %ZIS="QM" D ^%ZIS Q:POP
  1. I $D(IO("Q")) D G EOBQUIT
  1. . S ZTRTN="REGION0^IBCAPR2(IBI,.IBSHEOB)"
  1. . S ZTSAVE("IB*")="",ZTSAVE("IEN")="",ZTSAVE("FRMTYP")="",ZTSAVE("INPAT")="",ZTSAVE("EOBDATE")=""
  1. . S ZTDESC="IB - EOB PRINTING"
  1. . D ^%ZTLOAD
  1. . W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
  1. . K IO("Q"),ZTSK D HOME^%ZIS
  1. U IO D REGION0(IBI,.IBSHEOB)
  1. EOBQUIT ;
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. I FULLSTOP=0,$E(IOST,1,2)["C-" D PAUSE^VALM1
  1. D ^%ZISC
  1. Q
  1. ;
  1. MRAPRINT(IBI) ; PRINT THE REQUESTED MRA
  1. N IEN,%ZIS,POP
  1. N IBQUIT,IBPGN S IBQUIT=0
  1. S IEN=IBI
  1. S %ZIS("A")="MRA Device: "
  1. S %ZIS="QM" D ^%ZIS Q:POP
  1. I $D(IO("Q")) D G MRAQUIT
  1. . S ZTRTN="PRNTMRA^IBCEMRAA"
  1. . S ZTSAVE("IB*")="",ZTSAVE("IEN")="",ZTSAVE("FRMTYP")="",ZTSAVE("INPAT")="",ZTSAVE("EOBDATE")=""
  1. . S ZTDESC="IB - MRA PRINTING"
  1. . D ^%ZTLOAD
  1. . W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
  1. . K IO("Q"),ZTSK D HOME^%ZIS
  1. U IO D PRNTMRA^IBCEMRAA
  1. MRAQUIT ;
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. I $E(IOST,1,2)["C-" D PAUSE^VALM1
  1. D ^%ZISC
  1. Q
  1. ;
  1. GETIBIFN() ; Get Internal Claim Pointer
  1. N DIR,IBDA,IBIFN S IBIFN=""
  1. D FULL^VALM1
  1. D EN^VALM2($G(XQORNOD(0)),"S")
  1. S IBDA=$O(VALMY(0))
  1. S:IBDA IBIFN=$P($G(^TMP("IBCECOB",$J,IBDA)),U,2)
  1. Q IBIFN
  1. ;
  1. WRITE(IBSTR) ;
  1. W IBSTR,!
  1. Q $$PAUSE
  1. ;
  1. PAUSE() ;
  1. Q:$E(IOST,1,2)'["C-" 0
  1. I $Y>(IOSL-5) D W @IOF,*13 I $D(DIRUT)!($D(DUOUT)) S FULLSTOP=1 K DIRUT,DTOUT,DUOUT Q 1
  1. . S DIR(0)="E" D ^DIR K DIR
  1. Q 0
  1. ;
  1. ; ---------- Start of EOB Printing Section ----------
  1. 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
  1. ; Input: IBSHEOB (optional) array of EOBs to be printed
  1. I $G(IBI) D REGION1(IBI) Q
  1. S IBI=0 F S IBI=$O(IBSHEOB(IBI)) Q:'+IBI D REGION1(IBI) I $O(IBSHEOB(IBI)) W @IOF
  1. Q
  1. REGION1(IBI) ; EOB Claim Header Information
  1. N IBD,IBSTR,IBX,IBM,IBM1,IBM2,IBCA,IBCN
  1. N IBPR,IBPT,IBPY,IBST,IBTA,IBTS,IBTY,IBSPL
  1. ;
  1. ; Line 1
  1. S IBD="EOB/MRA Information"
  1. S IBSTR=$$SETLN(IBD,"",30,45) Q:$$WRITE(IBSTR)
  1. ;
  1. ; Line 2
  1. ; IBSPL = 0 if EOB represents one bill's payment
  1. ; = 1 if AR had to split the EOB between multiple bills
  1. S IBSPL=+$O(^IBM(361.1,IBI,8,0)),IBSPL=(+$O(^(IBSPL))'=IBSPL)
  1. S IBM=$G(^IBM(361.1,IBI,0))
  1. S IBTY=$P(IBM,U,4),IBTY=$S(IBTY:"MEDICARE MRA",1:"NORMAL EOB")
  1. I IBTY'["MRA",IBSPL S IBTY="A/R SPLIT/COVERS MORE THAN 1 BILL"
  1. I $P(IBM,U,13)>1,$P(IBM,U,13)<5 S IBTY=IBTY_" ("_$$EXTERNAL^DILFD(361.1,.13,,$P(IBM,U,13))_")"
  1. S IBD="EOB Type: "_IBTY,IBSTR=$$SETLN(IBD,"",5,25)
  1. S IBD="Claim Number: "_$$GET1^DIQ(399,IBIFN_", ",.01),IBSTR=$$SETLN(IBD,IBSTR,51,25)
  1. Q:$$WRITE(IBSTR)
  1. ;
  1. ; Line 3
  1. S IBCN=$P(IBM,U,14)
  1. S IBX="0.00"
  1. S IBD="ICN: "_IBCN,IBSTR=$$SETLN(IBD,"",10,30)
  1. S IBM1=$G(^IBM(361.1,IBI,1))
  1. S IBPT=$P(IBM1,U,2) ; patient responsibility 1.02 field
  1. I $P(IBM,U,4),$D(^IBM(361.1,IBI,"ERR")) S IBPT=0 ; filing error
  1. ; If MRA & UB, then calculate patient responsiblity value
  1. I $P(IBM,U,4),$$FT^IBCEF(+$P(IBM,U,1))=3 S IBPT=$$PTRESPI^IBCECOB1(IBI)
  1. S IBD="Patient Resp Amount: "_$S('IBPT:IBX,1:IBPT)
  1. S IBSTR=$$SETLN(IBD,IBSTR,44,35)
  1. Q:$$WRITE(IBSTR)
  1. ;
  1. ; Line 4
  1. S IBPY=$$GET1^DIQ(36,+$P(IBM,U,2)_", ",.01)
  1. S IBM2=$G(^IBM(361.1,IBI,2)),IBTA=$P(IBM2,U,3)
  1. ; if no Total Allowed Amount, sum up amounts on Line Level Adjustment
  1. I IBTA="" S IBTA=$$ALLOWED^IBCEMU2(IBI)
  1. S IBD="Payer Name: "_IBPY,IBSTR=$$SETLN(IBD,"",3,40)
  1. S IBD="Total Allowed Amount: "_$S('IBTA:IBX,1:IBTA)
  1. S IBSTR=$$SETLN(IBD,IBSTR,43,36)
  1. Q:$$WRITE(IBSTR)
  1. ;
  1. ; Line 5
  1. S IBTS=$P(IBM2,U,4)
  1. S IBPR=$$FMTE^XLFDT($P(IBM,U,6))
  1. S IBD="EOB Date: "_IBPR,IBSTR=$$SETLN(IBD,"",5,35)
  1. S IBD="Total Submitted Charges: "_$S('IBTS:IBX,1:IBTS)
  1. S IBSTR=$$SETLN(IBD,IBSTR,40,39)
  1. Q:$$WRITE(IBSTR)
  1. ;
  1. ; Line 6
  1. S IBD="Svc From Dt: "_$$DAT1^IBOUTL($P(IBM1,U,10))
  1. S IBSTR=$$SETLN(IBD,"",2,38)
  1. S IBD="Svc To Dt: "_$$DAT1^IBOUTL($P(IBM1,U,11))
  1. S IBSTR=$$SETLN(IBD,IBSTR,54,25)
  1. Q:$$WRITE(IBSTR)
  1. ;
  1. ; Line 7
  1. S IBCA=$P(IBM1,U)
  1. S IBST=$P(IBM,U,16),IBST=$$EXPAND^IBTRE(361.1,.16,+IBST)
  1. S IBSTR=""
  1. I IBTY["MRA" S IBD="MRA Review Status: "_IBST,IBSTR=$$SETLN(IBD,"",2,38)
  1. S IBD=$S('$G(IBSPL):" ",1:"**")_"Reported Payment Amt: "_$S('IBCA:$J(IBX,"",2),1:$J(+IBCA,"",2))
  1. S IBSTR=$$SETLN(IBD,IBSTR,41,37)
  1. Q:$$WRITE(IBSTR)
  1. ;
  1. REGION2 ; EOB MEDICARE RA Information
  1. ;
  1. I IBTY["MRA",$D(^IBM(361.1,IBI,21)) D
  1. . S IBD=$TR($J("",35)," ","-")_"Review"_$TR($J("",38)," ","-")
  1. . S IBSTR=$$SETLN(IBD,"",1,79) W IBSTR,!
  1. . S (IBST,IBCN)=0 F S IBCN=$O(^IBM(361.1,IBI,21,IBCN)) Q:'IBCN S X=$G(^(IBCN,0)) D
  1. .. S IBST=0
  1. .. S IBD="Review Date: "_$$DAT1^IBOUTL($P(X,U))
  1. .. S IBSTR=$$SETLN(IBD,"",1,30)
  1. .. S IBD="Reviewed By: "_$$GET1^DIQ(200,+$P(X,U,2)_", ",.01) ; DBIA 10060
  1. .. S IBSTR=$$SETLN(IBD,IBSTR,40,39)
  1. .. Q:$$WRITE(IBSTR)
  1. .. 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)
  1. . I 'IBST D
  1. .. S IBSTR=$$SETLN("None","",1,10)
  1. .. Q:$$WRITE(IBSTR)
  1. ;
  1. REGION3 ; EOB CLAIM and LINE level Information
  1. N Z
  1. K ^TMP("PRCA_EOB",$J)
  1. D GETEOB^IBCECSA6(IBI,2)
  1. 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
  1. . K ^TMP("PRCA_EOB",$J,IBI,Z)
  1. 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)
  1. K ^TMP("PRCA_EOB",$J)
  1. ;
  1. REGION4 ; EOB Display information about any 361.1 message storage or filing errors
  1. N Z
  1. I '$O(^IBM(361.1,IBI,"ERR",0)) Q
  1. S IBSTR=$$SETLN(" ** MESSAGE STORAGE ERRORS **","",1,79) Q:$$WRITE(IBSTR)
  1. 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)
  1. Q
  1. ;
  1. SETLN(S,V,X,L) ; -- insert text(S) into variable(V)
  1. ; S := string to insert
  1. ; V := destination string
  1. ; X := insert @ col X
  1. ; L := clear # of chars (length)
  1. Q $E(V_$J("",X-1),1,X-1)_$E(S_$J("",L),1,L)_$E(V,X+L,999)
  1. ;
  1. ; ---------- End of EOB Printing Section ----------
  1. ;
  1. EOBALL(IBIFN) ;
  1. ;
  1. ; This is passed in a claim and prints all EOBs associated with the claim.
  1. ; Only ask the device once.
  1. ; It prints EOB for current payer sequence and works backwards.
  1. ;
  1. N IBALL,IBSHEOB,IBI,Z
  1. D GETEOBCL^IBCAPR(IBIFN,.IBALL)
  1. ;
  1. D GETEOBS(.IBALL,.IBSHEOB)
  1. Q:'$D(IBSHEOB) ; nothing to print
  1. ;
  1. Q:'$$OKTOPRT()
  1. D EOBPRINT("",.IBSHEOB)
  1. Q
  1. ;
  1. 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
  1. ; user if the EOB(s) should be printed at this time too.
  1. ;
  1. NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. ;
  1. S DIR(0)="YO",DIR("B")="YES"
  1. S DIR("A",1)="There are one or more EOBs associated with this bill."
  1. S DIR("A")="Do you want to print them now"
  1. 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."
  1. W !!
  1. D ^DIR
  1. Q $S(Y:1,1:0)
  1. ;
  1. GETEOBS(IBALL,IBSHEOB) ; Get all the EOBS
  1. ; INPUT - IBALL array of claim numbers (IEN to 399)
  1. ; OUTPUT - IBSHEOB array of EOBs (IEN to 361.1)
  1. ;
  1. N IBIFN
  1. S IBIFN=0
  1. F S IBIFN=$O(IBALL(IBIFN)) Q:IBIFN="" D
  1. .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
  1. .;
  1. .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
  1. ;
  1. Q
  1. ;
  1. SEL(IBSHEOB) ; Function to display and allow user selection
  1. ; of an EOB/MRA on file in 361.1 for a sequence of bills.
  1. ;
  1. ; Input: IBSHEOB - array of internal bill numbers (required)
  1. ; ex IBSHEOB(361.1 IEN1)=""
  1. ; IBSHEOB(361.1 IEN2)=""
  1. ;
  1. ; Function Value: IEN to file 361.1 or nil if no selection made
  1. ;
  1. NEW IBEOB,EOBDATE,COUNT,IEN,IBM,INSCO,SEQ,EOBDT,EOBTYP,CLMSTAT,LIST
  1. NEW J,A,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBM1
  1. ;
  1. S IBEOB=""
  1. Q:'$D(IBSHEOB) IBEOB
  1. S IEN="",COUNT=0
  1. F S IEN=$O(IBSHEOB(IEN)) Q:'+IEN D
  1. . S IBM=$G(^IBM(361.1,IEN,0))
  1. . S INSCO=$$EXTERNAL^DILFD(361.1,.02,,$P(IBM,U,2))
  1. . S SEQ=$E($$EXTERNAL^DILFD(361.1,.15,,$P(IBM,U,15)),1)
  1. . S EOBDT=$$FMTE^XLFDT($P($P(IBM,U,6),".",1),"2Z")
  1. . S EOBTYP=$P("EOB^MRA",U,$P(IBM,U,4)+1)
  1. . S CLMSTAT=$$EXTERNAL^DILFD(361.1,.13,"",$P(IBM,U,13))
  1. . S COUNT=COUNT+1
  1. . S LIST(COUNT)=IEN_U_SEQ_U_INSCO_U_EOBDT_U_EOBTYP_U_CLMSTAT
  1. ;
  1. I 'COUNT G SELX ; no mra/eob data found
  1. ;
  1. ; Display mra/eob data
  1. S J="EOB's/MRA's"
  1. I COUNT>1 W !!,"The selected bill has multiple ",J," on file. Please choose one."
  1. W !!?7,"#",?11,"Seq",?17,"Insurance Company",?40,"EOB Date"
  1. W ?51,"Type",?57,"Claim Status"
  1. F J=1:1:COUNT S A=LIST(J) D
  1. . W !?5,$J(J,3),?11,"(",$P(A,U,2),")",?17,$E($P(A,U,3),1,20)
  1. . W ?40,$P(A,U,4),?51,$P(A,U,5),?57,$P(A,U,6)
  1. . Q
  1. ;
  1. ; User Selection
  1. W ! S DIR(0)="NO^1:"_COUNT,DIR("A")="Select an EOB/MRA"
  1. D ^DIR K DIR
  1. I 'Y G SELX ; no selection made
  1. S IBEOB=+$G(LIST(Y))
  1. ;
  1. SELX ;
  1. Q IBEOB
  1. ;
  1. PRINTOPT ; PRINT EOB OPTION
  1. N DIC,IBIFN,Y
  1. S DIC="^IBM(361.1,",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,4)='1"
  1. S DIC("W")="D EOBLST^IBCEMU1(Y)" ; modify generic lister
  1. D ^DIC
  1. I Y<1!$D(DTOUT)!$D(DUOUT) S IBQUIT=1 Q
  1. S IBI=$P(Y,U,1),IBIFN=$P(Y,U,2)
  1. D EOBPRINT(IBI) ; PRINT THE REQUESTED EOB
  1. Q