IBTOSUM.m

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