- IBJDU1 ;ALB/CPM - UTILIZATION WORKLOAD REPORT ; 24-DEC-96
- ;;Version 2.0 ; INTEGRATED BILLING ;**69**; 21-MAR-94
- ;
- EN ; Option entry point.
- ;
- W !!,"This report provides a measure of the number of Insurance Reviews"
- W !,"which are conducted in the Medical Center.",!
- ;
- D DATE^IBOUTL I IBBDT=""!(IBEDT="") G ENQ
- ;
- W !!,"This report only requires an 80 column printer."
- ;
- W !!," Note: This report may take a while to run."
- W !?10,"You should queue this report to run after normal business hours.",!
- ;
- ; - select a device
- S %ZIS="QM" D ^%ZIS G:POP ENQ
- I $D(IO("Q")) D G ENQ
- .S ZTRTN="DQ^IBJDU1",ZTDESC="IB - UTILIZATION WORKLOAD REPORT"
- .F I="IBBDT","IBEDT" S ZTSAVE(I)=""
- .D ^%ZTLOAD
- .W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
- .K ZTSK,IO("Q") D HOME^%ZIS
- ;
- U IO
- ;
- DQ ; Tasked entry point.
- ;
- K IB F I=1:1:10 S IB(I)=0
- ;
- ; - count admissions within the user-specified date range
- S IBDT=IBBDT-.000000001,IBQ=0
- F S IBDT=$O(^DGPM("AMV1",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.24)) D Q:IBQ
- .S DFN=0 F S DFN=$O(^DGPM("AMV1",IBDT,DFN)) Q:'DFN D Q:IBQ
- ..S IBPM=0 F S IBPM=$O(^DGPM("AMV1",IBDT,DFN,IBPM)) Q:'IBPM D Q:IBQ
- ...;
- ...I IBPM#100=0 S IBQ=$$STOP^IBOUTL("Utilization Workload Report") Q:IBQ
- ...;
- ...S IB(1)=IB(1)+1 ; total admissions
- ...;
- ...Q:'$$INSURED^IBCNS1(DFN,IBDT)
- ...;
- ...S IB(2)=IB(2)+1 ; insured admissions
- ...D ELIG^VADPT
- ...I VAEL(3) S IB(3)=IB(3)+1 Q ; insured SC admissions
- ...S IB(4)=IB(4)+1 ; insured NSC admissions
- ;
- I IBQ G ENQ
- ;
- ; - count insurance reviews
- K ^TMP("IBJDU1",$J)
- S IBDT=IBBDT-.000000001
- F S IBDT=$O(^IBT(356.2,"B",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.9)) D Q:IBQ
- .S IBTRC=0 F S IBTRC=$O(^IBT(356.2,"B",IBDT,IBTRC)) Q:'IBTRC D Q:IBQ
- ..;
- ..I IBTRC#100=0 S IBQ=$$STOP^IBOUTL("Utilization Workload Report") Q:IBQ
- ..;
- ..S IBTRCD=$G(^IBT(356.2,+IBTRC,0)) Q:IBTRCD=""
- ..S IBTRN=$P(IBTRCD,"^",2)
- ..Q:$P(IBTRCD,"^",19)<10 ; review is not complete
- ..Q:'IBTRN ; no corresponding CT entry
- ..S IBPM=$P($G(^IBT(356,IBTRN,0)),"^",5)
- ..Q:'IBPM ; review not for an admission
- ..;
- ..; - get contact type
- ..S IBRTY=$P($G(^IBE(356.11,+$P(IBTRCD,"^",4),0)),"^",2)
- ..;
- ..; - appeals
- ..I IBRTY=60!(IBRTY=65) D Q
- ...I '$D(^TMP("IBJDU1",$J,IBTRN)) S ^(IBTRN)="",IB(10)=IB(10)+1
- ..;
- ..; - admission reviews
- ..I IBRTY=10!(IBRTY=15)!(IBRTY=20) D Q
- ...S IB(5)=IB(5)+1
- ...;
- ...; - count reviews where the entire admission was denied
- ...Q:'$P($G(^IBT(356.2,IBTRC,1)),"^",7)
- ...;
- ...S IB(7)=IB(7)+1
- ...S X=$G(^DGPM(IBPM,0)),Y=+$G(^DGPM(+$P(X,"^",17),0))\1
- ...S:'Y Y=DT
- ...S IB(9)=IB(9)+$$FMDIFF^XLFDT(Y,+X\1)
- ..;
- ..; - continued stay reviews
- ..I IBRTY=30 D
- ...S IB(6)=IB(6)+1
- ...;
- ...; - look at denials
- ...Q:$P($G(^IBE(356.7,+$P(IBTRCD,"^",11),1)),"^",3)'=20
- ...S IB(8)=IB(8)+1
- ...S X=$P(IBTRCD,"^",15),Y=$P(IBTRCD,"^",16) S:'Y Y=X
- ...I X S IB(9)=IB(9)+$$FMDIFF^XLFDT(Y,X)+1
- ;
- I IBQ G ENQ
- ;
- ; - print the reports
- S (IBPAG,IBQ)=0 D NOW^%DTC S IBRUN=$$DAT2^IBOUTL(%)
- D SUM
- ;
- ENQ K ^TMP("IBJDU1",$J)
- I $D(ZTQUEUED) S ZTREQ="@" G ENQ1
- ;
- D ^%ZISC
- ENQ1 K IB,IBQ,IBBDT,IBEDT,IBDT,IBPM,IBPAG,IBRUN,IBTRC,IBTRCD,IBTRN,IBRTY
- K %,%ZIS,DFN,IBPERI,IBPERS,POP,X,Y,VA,VAERR,VAEL,ZTDESC,ZTRTN,ZTSAVE
- Q
- ;
- ;
- ;
- SUM ; Print the Summary Report.
- I $E(IOST,1,2)="C-" W @IOF,*13
- ;
- ; - print overall summary header
- W !!?30,"UTILIZATION WORKLOAD"
- W !?33,"SUMMARY REPORT"
- W !!?22,"For Reviews from ",$$DAT1^IBOUTL(IBBDT)," - ",$$DAT1^IBOUTL(IBEDT)
- W !!?24,"Run Date: ",IBRUN
- W !?24,$$DASH(31),!!
- ;
- ; - print overall summary statistics
- S IBPERI=$S('IB(1):0,1:$J(IB(2)/IB(1)*100,0,2))
- S IBPERS=$S('IB(2):0,1:$J(IB(3)/IB(2)*100,0,2))
- W ?21,"Total Number of Admissions:",?60,$J(IB(1),7)
- W !?6,"Total Number of Admissions with Insurance:",?60,$J(IB(2),7)," (",IBPERI,"%)"
- W !?39,"SC:",?60,$J(IB(3),7)," (",IBPERS,"%)"
- W !?38,"NSC:",?60,$J(IB(4),7)," (",$J(100-IBPERS,0,2),"%)"
- ;
- W !!?7,"Total Number of Admission Reviews completed"
- W !?9,"on Insurance Patients (including pre-certifications):",?65,$J(IB(5),7)
- W !?13,"Total Number of Continued Stay Reviews completed:",?65,$J(IB(6),7)
- W !?5,"Total Number of Admission Denials by Insurance Companies:",?65,$J(IB(7),7)
- W !,"Total Number of Continued Stay Denials by Insurance Companies:",?65,$J(IB(8),7)
- W !?11,"Total Number of days denied by Insurance Companies:",?65,$J(IB(9),7)
- W !?31,"Total Number of Appealed Cases:",?65,$J(IB(10),7)
- ;
- D PAUSE
- Q
- ;
- DASH(X) ; Return a dashed line.
- Q $TR($J("",X)," ","=")
- ;
- PAUSE ; Page break
- Q:$E(IOST,1,2)'="C-"
- N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
- F IBX=$Y:1:(IOSL-3) W !
- S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S IBQ=1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJDU1 4962 printed Jan 18, 2025@03:24:37 Page 2
- IBJDU1 ;ALB/CPM - UTILIZATION WORKLOAD REPORT ; 24-DEC-96
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;**69**; 21-MAR-94
- +2 ;
- EN ; Option entry point.
- +1 ;
- +2 WRITE !!,"This report provides a measure of the number of Insurance Reviews"
- +3 WRITE !,"which are conducted in the Medical Center.",!
- +4 ;
- +5 DO DATE^IBOUTL
- IF IBBDT=""!(IBEDT="")
- GOTO ENQ
- +6 ;
- +7 WRITE !!,"This report only requires an 80 column printer."
- +8 ;
- +9 WRITE !!," Note: This report may take a while to run."
- +10 WRITE !?10,"You should queue this report to run after normal business hours.",!
- +11 ;
- +12 ; - select a device
- +13 SET %ZIS="QM"
- DO ^%ZIS
- if POP
- GOTO ENQ
- +14 IF $DATA(IO("Q"))
- Begin DoDot:1
- +15 SET ZTRTN="DQ^IBJDU1"
- SET ZTDESC="IB - UTILIZATION WORKLOAD REPORT"
- +16 FOR I="IBBDT","IBEDT"
- SET ZTSAVE(I)=""
- +17 DO ^%ZTLOAD
- +18 WRITE !!,$SELECT($DATA(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
- +19 KILL ZTSK,IO("Q")
- DO HOME^%ZIS
- End DoDot:1
- GOTO ENQ
- +20 ;
- +21 USE IO
- +22 ;
- DQ ; Tasked entry point.
- +1 ;
- +2 KILL IB
- FOR I=1:1:10
- SET IB(I)=0
- +3 ;
- +4 ; - count admissions within the user-specified date range
- +5 SET IBDT=IBBDT-.000000001
- SET IBQ=0
- +6 FOR
- SET IBDT=$ORDER(^DGPM("AMV1",IBDT))
- if 'IBDT!(IBDT>(IBEDT+.24))
- QUIT
- Begin DoDot:1
- +7 SET DFN=0
- FOR
- SET DFN=$ORDER(^DGPM("AMV1",IBDT,DFN))
- if 'DFN
- QUIT
- Begin DoDot:2
- +8 SET IBPM=0
- FOR
- SET IBPM=$ORDER(^DGPM("AMV1",IBDT,DFN,IBPM))
- if 'IBPM
- QUIT
- Begin DoDot:3
- +9 ;
- +10 IF IBPM#100=0
- SET IBQ=$$STOP^IBOUTL("Utilization Workload Report")
- if IBQ
- QUIT
- +11 ;
- +12 ; total admissions
- SET IB(1)=IB(1)+1
- +13 ;
- +14 if '$$INSURED^IBCNS1(DFN,IBDT)
- QUIT
- +15 ;
- +16 ; insured admissions
- SET IB(2)=IB(2)+1
- +17 DO ELIG^VADPT
- +18 ; insured SC admissions
- IF VAEL(3)
- SET IB(3)=IB(3)+1
- QUIT
- +19 ; insured NSC admissions
- SET IB(4)=IB(4)+1
- End DoDot:3
- if IBQ
- QUIT
- End DoDot:2
- if IBQ
- QUIT
- End DoDot:1
- if IBQ
- QUIT
- +20 ;
- +21 IF IBQ
- GOTO ENQ
- +22 ;
- +23 ; - count insurance reviews
- +24 KILL ^TMP("IBJDU1",$JOB)
- +25 SET IBDT=IBBDT-.000000001
- +26 FOR
- SET IBDT=$ORDER(^IBT(356.2,"B",IBDT))
- if 'IBDT!(IBDT>(IBEDT+.9))
- QUIT
- Begin DoDot:1
- +27 SET IBTRC=0
- FOR
- SET IBTRC=$ORDER(^IBT(356.2,"B",IBDT,IBTRC))
- if 'IBTRC
- QUIT
- Begin DoDot:2
- +28 ;
- +29 IF IBTRC#100=0
- SET IBQ=$$STOP^IBOUTL("Utilization Workload Report")
- if IBQ
- QUIT
- +30 ;
- +31 SET IBTRCD=$GET(^IBT(356.2,+IBTRC,0))
- if IBTRCD=""
- QUIT
- +32 SET IBTRN=$PIECE(IBTRCD,"^",2)
- +33 ; review is not complete
- if $PIECE(IBTRCD,"^",19)<10
- QUIT
- +34 ; no corresponding CT entry
- if 'IBTRN
- QUIT
- +35 SET IBPM=$PIECE($GET(^IBT(356,IBTRN,0)),"^",5)
- +36 ; review not for an admission
- if 'IBPM
- QUIT
- +37 ;
- +38 ; - get contact type
- +39 SET IBRTY=$PIECE($GET(^IBE(356.11,+$PIECE(IBTRCD,"^",4),0)),"^",2)
- +40 ;
- +41 ; - appeals
- +42 IF IBRTY=60!(IBRTY=65)
- Begin DoDot:3
- +43 IF '$DATA(^TMP("IBJDU1",$JOB,IBTRN))
- SET ^(IBTRN)=""
- SET IB(10)=IB(10)+1
- End DoDot:3
- QUIT
- +44 ;
- +45 ; - admission reviews
- +46 IF IBRTY=10!(IBRTY=15)!(IBRTY=20)
- Begin DoDot:3
- +47 SET IB(5)=IB(5)+1
- +48 ;
- +49 ; - count reviews where the entire admission was denied
- +50 if '$PIECE($GET(^IBT(356.2,IBTRC,1)),"^",7)
- QUIT
- +51 ;
- +52 SET IB(7)=IB(7)+1
- +53 SET X=$GET(^DGPM(IBPM,0))
- SET Y=+$GET(^DGPM(+$PIECE(X,"^",17),0))\1
- +54 if 'Y
- SET Y=DT
- +55 SET IB(9)=IB(9)+$$FMDIFF^XLFDT(Y,+X\1)
- End DoDot:3
- QUIT
- +56 ;
- +57 ; - continued stay reviews
- +58 IF IBRTY=30
- Begin DoDot:3
- +59 SET IB(6)=IB(6)+1
- +60 ;
- +61 ; - look at denials
- +62 if $PIECE($GET(^IBE(356.7,+$PIECE(IBTRCD,"^",11),1)),"^",3)'=20
- QUIT
- +63 SET IB(8)=IB(8)+1
- +64 SET X=$PIECE(IBTRCD,"^",15)
- SET Y=$PIECE(IBTRCD,"^",16)
- if 'Y
- SET Y=X
- +65 IF X
- SET IB(9)=IB(9)+$$FMDIFF^XLFDT(Y,X)+1
- End DoDot:3
- End DoDot:2
- if IBQ
- QUIT
- End DoDot:1
- if IBQ
- QUIT
- +66 ;
- +67 IF IBQ
- GOTO ENQ
- +68 ;
- +69 ; - print the reports
- +70 SET (IBPAG,IBQ)=0
- DO NOW^%DTC
- SET IBRUN=$$DAT2^IBOUTL(%)
- +71 DO SUM
- +72 ;
- ENQ KILL ^TMP("IBJDU1",$JOB)
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- GOTO ENQ1
- +2 ;
- +3 DO ^%ZISC
- ENQ1 KILL IB,IBQ,IBBDT,IBEDT,IBDT,IBPM,IBPAG,IBRUN,IBTRC,IBTRCD,IBTRN,IBRTY
- +1 KILL %,%ZIS,DFN,IBPERI,IBPERS,POP,X,Y,VA,VAERR,VAEL,ZTDESC,ZTRTN,ZTSAVE
- +2 QUIT
- +3 ;
- +4 ;
- +5 ;
- SUM ; Print the Summary Report.
- +1 IF $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF,*13
- +2 ;
- +3 ; - print overall summary header
- +4 WRITE !!?30,"UTILIZATION WORKLOAD"
- +5 WRITE !?33,"SUMMARY REPORT"
- +6 WRITE !!?22,"For Reviews from ",$$DAT1^IBOUTL(IBBDT)," - ",$$DAT1^IBOUTL(IBEDT)
- +7 WRITE !!?24,"Run Date: ",IBRUN
- +8 WRITE !?24,$$DASH(31),!!
- +9 ;
- +10 ; - print overall summary statistics
- +11 SET IBPERI=$SELECT('IB(1):0,1:$JUSTIFY(IB(2)/IB(1)*100,0,2))
- +12 SET IBPERS=$SELECT('IB(2):0,1:$JUSTIFY(IB(3)/IB(2)*100,0,2))
- +13 WRITE ?21,"Total Number of Admissions:",?60,$JUSTIFY(IB(1),7)
- +14 WRITE !?6,"Total Number of Admissions with Insurance:",?60,$JUSTIFY(IB(2),7)," (",IBPERI,"%)"
- +15 WRITE !?39,"SC:",?60,$JUSTIFY(IB(3),7)," (",IBPERS,"%)"
- +16 WRITE !?38,"NSC:",?60,$JUSTIFY(IB(4),7)," (",$JUSTIFY(100-IBPERS,0,2),"%)"
- +17 ;
- +18 WRITE !!?7,"Total Number of Admission Reviews completed"
- +19 WRITE !?9,"on Insurance Patients (including pre-certifications):",?65,$JUSTIFY(IB(5),7)
- +20 WRITE !?13,"Total Number of Continued Stay Reviews completed:",?65,$JUSTIFY(IB(6),7)
- +21 WRITE !?5,"Total Number of Admission Denials by Insurance Companies:",?65,$JUSTIFY(IB(7),7)
- +22 WRITE !,"Total Number of Continued Stay Denials by Insurance Companies:",?65,$JUSTIFY(IB(8),7)
- +23 WRITE !?11,"Total Number of days denied by Insurance Companies:",?65,$JUSTIFY(IB(9),7)
- +24 WRITE !?31,"Total Number of Appealed Cases:",?65,$JUSTIFY(IB(10),7)
- +25 ;
- +26 DO PAUSE
- +27 QUIT
- +28 ;
- DASH(X) ; Return a dashed line.
- +1 QUIT $TRANSLATE($JUSTIFY("",X)," ","=")
- +2 ;
- PAUSE ; Page break
- +1 if $EXTRACT(IOST,1,2)'="C-"
- QUIT
- +2 NEW IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
- +3 FOR IBX=$Y:1:(IOSL-3)
- WRITE !
- +4 SET DIR(0)="E"
- DO ^DIR
- IF $DATA(DIRUT)!($DATA(DUOUT))
- SET IBQ=1
- +5 QUIT