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

IBOBL.m

Go to the documentation of this file.
  1. IBOBL ;ALB/ARH - LIST ALL BILLS FOR AN EPISODE OF CARE ; 25-MAY-90
  1. ;;2.0;INTEGRATED BILLING;**80,106**;21-MAR-94
  1. ;
  1. EN ;get parameters then run the report
  1. D HOME^%ZIS N IBASK,IBCANC,IBX W !!,"Episode of Care Bill List:",!,"--------------------------"
  1. W !,"Enter a Bill Number to get a list of all bills that match the selected bill's",!,"event date or any of it's outpatient visit dates."
  1. W !,"Enter a Patient Name and Episode Date to get a list of all bills for a patient",!,"that have either that date as the event date or as an outpatient visit date."
  1. W !,"This report also includes bills related as continuing episodes of care."
  1. ;
  1. S IBASK=$$PB^IBJTU2 Q:IBASK'>0 W !
  1. I +IBASK=1 S IBX=$$GETDT^IBCRU1("","Episode Date") Q:IBX'?7N S IBASK=IBASK_U_IBX W !
  1. S IBADDCPT=$$CPT Q:IBADDCPT<0
  1. S IBCANC=$$CANC Q:IBCANC<0 W !
  1. ;
  1. DEV ;get the device
  1. W !,"Report requires 132 columns."
  1. S %ZIS="QM",%ZIS("A")="OUTPUT DEVICE: " D ^%ZIS G:POP EXIT
  1. I $D(IO("Q")) S ZTRTN="RPT^IBOBL",ZTDESC="Episode of Care Bill List",ZTSAVE("IB*")="" D ^%ZTLOAD K IO("Q") G EXIT
  1. U IO
  1. ;
  1. RPT ;find, save, and print the data that satisfies the search parameters
  1. ;entry point for tasked jobs
  1. ;
  1. K ^TMP($J,"IBOBL") I '$G(IBASK) G EXIT
  1. ;
  1. D FIND
  1. D PRINT
  1. ;
  1. EXIT ;clean up and quit
  1. K ^TMP($J,"IBOBL"),IBASK,IBADDCPT,IBCANC,IBX Q:$D(ZTQUEUED)
  1. D ^%ZISC
  1. Q
  1. ;
  1. FIND ; compile list of all related bills
  1. N IBIFN,IB0,DFN,IBEPDT,IBX
  1. ;
  1. ; compile list of related bills based on event date and opt visit dates of selected bill
  1. I +IBASK=2 S IBIFN=+$P(IBASK,U,2),IB0=$G(^DGCR(399,IBIFN,0)) D
  1. . S DFN=$P(IB0,U,2),IBEPDT=$P(IB0,U,3) D FIND1(DFN,IBEPDT)
  1. . S IBX=0 F S IBX=$O(^DGCR(399,+IBIFN,"OP",IBX)) Q:'IBX D
  1. .. S IBEPDT=+$G(^DGCR(399,+IBIFN,"OP",IBX,0)) Q:'IBEPDT D FIND1(DFN,IBEPDT)
  1. ;
  1. ; compile list of related bills based on selected patient and episode date
  1. I +IBASK=1 S DFN=$P(IBASK,U,2),IBEPDT=$P(IBASK,U,3) D FIND1(DFN,IBEPDT)
  1. ;
  1. D FIND2 ; compile list of bills based on Primary Bill link with bills already found
  1. Q
  1. ;
  1. FIND1(DFN,IBEPDT) ; find all bills for a patient with a specific event date or opt visit date
  1. N IBX,IBIFN,IBDT S IBEPDT=IBEPDT\1
  1. ;
  1. ; find all bills for patient with episode date as outpatient visit date
  1. S IBDT=IBEPDT-.0001 F S IBDT=$O(^DGCR(399,"AOPV",DFN,IBDT)) Q:((IBDT\1)'=IBEPDT) D
  1. . S IBIFN=0 F S IBIFN=$O(^DGCR(399,"AOPV",DFN,IBDT,IBIFN)) Q:'IBIFN D
  1. .. S IBX=$G(^DGCR(399,IBIFN,0)) I IBX="" Q
  1. .. S ^TMP($J,"IBOBL","BILL",IBIFN)=""
  1. .. I +$P(IBX,U,17) S ^TMP($J,"IBOBL","BILL",+$P(IBX,U,17))=""
  1. ;
  1. ; find all bills for patient with episode date as Event Date
  1. S IBDT=IBEPDT-.00001 F S IBDT=$O(^DGCR(399,"D",IBDT)) Q:((IBDT\1)'=IBEPDT) D
  1. . S IBIFN=0 F S IBIFN=$O(^DGCR(399,"D",IBDT,IBIFN)) Q:'IBIFN D
  1. .. S IBX=$G(^DGCR(399,IBIFN,0)) I $P(IBX,U,2)'=DFN Q
  1. .. S ^TMP($J,"IBOBL","BILL",IBIFN)=""
  1. .. I +$P(IBX,U,17) S ^TMP($J,"IBOBL","BILL",+$P(IBX,U,17))=""
  1. ;
  1. Q
  1. ;
  1. FIND2 ; compile list of related bills based on Primary Bill of bills already found
  1. N IBBILL,IBIFN,IBX
  1. S IBBILL=0 F S IBBILL=$O(^TMP($J,"IBOBL","BILL",IBBILL)) Q:'IBBILL D
  1. . S IBIFN=0 F S IBIFN=$O(^DGCR(399,"AC",IBBILL,IBIFN)) Q:'IBIFN D
  1. .. S IBX=$G(^DGCR(399,IBIFN,0)) I IBX="" Q
  1. .. S ^TMP($J,"IBOBL","BILL",IBIFN)=""
  1. Q
  1. ;
  1. PRINT ;print the report from the temp sort file to the appropriate device
  1. N IBPGN,IBQUIT,IBLN,IBHDR1,IBHDR2,IBIFN
  1. S IBPGN=0,IBQUIT=0 D HDRLNS,HDR Q:IBQUIT
  1. ;
  1. S IBIFN=0 F S IBIFN=$O(^TMP($J,"IBOBL","BILL",IBIFN)) Q:'IBIFN D Q:$$LNCHK(2)
  1. . I '$G(IBCANC),$P($G(^DGCR(399,+IBIFN,0)),U,13)=7 Q
  1. . D PRTLN(IBIFN,IBADDCPT)
  1. ;
  1. I 'IBQUIT D PAUSE
  1. Q
  1. ;
  1. PRTLN(IBIFN,IBADDCPT) ; print one bill with all it's CPTs
  1. N IB0,IBU,IBM,IBMP,IBX,IBCPT S IBLN=IBLN+1
  1. S IB0=$G(^DGCR(399,+$G(IBIFN),0)) Q:IB0="" S IBU=$G(^DGCR(399,IBIFN,"U"))
  1. S IBM=$G(^DGCR(399,IBIFN,"M")),IBMP=$G(^DGCR(399,IBIFN,"MP"))
  1. W !,$P(IB0,U,1),?12,$P($G(^DGCR(399.3,+$P(IB0,U,7),0)),U,4) S IBX=$P(IB0,U,5)
  1. W ?24,$S(IBX=1:"INPT",IBX=2:"INPT-H",IBX=3:"OPT",IBX=4:"OPT-H",1:"") S IBX=$P(IB0,U,27)
  1. W ?32,$S(IBX=1:"INST",IBX=2:"PROF",1:"")
  1. W ?39,$$DATE(+$P(IB0,U,3)),?49,$$DATE(+IBU),?59,$$DATE(+$P(IBU,U,2))
  1. W ?70,$P($$ARSTATA^IBJTU4(IBIFN),U,2) S IBX=$P(IB0,U,21)
  1. W ?75,$S(IBX="P":"PRIM",IBX="S":"SEC",IBX="T":"TER",IBX="A":"PAT",1:"") S IBX=$P(IB0,U,11)
  1. W ?82,$E($S(IBX="i":$P($G(^DIC(36,+IBMP,0)),U,1),IBX="o":$P($G(^DIC(4,+$P(IBM,U,11),0)),U,1),IBX="p":$P($G(^DPT(+$P(IB0,U,2),0)),U,1),1:""),1,23)
  1. W ?107,$J(+$P($$BILL^RCJIBFN2(IBIFN),U,1),10,2)
  1. ;
  1. I 'IBADDCPT W ! Q
  1. ;
  1. S IBX=0 F S IBX=$O(^DGCR(399,IBIFN,"CP",IBX)) Q:'IBX D
  1. . S IBCPT=$P($G(^DGCR(399,IBIFN,"CP",IBX,0)),U,1) I IBCPT["ICPT" S IBCPT(+IBCPT)=+$G(IBCPT(+IBCPT))+1
  1. ;
  1. S IBCPT="" F S IBCPT=$O(IBCPT(IBCPT)) Q:'IBCPT D Q:$$LNCHK(1)
  1. . S IBX=+IBCPT(IBCPT) W ?120,$P($$CPT^ICPTCOD(+IBCPT),U,2),?127,$S(IBX'=1:"("_IBX_")",1:""),! S IBLN=IBLN+1
  1. ;
  1. Q
  1. ;
  1. HDR ;print the report header
  1. N IBNOW,IBI
  1. S IBQUIT=$$STOP Q:IBQUIT S IBPGN=IBPGN+1,IBLN=7
  1. S IBNOW=$$FMTE^XLFDT($$NOW^XLFDT),IBNOW=$P(IBNOW,"@",1)_" "_$P($P(IBNOW,"@",2),":",1,2)
  1. I IBPGN>1!($E(IOST,1,2)["C-") W @IOF
  1. ;
  1. W !,IBHDR1,?(IOM-30),IBNOW,?(IOM-8),"PAGE ",IBPGN,!,IBHDR2
  1. W !,"BILL #",?12,"RATE",?24,"CLASSIFICATION",?39,"EVENT",?49,"FROM",?59,"TO",?70,"AR",?75,"COB",?82,"PAYER",?112,"TOTAL",?120,"CPT'S",!
  1. S IBI="",$P(IBI,"-",IOM+1)="" W IBI
  1. W !
  1. Q
  1. ;
  1. HDRLNS ; set up header lines
  1. N DFN,IBX S DFN=0
  1. S IBHDR1="EPISODE OF CARE BILL LIST FOR "
  1. I +IBASK=1 S IBHDR1=IBHDR1_$P($G(^DPT(+$P(IBASK,U,2),0)),U,1)_" ON "_$$DATE(+$P(IBASK,U,3)) S DFN=+$P(IBASK,U,2)
  1. I +IBASK=2 S IBX=$G(^DGCR(399,+$P(IBASK,U,2),0)),IBHDR1=IBHDR1_$P(IBX,U,1) S DFN=+$P(IBX,U,2)
  1. S IBX=$G(^DPT(DFN,0)) S IBHDR2=$P(IBX,U,1)_$J("",10)_$E(IBX)_$P($$PT^IBEFUNC(DFN),U,3)_$J("",10)_"DOB: "_$$DATE($P(IBX,U,3))
  1. Q
  1. ;
  1. DATE(X) ;
  1. Q $E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
  1. ;
  1. LNCHK(LNS) ; check if new page is needed
  1. I 'IBQUIT,IBLN>(IOSL-LNS) D PAUSE I 'IBQUIT D HDR
  1. Q IBQUIT
  1. ;
  1. PAUSE ;pause at end of screen if beeing displayed on a terminal
  1. Q:$E(IOST,1,2)'["C-" N DIR,DUOUT,DTOUT,DIRUT
  1. S DIR(0)="E" D ^DIR K DIR
  1. I $D(DUOUT)!($D(DIRUT)) S IBQUIT=1
  1. Q
  1. ;
  1. STOP() ;determine if user has requested the queued report to stop
  1. I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPGN) W !,"***TASK STOPPED BY USER***"
  1. Q +$G(ZTSTOP)
  1. ;
  1. CPT() ; return true if include bills CPT procedures
  1. N IBX,DIR,DTOUT,DUOUT,DIRUT,X,Y S IBX=0
  1. S DIR("?")="Enter either 'Y' or 'N'. Enter 'Y' if you want the CPT procedures for each bill included in the report."
  1. S DIR("A")="Include CPT Procedures",DIR(0)="Y",DIR("B")="No" D ^DIR K DIR S:Y=1 IBX=1 I $D(DIRUT) S IBX=-1
  1. Q IBX
  1. ;
  1. CANC() ; return true if include canceled bills
  1. N IBX,DIR,DTOUT,DUOUT,DIRUT,X,Y S IBX=0
  1. S DIR("?")="Enter either 'Y' or 'N'. Enter 'Y' if you want cancelled bills included in the report."
  1. S DIR("A")="Include Cancelled Bills",DIR(0)="Y",DIR("B")="No" D ^DIR K DIR S:Y=1 IBX=1 I $D(DIRUT) S IBX=-1
  1. Q IBX