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

IBJDU1.m

Go to the documentation of this file.
  1. IBJDU1 ;ALB/CPM - UTILIZATION WORKLOAD REPORT ; 24-DEC-96
  1. ;;Version 2.0 ; INTEGRATED BILLING ;**69**; 21-MAR-94
  1. ;
  1. EN ; Option entry point.
  1. ;
  1. W !!,"This report provides a measure of the number of Insurance Reviews"
  1. W !,"which are conducted in the Medical Center.",!
  1. ;
  1. D DATE^IBOUTL I IBBDT=""!(IBEDT="") G ENQ
  1. ;
  1. W !!,"This report only requires an 80 column printer."
  1. ;
  1. W !!," Note: This report may take a while to run."
  1. W !?10,"You should queue this report to run after normal business hours.",!
  1. ;
  1. ; - select a device
  1. S %ZIS="QM" D ^%ZIS G:POP ENQ
  1. I $D(IO("Q")) D G ENQ
  1. .S ZTRTN="DQ^IBJDU1",ZTDESC="IB - UTILIZATION WORKLOAD REPORT"
  1. .F I="IBBDT","IBEDT" S ZTSAVE(I)=""
  1. .D ^%ZTLOAD
  1. .W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
  1. .K ZTSK,IO("Q") D HOME^%ZIS
  1. ;
  1. U IO
  1. ;
  1. DQ ; Tasked entry point.
  1. ;
  1. K IB F I=1:1:10 S IB(I)=0
  1. ;
  1. ; - count admissions within the user-specified date range
  1. S IBDT=IBBDT-.000000001,IBQ=0
  1. F S IBDT=$O(^DGPM("AMV1",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.24)) D Q:IBQ
  1. .S DFN=0 F S DFN=$O(^DGPM("AMV1",IBDT,DFN)) Q:'DFN D Q:IBQ
  1. ..S IBPM=0 F S IBPM=$O(^DGPM("AMV1",IBDT,DFN,IBPM)) Q:'IBPM D Q:IBQ
  1. ...;
  1. ...I IBPM#100=0 S IBQ=$$STOP^IBOUTL("Utilization Workload Report") Q:IBQ
  1. ...;
  1. ...S IB(1)=IB(1)+1 ; total admissions
  1. ...;
  1. ...Q:'$$INSURED^IBCNS1(DFN,IBDT)
  1. ...;
  1. ...S IB(2)=IB(2)+1 ; insured admissions
  1. ...D ELIG^VADPT
  1. ...I VAEL(3) S IB(3)=IB(3)+1 Q ; insured SC admissions
  1. ...S IB(4)=IB(4)+1 ; insured NSC admissions
  1. ;
  1. I IBQ G ENQ
  1. ;
  1. ; - count insurance reviews
  1. K ^TMP("IBJDU1",$J)
  1. S IBDT=IBBDT-.000000001
  1. F S IBDT=$O(^IBT(356.2,"B",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.9)) D Q:IBQ
  1. .S IBTRC=0 F S IBTRC=$O(^IBT(356.2,"B",IBDT,IBTRC)) Q:'IBTRC D Q:IBQ
  1. ..;
  1. ..I IBTRC#100=0 S IBQ=$$STOP^IBOUTL("Utilization Workload Report") Q:IBQ
  1. ..;
  1. ..S IBTRCD=$G(^IBT(356.2,+IBTRC,0)) Q:IBTRCD=""
  1. ..S IBTRN=$P(IBTRCD,"^",2)
  1. ..Q:$P(IBTRCD,"^",19)<10 ; review is not complete
  1. ..Q:'IBTRN ; no corresponding CT entry
  1. ..S IBPM=$P($G(^IBT(356,IBTRN,0)),"^",5)
  1. ..Q:'IBPM ; review not for an admission
  1. ..;
  1. ..; - get contact type
  1. ..S IBRTY=$P($G(^IBE(356.11,+$P(IBTRCD,"^",4),0)),"^",2)
  1. ..;
  1. ..; - appeals
  1. ..I IBRTY=60!(IBRTY=65) D Q
  1. ...I '$D(^TMP("IBJDU1",$J,IBTRN)) S ^(IBTRN)="",IB(10)=IB(10)+1
  1. ..;
  1. ..; - admission reviews
  1. ..I IBRTY=10!(IBRTY=15)!(IBRTY=20) D Q
  1. ...S IB(5)=IB(5)+1
  1. ...;
  1. ...; - count reviews where the entire admission was denied
  1. ...Q:'$P($G(^IBT(356.2,IBTRC,1)),"^",7)
  1. ...;
  1. ...S IB(7)=IB(7)+1
  1. ...S X=$G(^DGPM(IBPM,0)),Y=+$G(^DGPM(+$P(X,"^",17),0))\1
  1. ...S:'Y Y=DT
  1. ...S IB(9)=IB(9)+$$FMDIFF^XLFDT(Y,+X\1)
  1. ..;
  1. ..; - continued stay reviews
  1. ..I IBRTY=30 D
  1. ...S IB(6)=IB(6)+1
  1. ...;
  1. ...; - look at denials
  1. ...Q:$P($G(^IBE(356.7,+$P(IBTRCD,"^",11),1)),"^",3)'=20
  1. ...S IB(8)=IB(8)+1
  1. ...S X=$P(IBTRCD,"^",15),Y=$P(IBTRCD,"^",16) S:'Y Y=X
  1. ...I X S IB(9)=IB(9)+$$FMDIFF^XLFDT(Y,X)+1
  1. ;
  1. I IBQ G ENQ
  1. ;
  1. ; - print the reports
  1. S (IBPAG,IBQ)=0 D NOW^%DTC S IBRUN=$$DAT2^IBOUTL(%)
  1. D SUM
  1. ;
  1. ENQ K ^TMP("IBJDU1",$J)
  1. I $D(ZTQUEUED) S ZTREQ="@" G ENQ1
  1. ;
  1. D ^%ZISC
  1. ENQ1 K IB,IBQ,IBBDT,IBEDT,IBDT,IBPM,IBPAG,IBRUN,IBTRC,IBTRCD,IBTRN,IBRTY
  1. K %,%ZIS,DFN,IBPERI,IBPERS,POP,X,Y,VA,VAERR,VAEL,ZTDESC,ZTRTN,ZTSAVE
  1. Q
  1. ;
  1. ;
  1. ;
  1. SUM ; Print the Summary Report.
  1. I $E(IOST,1,2)="C-" W @IOF,*13
  1. ;
  1. ; - print overall summary header
  1. W !!?30,"UTILIZATION WORKLOAD"
  1. W !?33,"SUMMARY REPORT"
  1. W !!?22,"For Reviews from ",$$DAT1^IBOUTL(IBBDT)," - ",$$DAT1^IBOUTL(IBEDT)
  1. W !!?24,"Run Date: ",IBRUN
  1. W !?24,$$DASH(31),!!
  1. ;
  1. ; - print overall summary statistics
  1. S IBPERI=$S('IB(1):0,1:$J(IB(2)/IB(1)*100,0,2))
  1. S IBPERS=$S('IB(2):0,1:$J(IB(3)/IB(2)*100,0,2))
  1. W ?21,"Total Number of Admissions:",?60,$J(IB(1),7)
  1. W !?6,"Total Number of Admissions with Insurance:",?60,$J(IB(2),7)," (",IBPERI,"%)"
  1. W !?39,"SC:",?60,$J(IB(3),7)," (",IBPERS,"%)"
  1. W !?38,"NSC:",?60,$J(IB(4),7)," (",$J(100-IBPERS,0,2),"%)"
  1. ;
  1. W !!?7,"Total Number of Admission Reviews completed"
  1. W !?9,"on Insurance Patients (including pre-certifications):",?65,$J(IB(5),7)
  1. W !?13,"Total Number of Continued Stay Reviews completed:",?65,$J(IB(6),7)
  1. W !?5,"Total Number of Admission Denials by Insurance Companies:",?65,$J(IB(7),7)
  1. W !,"Total Number of Continued Stay Denials by Insurance Companies:",?65,$J(IB(8),7)
  1. W !?11,"Total Number of days denied by Insurance Companies:",?65,$J(IB(9),7)
  1. W !?31,"Total Number of Appealed Cases:",?65,$J(IB(10),7)
  1. ;
  1. D PAUSE
  1. Q
  1. ;
  1. DASH(X) ; Return a dashed line.
  1. Q $TR($J("",X)," ","=")
  1. ;
  1. PAUSE ; Page break
  1. Q:$E(IOST,1,2)'="C-"
  1. N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
  1. F IBX=$Y:1:(IOSL-3) W !
  1. S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S IBQ=1
  1. Q