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

IBTOECT.m

Go to the documentation of this file.
  1. IBTOECT ;OAK/ELZ- ENHANCED CLAIMS TRACKING REPORTS ;7/15/2005
  1. ;;2.0;INTEGRATED BILLING;**317**;21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. UNREV ; Main entry for the Un-reviewed Claims for Coders Report
  1. ;
  1. N IBBEG,IBEND
  1. ;
  1. D DATE^IBCONS4 Q:'$D(IBBEG)!('$D(IBEND))
  1. Q:$$DEV("QUNREV","IB - Unreviewed Claims for Coders Report")
  1. ;
  1. QUNREV ; tasman entry
  1. U IO
  1. N IBOE,IBX,IBCT0,IBCT2,IBPNAM,IBSSN,IBOE0,IBY,IBR,IBP,IBL,IBCPT,IBMOD,IBA,IBONE,IBC,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. K ^TMP("IBTOECT",$J) S IBP=0,$P(IBL,"-",IOM)=""
  1. ;
  1. ; create sort by Outpatient Encounter then by patient name (no x-ref supports this)
  1. S IBOE=$$FMADD^XLFDT($P(IBBEG,"."),-1)+.99 F S IBOE=$O(^IBT(356,"D",IBOE)) Q:'IBOE!(IBOE>(IBEND_".9999")) S IBX=0 F S IBX=$O(^IBT(356,"D",IBOE,IBX)) Q:'IBX D
  1. . S IBCT0=$G(^IBT(356,IBX,0)),IBCT2=$G(^(2))
  1. . I $P(IBCT0,"^",4),$P(IBCT0,"^",24),'$P(IBCT0,"^",19),'$P(IBCT2,"^",3),$P(IBCT0,"^",2) S ^TMP("IBTOECT",$J,IBOE,$P(^DPT($P(IBCT0,"^",2),0),"^"),IBX)=""
  1. ;
  1. ;
  1. S IBOE=0 F S IBOE=$O(^TMP("IBTOECT",$J,IBOE)) Q:'IBOE!($D(DIRUT)) S IBPNAM="" F S IBPNAM=$O(^TMP("IBTOECT",$J,IBOE,IBPNAM)) Q:IBPNAM=""!($D(DIRUT)) S IBX=0 F S IBX=$O(^TMP("IBTOECT",$J,IBOE,IBPNAM,IBX)) Q:'IBX!($D(DIRUT)) D
  1. . S IBCT0=$G(^IBT(356,IBX,0)) Q:'IBCT0
  1. . S IBSSN=$P($G(^DPT(+$P(IBCT0,"^",2),0)),"^",9)
  1. . S IBOE0=$G(^SCE(+$P(IBCT0,"^",4),0))
  1. . S IBY=$$INSUR^IBBAPI($P(IBOE0,"^",2),+IBOE0,"RB",.IBR,"1,11,16")
  1. . S IBCPT=0,IBONE=0
  1. . ;
  1. . I 'IBP!($Y+3>IOSL) D
  1. . . I $E(IOST,1,2)="C-",IBP'=0 S DIR(0)="E" D ^DIR I $D(DIRUT) Q
  1. . . S IBP=IBP+1
  1. . . W @IOF,!,"Unreviewed Claims for Coders Report from ",$$FMTE^XLFDT(IBBEG)," to ",$$FMTE^XLFDT(IBEND),?100,$$FMTE^XLFDT(DT),?115,"Page: ",IBP
  1. . . W !,"Patient Name",?27,"SSN",?39,"Visit Date",?58,"Location",?80,"CPTs",?87,"Mod",?91,"Insurance",?113,"Exp Date",?125,"Bill",!,IBL
  1. . Q:$D(DIRUT)
  1. . W:$X ! W $E(IBPNAM,1,25),?27,IBSSN,?39,$$FMTE^XLFDT(+IBOE0,2),?58,$E($P($G(^SC(+$P(IBOE0,"^",4),0)),"^"),1,20)
  1. . S:$P(IBCT0,"^",3) IBCPT=$$GETIENS^PXAAVCPT($P(IBCT0,"^",3),.IBCPT)
  1. . S (IBC,IBCPT)=0 F S IBCPT=$O(IBCPT(IBCPT)) Q:'IBCPT D
  1. . . S IBC=IBC+1,IBONE=1
  1. . . S IBA(IBC)=$$CPT^PXAAVCPT(IBCPT)
  1. . . D:$P(IBCT0,"^",3) CPTMODIF^PXAAVCPT($P(IBCT0,"^",3),.IBMOD)
  1. . . S IBMOD=0 F S IBMOD=$O(IBMOD(1,IBMOD)) Q:'IBMOD D
  1. . . . S:'IBONE IBC=IBC+1
  1. . . . S $P(IBA(IBC),"^",2)=$G(IBMOD(1,+IBMOD,0))
  1. . . . S IBONE=0
  1. . F IBC=1:1 Q:'$D(IBA(IBC))&('$D(IBR("IBBAPI","INSUR",IBC))) D
  1. . . W:$G(IBA(IBC)) ?80,$P($$CPT^ICPTCOD(+$G(IBA(IBC)),+IBOE0),"^",2)
  1. . . W:$P($G(IBA(IBC)),"^",2) ?87,$P($$MOD^ICPTMOD(+$P($G(IBA(IBC)),"^",2),"I",+IBOE0),"^",2)
  1. . . W ?91,$E($P($G(IBR("IBBAPI","INSUR",IBC,1)),"^",2),1,20)
  1. . . W:$G(IBR("IBBAPI","INSUR",IBC,11)) ?113,$$FMTE^XLFDT($G(IBR("IBBAPI","INSUR",IBC,11)),2)
  1. . . W ?125,$P($G(IBR("IBBAPI","INSUR",IBC,16)),"^",2),!
  1. . K IBA
  1. ;
  1. ;
  1. K ^TMP("IBTOECT",$J)
  1. D ^%ZISC
  1. S:$D(ZTQUEUED) ZTREQ="@"
  1. Q
  1. ;
  1. ENR ; entered/not reviewed report
  1. ;
  1. N IBBEG,IBEND
  1. ;
  1. D DATE^IBCONS4 Q:'$D(IBBEG)!('$D(IBEND))
  1. Q:$$DEV("QENR","IB - Entered/Not Reviewed Bills Report")
  1. ;
  1. QENR ; tasked entry
  1. ;
  1. N IBDT,IB0,IBR,IBPNAM,IBX,DFN,IBP,IBL,IBPNAMS,IBCP,IBC,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBA
  1. U IO
  1. K ^TMP("IBTOECT",$J)
  1. ;
  1. ;set up some variables
  1. S IBR=$S($O(^DGCR(399.3,"B","REIMBURSABLE INS.",0)):$O(^DGCR(399.3,"B","REIMBURSABLE INS.",0)),1:8)
  1. S IBP=0,$P(IBL,"-",IOM)="",IBPNAMS=""
  1. ;
  1. ; find the bills that match criteria and sort in ^tmp
  1. S IBDT=$$FMADD^XLFDT($P(IBBEG,"."),-1)+.99 F S IBDT=$O(^DGCR(399,"D",IBDT)) Q:'IBDT!(IBDT>(IBEND_".9999")) S IBX=0 F S IBX=$O(^DGCR(399,"D",IBDT,IBX)) Q:'IBX S IB0=^DGCR(399,IBX,0) D
  1. . I $P(IB0,"^",7)=IBR,$P(IB0,"^",5)=3,$P(IB0,"^",13)=1 S ^TMP("IBTOECT",$J,$P(^DPT($P(IB0,"^",2),0),"^"),IBDT,IBX)=""
  1. ;
  1. S IBPNAM="" F S IBPNAM=$O(^TMP("IBTOECT",$J,IBPNAM)) Q:IBPNAM=""!($D(DIRUT)) S IBDT=0 F S IBDT=$O(^TMP("IBTOECT",$J,IBPNAM,IBDT)) Q:'IBDT!($D(DIRUT)) S IBX=0 F S IBX=$O(^TMP("IBTOECT",$J,IBPNAM,IBDT,IBX)) Q:'IBX!($D(DIRUT)) D
  1. . S IB0=$G(^DGCR(399,IBX,0)),DFN=$P(IB0,"^",2) Q:'DFN
  1. . D DEM^VADPT,ELIG^VADPT
  1. . I 'IBP!($Y+5>IOSL) D
  1. . . I $E(IOST,1,2)="C-",IBP'=0 S DIR(0)="E" D ^DIR I $D(DIRUT) Q
  1. . . S IBP=IBP+1
  1. . . W @IOF,!,"Entered/Not Reviewed Bills Report from ",$$FMTE^XLFDT(IBBEG)," to ",$$FMTE^XLFDT(IBEND),?100,$$FMTE^XLFDT(DT),?115,"Page: ",IBP
  1. . . W !,"Bill #",?12,"Primary Insurance",?34,"Clinic",?44,"Date",?56,"Proc",?63,"Provider",?85,"RNB",?107,"Billable Findings",!,IBL
  1. . Q:$D(DIRUT)
  1. . W:IBPNAMS'=IBPNAM !,"Name: ",$E(VADM(1),1,25),?33,"Sex: ",$P(VADM(5),"^"),?42,"SSN: ",$P(VADM(2),"^",2),?61,"Age: ",VADM(4),?70,"MT Status: ",$P(VAEL(9),"^",2)
  1. . S IBPNAMS=IBPNAM
  1. . W:$X ! W $P(IB0,"^"),?12,$E($P($G(^DIC(36,+^DGCR(399,IBX,"M"),0)),"^"),1,20)
  1. . ; IBA format: 399 sub CP ien ^ RNB (ien) (only one) ^ billable findings description (ien)
  1. . S (IBCP,IBC)=0 F S IBCP=$O(^DGCR(399,IBX,"CP",IBCP)) Q:'IBCP S IBC=IBC+1,IBA(IBC)=IBCP
  1. . S IBCT=$O(^IBT(356,"E",IBX,0)),$P(IBA(1),"^",2)=$P($G(^IBT(356,+IBCT,0)),"^",19)
  1. . S (IBCP,IBC)=0 F S IBCP=$O(^IBT(356,+IBCT,3,IBCP)) Q:'IBCP S IBC=IBC+1,$P(IBA(IBC),"^",3)=$G(^IBT(356,IBCT,3,IBCP,0))
  1. . F IBC=1:1 Q:'$D(IBA(IBC)) D
  1. . . S IBCP=$G(^DGCR(399,IBX,"CP",+IBA(IBC),0))
  1. . . W ?34,$E($P($G(^SC(+$P(IBCP,"^",7),0)),"^"),1,7)
  1. . . W ?44,$$FMTE^XLFDT($P(IBCP,"^",2),2)
  1. . . W ?56,$$EXTERNAL^DILFD(399.0304,.01,,$P(IBCP,"^"))
  1. . . W ?63,$E($P($G(^VA(200,+$P(IBCP,"^",18),0)),"^"),1,20)
  1. . . W ?85,$E($P($G(^IBE(356.8,+$P(IBA(IBC),"^",2),0)),"^"),1,20)
  1. . . W ?107,$E($P($G(^IBT(356.85,+$P(IBA(IBC),"^",3),0)),"^"),1,20),!
  1. . K IBA
  1. ;
  1. K ^TMP("IBTOECT",$J)
  1. D ^%ZISC
  1. S:$D(ZTQUEUED) ZTREQ="@"
  1. ;
  1. Q
  1. ;
  1. DEV(ZTRTN,ZTDESC) ; -- ask device
  1. N ZTSAVE,IBRTN,%ZIS,POP,ZTSK
  1. ;
  1. W !!,"*** Margin width of this output is 132 ***"
  1. W !,"*** This output should be queued ***"
  1. ;
  1. S %ZIS="QM" D ^%ZIS I POP Q 1
  1. I $D(IO("Q")) D Q 1
  1. .S ZTRTN=ZTRTN_"^IBTOECT",ZTSAVE("IB*")=""
  1. .D ^%ZTLOAD,HOME^%ZIS W "Task #",ZTSK K IO("Q")
  1. Q 0