IBTOSUM ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ; 29-OCT-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
% I '$D(DT) D DT^DICRW
W !!,"MCCR/UR Summary Report",!!
S IBQUIT=0
;
; -- print either by admissions or discharges
SORT ; -- ask how they want it sorted
N DIR
S DIR(0)="SOBA^A:Admissions;D:Discharges"
S DIR("A")="Print Report By [A]dmissions [D]ischarges: "
S DIR("B")="D"
S DIR("?",1)="This summary report may be prepared by either Admissions or Discharges."
S DIR("?",2)="If you choose by discharge the report will contain information on all"
S DIR("?",3)="claims tracking information for the discharges that fall in the date"
S DIR("?",4)="Range. That is, all reviews for discharges found in the date range"
S DIR("?",5)="will be included in the report. If you choose by Admissions all"
S DIR("?",6)="reviews found in the date range will be included but the reviews"
S DIR("?",7)="may be for cases not related to the admissions."
S DIR("?",8)=" "
S DIR("?")="If you want to know the total reviews done during a date range sort by admissions. If you want to know the total reviews done on the discharges for a date range sort by Discharges"
D ^DIR K DIR
S IBSORT=Y I "AD"'[Y!($D(DIRUT)) G END
;
; -- get date range
W ! D DATE^IBOUTL
I IBBDT=""!(IBEDT="") G END
;
DEV ; -- select device, run option
W ! S %ZIS="QM" D ^%ZIS G:POP END
I $D(IO("Q")) S ZTRTN="RPT^IBTOSUM",ZTSAVE("IB*")="",ZTDESC="IB - MCCR/UR Summary Report" D ^%ZTLOAD K IO("Q"),ZTSK D HOME^%ZIS G END
U IO
;
RPT ; -- entry point from task man
; store data in ^tmp($j,"IBTOSUM",N)
K ^TMP($J)
S IBQUIT=0,IBPAG=0,Y=DT D D^DIQ S IBHDT=Y
F I=0:1:13 S IBCNT(I)=0
F I=20,21,80,81,82,99 S IBCNT(I)=0
F I=0:1:4 S IBCNT(30+I)=0
I IBSORT="A" D ADM
I IBSORT="D" D DIS
D CHK^IBTOSUM2
I $G(ZTSTOP) G END
;
D PRINT^IBTOSUM2
;
END ; -- Clean up
W !
I $D(IBCNT(1)),$E(IOST,1,2)="C-" D PAUSE^VALM1
K ^TMP($J)
I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
K X,X1,X2,X3,Y,%ZIS,POP,DA,DIRUT,DUOUT,IBRATE,IBBBS,IBSORT,IBC,IBPCNT,IBDCNT,IBMAX,IBCDT
K IBDT,IBBDT,IBEDT,IBQUIT,IBPAG,IBHDT,IBCNT,IBSPEC,IBINS,IBAC,IBPEN,IBPEND,IBTRN,IBTRND,IBTRC,IBTRCD,DFN,DGPM,IBNOD,IBDAY,IBFAC,IBSITE,IBSNM,X,Y,I,J
Q
;
ADM ; -- count admission
D CHK^IBTOSUM2 I $G(ZTSTOP) Q
S IBDT=IBBDT-.000000001
F S IBDT=$O(^DGPM("AMV1",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.24)) D
.S DFN=0 F S DFN=$O(^DGPM("AMV1",IBDT,DFN)) Q:'DFN D
..S DA=0 F S DA=$O(^DGPM("AMV1",IBDT,DFN,DA)) Q:'DA D PROC
..Q
.Q
Q
;
DIS ; -- count discharges
D CHK^IBTOSUM2 I $G(ZTSTOP) Q
S IBDT=IBBDT-.000000001
F S IBDT=$O(^DGPM("AMV3",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.24)) D
.S DFN=0 F S DFN=$O(^DGPM("AMV3",IBDT,DFN)) Q:'DFN D
..S DA=0 F S DA=$O(^DGPM("AMV3",IBDT,DFN,DA)) Q:'DA D PROC
..Q
.Q
Q
;
PROC ; -- Process each admission or discharge
S DGPM=$P($G(^DGPM(DA,0)),"^",14)
S IBCNT(1)=IBCNT(1)+1 ; count of admsisions or discharges
S IBTRN=$O(^IBT(356,"AD",DGPM,0))
Q:'IBTRN
;
S IBTRND=$G(^IBT(356,+IBTRN,0)) ;W !,IBTRND
Q:'$P(IBTRND,"^",20) ; must be an active visit
;
Q:'$$INSURED^IBCNS1(DFN,IBDT) ; must be insured for visit to count
;
S IBCNT(2)=IBCNT(2)+1 ; count of insured admissions or discharges discharges
;
S IBCNT(3,+$P(IBTRND,"^",19))=$G(IBCNT(3,+$P(IBTRND,"^",19)))+1 ;count of billable
;
S X=$P($G(^IBT(356,+IBTRN,1)),"^",7) I X>3 S IBCNT(4)=IBCNT(4)+1
I X="",$P(IBTRND,"^",24),'$P(IBTRND,"^",19) S IBCNT(4)=IBCNT(4)+1 ;reviews required
;
I $$APPEAL(IBTRN) S IBCNT(80)=IBCNT(80)+1
;
K IBDCNT,IBPCNT
S IBTRC=0 F S IBTRC=$O(^IBT(356.2,"C",IBTRN,IBTRC)) Q:'IBTRC D RCNT^IBTOSUM1
S:$D(IBPCNT(IBTRN)) IBCNT(99)=IBCNT(99)+1
S:$O(IBPCNT(IBTRN,+$O(IBPCNT(IBTRN,0)))) IBCNT(13)=IBCNT(13)+1 ;more than one policy per case
Q
;
APPEAL(IBTRN) ; -- was this case appealed:
;
N A,X
S A=0
I 'IBTRN G APPEALQ
S X=$O(^IBE(356.11,"ACODE",60,0)) ; initial appeal
I $O(^IBT(356.2,"ATRTP",IBTRN,X,0)) S A=1 G APPEALQ
S X=$O(^IBE(356.11,"ACODE",65,0)) ; subsequent appeal
I $O(^IBT(356.2,"ATRTP",IBTRN,X,0)) S A=1 G APPEALQ
APPEALQ Q A
IBTOSUM ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ; 29-OCT-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;
% IF '$DATA(DT)
DO DT^DICRW
+1 WRITE !!,"MCCR/UR Summary Report",!!
+2 SET IBQUIT=0
+3 ;
+4 ; -- print either by admissions or discharges
SORT ; -- ask how they want it sorted
+1 NEW DIR
+2 SET DIR(0)="SOBA^A:Admissions;D:Discharges"
+3 SET DIR("A")="Print Report By [A]dmissions [D]ischarges: "
+4 SET DIR("B")="D"
+5 SET DIR("?",1)="This summary report may be prepared by either Admissions or Discharges."
+6 SET DIR("?",2)="If you choose by discharge the report will contain information on all"
+7 SET DIR("?",3)="claims tracking information for the discharges that fall in the date"
+8 SET DIR("?",4)="Range. That is, all reviews for discharges found in the date range"
+9 SET DIR("?",5)="will be included in the report. If you choose by Admissions all"
+10 SET DIR("?",6)="reviews found in the date range will be included but the reviews"
+11 SET DIR("?",7)="may be for cases not related to the admissions."
+12 SET DIR("?",8)=" "
+13 SET DIR("?")="If you want to know the total reviews done during a date range sort by admissions. If you want to know the total reviews done on the discharges for a date range sort by Discharges"
+14 DO ^DIR
KILL DIR
+15 SET IBSORT=Y
IF "AD"'[Y!($DATA(DIRUT))
GOTO END
+16 ;
+17 ; -- get date range
+18 WRITE !
DO DATE^IBOUTL
+19 IF IBBDT=""!(IBEDT="")
GOTO END
+20 ;
DEV ; -- select device, run option
+1 WRITE !
SET %ZIS="QM"
DO ^%ZIS
IF POP
GOTO END
+2 IF $DATA(IO("Q"))
SET ZTRTN="RPT^IBTOSUM"
SET ZTSAVE("IB*")=""
SET ZTDESC="IB - MCCR/UR Summary Report"
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
DO HOME^%ZIS
GOTO END
+3 USE IO
+4 ;
RPT ; -- entry point from task man
+1 ; store data in ^tmp($j,"IBTOSUM",N)
+2 KILL ^TMP($JOB)
+3 SET IBQUIT=0
SET IBPAG=0
SET Y=DT
DO D^DIQ
SET IBHDT=Y
+4 FOR I=0:1:13
SET IBCNT(I)=0
+5 FOR I=20,21,80,81,82,99
SET IBCNT(I)=0
+6 FOR I=0:1:4
SET IBCNT(30+I)=0
+7 IF IBSORT="A"
DO ADM
+8 IF IBSORT="D"
DO DIS
+9 DO CHK^IBTOSUM2
+10 IF $GET(ZTSTOP)
GOTO END
+11 ;
+12 DO PRINT^IBTOSUM2
+13 ;
END ; -- Clean up
+1 WRITE !
+2 IF $DATA(IBCNT(1))
IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE^VALM1
+3 KILL ^TMP($JOB)
+4 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+5 DO ^%ZISC
+6 KILL X,X1,X2,X3,Y,%ZIS,POP,DA,DIRUT,DUOUT,IBRATE,IBBBS,IBSORT,IBC,IBPCNT,IBDCNT,IBMAX,IBCDT
+7 KILL IBDT,IBBDT,IBEDT,IBQUIT,IBPAG,IBHDT,IBCNT,IBSPEC,IBINS,IBAC,IBPEN,IBPEND,IBTRN,IBTRND,IBTRC,IBTRCD,DFN,DGPM,IBNOD,IBDAY,IBFAC,IBSITE,IBSNM,X,Y,I,J
+8 QUIT
+9 ;
ADM ; -- count admission
+1 DO CHK^IBTOSUM2
IF $GET(ZTSTOP)
QUIT
+2 SET IBDT=IBBDT-.000000001
+3 FOR
SET IBDT=$ORDER(^DGPM("AMV1",IBDT))
IF 'IBDT!(IBDT>(IBEDT+.24))
QUIT
Begin DoDot:1
+4 SET DFN=0
FOR
SET DFN=$ORDER(^DGPM("AMV1",IBDT,DFN))
IF 'DFN
QUIT
Begin DoDot:2
+5 SET DA=0
FOR
SET DA=$ORDER(^DGPM("AMV1",IBDT,DFN,DA))
IF 'DA
QUIT
DO PROC
+6 QUIT
End DoDot:2
+7 QUIT
End DoDot:1
+8 QUIT
+9 ;
DIS ; -- count discharges
+1 DO CHK^IBTOSUM2
IF $GET(ZTSTOP)
QUIT
+2 SET IBDT=IBBDT-.000000001
+3 FOR
SET IBDT=$ORDER(^DGPM("AMV3",IBDT))
IF 'IBDT!(IBDT>(IBEDT+.24))
QUIT
Begin DoDot:1
+4 SET DFN=0
FOR
SET DFN=$ORDER(^DGPM("AMV3",IBDT,DFN))
IF 'DFN
QUIT
Begin DoDot:2
+5 SET DA=0
FOR
SET DA=$ORDER(^DGPM("AMV3",IBDT,DFN,DA))
IF 'DA
QUIT
DO PROC
+6 QUIT
End DoDot:2
+7 QUIT
End DoDot:1
+8 QUIT
+9 ;
PROC ; -- Process each admission or discharge
+1 SET DGPM=$PIECE($GET(^DGPM(DA,0)),"^",14)
+2 ; count of admsisions or discharges
SET IBCNT(1)=IBCNT(1)+1
+3 SET IBTRN=$ORDER(^IBT(356,"AD",DGPM,0))
+4 IF 'IBTRN
QUIT
+5 ;
+6 ;W !,IBTRND
SET IBTRND=$GET(^IBT(356,+IBTRN,0))
+7 ; must be an active visit
IF '$PIECE(IBTRND,"^",20)
QUIT
+8 ;
+9 ; must be insured for visit to count
IF '$$INSURED^IBCNS1(DFN,IBDT)
QUIT
+10 ;
+11 ; count of insured admissions or discharges discharges
SET IBCNT(2)=IBCNT(2)+1
+12 ;
+13 ;count of billable
SET IBCNT(3,+$PIECE(IBTRND,"^",19))=$GET(IBCNT(3,+$PIECE(IBTRND,"^",19)))+1
+14 ;
+15 SET X=$PIECE($GET(^IBT(356,+IBTRN,1)),"^",7)
IF X>3
SET IBCNT(4)=IBCNT(4)+1
+16 ;reviews required
IF X=""
IF $PIECE(IBTRND,"^",24)
IF '$PIECE(IBTRND,"^",19)
SET IBCNT(4)=IBCNT(4)+1
+17 ;
+18 IF $$APPEAL(IBTRN)
SET IBCNT(80)=IBCNT(80)+1
+19 ;
+20 KILL IBDCNT,IBPCNT
+21 SET IBTRC=0
FOR
SET IBTRC=$ORDER(^IBT(356.2,"C",IBTRN,IBTRC))
IF 'IBTRC
QUIT
DO RCNT^IBTOSUM1
+22 IF $DATA(IBPCNT(IBTRN))
SET IBCNT(99)=IBCNT(99)+1
+23 ;more than one policy per case
IF $ORDER(IBPCNT(IBTRN,+$ORDER(IBPCNT(IBTRN,0))))
SET IBCNT(13)=IBCNT(13)+1
+24 QUIT
+25 ;
APPEAL(IBTRN) ; -- was this case appealed:
+1 ;
+2 NEW A,X
+3 SET A=0
+4 IF 'IBTRN
GOTO APPEALQ
+5 ; initial appeal
SET X=$ORDER(^IBE(356.11,"ACODE",60,0))
+6 IF $ORDER(^IBT(356.2,"ATRTP",IBTRN,X,0))
SET A=1
GOTO APPEALQ
+7 ; subsequent appeal
SET X=$ORDER(^IBE(356.11,"ACODE",65,0))
+8 IF $ORDER(^IBT(356.2,"ATRTP",IBTRN,X,0))
SET A=1
GOTO APPEALQ
APPEALQ QUIT A
